*.log
*.dvi
*.ps
+manual
\ No newline at end of file
-all: manual.ps
+all: manual.ps manual/index.html
clean:
rm *.aux *.dvi *.ps *.log
dvips -o manual.ps manual.dvi
manual.dvi: manual.tex
- latex manual.tex
\ No newline at end of file
+ latex manual.tex
+
+manual/index.html: manual.tex
+ latex2html -local_icons manual.tex
\ No newline at end of file
Where {\tt temp} is the name of a template in the current project, {\tt @temp} evaluates to a function {\tt (string * string) list -> unit} that takes in a list of name-value pairs for CGI parameters to modify and runs {\tt temp} with those changes. The Compilation Manager will prevent template calls from being used to implement any sort of recursion.
+\subsubsection{Anonymous functions}
+
+Anonymous {\tt fn} functions are available with the SML syntax.
+
+\subsubsection{\tt case}
+
+SML {\tt case} expressions are supported.
+
+\subsubsection{\tt raise}
+
+SML {\tt raise} expressions are supported.
+
\subsection{Patterns}
Patterns are identical to SML patterns without support for user-defined infix constructors, though {\tt ::} is supported. Record patterns can include field names with no assigned patterns (the pattern for such a field is taken to be the field name) and "flex record" {\tt ...}'s to stand for unused fields.
If statements are in the usual imperative style, meaning that else clauses are optional. They are of the form:
\begin{verbatim}
-if (condition1)
-{
+if condition1 then
block1
-}
-else if (condition 2)
-{
+else if condition 2 then
block 2
-}
else
-{
block 3
-}
+end
\end{verbatim}
-The {\tt block}s are sequences of statements and declarations. Every {\tt if} statement is followed by zero or more {\tt else if}'s and one or zero {\tt else}'s. Conditions must be enclosed in parentheses.
+The {\tt block}s are sequences of statements and declarations. Every {\tt if} statement is followed by zero or more {\tt else if}'s and one or zero {\tt else}'s.
\subsubsection{\tt foreach}
All looping is done via {\tt foreach} statements, which have two forms. One is:
\begin{verbatim}
-foreach (var in exp)
-{
+foreach var in exp do
block
-}
+end
\end{verbatim}
Where {\tt exp} has type {\tt t list}, {\tt block} is executed for each of {\tt exp}'s elements, binding {\tt var} to each of them in order from first to last.
There is also a shortcut integer iteration form:
\begin{verbatim}
-foreach (var in fromExp .. toExp)
-{
+foreach var in fromExp .. toExp do
block
-}
+end
\end{verbatim}
{\tt fromExp} and {\tt toExp} must have type {\tt int}. {\tt block} is evaluated with {\tt var} bound in sequence to each integer in the range defined by {\tt fromExp} and {\tt toExp}.
-\subsubsection{\tt case}
+\subsubsection{\tt switch}
-{\tt case} statements are straightforward imperative modifications of SML {\tt case} expressions, such as:
+{\tt switch} statements are imperative equivalents of {\tt case} expressions, such as:
\begin{verbatim}
-case (exp)
-(pat1) { block1 }
-(pat2) { block2 }
+switch exp of
+ pat1 => block1
+| pat2 => block2
+end
\end{verbatim}
-The case object and patterns must be enclosed in parentheses.
-
-\subsubsection{{\tt try}..{\tt catch}}
+\subsubsection{{\tt try}..{\tt with}}
-This construction is to SML's {\tt handle} what template {\tt case} is to SML {\tt case}. For example:
+This construction is to SML's {\tt handle} what {\tt switch} is to {\tt case}. For example:
\begin{verbatim}
try
-{
block1
-}
-catch (pat1)
-{
- block2
-}
-catch (pat2)
-{
- block3
-}
+with pat1 => block2
+| pat2 => block3
+end
\end{verbatim}
\end{document}
\ No newline at end of file
str (toUpper (String.sub (name, 0))) ^ String.extract (name, 1, NONE)
else
raise Error
+ val name = name ^ "_"
in
(name, Mlt.trans (config, env, templates, name, Parse.parse path))
end
"mlt" => loop (smls, (path ^ "/" ^ fname) :: mlts)
| ("sml"|"sig") =>
let
- val mltName = removeExt fname ^ ".mlt"
+ val fname = getFname fname
in
- if getFname fname = "_main.sml" orelse Posix.FileSys.access (mltName, []) then
+ if String.sub (fname, 0) = #"_" then
loop (smls, mlts)
else
loop ((path ^ "/" ^ fname) :: smls, mlts)
val _ = TextIO.closeOut outf
val outf = TextIO.openOut (outPath ^ "/.build.sml")
+ val _ = TextIO.output (outf, "Control.quotation := true;\n")
fun printMlts [] = ()
| printMlts (h::t) =
(TextIO.output (outf, "\"" ^ h ^ "\"");
val libList = foldl (fn (l, s) => s ^ "if CM.make \"" ^ l ^ "\" then () else OS.Process.exit OS.Process.failure;\n") "" (Config.cm config)
in
- TextIO.output (outf, "if CM.make \"" ^ outPath ^ "/libs.cm\" then () else OS.Process.exit OS.Process.failure;\nif CM.make \"" ^ Config.compiler config ^ "\" then () else OS.Process.exit OS.Process.failure;\n");
+ TextIO.output (outf, "if CM.make \"" ^ outPath ^ "/libs.cm\" then () else OS.Process.exit OS.Process.failure;\nif CM.make \"" ^ Config.compiler config ^ "\" then () else OS.Process.exit OS.Process.failure;\nif CM.make \"" ^ Config.lib config ^ "\" then () else OS.Process.exit OS.Process.failure;\n");
TextIO.output (outf, libList);
TextIO.output (outf, "Compiler.compileTemplates (Config.read \"mlt.conf\" (Config.default ())) ([");
printMlts mlts;
fun compileTemplates config (mlts, smls) =
let
+ val err_flag = ref false
val _ = ErrorMsg.reset ()
val path = Config.inPath config
let
val _ = print ("Compiling " ^ fname ^ "....\n")
val (name, output) = compileTemplate (config, env, templates) fname
+ val _ = err_flag := (!err_flag orelse !ErrorMsg.anyErrors)
val scriptName = removeExt (getFname fname)
- val outName = scriptName ^ ".sml"
+ val outName = "__" ^ scriptName ^ ".sml"
val outf = TextIO.openOut (outPath ^ "/" ^ outName)
in
TextIO.output (outf, output);
Posix.FileSys.chmod (name, cgiMode)
end
in
- if !ErrorMsg.anyErrors then
+ if !err_flag then
(TextIO.print "Errors compiling templates.\n";
OS.Process.failure)
else
let
val _ = Cgi.init ()
val cgiFields = Cgi.cgi_fieldnames ()
- fun mapper name = (name, valOf (Cgi.cgi_field_string name))
+ fun mapper name = (name, Cgi.cgi_field_strings name)
in
Web.pushParams (map mapper cgiFields);
case args of
| SOME f => (f ();
Web.output ();
OS.Process.success))
- end handle ex => (print "Status: 500\nContent-type: text/plain\n\nAn exception!\n\n";
+ end handle Fail msg => (print "Status: 500\nContent-type: text/plain\n\nFatal error: \n\n";
+ print msg;
+ OS.Process.failure)
+ | ex => (print "Status: 500\nContent-type: text/plain\n\nAn exception!\n\n";
app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex);
OS.Process.failure)
end
\ No newline at end of file
signature TEMPLATES
signature MAIN
signature WEB
+ signature SQL
+ structure Sql
structure Web
functor MainFn
web.sig
web.sml
+ sql.sig
+ sql.sml
main.sml
\ No newline at end of file
signature WEB =
sig
+ val for : (int -> unit) -> int * int -> unit
+
val print : string -> unit
val output : unit -> unit
- val setParam : string * string -> unit
+ val setParam : string * string list -> unit
+ val setSingleParam : string * string -> unit
val getParam : string -> string
+ val getMultiParam : string -> string list
- val pushParams : (string * string) list -> unit
+ val pushParams : (string * string list) list -> unit
val popParams : unit -> unit
- val withParams : (unit -> 'a) -> (string * string) list -> 'a
+ val withParams : (unit -> 'a) -> (string * string list) list -> 'a
+
+ val getCgi : string -> string option
+
+ val html : string -> string
+ val htmlNl : string -> string
+
+ exception Format of string
+ val stoi : string -> int
+ val stor : string -> real
+
+ val summary : unit -> string
end
\ No newline at end of file
structure Web :> WEB =
struct
- val params : string StringMap.map ref = ref StringMap.empty
+ fun for f (r1, r2) =
+ if r1 < r2 then
+ let
+ fun loop i =
+ if i > r2 then
+ ()
+ else
+ (f i;
+ loop (i+1))
+ in
+ loop r1
+ end
+ else
+ let
+ fun loop i =
+ if i < r2 then
+ ()
+ else
+ (f i;
+ loop (i-1))
+ in
+ loop r1
+ end
- val paramStack : string StringMap.map list ref = ref []
+ val params : string list StringMap.map ref = ref StringMap.empty
+
+ val paramStack : string list StringMap.map list ref = ref []
fun setParam (n, v) = params := StringMap.insert (!params, n, v)
+ fun setSingleParam (n, v) = setParam (n, [v])
fun getParam v =
(case StringMap.find (!params, v) of
NONE => ""
- | SOME s => s)
+ | SOME [] => ""
+ | SOME (s::_) => s)
+
+ fun getMultiParam v =
+ (case StringMap.find (!params, v) of
+ NONE => []
+ | SOME l => l)
fun pushParams nvs =
(paramStack := (!params) :: (!paramStack);
fun output () =
(TextIO.print "Status: 200\nContent-type: text/html\n\n";
TextIO.print (String.concat (List.rev (!text))))
+
+ val getCgi = OS.Process.getEnv
+
+ fun html s =
+ let
+ fun xch #"<" = "<"
+ | xch #">" = ">"
+ | xch #"&" = "&"
+ | xch #"\"" = """
+ | xch ch = str ch
+ in
+ foldr op^ "" (map xch (String.explode s))
+ end
+
+ fun htmlNl s =
+ let
+ fun xch #"<" = "<"
+ | xch #">" = ">"
+ | xch #"&" = "&"
+ | xch #"\"" = """
+ | xch #"\n" = "<br />"
+ | xch ch = str ch
+ in
+ foldr op^ "" (map xch (String.explode s))
+ end
+
+ exception Format of string
+
+ fun stoiOpt s = Int.fromString s
+ fun stoi s =
+ (case Int.fromString s of
+ NONE => raise Format s
+ | SOME i => i)
+
+ fun storOpt s = Real.fromString s
+ fun stor s =
+ (case Real.fromString s of
+ NONE => raise Format s
+ | SOME r => r)
+
+ fun summary () =
+ StringMap.foldli (fn (n, vs, s) => foldl (fn (v, s) => s ^ " VALUE: " ^ v) (s ^ " NAME: " ^ n) vs)
+ "" (!params)
end
\ No newline at end of file
%term
EOF
| HTML of string
- | IF | THEN | ELSE | AS | WITH | OPEN | VAL | REF | TRY | CATCH
- | FOREACH | IN | CASE | ORELSE | ANDALSO
+ | IF | THEN | ELSE
+ | AS | WITH | OPEN | VAL | REF | TRY | CATCH
+ | FN | END | RAISE
+ | FOREACH | IN | DO
+ | SWITCH | CASE | OF | BAR | ARROW
| LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | HASH | SEMI | CONS
| PLUS | MINUS | TIMES | DIVIDE | MOD | NEG | DOLLAR | AT | STRCAT
| ASN | EQ | NEQ | GT | GTE | LT | LTE
+ | ANDALSO | ORELSE
| IDENT of string | DOT | DOTDOT | DOTDOTDOT | COMMA | COLON | CARET | TILDE | UNDER
- | INT of int | STRING of string | CHAR of string
+ | INT of int | STRING of string | CHAR of string | REAL of real
%nonterm
file of block
| block of block
| exp of exp
+ | cases of (pat * exp) list
| appsL of exp list
| apps of exp
| term of exp
| path of ident list
| pathList of ident list list
| blockItem of blockItem
- | ifte of ((exp * block) list * block option) withext
+ | elseOpt of block option
| matches of (pat * block) list withext
| pexp of exp
| ppat of pat
ivlist : IDENT EQ exp COMMA ivlist ((IDENT, exp) :: ivlist)
| IDENT EQ exp ([(IDENT, exp)])
-catch : CATCH ppat LBRACE block RBRACE (ppat, block)
+catch : pat ARROW block (pat, block)
-catches : catch catches (catch::catches)
- | catch ([catch])
+catches : catches BAR catch (catch::catches)
+ | catch ([catch])
blockItem : HTML (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
| REF ivlist (BITEM (Ref_i ivlist, (REFleft, ivlistright)))
| VAL pat EQ exp (BITEM (Val_i (pat, exp), (patleft, expright)))
| IDENT ASN exp (BITEM (Assn_i (IDENT, exp), (IDENTleft, expright)))
| exp (BITEM (Exp_i exp, (expleft, expright)))
- | IF LPAREN exp RPAREN LBRACE block RBRACE ifte
- (let val ((L, O), _) = ifte in
- BITEM (Ifthenelse_i((exp, block) :: L, O),
- (IFleft, ifteright))
- end)
- | FOREACH LPAREN IDENT IN exp RPAREN LBRACE block RBRACE
+ | IF exp THEN block elseOpt END
+ (BITEM (Ifthenelse_i(exp, block, elseOpt),
+ (IFleft, ENDright)))
+ | FOREACH IDENT IN exp DO block END
(BITEM (Foreach_i (IDENT, exp, block),
- (FOREACHleft, RBRACEright)))
- | FOREACH LPAREN IDENT IN exp DOTDOT exp RPAREN LBRACE block RBRACE
+ (FOREACHleft, ENDright)))
+ | FOREACH IDENT IN exp DOTDOT exp DO block END
(BITEM (For_i (IDENT, exp1, exp2, block),
- (FOREACHleft, RBRACEright)))
- | CASE pexp matches
- (BITEM (Case_i (pexp, #1 matches), (CASEleft, matchesright)))
- | TRY LBRACE block RBRACE catches
- (BITEM (TryCatch_i (block, catches), (TRYleft, catchesright)))
-
-ifte : ELSE LBRACE block RBRACE (([], SOME block), (ELSEleft, RBRACEright))
- | ELSE IF LPAREN exp RPAREN LBRACE block RBRACE ifte (let val ((L, O), _) = ifte in
- (((exp, block) :: L, O), (ELSEleft, ifteright))
- end)
- | (([], NONE), (0, 0))
+ (FOREACHleft, ENDright)))
+ | SWITCH exp OF matches END
+ (BITEM (Case_i (exp, List.rev (#1 matches)), (SWITCHleft, ENDright)))
+ | TRY block WITH catches END
+ (BITEM (TryCatch_i (block, List.rev catches), (TRYleft, ENDright)))
+
+elseOpt : (NONE)
+ | ELSE block (SOME block)
block : blockItem (BLOCK ([blockItem], (blockItemleft, blockItemright)))
| blockItem SEMI block (BLOCK (blockItem :: (unblock block), (blockItemleft, blockright)))
| pexp (pexp)
| STRING (EXP (String_e STRING, (STRINGleft, STRINGright)))
| CHAR (EXP (Char_e CHAR, (CHARleft, CHARright)))
+ | REAL (EXP (Real_e REAL, (REALleft, REALright)))
| path (EXP (Ident_e path, (pathleft, pathright)))
| INT (EXP (Int_e INT, (INTleft, INTright)))
| NEG (EXP (Neg_e, (NEGleft, NEGright)))
| exp STRCAT exp (EXP (StrCat_e (exp1, exp2), (exp1left, exp2right)))
| exp ORELSE exp (EXP (Orelse_e (exp1, exp2), (exp1left, exp2right)))
| exp ANDALSO exp (EXP (Andalso_e (exp1, exp2), (exp1left, exp2right)))
+ | CASE exp OF cases (EXP (Case_e (exp, List.rev cases), (expleft, casesright)))
+ | FN cases (EXP (Fn_e (List.rev cases), (FNleft, casesright)))
+ | RAISE exp (EXP (Raise_e exp, (RAISEleft, expright)))
+
+
+cases : pat ARROW exp ([(pat, exp)])
+ | cases BAR pat ARROW exp ((pat, exp) :: cases)
-matches : ppat LBRACE block RBRACE matches (((ppat, block) :: (#1 matches), (ppatleft, matchesright)))
- | ([], (0, 0))
+matches : matches BAR pat ARROW block (((pat, block) :: (#1 matches), (matchesleft, blockright)))
+ | pat ARROW block ([(pat, block)], (patleft, blockright))
rseq : IDENT EQ pat COMMA rseq ((IDENT, pat) :: rseq)
| IDENT COMMA rseq ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: rseq)
| UNDER (PAT (Wild_p, (UNDERleft, UNDERright)))
| INT (PAT (Int_p INT, (INTleft, INTright)))
| STRING (PAT (String_p STRING, (STRINGleft, STRINGright)))
+ | CHAR (PAT (Char_p CHAR, (CHARleft, CHARright)))
+ | REAL (PAT (Real_p REAL, (REALleft, REALright)))
| LBRACE rseq RBRACE (PAT (Record_p (false, sortRcs rseq), (LBRACEleft, RBRACEright)))
| LBRACE RBRACE (PAT (Record_p (false, []), (LBRACEleft, RBRACEright)))
| LBRACE frseq RBRACE (PAT (FlexRecord_p (sortRcs frseq), (LBRACEleft, RBRACEright)))
id = ([A-Za-z_][A-Za-z0-9_]*)|([:]+);
intconst = [0-9]+;
+realconst = [0-9]+\.[0-9]*;
ws = [\ \t\012];
bo = [^<]+;
<CODE> "@" => (Tokens.AT (yypos, yypos + size yytext));
<CODE> "if" => (Tokens.IF (yypos, yypos + 2));
+<CODE> "then" => (Tokens.THEN (yypos, yypos + 4));
<CODE> "else" => (Tokens.ELSE (yypos, yypos + 4));
<CODE> "foreach" => (Tokens.FOREACH (yypos, yypos + 7));
<CODE> "in" => (Tokens.IN (yypos, yypos + 2));
<CODE> "case" => (Tokens.CASE (yypos, yypos + 4));
<CODE> "as" => (Tokens.AS (yypos, yypos + 2));
+<CODE> "fn" => (Tokens.FN (yypos, yypos + 2));
<CODE> "with" => (Tokens.WITH (yypos, yypos + 4));
<CODE> "open" => (Tokens.OPEN (yypos, yypos + 4));
<CODE> "val" => (Tokens.VAL (yypos, yypos + 3));
<CODE> "ref" => (Tokens.REF (yypos, yypos + 3));
<CODE> "try" => (Tokens.TRY (yypos, yypos + 3));
<CODE> "catch" => (Tokens.CATCH (yypos, yypos + 5));
-<CODE> "or" => (Tokens.ORELSE (yypos, yypos + 5));
-<CODE> "and" => (Tokens.ANDALSO (yypos, yypos + 5));
+<CODE> "or" => (Tokens.ORELSE (yypos, yypos + 2));
+<CODE> "and" => (Tokens.ANDALSO (yypos, yypos + 3));
+<CODE> "switch" => (Tokens.SWITCH (yypos, yypos + 6));
+<CODE> "of" => (Tokens.OF (yypos, yypos + 2));
+<CODE> "=>" => (Tokens.ARROW (yypos, yypos + 2));
+<CODE> "|" => (Tokens.BAR (yypos, yypos + 1));
+<CODE> "do" => (Tokens.DO (yypos, yypos + 2));
+<CODE> "end" => (Tokens.END (yypos, yypos + 3));
+<CODE> "raise" => (Tokens.RAISE (yypos, yypos + 5));
<CODE> "::" => (Tokens.CONS (yypos, yypos + 2));
<CODE> {id} => (Tokens.IDENT (yytext, yypos, yypos + size yytext));
<CODE> {intconst} => (case Int.fromString yytext of
- SOME (x) => Tokens.INT (x, yypos, yypos + size yytext)
- | NONE => (ErrorMsg.error (SOME (yypos, yypos))
- ("Expected number, received: " ^ yytext);
- continue ()));
+ SOME x => Tokens.INT (x, yypos, yypos + size yytext)
+ | NONE => (ErrorMsg.error (SOME (yypos, yypos))
+ ("Expected int, received: " ^ yytext);
+ continue ()));
+<CODE> {realconst} => (case Real.fromString yytext of
+ SOME x => Tokens.REAL (x, yypos, yypos + size yytext)
+ | NONE => (ErrorMsg.error (SOME (yypos, yypos))
+ ("Expected real, received: " ^ yytext);
+ continue ()));
<CODE> "\"" {id} "\"" => (Tokens.STRING (String.substring(yytext, 1, String.size yytext - 2), yypos, yypos + size yytext));
(*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
(* Pattern *)
datatype pat' =
- Wild_p | Int_p of int | String_p of string
+ Wild_p | Int_p of int | String_p of string | Char_p of string | Real_p of real
| Ident_p of path
| Record_p of bool * (ident * pat) list
| FlexRecord_p of (ident * pat) list
(* Expression *)
and exp' =
- Int_e of int | String_e of string | Char_e of string | Ident_e of path
+ Int_e of int | String_e of string | Char_e of string | Real_e of real | Ident_e of path
| Plus_e of exp * exp | Minus_e of exp * exp | Times_e of exp * exp
| Divide_e of exp * exp | Mod_e of exp * exp | Neg_e | Param_e
| Template_e of ident
| Record_e of bool * (ident * exp) list
| RecordUpd_e of exp * (ident * exp) list
| Proj_e of ident | App_e of exp * exp
+ | Case_e of exp * (pat * exp) list
+ | Fn_e of (pat * exp) list
+ | Raise_e of exp
and exp = EXP of exp' withext
and blockItem' =
| Assn_i of ident * exp (* assignment to ref *)
| Exp_i of exp (* expression to be evaluated *)
| Open_i of path list (* imports to top level *)
- | Ifthenelse_i of (exp * block) list * block option (* if statement *)
+ | Ifthenelse_i of exp * block * block option (* if statement *)
| Case_i of exp * (pat * block) list (* case statement *)
| Foreach_i of ident * exp * block (* foreach statement with list *)
| For_i of ident * exp * exp * block (* foreach statement with integer range *)