Mercurial > urweb

comparison src/especialize.sml @ 480:40c737913075

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Especialize handles records better
author Adam Chlipala <adamc@hcoop.net>
date Sat, 08 Nov 2008 16:02:59 -0500
parents ffa18975e661
children 9117a7bf229c
comparison
equal deleted inserted replaced
479:ffa18975e661 480:40c737913075
104 fun exp (e, st : state) = 104 fun exp (e, st : state) =
105 let 105 let
106 fun getApp e = 106 fun getApp e =
107 case e of 107 case e of
108 ENamed f => SOME (f, [], []) 108 ENamed f => SOME (f, [], [])
109 | EField ((ERecord xes, _), (CName x, _), _) =>
110 (case List.find (fn ((CName x', _), _,_) => x' = x
111 | _ => false) xes of
112 NONE => NONE
113 | SOME (_, (e, _), _) => getApp e)
109 | EApp (e1, e2) => 114 | EApp (e1, e2) =>
110 (case getApp (#1 e1) of 115 (case getApp (#1 e1) of
111 NONE => NONE 116 NONE => NONE
112 | SOME (f, xs, xs') => 117 | SOME (f, xs, xs') =>
113 let 118 let
123 end) 128 end)
124 | _ => NONE 129 | _ => NONE
125 in 130 in
126 case getApp e of 131 case getApp e of
127 NONE => (e, st) 132 NONE => (e, st)
128 | SOME (_, [], _) => (e, st) 133 | SOME (f, [], xs') => (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
134 (ENamed f, ErrorMsg.dummySpan) xs'), st)
129 | SOME (f, xs, xs') => 135 | SOME (f, xs, xs') =>
130 case IM.find (#funcs st, f) of 136 case IM.find (#funcs st, f) of
131 NONE => ((*print ("SHOT DOWN! " ^ Int.toString f ^ "\n");*) (e, st)) 137 NONE =>
138 let
139 val e = foldl (fn (arg, e) => (EApp (e, skeyOut arg), ErrorMsg.dummySpan))
140 (ENamed f, ErrorMsg.dummySpan) xs
141 in
142 (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
143 e xs'), st)
144 end
132 | SOME {name, args, body, typ, tag} => 145 | SOME {name, args, body, typ, tag} =>
133 case KM.find (args, xs) of 146 case KM.find (args, xs) of
134 SOME f' => ((*Print.prefaces "Pre-existing" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];*) 147 SOME f' => ((*Print.prefaces "Pre-existing" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];*)
135 (#1 (foldl (fn (e, arg) => (EApp (e, arg), ErrorMsg.dummySpan)) 148 (#1 (foldl (fn (e, arg) => (EApp (e, arg), ErrorMsg.dummySpan))
136 (ENamed f', ErrorMsg.dummySpan) xs'), 149 (ENamed f', ErrorMsg.dummySpan) xs'),