Clean up the code

Removed unwanted diffs introduced by a series of modifications

frege/compiler/Classes.fr

@@ -261,7 +261,7 @@ passC = do
         mkanno csym mpos osym ssym = do
             g <- getST
             i <- uniqid
-            let newvar = TVar{pos=mpos, var=noClashIdent ("t" ++ show i), kind = KVar}
+            let newvar = TVar {pos=mpos, var=noClashIdent ("t" ++ show i), kind = KVar}
                 oldvar = ssym.clvar.var
                 thsvar = csym.clvar.var
                 tree1  = TreeMap.insert empty oldvar csym.clvar
@@ -749,7 +749,7 @@ tcInstMethod (sc:scs) isym msym = do
                         case msym of
                             SymMeth.V msymv -> changeSym $ SymbolT.V msymv.{typ = msig, anno = true}
                             _ -> pure ()
-                    _ -> E.fatal isym.pos $ msgdoc $ "RhoTau expected, got " ++ rhotau.nicer g
+                    other -> E.fatal isym.pos (msgdoc ("RhoTau expected, got " ++ rhotau.nicer g))
             Just (SymMeth.V (symv@SymV {typ=sig})) -> do -- isPSigma sig == true
                     E.fatal symv.pos (text (symv.nice g ++ " of " ++ sc.nice g ++ " is not annotated"))
             -- Some class has a default method that links somewhere else

frege/compiler/Kinds.fr

@@ -122,7 +122,7 @@ kiSigmaX sigma kind = do
 
 substSigmaBound (ForAll bound rho) e = ForAll new rho
     where
-        new = [ tv.{kind=k} | tv <- bound, k <- lookup tv.var e ]
+        new = [ tv.{kind=k} | tv ← bound, k ← lookup tv.var e ]
 
 kiRhoX :: Rho -> Envs -> Kind -> StG (Rho, Envs, Kind)
 kiRhoX (RhoT.Tau it) env kind = do
@@ -198,9 +198,9 @@ substCtxKind :: TreeMap String (KindT β) -> ContextT β -> ContextT β
 substCtxKind env it = it.{tau <- substTauKind env}
 
 substTauKind :: TreeMap String (KindT β) -> TauT β -> TauT β
-substTauKind env (TauT.Var it) = case env.lookup it.var of
-    Just kind -> TauT.Var it.{kind}
-    _         -> TauT.Var it
+substTauKind env (TauT.Var it) = TauT.Var $ case env.lookup it.var of
+    Just kind -> it.{kind}
+    _         -> it    
 substTauKind env (TApp a b)  = TApp (substTauKind env a) (substTauKind env b)
 substTauKind env tau         = tau
 
@@ -251,12 +251,12 @@ unifyTauKind names env (TauT.Var tvar) exp
               case unifyKind tvar.kind exp of
                 Nothing → do 
                     g ← getST
