Skip to content

Commit 6c08a46

Browse files
vidsinghalvidsinghal
committed
compilable refactor
1 parent edcb9de commit 6c08a46

File tree

5 files changed

+22
-18
lines changed

5 files changed

+22
-18
lines changed

‎gibbon-compiler/src/Gibbon/Compiler.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -838,21 +838,21 @@ Also see Note [Adding dummy traversals] and Note [Adding random access nodes].
838838
go :: PassRunner a b v
839839
go = pass config
840840

841-
goE2 :: (InterpProg Store b, Show v) => InterpPassRunner a b Store v
841+
goE2 :: (InterpProg Store b Var, Show v) => InterpPassRunner a b Store v
842842
goE2 = passE emptyStore config
843843

844-
goE0 :: (InterpProg () b, Show v) => InterpPassRunner a b () v
844+
goE0 :: (InterpProg () b Var, Show v) => InterpPassRunner a b () v
845845
goE0 = passE () config
846846

847-
goE1 :: (InterpProg () b, Show v) => InterpPassRunner a b () v
847+
goE1 :: (InterpProg () b Var, Show v) => InterpPassRunner a b () v
848848
goE1 = passE () config
849849

850850
type PassRunner a b v = (Pretty b, Out b, NFData a, NFData b) =>
851851
String -> (a -> PassM b) -> a -> StateT (CompileState v) IO b
852852

853853
type InterpPassRunner a b s v = (HasPretty a, HasPretty b, HasOut a, HasOut b,
854854
HasGeneric a, HasGeneric b, HasNFData a, HasNFData b) =>
855-
String -> (Prog a -> PassM (Prog b)) -> Prog a -> StateT (CompileState v) IO (Prog b)
855+
String -> (Prog Var a -> PassM (Prog Var b)) -> Prog Var a -> StateT (CompileState v) IO (Prog Var b)
856856

857857
-- | Run a pass and return the result
858858
--
@@ -882,7 +882,7 @@ passChatterLvl = 3
882882

883883
-- | Like 'pass', but also evaluates and checks the result.
884884
--
885-
passE :: (InterpProg s p2, Show v) => s -> Config -> InterpPassRunner p1 p2 s v
885+
passE :: (InterpProg s p2 Var, Show v) => s -> Config -> InterpPassRunner p1 p2 s v
886886
passE s config@Config{mode} = wrapInterp s mode (pass config)
887887

888888

@@ -896,7 +896,7 @@ passF = pass
896896

897897
-- | Wrapper to enable running a pass AND interpreting the result.
898898
--
899-
wrapInterp :: (InterpProg s b, Show v)
899+
wrapInterp :: (InterpProg s b Var, Show v)
900900
=> s -> Mode -> InterpPassRunner a b s v -> InterpPassRunner a b s v
901901
wrapInterp s mode pass who fn x =
902902
do CompileState{result} <- get

‎gibbon-compiler/src/Gibbon/L0/Specialize2.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -459,7 +459,7 @@ monoOblsTy ddefs1 t = do
459459

460460

461461
-- | Collect monomorphization obligations.
462-
collectMonoObls :: DDefs0 -> Env2 Ty0 -> S.Set Var -> Exp0 -> MonoM Exp0
462+
collectMonoObls :: DDefs0 -> Env2 Var Ty0 -> S.Set Var -> Exp0 -> MonoM Exp0
463463
collectMonoObls ddefs env2 toplevel ex =
464464
case ex of
465465
AppE f [] args -> do
@@ -998,7 +998,7 @@ specLambdasFun ddefs new_fn_name refs fn@FunDef{funArgs, funTy} = do
998998

999999
subst' old new ex = gRename (M.singleton old new) ex
10001000

1001-
specLambdasExp :: DDefs0 -> Env2 Ty0 -> Exp0 -> SpecM Exp0
1001+
specLambdasExp :: DDefs0 -> Env2 Var Ty0 -> Exp0 -> SpecM Exp0
10021002
specLambdasExp ddefs env2 ex =
10031003
case ex of
10041004
-- TODO, docs.
@@ -1204,7 +1204,7 @@ specLambdasExp ddefs env2 ex =
12041204
_ -> False
12051205

12061206
-- fn_0 (fn_1, thing, fn_2) => fn_0 (thing)
1207-
dropFunRefs :: Var -> Env2 Ty0 -> [Exp0] -> [Exp0]
1207+
dropFunRefs :: Var -> Env2 Var Ty0 -> [Exp0] -> [Exp0]
12081208
dropFunRefs fn_name env21 args =
12091209
foldr (\(a,t) acc -> if isFunTy t then acc else a:acc) [] (zip args arg_tys)
12101210
where
@@ -1737,7 +1737,7 @@ floatOutCase (Prog ddefs fundefs mainExp) = do
17371737
where
17381738
err1 msg = error $ "floatOutCase: " ++ msg
17391739

