Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix documentation and small things

Browse source
This commit is contained in:
Martin Fredin 2023-02-10 16:44:55 +01:00
parent 5956cdf121
commit f3600ffdf8
1 changed files with 26 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

50
src/LambdaLifter.hs
View file

@ -15,7 +15,6 @@ import Grammar.Abs
import Prelude hiding (exp) import Prelude hiding (exp)
-- | Lift lambdas and let expression into supercombinators. -- | Lift lambdas and let expression into supercombinators.
lambdaLift :: Program -> Program lambdaLift :: Program -> Program
lambdaLift = collectScs . rename . abstract . freeVars lambdaLift = collectScs . rename . abstract . freeVars
@ -28,42 +27,49 @@ freeVars (Program ds) = [ (n, xs, freeVarsExp (Set.fromList xs) e)
] ]
freeVarsExp :: Set Ident -> Exp -> AnnExp freeVarsExp :: Set Ident -> Exp -> AnnExp
freeVarsExp lv = \case freeVarsExp localVars = \case
EId n | Set.member n lv -> (Set.singleton n, AId n) EId n | Set.member n localVars -> (Set.singleton n, AId n)
| otherwise -> (mempty, AId n) | otherwise -> (mempty, AId n)
EInt i -> (mempty, AInt i) EInt i -> (mempty, AInt i)
EApp e1 e2 -> (Set.union (freeVarsOf e1') (freeVarsOf e2'), AApp e1' e2') EApp e1 e2 -> (Set.union (freeVarsOf e1') (freeVarsOf e2'), AApp e1' e2')
where e1' = freeVarsExp lv e1 where
e2' = freeVarsExp lv e2 e1' = freeVarsExp localVars e1
e2' = freeVarsExp localVars e2
EAdd e1 e2 -> (Set.union (freeVarsOf e1') (freeVarsOf e2'), AAdd e1' e2') EAdd e1 e2 -> (Set.union (freeVarsOf e1') (freeVarsOf e2'), AAdd e1' e2')
where e1' = freeVarsExp lv e1 where
e2' = freeVarsExp lv e2 e1' = freeVarsExp localVars e1
e2' = freeVarsExp localVars e2
EAbs parms e -> (freeVarsOf e' \\ Set.fromList parms, AAbs parms e') EAbs parms e -> (freeVarsOf e' \\ Set.fromList parms, AAbs parms e')
where e' = freeVarsExp (foldr Set.insert lv parms) e
ELet bs e -> (Set.union bsFree eFree, ALet bs' e')
where where
bsFree = freeInValues \\ nsSet e' = freeVarsExp (foldr Set.insert localVars parms) e
eFree = freeVarsOf e' \\ nsSet
bs' = zipWith3 ABind ns xs es' -- Sum free variables present in binders and the expression
e' = freeVarsExp e_lv e ELet binders e -> (Set.union binders_frees e_free, ALet binders' e')
(ns, xs, es) = fromBinders bs where
nsSet = Set.fromList ns binders_frees = rhss_frees \\ names_set
e_lv = Set.union lv nsSet e_free = freeVarsOf e' \\ names_set
es' = map (freeVarsExp e_lv) es
freeInValues = foldr1 Set.union (map freeVarsOf es') rhss_frees = foldr1 Set.union (map freeVarsOf rhss')
names_set = Set.fromList names
(names, parms, rhss) = fromBinders binders
rhss' = map (freeVarsExp e_localVars) rhss
e_localVars = Set.union localVars names_set
binders' = zipWith3 ABind names parms rhss'
e' = freeVarsExp e_localVars e
freeVarsOf :: AnnExp -> Set Ident freeVarsOf :: AnnExp -> Set Ident
freeVarsOf = fst freeVarsOf = fst
fromBinders :: [Bind] -> ([Ident], [[Ident]], [Exp]) fromBinders :: [Bind] -> ([Ident], [[Ident]], [Exp])
fromBinders bs = unzip3 [ (n, xs, e) | Bind n xs e <- bs ] fromBinders bs = unzip3 [ (name, parms, rhs) | Bind name parms rhs <- bs ]
-- AST annotated with free variables -- AST annotated with free variables
type AnnProgram = [(Ident, [Ident], AnnExp)] type AnnProgram = [(Ident, [Ident], AnnExp)]
@ -221,8 +227,6 @@ collectScsExp = \case
where where
(rhs_scs, rhs') = collectScsExp rhs (rhs_scs, rhs') = collectScsExp rhs
isEAbs :: Exp -> Bool isEAbs :: Exp -> Bool
isEAbs = \case isEAbs = \case
EAbs {} -> True EAbs {} -> True
@ -231,5 +235,3 @@ isEAbs = \case
mkEAbs :: [Bind] -> Exp -> Exp mkEAbs :: [Bind] -> Exp -> Exp
mkEAbs [] e = e mkEAbs [] e = e
mkEAbs bs e = ELet bs e mkEAbs bs e = ELet bs e