-                    E.error tvar.pos (text ("kind error, wildcard `"
+                    E.error tvar.pos (text ("kind error, wildcard `" 
                                         ++ "` has kind " 
                                         ++ nicer tvar.kind g
                                         ++ ", expected was " ++ nicer exp g))
                     pure (tvar.kind, env')
-                Just _ -> pure (tvar.kind, env')
+                Just _ → pure (tvar.kind, env')                   
 unifyTauKind names env (TauT.Var TVar{pos,var,kind}) exp = do
         g <- getST
         E.logmsg TRACEK pos (text ("unifyTauKind: " ++ var

frege/compiler/Typecheck.fr

@@ -180,7 +180,7 @@ pass = do
 
 --- e.g. @tc "Int"@ is the @'TCon' 'QName'@ with type constructor for @PreludeBase.Int@
 tc :: String -> TCon QName
-tc n = TCon{pos=Position.null, name=TName pPreludeBase n}
+tc n = TCon {pos=Position.null, name=TName pPreludeBase n}
 
 --- @tcTau = TauT.Con . tc@, for abbreviation
 tcTau :: String -> Tau
@@ -370,7 +370,7 @@ checkKind = correctK empty
         mapM_ (correctK subst) syms
         ex'  <-  mapEx false (correctKind subst) ex
         pure $ Right Let{env, ex = ex', typ = fmap (substSigma $ fmap TauT.Var subst) typ }
-    correctKind subst x = pure $ Left  x.{typ ← fmap (substSigma $ fmap TauT.Var subst)}
+    correctKind subst x = pure $ Left x.{typ <- fmap (substSigma $ fmap TauT.Var subst)}
 
 checkAmbiguous :: Symbol -> Sigma -> StG ()
 checkAmbiguous sym (ForAll bnd r) = do
@@ -746,7 +746,7 @@ approxRho :: Expr -> StG Rho
 approxRho (Lam {ex,pat}) = do
     sig <- case pat of
         PAnn{pat, typ} -> return typ
-        sonst          -> ForAll [] . RhoT.Tau . RhoTau [] <$> newMeta2 ("arg", KType)
+        _              -> ForAll [] . RhoT.Tau . RhoTau [] <$> newMeta2 ("arg", KType)
     rho <- approxRho ex
     pure $ RhoT.Fun $ RhoFun [] sig rho
 approxRho _ = newRhoTyVar ("res", KType)

frege/compiler/Utilities.fr

@@ -220,7 +220,7 @@ freeCtxTVars bnd coll cs = fold ctxTVars coll cs
 
 freeTauTVars :: [String] -> SigmaEnv t -> TauT t -> SigmaEnv t
 freeTauTVars bound collected (TauT.Var (tv@TVar{var,kind}))
-    | isJust (TauT.Var tv).wildTau = coll
+    | isJust tv.wildTau = coll
     | var `elem` bound = coll
     | otherwise = insert var tv coll
     where
@@ -434,13 +434,13 @@ private transSigma1 outer sigma = do
     case sigma of 
         ForAll bound rho -> do
                 inner ←  transBounds sigma.bound
-                let env = fold (\tm tv -> tm.insertS tv.var tv) outer inner
-                    unshadowedOuter = fold (\tm tv -> tm.delete tv.var) outer inner
+                let env = fold (\tm tv → tm.insertS tv.var tv) outer inner
+                    unshadowedOuter = fold (\tm tv → tm.delete tv.var) outer inner
                 rho <- transRho env rho
                 let freeTV = freeTVars (keys unshadowedOuter) rho   -- same as inner?
-                    innerMap = fold (\tm tv -> tm.insertS tv.var tv) TreeMap.empty inner
-                    newbound = [ maybe tv id (innerMap.lookupS tv.var) | tv <- freeTV ]
-                    constraints rho = case rho of
+                    innerMap = fold (\tm tv → tm.insertS tv.var tv) TreeMap.empty inner
+                    newbound = [ maybe tv id (innerMap.lookupS tv.var) | tv ← freeTV ]
+                    constraints rho = case rho of 
                         RhoT.Tau r -> (r.context, RhoT.Tau r.{context=[]})
                         RhoT.Fun r -> (r.context ++ subctx, RhoT.Fun r.{context=[], rho=subrho})
                                     where (subctx, subrho) = constraints r.rho

frege/compiler/common/ImpExp.fr

@@ -144,7 +144,7 @@ sigmaFromA :: JArray TauA -> JArray Tau -> JArray Rho -> SigmaA -> Sigma
 sigmaFromA karray tarray rarray SigmaA{bound, kinds, rho} 
     = ForAll 
         (zipWith 
-            (\var kind -> TVar{pos=Position.null, var, kind})
+            (\var kind -> TVar{pos=Position.null, var, kind}) 
             bound 
             (map kind kinds)) 
         rarray.[rho]

frege/compiler/common/Types.fr

@@ -40,9 +40,9 @@ unboundSigmaTvs' g (ForAll{rho}) acc = unboundRhoTvs' g rho acc
 
 --- accumulate unbound 'MetaTv's from the components of a 'Rho'
 unboundRhoTvs' g (RhoT.Fun r) acc =
-    unboundRhoTvs' g r.rho (
-        unboundSigmaTvs' g r.sigma (
-            fold (unboundCtxTvs' g) acc r.context))
+    unboundRhoTvs' g r.rho $
+        unboundSigmaTvs' g r.sigma $
+            fold (unboundCtxTvs' g) acc r.context
 unboundRhoTvs' g (RhoT.Tau r) acc =
     unboundTauTvs' g r.tau (fold (unboundCtxTvs' g) acc r.context)
 
@@ -231,9 +231,9 @@ substCtx t x  = x.{tau <- substTau t}
 -}
 tauKind :: Tau -> Kind
 tauKind app = case app.flat of
-    TauT.Var TVar{pos, kind, var}:_ -> kind
-    Meta Flexi{uid, hint, kind}:_   -> kind
-    other                           -> KType
+    TauT.Var TVar{kind}:_ -> kind
+    Meta Flexi{kind}:_    -> kind
+    other                 -> KType
 
 --- kindedness of a 'Sigma', based on enclosed 'Tau', see 'tauKind'
 sigmaKind (ForAll _ rho) = rhoKind rho
@@ -280,7 +280,7 @@ rhoKind (RhoT.Tau r) = tauKind r.tau
 
 avoidSigma avoid (ForAll tvs rho) = ForAll ntvs (avoidRho (\s -> avoid s ||  s `elem` new) rho')
     where
-        old = map _.var tvs  -- old variables
+        old = map _.var tvs                         -- old variables
         bads = filter avoid old                     -- the variables that need replacement
         safe s = not (avoid s) && s `notElem` old   -- check for a safe name
         salvage s = head
@@ -395,5 +395,5 @@ unifyTau t _ _ = t
  * which must be a valid substitution of the former (up to contexts).
  -}
 sigmaInst :: Sigma -> Sigma -> [Tau]
-sigmaInst sigma1 sigma2 = [ s | Just s <-  map (TreeMap.lookupS tree) (Sigma.vars sigma1) ]
+sigmaInst sigma1 sigma2 = [ s | Just s <- map (TreeMap.lookupS tree) (Sigma.vars sigma1) ]
     where tree = unifySigma sigma1 sigma2

frege/compiler/common/UnAlias.fr

@@ -95,10 +95,10 @@ unAlias g tau
 
                 -- substTau env (TFun a b)  = TFun (substTau env a) (substTau env b)
                 substTau :: TreeMap String (TauT β) -> TauT β -> TauT β
-                substTau env (TApp a b) = TApp (substTau env a) (substTau env b)
+                substTau env (TApp a b)  = TApp (substTau env a) (substTau env b)
                 substTau env (TauT.Var TVar{var})
-                    | Just tau <- lookup var env = tau
-                substTau env tau        = tau
+                    | Just tau <- lookup var env  = tau
+                substTau env tau         = tau
 
 
                 -- unify t (TFun a b) (TFun c d) = do

frege/compiler/gen/java/Common.fr

@@ -448,8 +448,8 @@ unifyJT ta tb subst = case ta  of
 
 --- type arguments for sigma type
 targs :: Global -> Sigma -> [JTVar]
-targs g = map (\tv -> targ g tv.var tv.kind) . Sigma.bound
-
+targs g = map (\tv → targ g tv.var tv.kind) . Sigma.bound
+             
 --- reconstruct & print Java code tokens
 reconstruct ∷ [Token] → StIO ()
 reconstruct xs = work xs

frege/compiler/gen/java/DataCode.fr

@@ -12,7 +12,7 @@ import Compiler.classes.Nice
 import Compiler.types.Global
 import Compiler.types.Symbols
 import Compiler.types.AbstractJava
-import Compiler.types.Types(TVar, pSigma)
+import Compiler.types.Types(pSigma)
 import Compiler.gen.java.VarCode(varCode)
 import Compiler.gen.java.Match(variantType, conGetter)
 import Compiler.gen.java.Common
@@ -234,7 +234,7 @@ simsalabim g sym jt gvars = JMethod{attr = attrs [JUnchecked, JPublic, JFinal],
         newtyp = jt.{gargs=map (TArg . _.var) unusedvars}
         -- just give the type variables different names for the return type,
         -- as this is an instance method
-        unusedvars = targs g sym.typ.{bound = zipWith TVar.{var=}
+        unusedvars = targs g sym.typ.{bound = zipWith _.{var=}
                                     sym.typ.bound
                                     (filter (`notElem` sym.typ.vars) (allBinders g))
                                     }

frege/compiler/gen/java/InstanceCode.fr

@@ -374,16 +374,16 @@ instFun symc symi mname = do
                 let otvs = filter ((`elem` symi.typ.vars) . _.var) cmem.typ.tvars
                     orep = filter (`notElem` (cmem.typ.vars)) (allBinders g)
                     substBound :: TreeMap String (TVar QName) -> [TVar QName] -> [TVar QName]
-                    substBound subst = map $ \tv -> maybe tv _.{kind=tv.kind} (lookup tv.var subst)
-                    subst1 = Map.fromList [ (tv.var, tv.{var=s}) | (s,tv) <- zip orep otvs]
+                    substBound subst xs = map (\tv -> maybe tv _.{kind=tv.kind} (lookup tv.var subst)) xs
+                    subst1 = Map.fromList [ (tv.var, tv.{var=s}) | (s,tv) ← zip orep otvs]
                     typ1 = ForAll (substBound subst1 cmem.typ.bound) (substRho (fmap TauT.Var subst1) cmem.typ.rho)
                 E.logmsg TRACEG symi.pos (
                         text "(1) renamed type :: "
                         <+> text (nicer typ1 g)
                     )
 
                 let cvar = substTVar subst1 symc.clvar
-                    withoutCVar = filter ((cvar.var !=) . _.var)
+                    withoutCVar  = filter ((!=) cvar.var . _.var)
                 E.logmsg TRACEG symi.pos (
                         text "(2) class var is now " <+> text (nicer cvar g)
                     )
@@ -402,7 +402,7 @@ instFun symc symi mname = do
                 E.logmsg TRACEG symi.pos (
                         text "(3j) java type of (3) :: " <+> text (show jty3))
 
-                let othertv = head (filter ((!= cvar.var) . _.var) typ3.tvars)
+                let othertv = head (filter ((!=cvar.var) . _.var) typ3.tvars)
                     instTau0 = (symItau symi).tau
                     instTau  = if special then TApp instTau0 (TauT.Var othertv) else instTau0
                     subst4 = Map.singleton cvar.var instTau

frege/compiler/gen/java/MethodCall.fr

@@ -5,7 +5,7 @@ import Data.TreeMap(TreeMap, values)
 import Data.List(elemBy)
 
 import frege.data.Monoid (First)
-import frege.compiler.common.Lens (Getting, _Just, preview, view)
+import frege.compiler.common.Lens (Getting, _Just, preview)
 
 import Compiler.Utilities as U()
 

frege/compiler/grammar/Frege.fr

@@ -6011,12 +6011,12 @@ private reduce226 =  liste
 private reduce227 =  \_\(fr,jv,ga)\col\t ->
                     NatDcl {pos=yyline fr, vis=Public, name=fr.value,
                                                 meth=jv, txs=t, isPure=false,
-                                                gargs = ga,
+                                                gargs = ga, 
                                                 doc=Nothing}
 ;
 private reduce229 =  ForAll [] 
 ;
-private reduce230 =  \_\vs\_\r -> ForAll vs r 
+private reduce230 =  \_\vs\_\r      -> ForAll  vs  r 
 ;
 private reduce232 =  \dot -> do
                                         when (Token.value dot != "•") do
@@ -6244,15 +6244,15 @@ private reduce297 =
 private reduce298 = 
         \dat\d\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d,
                                     jclas=jt, vars=[], defs=[],
-                                    gargs,
+                                    gargs,  
                                     isPure = pur, 
                                     doc=Nothing}
 
 ;
 private reduce299 = 
         \dat\d\ds\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d,
                                     jclas=jt, vars=ds, defs=[],
-                                    gargs,
+                                    gargs, 
                                     isPure = pur,
                                     doc=Nothing}
 
@@ -6344,7 +6344,7 @@ private reduce340 =  \t\i   \_\r -> TypDcl {pos=yyline i,
 private reduce341 =  \t\i\vs\_\r -> TypDcl {pos=yyline i, 
                                                             vis=Public, 
                                                             name=Token.value i, 
-                                                            vars=vs,
+                                                            vars=vs, 
                                                             typ = r, 
                                                             doc=Nothing}
 ;

frege/compiler/grammar/Frege.y

@@ -819,7 +819,7 @@ impurenativedef:
     NATIVE methodspec DCOLON sigexs { \_\(fr,jv,ga)\col\t ->
                     NatDcl {pos=yyline fr, vis=Public, name=fr.value,
                                                 meth=jv, txs=t, isPure=false,
-                                                gargs = ga,
+                                                gargs = ga, 
                                                 doc=Nothing}}
     ;
 
@@ -831,7 +831,7 @@ sigma:
     ;
 
 forall:
-    FORALL dvars mbdot rho        { \_\vs\_\r -> ForAll vs r }
+    FORALL dvars mbdot rho        { \_\vs\_\r      -> ForAll  vs  r }
     ;
 
 mbdot:
@@ -1103,14 +1103,14 @@ datajavainit:
     DATA CONID '=' nativepur nativespec {
         \dat\d\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d,
                                     jclas=jt, vars=[], defs=[],
-                                    gargs,
+                                    gargs,  
                                     isPure = pur, 
                                     doc=Nothing}
     }
     | DATA CONID dvars '=' nativepur nativespec {
         \dat\d\ds\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d,
                                     jclas=jt, vars=ds, defs=[],
-                                    gargs,
+                                    gargs, 
                                     isPure = pur,
                                     doc=Nothing}
     }
@@ -1225,7 +1225,7 @@ typedef:
     | TYPE CONID dvars '=' sigma { \t\i\vs\_\r -> TypDcl {pos=yyline i, 
                                                             vis=Public, 
                                                             name=Token.value i, 
-                                                            vars=vs,
+                                                            vars=vs, 
                                                             typ = r, 
                                                             doc=Nothing}}
     ;

frege/compiler/passes/Easy.fr

@@ -23,7 +23,6 @@ import  frege.compiler.Utilities  as  U(allourvars, allvars)
 import  frege.compiler.Typecheck  as  TC(checkRho, substInst, zonkExpr, zonkRigid)
 import  frege.compiler.tc.Util  as  TCU()
 import  frege.compiler.common.Trans
-
 {--
  * In this pass, we make sure that all expressions are in
  * a form we need for code generation. We say that an expression is, or is not /easy/.
@@ -185,8 +184,8 @@ recycle newpos expr rho = do
         g <- getST
         expr <- U.copyExpr (Just newpos) empty expr
         expr <- U.untypeExpr expr
-        let freevars = U.freeTVars [] rho
-            tvnames  = map _.var freevars
+        let freevars =  U.freeTVars [] rho
+            tvnames  =  map _.var freevars
         (metas, rho) <- TCU.skolemise (ForAll freevars rho)
         x <- checkRho expr rho
         -- foreach (zip metas freevars) (uncurry unInst)

frege/compiler/passes/Imp.fr

@@ -700,7 +700,7 @@ preludeBasics = do
     -- unnamed, undocumented field, strictness and type must be given
     aField = Field Position.null Nothing Nothing Public
     vars  = map ctos ['a' .. 'z']
-    varks = zipWith (\var kind -> TVar{pos=Position.null, var, kind}) vars (repeat KType)
+    varks = zipWith (\var kind → TVar{pos=Position.null, var, kind}) vars (repeat KType)
     tvars = map (mvar.{var=}) vars
     commas = repeat ','
     tuple n = "(" ++ packed (take (n-1) commas) ++ ")"

frege/compiler/passes/LetUnroll.fr

@@ -203,7 +203,7 @@ unLet (x@Let {env,ex})
             -- sym <- globalize sym
             g <- getST
             E.logmsg TRACE7 pos (text ("global: " ++ gsym.name.nice g ++ " = " ++ nice ex g))
-            let vks = U.freeTVars [] sym.typ.rho
+            let vks  =  U.freeTVars [] sym.typ.rho
             let typ = ForAll vks sym.typ.rho
             changeST Global.{sub <- SubSt.{
                                 idKind <- insert (KeyTk gsym.pos.first) (Right gsym.name)}}