git.iko.soy/elk
on d3bd238 help sign in
elk/compiler/Transform/SortDefinitions.hs
112 lines 3.1 kB history raw
2module Transform.SortDefinitions (boundVars) where
4import Control.Monad.State
5import qualified Data.Set as Set
6import qualified Data.Map as Map
7import SourceSyntax.Everything
10boundVars :: Pattern -> Set.Set String
11boundVars pattern =
12 case pattern of
13 PVar x -> Set.singleton x
14 PAlias x p -> Set.insert x (boundVars p)
15 PData _ ps -> Set.unions (map boundVars ps)
16 PRecord fields -> Set.fromList fields
17 PAnything -> Set.empty
18 PLiteral _ -> Set.empty
20free x = modify (Set.insert x)
21bound boundVars = modify (\freeVars -> Set.difference freeVars boundVars)
23reorderAndGetDependencies pattern expr =
24 do globalFrees <- get
25 expr' <- reorder expr
26 localFrees <- get
27 modify (Set.union globalFrees)
28 let addDep var deps = Map.insert var localFrees deps
29 dependencies = Set.foldr addDep Map.empty (boundVars pattern)
30 return (expr', dependencies)
32reorder :: LExpr t v -> State (Set.Set String) (LExpr t v)
33reorder lexpr@(L a b expr) =
34 L a b `liftM`
35 case expr of
36{--
37 -- Actually do some reordering
38 Let defs body ->
39 do -- swap in a fresh environment
41 -- swap in the old environment
42 body' <- reorder body
43 bound (boundVars (patterns defs))
44 Let `liftM` defs' `ap` body'
46 where
47 patterns = flip concatMap defs $
48 case def of
49 Def pattern _ -> [pattern]
50 TypeAnnotation _ _ -> []
51--}
52 -- Be careful adding and restricting freeVars
53 Var x -> free x >> return expr
55 Lambda p e ->
56 uncurry Lambda `liftM` bindingReorder (p,e)
58 Binop op e1 e2 ->
59 do free op
60 Binop op `liftM` reorder e1 `ap` reorder e2
62 Case e cases ->
63 Case `liftM` reorder e `ap` mapM bindingReorder cases
65 Data name es ->
66 do free name
67 Data name `liftM` mapM reorder es
69 -- Just pipe the reorder though
70 Literal _ -> return expr
72 Range e1 e2 ->
73 Range `liftM` reorder e1 `ap` reorder e2
75 ExplicitList es ->
76 ExplicitList `liftM` mapM reorder es
78 App e1 e2 ->
79 App `liftM` reorder e1 `ap` reorder e2
81 MultiIf branches ->
82 MultiIf `liftM` mapM reorderPair branches
84 Access e lbl ->
85 Access `liftM` reorder e `ap` return lbl
87 Remove e lbl ->
88 Remove `liftM` reorder e `ap` return lbl
90 Insert e lbl v ->
91 Insert `liftM` reorder e `ap` return lbl `ap` reorder v
93 Modify e fields ->
94 Modify `liftM` reorder e `ap` mapM reorderField fields
96 Record fields ->
97 Record `liftM` mapM reorderField fields
99 Markdown _ -> return expr
101reorderField (label, expr) =
102 (,) label `liftM` reorder expr
104reorderPair (e1,e2) =
105 (,) `liftM` reorder e1 `ap` reorder e2
107bindingReorder :: (Pattern, LExpr t v) -> State (Set.Set String) (Pattern, LExpr t v)
108bindingReorder (pattern,expr) =
109 do expr' <- reorder expr
110 bound (boundVars pattern)
111 return (pattern, expr')