Mercurial > urweb

comparison src/elaborate.sml @ 188:8e9f97508f0d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Datatype representation optimization
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 19:49:21 -0400
parents d11754ffe252
children aa54250f58ac
comparison
equal deleted inserted replaced
187:fb6ed259f5bd 188:8e9f97508f0d
931 val perror = (L'.PWild, loc) 931 val perror = (L'.PWild, loc)
932 val terror = (L'.CError, loc) 932 val terror = (L'.CError, loc)
933 val pterror = (perror, terror) 933 val pterror = (perror, terror)
934 val rerror = (pterror, (env, bound)) 934 val rerror = (pterror, (env, bound))
935 935
936 fun pcon (pc, po, to, dn) = 936 fun pcon (pc, po, to, dn, dk) =
937 937 case (po, to) of
938 case (po, to) of 938 (NONE, SOME _) => (expError env (PatHasNoArg loc);
939 (NONE, SOME _) => (expError env (PatHasNoArg loc); 939 rerror)
940 rerror) 940 | (SOME _, NONE) => (expError env (PatHasArg loc);
941 | (SOME _, NONE) => (expError env (PatHasArg loc); 941 rerror)
942 rerror) 942 | (NONE, NONE) => (((L'.PCon (dk, pc, NONE), loc), dn),
943 | (NONE, NONE) => (((L'.PCon (pc, NONE), loc), dn), 943 (env, bound))
944 (env, bound)) 944 | (SOME p, SOME t) =>
945 | (SOME p, SOME t) => 945 let
946 let 946 val ((p', pt), (env, bound)) = elabPat (p, (env, denv, bound))
947 val ((p', pt), (env, bound)) = elabPat (p, (env, denv, bound)) 947 in
948 in 948 (((L'.PCon (dk, pc, SOME p'), loc), dn),
949 (((L'.PCon (pc, SOME p'), loc), dn), 949 (env, bound))
950 (env, bound)) 950 end
951 end
952 in 951 in
953 case p of 952 case p of
954 L.PWild => (((L'.PWild, loc), cunif (loc, (L'.KType, loc))), 953 L.PWild => (((L'.PWild, loc), cunif (loc, (L'.KType, loc))),
955 (env, bound)) 954 (env, bound))
956 | L.PVar x => 955 | L.PVar x =>
968 (env, bound)) 967 (env, bound))
969 | L.PCon ([], x, po) => 968 | L.PCon ([], x, po) =>
970 (case E.lookupConstructor env x of 969 (case E.lookupConstructor env x of
971 NONE => (expError env (UnboundConstructor (loc, [], x)); 970 NONE => (expError env (UnboundConstructor (loc, [], x));
972 rerror) 971 rerror)
973 | SOME (n, to, dn) => pcon (L'.PConVar n, po, to, (L'.CNamed dn, loc))) 972 | SOME (dk, n, to, dn) => pcon (L'.PConVar n, po, to, (L'.CNamed dn, loc), dk))
974 | L.PCon (m1 :: ms, x, po) => 973 | L.PCon (m1 :: ms, x, po) =>
975 (case E.lookupStr env m1 of 974 (case E.lookupStr env m1 of
976 NONE => (expError env (UnboundStrInExp (loc, m1)); 975 NONE => (expError env (UnboundStrInExp (loc, m1));
977 rerror) 976 rerror)
978 | SOME (n, sgn) => 977 | SOME (n, sgn) =>
984 ((L'.StrVar n, loc), sgn) ms 983 ((L'.StrVar n, loc), sgn) ms
985 in 984 in
986 case E.projectConstructor env {str = str, sgn = sgn, field = x} of 985 case E.projectConstructor env {str = str, sgn = sgn, field = x} of
987 NONE => (expError env (UnboundConstructor (loc, m1 :: ms, x)); 986 NONE => (expError env (UnboundConstructor (loc, m1 :: ms, x));
988 rerror) 987 rerror)
989 | SOME (_, to, dn) => pcon (L'.PConProj (n, ms, x), po, to, dn) 988 | SOME (dk, _, to, dn) => pcon (L'.PConProj (n, ms, x), po, to, dn, dk)
990 end) 989 end)
991 990
992 | L.PRecord (xps, flex) => 991 | L.PRecord (xps, flex) =>
993 let 992 let
994 val (xpts, (env, bound, _)) = 993 val (xpts, (env, bound, _)) =
1034 let 1033 let
1035 val (str, sgn) = E.chaseMpath env (m1, ms) 1034 val (str, sgn) = E.chaseMpath env (m1, ms)
1036 in 1035 in
1037 case E.projectConstructor env {str = str, sgn = sgn, field = x} of 1036 case E.projectConstructor env {str = str, sgn = sgn, field = x} of
1038 NONE => raise Fail "exhaustive: Can't project constructor" 1037 NONE => raise Fail "exhaustive: Can't project constructor"
1039 | SOME (n, _, _) => n 1038 | SOME (_, n, _, _) => n
1040 end 1039 end
1041 1040
1042 fun coverage (p, _) = 1041 fun coverage (p, _) =
1043 case p of 1042 case p of
1044 L'.PWild => Wild 1043 L'.PWild => Wild
1045 | L'.PVar _ => Wild 1044 | L'.PVar _ => Wild
1046 | L'.PPrim _ => None 1045 | L'.PPrim _ => None
1047 | L'.PCon (pc, NONE) => Datatype (IM.insert (IM.empty, pcCoverage pc, Wild)) 1046 | L'.PCon (_, pc, NONE) => Datatype (IM.insert (IM.empty, pcCoverage pc, Wild))
1048 | L'.PCon (pc, SOME p) => Datatype (IM.insert (IM.empty, pcCoverage pc, coverage p)) 1047 | L'.PCon (_, pc, SOME p) => Datatype (IM.insert (IM.empty, pcCoverage pc, coverage p))
1049 | L'.PRecord xps => Record [foldl (fn ((x, p, _), fmap) => 1048 | L'.PRecord xps => Record [foldl (fn ((x, p, _), fmap) =>
1050 SM.insert (fmap, x, coverage p)) SM.empty xps] 1049 SM.insert (fmap, x, coverage p)) SM.empty xps]
1051 1050
1052 fun merge (c1, c2) = 1051 fun merge (c1, c2) =
1053 case (c1, c2) of 1052 case (c1, c2) of