(*end*)
handle Unify.Unify msg =>
(PrettyPrint.begin_block ppstream PrettyPrint.CONSISTENT 0;
- PrettyPrint.add_string ppstream "Error unifying\n\t";
- PrettyPrint.add_break ppstream (0, 0);
+ PrettyPrint.add_string ppstream "Error unifying";
+ PrettyPrint.add_break ppstream (1, 0);
PrettyPrint.begin_block ppstream PrettyPrint.CONSISTENT 5;
PPType.ppType env ppstream t1;
PrettyPrint.end_block ppstream;
- PrettyPrint.add_break ppstream (0, 0);
- PrettyPrint.add_string ppstream "\nand\n\t";
- PrettyPrint.add_break ppstream (0, 0);
+ PrettyPrint.add_break ppstream (1, 0);
+ PrettyPrint.add_string ppstream "and";
+ PrettyPrint.add_break ppstream (1, 0);
PrettyPrint.begin_block ppstream PrettyPrint.CONSISTENT 5;
PPType.ppType env ppstream t2;
PrettyPrint.end_block ppstream;
- PrettyPrint.add_string ppstream "\n";
PrettyPrint.end_block ppstream;
+ PrettyPrint.add_break ppstream (1, 0);
PrettyPrint.flush_ppstream ppstream;
error (SOME pos, Unify.failMessage msg))
(case e of
Int_e n =>
(BasicTypes.intTy, Int.toString n)
+ | Real_e n =>
+ (BasicTypes.realTy, Real.toString n)
| String_e s =>
(BasicTypes.stringTy, "\"" ^ s ^ "\"")
| Char_e s =>
unify state (pos, dom, xt);
(ran, "(" ^ fs ^ ") (" ^ xs ^ ")")
end
+ | Case_e (e, matches) =>
+ let
+ val (ty, s) = xexp state e
+
+ fun folder ((p, e'), (first, str, bodyTy)) =
+ let
+ val (pty, vars', ps) = xpat state p
+
+ val _ = unify state (pos, ty, pty)
+
+ val (ty', str') = xexp (addVars (state, vars')) e'
+ in
+ unify state (pos, ty', bodyTy);
+ (false,
+ str ^ (if first then " " else " | ") ^ "(" ^ ps ^ ") => " ^
+ str' ^ "\n",
+ bodyTy)
+ end
+ val bodyTy = newTyvar false
+ val (_, str, _) =
+ foldl folder (true, "(case (" ^ s ^ ") of\n", bodyTy) matches
+ val str = str ^ ")\n"
+ in
+ (bodyTy, str)
+ end
| Record_e (ist, cs) =>
let
val (cs, str) = foldl (fn ((id, e), (cs, str)) =>
in
(BasicTypes.recordTy cs, str)
end
+ | Fn_e matches =>
+ let
+ val dom = newTyvar false
+ val ran = newTyvar false
+
+ fun folder ((p, e'), (first, str)) =
+ let
+ val (pty, vars', ps) = xpat state p
+
+ val _ = unify state (pos, dom, pty)
+
+ val (ty', str') = xexp (addVars (state, vars')) e'
+ in
+ unify state (pos, ty', ran);
+ (false,
+ str ^ (if first then " " else " | ") ^ "(" ^ ps ^ ") => " ^
+ str' ^ "\n")
+ end
+ val (_, str) =
+ foldl folder (true, "(fn \n") matches
+ val str = str ^ ")\n"
+ in
+ (BasicTypes.--> (dom, ran), str)
+ end
+ | Raise_e e =>
+ let
+ val (ty, es) = xexp state e
+ in
+ unify state (pos, ty, BasicTypes.exnTy);
+ (newTyvar false, "(raise (" ^ es ^ "))")
+ end
| RecordUpd_e (e, cs) =>
let
val (ty, es) = xexp state e
end)
handle Skip => (errorTy, "<error>")
- fun mergePatVars pos (vars1, vars2) =
+ and mergePatVars pos (vars1, vars2) =
StringMap.foldli (fn (v, ty, vars) =>
(case StringMap.find (vars, v) of
NONE => StringMap.insert (vars, v, ty)
| SOME _ => error (SOME pos, "Duplicate variable " ^ v ^ " in pattern"))) vars1 vars2
- fun xpat state (PAT (p, pos)) =
+ and xpat state (PAT (p, pos)) =
(case p of
Ident_p [] => raise Fail "Impossible empty Ident_p"
| Ident_p [id] =>
(resolveCon (pos, state, path), StringMap.empty, foldl (fn (v, st) => st ^ "." ^ v) s rest)
| Wild_p => (newTyvar false, StringMap.empty, "_")
| Int_p n => (BasicTypes.intTy, StringMap.empty, Int.toString n)
+ | Real_p n => (BasicTypes.realTy, StringMap.empty, Real.toString n)
| String_p s => (BasicTypes.stringTy, StringMap.empty, "\"" ^ s ^ "\"")
+ | Char_p s => (BasicTypes.charTy, StringMap.empty, "#\"" ^ s ^ "\"")
| App_p ([], _) => raise Fail "Impossible App_p"
| App_p ([id], p) =>
let
in
(state, str ^ "val _ = " ^ printFn ^ " (" ^ s ^ ")\n")
end
- | Ifthenelse_i (ifs, els) =>
+ | Ifthenelse_i (e, b, els) =>
let
val str = str ^ "val _ = "
- fun folder ((e, b), (first, str)) =
- let
- val (ty, s) = xexp state e
- val (_, str') = xblock state b
- in
- unify state (pos, ty, BasicTypes.boolTy);
- (false, str ^ (if first then "" else "else ") ^ "if (" ^ s ^ ") then let\n" ^
- str' ^
- "in () end\n")
- end
- val (_, str) = foldl folder (true, str) ifs
+ val (ty, s) = xexp state e
+ val (_, str') = xblock state b
+ val _ = unify state (pos, ty, BasicTypes.boolTy)
+ val str = str ^ "if (" ^ s ^ ") then let\n" ^
+ str' ^
+ "in () end\n"
val str =
case els of
NONE =>
val state = addVar (state, id, VAR parm)
val (_, bs) = xblock state b
in
- (state, str ^ "fun foreach (" ^ id ^ (*" : " ^
- Elab.tyToString (context, ivmap, pty) ^*) ") = let\n" ^
+ (state, str ^ "fun foreach (" ^ id ^ " : " ^
+ tyToString state parm ^ ") = let\n" ^
bs ^
"in () end\n" ^
"val _ = app foreach (" ^ es ^ ")\n")
(state, str ^ "fun forFunc " ^ id ^ " = let\n" ^
bs ^
"in () end\n" ^
- "val _ = for forFunc (" ^ es1 ^ ", " ^ es2 ^ ")\n")
+ "val _ = Web.for forFunc (" ^ es1 ^ ", " ^ es2 ^ ")\n")
end
| Case_i (e, matches) =>
let
HCoop / hcoop / mlt.git / blobdiff