comparison src/elaborate.sml @ 176:33d4a8eea484

Case through explify
author Adam Chlipala <adamc@hcoop.net>
date Thu, 31 Jul 2008 16:28:55 -0400
parents b2d752455182
children d11754ffe252
comparison
equal deleted inserted replaced
175:b2d752455182 176:33d4a8eea484
1043 end) 1043 end)
1044 (env, bound, SS.empty) xps 1044 (env, bound, SS.empty) xps
1045 1045
1046 val k = (L'.KType, loc) 1046 val k = (L'.KType, loc)
1047 val c = (L'.CRecord (k, map (fn (x, _, t) => ((L'.CName x, loc), t)) xpts), loc) 1047 val c = (L'.CRecord (k, map (fn (x, _, t) => ((L'.CName x, loc), t)) xpts), loc)
1048 val (flex, c) = 1048 val c =
1049 if flex then 1049 if flex then
1050 let 1050 (L'.CConcat (c, cunif (loc, (L'.KRecord k, loc))), loc)
1051 val flex = cunif (loc, (L'.KRecord k, loc))
1052 in
1053 (SOME flex, (L'.CConcat (c, flex), loc))
1054 end
1055 else 1051 else
1056 (NONE, c) 1052 c
1057 in 1053 in
1058 (((L'.PRecord (map (fn (x, p', _) => (x, p')) xpts, flex), loc), 1054 (((L'.PRecord (map (fn (x, p', _) => (x, p')) xpts), loc),
1059 (L'.TRecord c, loc)), 1055 (L'.TRecord c, loc)),
1060 (env, bound)) 1056 (env, bound))
1061 end 1057 end
1062 1058
1063 end 1059 end
1087 L'.PWild => Wild 1083 L'.PWild => Wild
1088 | L'.PVar _ => Wild 1084 | L'.PVar _ => Wild
1089 | L'.PPrim _ => None 1085 | L'.PPrim _ => None
1090 | L'.PCon (pc, NONE) => Datatype (IM.insert (IM.empty, pcCoverage pc, Wild)) 1086 | L'.PCon (pc, NONE) => Datatype (IM.insert (IM.empty, pcCoverage pc, Wild))
1091 | L'.PCon (pc, SOME p) => Datatype (IM.insert (IM.empty, pcCoverage pc, coverage p)) 1087 | L'.PCon (pc, SOME p) => Datatype (IM.insert (IM.empty, pcCoverage pc, coverage p))
1092 | L'.PRecord (xps, _) => Record [foldl (fn ((x, p), fmap) => 1088 | L'.PRecord xps => Record [foldl (fn ((x, p), fmap) =>
1093 SM.insert (fmap, x, coverage p)) SM.empty xps] 1089 SM.insert (fmap, x, coverage p)) SM.empty xps]
1090
1094 fun merge (c1, c2) = 1091 fun merge (c1, c2) =
1095 case (c1, c2) of 1092 case (c1, c2) of
1096 (None, _) => c2 1093 (None, _) => c2
1097 | (_, None) => c1 1094 | (_, None) => c1
1098 1095