Mercurial > urweb
diff src/especialize.sml @ 480:40c737913075
Especialize handles records better
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 08 Nov 2008 16:02:59 -0500 |
parents | ffa18975e661 |
children | 9117a7bf229c |
line wrap: on
line diff
--- a/src/especialize.sml Sat Nov 08 14:42:52 2008 -0500 +++ b/src/especialize.sml Sat Nov 08 16:02:59 2008 -0500 @@ -106,6 +106,11 @@ fun getApp e = case e of ENamed f => SOME (f, [], []) + | EField ((ERecord xes, _), (CName x, _), _) => + (case List.find (fn ((CName x', _), _,_) => x' = x + | _ => false) xes of + NONE => NONE + | SOME (_, (e, _), _) => getApp e) | EApp (e1, e2) => (case getApp (#1 e1) of NONE => NONE @@ -125,10 +130,18 @@ in case getApp e of NONE => (e, st) - | SOME (_, [], _) => (e, st) + | SOME (f, [], xs') => (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan)) + (ENamed f, ErrorMsg.dummySpan) xs'), st) | SOME (f, xs, xs') => case IM.find (#funcs st, f) of - NONE => ((*print ("SHOT DOWN! " ^ Int.toString f ^ "\n");*) (e, st)) + NONE => + let + val e = foldl (fn (arg, e) => (EApp (e, skeyOut arg), ErrorMsg.dummySpan)) + (ENamed f, ErrorMsg.dummySpan) xs + in + (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan)) + e xs'), st) + end | SOME {name, args, body, typ, tag} => case KM.find (args, xs) of SOME f' => ((*Print.prefaces "Pre-existing" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];*)