Mercurial > urweb
comparison src/mono_shake.sml @ 1073:b2311dfb3158
Initializers and setval
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 13 Dec 2009 14:20:41 -0500 |
parents | d8f58d488cfb |
children | 0657e5adc938 |
comparison
equal
deleted
inserted
replaced
1072:9001966ae1c8 | 1073:b2311dfb3158 |
---|---|
41 exp : IS.set | 41 exp : IS.set |
42 } | 42 } |
43 | 43 |
44 fun shake file = | 44 fun shake file = |
45 let | 45 let |
46 val page_es = List.foldl | 46 val usedVars = U.Exp.fold {typ = fn (c, st as (cs, es)) => |
47 (fn ((DExport (_, _, n, _, _), _), page_es) => n :: page_es | 47 case c of |
48 | ((DDatabase {expunge = n1, initialize = n2, ...}, _), page_es) => n1 :: n2 :: page_es | 48 TDatatype (n, _) => (IS.add (cs, n), es) |
49 | (_, page_es) => page_es) [] file | 49 | _ => st, |
50 exp = fn (e, st as (cs, es)) => | |
51 case e of | |
52 ENamed n => (cs, IS.add (es, n)) | |
53 | _ => st} | |
54 | |
55 val (page_cs, page_es) = | |
56 List.foldl | |
57 (fn ((DExport (_, _, n, _, _), _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) | |
58 | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) => | |
59 (page_cs, IS.addList (page_es, [n1, n2])) | |
60 | ((DInitializer e, _), st) => usedVars st e | |
61 | (_, st) => st) (IS.empty, IS.empty) file | |
50 | 62 |
51 val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) => | 63 val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) => |
52 (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef) | 64 (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef) |
53 | ((DVal (_, n, t, e, _), _), (cdef, edef)) => | 65 | ((DVal (_, n, t, e, _), _), (cdef, edef)) => |
54 (cdef, IM.insert (edef, n, (t, e))) | 66 (cdef, IM.insert (edef, n, (t, e))) |
59 | ((DSequence _, _), acc) => acc | 71 | ((DSequence _, _), acc) => acc |
60 | ((DView _, _), acc) => acc | 72 | ((DView _, _), acc) => acc |
61 | ((DDatabase _, _), acc) => acc | 73 | ((DDatabase _, _), acc) => acc |
62 | ((DJavaScript _, _), acc) => acc | 74 | ((DJavaScript _, _), acc) => acc |
63 | ((DCookie _, _), acc) => acc | 75 | ((DCookie _, _), acc) => acc |
64 | ((DStyle _, _), acc) => acc) | 76 | ((DStyle _, _), acc) => acc |
77 | ((DInitializer _, _), acc) => acc) | |
65 (IM.empty, IM.empty) file | 78 (IM.empty, IM.empty) file |
66 | 79 |
67 fun typ (c, s) = | 80 fun typ (c, s) = |
68 case c of | 81 case c of |
69 TDatatype (n, _) => | 82 TDatatype (n, _) => |
102 end | 115 end |
103 | _ => s | 116 | _ => s |
104 | 117 |
105 and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s | 118 and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s |
106 | 119 |
107 val s = {con = IS.empty, exp = IS.addList (IS.empty, page_es)} | 120 val s = {con = page_cs, exp = page_es} |
108 | 121 |
109 val s = foldl (fn (n, s) => | 122 val s = IS.foldl (fn (n, s) => |
110 case IM.find (edef, n) of | 123 case IM.find (cdef, n) of |
111 NONE => raise Fail "Shake: Couldn't find 'val'" | 124 NONE => raise Fail "MonoShake: Couldn't find 'datatype'" |
112 | SOME (t, e) => shakeExp s e) s page_es | 125 | SOME xncs => foldl (fn ((_, _, SOME c), s) => shakeTyp s c |
126 | _ => s) s xncs) s page_cs | |
127 | |
128 val s = IS.foldl (fn (n, s) => | |
129 case IM.find (edef, n) of | |
130 NONE => raise Fail "MonoShake: Couldn't find 'val'" | |
131 | SOME (t, e) => shakeExp s e) s page_es | |
113 in | 132 in |
114 List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts | 133 List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts |
115 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) | 134 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) |
116 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis | 135 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis |
117 | (DExport _, _) => true | 136 | (DExport _, _) => true |
119 | (DSequence _, _) => true | 138 | (DSequence _, _) => true |
120 | (DView _, _) => true | 139 | (DView _, _) => true |
121 | (DDatabase _, _) => true | 140 | (DDatabase _, _) => true |
122 | (DJavaScript _, _) => true | 141 | (DJavaScript _, _) => true |
123 | (DCookie _, _) => true | 142 | (DCookie _, _) => true |
124 | (DStyle _, _) => true) file | 143 | (DStyle _, _) => true |
144 | (DInitializer _, _) => true) file | |
125 end | 145 end |
126 | 146 |
127 end | 147 end |