diff --git a/gibbon-compiler/src/Gibbon/Compiler.hs b/gibbon-compiler/src/Gibbon/Compiler.hs index 6c2e8290..7a26220f 100644 --- a/gibbon-compiler/src/Gibbon/Compiler.hs +++ b/gibbon-compiler/src/Gibbon/Compiler.hs @@ -838,13 +838,13 @@ Also see Note [Adding dummy traversals] and Note [Adding random access nodes]. go :: PassRunner a b v go = pass config - goE2 :: (InterpProg Store b, Show v) => InterpPassRunner a b Store v + goE2 :: (InterpProg Store b Var, Show v) => InterpPassRunner a b Store v goE2 = passE emptyStore config - goE0 :: (InterpProg () b, Show v) => InterpPassRunner a b () v + goE0 :: (InterpProg () b Var, Show v) => InterpPassRunner a b () v goE0 = passE () config - goE1 :: (InterpProg () b, Show v) => InterpPassRunner a b () v + goE1 :: (InterpProg () b Var, Show v) => InterpPassRunner a b () v goE1 = passE () config type PassRunner a b v = (Pretty b, Out b, NFData a, NFData b) => @@ -852,7 +852,7 @@ type PassRunner a b v = (Pretty b, Out b, NFData a, NFData b) => type InterpPassRunner a b s v = (HasPretty a, HasPretty b, HasOut a, HasOut b, HasGeneric a, HasGeneric b, HasNFData a, HasNFData b) => - String -> (Prog a -> PassM (Prog b)) -> Prog a -> StateT (CompileState v) IO (Prog b) + String -> (Prog Var a -> PassM (Prog Var b)) -> Prog Var a -> StateT (CompileState v) IO (Prog Var b) -- | Run a pass and return the result -- @@ -882,7 +882,7 @@ passChatterLvl = 3 -- | Like 'pass', but also evaluates and checks the result. -- -passE :: (InterpProg s p2, Show v) => s -> Config -> InterpPassRunner p1 p2 s v +passE :: (InterpProg s p2 Var, Show v) => s -> Config -> InterpPassRunner p1 p2 s v passE s config@Config{mode} = wrapInterp s mode (pass config) @@ -896,7 +896,7 @@ passF = pass -- | Wrapper to enable running a pass AND interpreting the result. -- -wrapInterp :: (InterpProg s b, Show v) +wrapInterp :: (InterpProg s b Var, Show v) => s -> Mode -> InterpPassRunner a b s v -> InterpPassRunner a b s v wrapInterp s mode pass who fn x = do CompileState{result} <- get diff --git a/gibbon-compiler/src/Gibbon/L0/Specialize2.hs b/gibbon-compiler/src/Gibbon/L0/Specialize2.hs index 3bb8d693..103dd9b7 100644 --- a/gibbon-compiler/src/Gibbon/L0/Specialize2.hs +++ b/gibbon-compiler/src/Gibbon/L0/Specialize2.hs @@ -459,7 +459,7 @@ monoOblsTy ddefs1 t = do -- | Collect monomorphization obligations. -collectMonoObls :: DDefs0 -> Env2 Ty0 -> S.Set Var -> Exp0 -> MonoM Exp0 +collectMonoObls :: DDefs0 -> Env2 Var Ty0 -> S.Set Var -> Exp0 -> MonoM Exp0 collectMonoObls ddefs env2 toplevel ex = case ex of AppE f [] args -> do @@ -998,7 +998,7 @@ specLambdasFun ddefs new_fn_name refs fn@FunDef{funArgs, funTy} = do subst' old new ex = gRename (M.singleton old new) ex -specLambdasExp :: DDefs0 -> Env2 Ty0 -> Exp0 -> SpecM Exp0 +specLambdasExp :: DDefs0 -> Env2 Var Ty0 -> Exp0 -> SpecM Exp0 specLambdasExp ddefs env2 ex = case ex of -- TODO, docs. @@ -1204,7 +1204,7 @@ specLambdasExp ddefs env2 ex = _ -> False -- fn_0 (fn_1, thing, fn_2) => fn_0 (thing) - dropFunRefs :: Var -> Env2 Ty0 -> [Exp0] -> [Exp0] + dropFunRefs :: Var -> Env2 Var Ty0 -> [Exp0] -> [Exp0] dropFunRefs fn_name env21 args = foldr (\(a,t) acc -> if isFunTy t then acc else a:acc) [] (zip args arg_tys) where @@ -1737,7 +1737,7 @@ floatOutCase (Prog ddefs fundefs mainExp) = do where err1 msg = error $ "floatOutCase: " ++ msg - float_fn :: Env2 Ty0 -> Exp0 -> FloatM Exp0 + float_fn :: Env2 Var Ty0 -> Exp0 -> FloatM Exp0 float_fn env2 ex = do fundefs' <- get let fenv' = M.map funTy fundefs' @@ -1752,7 +1752,7 @@ floatOutCase (Prog ddefs fundefs mainExp) = do let fn = FunDef fn_name args fn_ty ex' (FunMeta NotRec NoInline False) state (\s -> ((AppE fn_name [] (map VarE free)), M.insert fn_name fn s)) - go :: Bool -> Env2 Ty0 -> Exp0 -> FloatM Exp0 + go :: Bool -> Env2 Var Ty0 -> Exp0 -> FloatM Exp0 go float env2 ex = case ex of VarE{} -> pure ex diff --git a/gibbon-compiler/src/Gibbon/Passes/Flatten.hs b/gibbon-compiler/src/Gibbon/Passes/Flatten.hs index 985c285c..5c205a19 100644 --- a/gibbon-compiler/src/Gibbon/Passes/Flatten.hs +++ b/gibbon-compiler/src/Gibbon/Passes/Flatten.hs @@ -45,8 +45,9 @@ flattenL1 prg@(Prog defs funs main) = do env20 = progToEnv prg - -flattenL2 :: Flattenable (E2Ext Var (UrTy LocVar)) => Prog2 -> PassM Prog2 +-- removing constraint solves compilation error +-- (Flattenable (E2Ext Var (UrTy LocVar))) +flattenL2 :: Prog2 -> PassM Prog2 flattenL2 prg@(Prog defs funs main) = do main' <- case main of diff --git a/gibbon-compiler/src/Gibbon/Pretty.hs b/gibbon-compiler/src/Gibbon/Pretty.hs index 44defae2..79ceab19 100644 --- a/gibbon-compiler/src/Gibbon/Pretty.hs +++ b/gibbon-compiler/src/Gibbon/Pretty.hs @@ -53,7 +53,7 @@ indentLevel = 4 type HasPretty ex = (Pretty ex, Pretty (TyOf ex), Pretty (ArrowTy (TyOf ex))) -- Program: -instance HasPretty ex => Pretty (Prog ex) where +instance HasPretty ex => Pretty (Prog Var ex) where pprintWithStyle sty (Prog ddefs funs me) = let meDoc = case me of Nothing -> empty @@ -165,7 +165,7 @@ instance Pretty FunMeta where pprintWithStyle _sty = text . show -- Functions: -instance HasPretty ex => Pretty (FunDef ex) where +instance HasPretty ex => Pretty (FunDef Var ex) where pprintWithStyle sty FunDef{funName,funArgs,funTy,funBody,funMeta} = braces (text "meta:" <+> pprintWithStyle sty funMeta) $$ text (fromVar funName) <+> doublecolon <+> pprintWithStyle sty funTy @@ -482,6 +482,9 @@ instance HasPrettyToo E2Ext l d => Pretty (L2.E2Ext l d) where L2.SSPush mode loc endloc tycon -> text "ss_push" <+> doc mode <+> pprint loc <+> pprint endloc <+> doc tycon L2.SSPop mode loc endloc -> text "ss_pop" <+> doc mode <+> pprint loc <+> pprint endloc +instance Pretty L2.LocVar where + pprintWithStyle _ loc = parens $ text $ sdoc loc + instance Pretty L2.Region where pprintWithStyle _ reg = parens $ text $ sdoc reg @@ -647,7 +650,7 @@ pprintHsWithEnv p@Prog{ddefs,fundefs,mainExp} = sty = PPHaskell - ppFun :: Env2 Ty1 -> FunDef1 -> Doc + ppFun :: Env2 Var Ty1 -> FunDef1 -> Doc ppFun env2 FunDef{funName, funArgs, funTy, funBody} = text (fromVar funName) <+> doublecolon <+> pprintWithStyle sty funTy $$ renderBod <> text "\n" @@ -657,7 +660,7 @@ pprintHsWithEnv p@Prog{ddefs,fundefs,mainExp} = renderBod = text (fromVar funName) <+> (hsep $ map (text . fromVar) funArgs) <+> equals $$ nest indentLevel (ppExp False env2' funBody) - ppExp :: Bool -> Env2 Ty1 -> Exp1 -> Doc + ppExp :: Bool -> Env2 Var Ty1 -> Exp1 -> Doc ppExp monadic env2 ex0 = case ex0 of VarE v -> pprintWithStyle sty v diff --git a/gibbon-compiler/src/Gibbon/SExpFrontend.hs b/gibbon-compiler/src/Gibbon/SExpFrontend.hs index e9c42cdd..5edf4fa4 100644 --- a/gibbon-compiler/src/Gibbon/SExpFrontend.hs +++ b/gibbon-compiler/src/Gibbon/SExpFrontend.hs @@ -20,7 +20,7 @@ import qualified Data.List as L import Data.Loc ( Loc(..), Pos(..)) import qualified Data.Map as M import qualified Data.Set as S -import Data.Text hiding (map, head, init, last, length, zip, reverse, foldr) +import Data.Text hiding (map, head, init, last, length, zip, reverse, foldr, show) import qualified Data.Text as T import Data.Text.IO (readFile) import System.FilePath