1740-
float_fn :: Env2 Ty0 -> Exp0 -> FloatM Exp0
1740+
float_fn :: Env2 Var Ty0 -> Exp0 -> FloatM Exp0
17411741
float_fn env2 ex = do
17421742
fundefs' <- get
17431743
let fenv' = M.map funTy fundefs'
@@ -1752,7 +1752,7 @@ floatOutCase (Prog ddefs fundefs mainExp) = do
17521752
let fn = FunDef fn_name args fn_ty ex' (FunMeta NotRec NoInline False)
17531753
state (\s -> ((AppE fn_name [] (map VarE free)), M.insert fn_name fn s))
17541754

1755-
go :: Bool -> Env2 Ty0 -> Exp0 -> FloatM Exp0
1755+
go :: Bool -> Env2 Var Ty0 -> Exp0 -> FloatM Exp0
17561756
go float env2 ex =
17571757
case ex of
17581758
VarE{} -> pure ex

‎gibbon-compiler/src/Gibbon/Passes/Flatten.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -45,8 +45,9 @@ flattenL1 prg@(Prog defs funs main) = do
4545

4646
env20 = progToEnv prg
4747

48-
49-
flattenL2 :: Flattenable (E2Ext Var (UrTy LocVar)) => Prog2 -> PassM Prog2
48+
-- removing constraint solves compilation error
49+
-- (Flattenable (E2Ext Var (UrTy LocVar)))
50+
flattenL2 :: Prog2 -> PassM Prog2
5051
flattenL2 prg@(Prog defs funs main) = do
5152
main' <-
5253
case main of

‎gibbon-compiler/src/Gibbon/Pretty.hs

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@ indentLevel = 4
5353
type HasPretty ex = (Pretty ex, Pretty (TyOf ex), Pretty (ArrowTy (TyOf ex)))
5454

5555
-- Program:
56-
instance HasPretty ex => Pretty (Prog ex) where
56+
instance HasPretty ex => Pretty (Prog Var ex) where
5757
pprintWithStyle sty (Prog ddefs funs me) =
5858
let meDoc = case me of
5959
Nothing -> empty
@@ -165,7 +165,7 @@ instance Pretty FunMeta where
165165
pprintWithStyle _sty = text . show
166166

167167
-- Functions:
168-
instance HasPretty ex => Pretty (FunDef ex) where
168+
instance HasPretty ex => Pretty (FunDef Var ex) where
169169
pprintWithStyle sty FunDef{funName,funArgs,funTy,funBody,funMeta} =
170170
braces (text "meta:" <+> pprintWithStyle sty funMeta) $$
171171
text (fromVar funName) <+> doublecolon <+> pprintWithStyle sty funTy
@@ -482,6 +482,9 @@ instance HasPrettyToo E2Ext l d => Pretty (L2.E2Ext l d) where
482482
L2.SSPush mode loc endloc tycon -> text "ss_push" <+> doc mode <+> pprint loc <+> pprint endloc <+> doc tycon
483483
L2.SSPop mode loc endloc -> text "ss_pop" <+> doc mode <+> pprint loc <+> pprint endloc
484484

485+
instance Pretty L2.LocVar where
486+
pprintWithStyle _ loc = parens $ text $ sdoc loc
487+
485488
instance Pretty L2.Region where
486489
pprintWithStyle _ reg = parens $ text $ sdoc reg
487490

@@ -647,7 +650,7 @@ pprintHsWithEnv p@Prog{ddefs,fundefs,mainExp} =
647650

648651
sty = PPHaskell
649652

650-
ppFun :: Env2 Ty1 -> FunDef1 -> Doc
653+
ppFun :: Env2 Var Ty1 -> FunDef1 -> Doc
651654
ppFun env2 FunDef{funName, funArgs, funTy, funBody} =
652655
text (fromVar funName) <+> doublecolon <+> pprintWithStyle sty funTy
653656
$$ renderBod <> text "\n"
@@ -657,7 +660,7 @@ pprintHsWithEnv p@Prog{ddefs,fundefs,mainExp} =
657660
renderBod = text (fromVar funName) <+> (hsep $ map (text . fromVar) funArgs) <+> equals
658661
$$ nest indentLevel (ppExp False env2' funBody)
659662

660-
ppExp :: Bool -> Env2 Ty1 -> Exp1 -> Doc
663+
ppExp :: Bool -> Env2 Var Ty1 -> Exp1 -> Doc
661664
ppExp monadic env2 ex0 =
662665
case ex0 of
663666
VarE v -> pprintWithStyle sty v

‎gibbon-compiler/src/Gibbon/SExpFrontend.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ import qualified Data.List as L
2020
import Data.Loc ( Loc(..), Pos(..))
2121
import qualified Data.Map as M
2222
import qualified Data.Set as S
23-
import Data.Text hiding (map, head, init, last, length, zip, reverse, foldr)
23+
import Data.Text hiding (map, head, init, last, length, zip, reverse, foldr, show)
2424
import qualified Data.Text as T
2525
import Data.Text.IO (readFile)
2626
import System.FilePath

0 commit comments

Comments
 (0)