Template language overhaul & misc. improvements

diff --git a/doc/.cvsignore b/doc/.cvsignore
index 8e7d85c..5369d10 100644 (file)
--- a/doc/.cvsignore
+++ b/doc/.cvsignore
@@ -2,3 +2,4 @@
 *.log
 *.dvi
 *.ps
 *.log
 *.dvi
 *.ps

+manual
\ No newline at end of file

diff --git a/doc/Makefile b/doc/Makefile
index 77428b8..819c9be 100644 (file)
--- a/doc/Makefile
+++ b/doc/Makefile
@@ -1,4 +1,4 @@
-all: manual.ps
+all: manual.ps manual/index.html

 
 clean:
        rm *.aux *.dvi *.ps *.log
 
 clean:
        rm *.aux *.dvi *.ps *.log


@@ -7,4 +7,7 @@ manual.ps: manual.dvi
        dvips -o manual.ps manual.dvi
 
 manual.dvi: manual.tex
        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

diff --git a/doc/manual.tex b/doc/manual.tex
index b86c295..034e772 100644 (file)
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -96,6 +96,18 @@ The syntax for creating records and extracting their fields is identical to SML'
 
 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.
 
 
 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.
 \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.


@@ -123,31 +135,25 @@ Variables with reference type are introduced with {\tt ref} declarations, which
 If statements are in the usual imperative style, meaning that else clauses are optional. They are of the form:
 
 \begin{verbatim}
 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
        block1

-}
-else if (condition 2)
-{
+else if condition 2 then

        block 2
        block 2

-}

 else
 else

-{

        block 3
        block 3

-}
+end

 \end{verbatim}
 
 \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}
 
 \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
        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.
 \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.


@@ -155,43 +161,34 @@ Where {\tt exp} has type {\tt t list}, {\tt block} is executed for each of {\tt
 There is also a shortcut integer iteration form:
 
 \begin{verbatim}
 There is also a shortcut integer iteration form:
 
 \begin{verbatim}

-foreach (var in fromExp .. toExp)
-{
+foreach var in fromExp .. toExp do

        block
        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}.
 
 \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}
 
 \begin{verbatim}

-case (exp)
-(pat1) { block1 }
-(pat2) { block2 }
+switch exp of
+  pat1 => block1
+| pat2 => block2
+end

 \end{verbatim}
 
 \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
 
 \begin{verbatim}
 try

-{

        block1
        block1

-}
-catch (pat1)
-{
-       block2
-}
-catch (pat2)
-{
-       block3
-}
+with pat1 => block2
+| pat2 => block3
+end

 \end{verbatim}
 
 \end{document}
\ No newline at end of file
 \end{verbatim}
 
 \end{document}
\ No newline at end of file

diff --git a/src/compiler.sml b/src/compiler.sml
index 6ef2807..e87cb57 100644 (file)
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -90,6 +90,7 @@ struct
                    str (toUpper (String.sub (name, 0))) ^ String.extract (name, 1, NONE)
                else
                    raise Error
                    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
        in
            (name, Mlt.trans (config, env, templates, name, Parse.parse path))
        end


@@ -110,9 +111,9 @@ struct
                          "mlt" => loop (smls, (path ^ "/" ^ fname) :: mlts)
                        | ("sml"|"sig") =>
                          let
                          "mlt" => loop (smls, (path ^ "/" ^ fname) :: mlts)
                        | ("sml"|"sig") =>
                          let

-                             val mltName = removeExt fname ^ ".mlt"
+                             val fname = getFname fname

                          in
                          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)
                                  loop (smls, mlts)
                              else
                                  loop ((path ^ "/" ^ fname) :: smls, mlts)


@@ -133,6 +134,7 @@ struct
            val _ = TextIO.closeOut outf
            
            val outf = TextIO.openOut (outPath ^ "/.build.sml")
            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 ^ "\"");
            fun printMlts [] = ()
              | printMlts (h::t) =
                (TextIO.output (outf, "\"" ^ h ^ "\"");


@@ -140,7 +142,7 @@ struct
 
            val libList = foldl (fn (l, s) => s ^ "if CM.make \"" ^ l ^ "\" then () else OS.Process.exit OS.Process.failure;\n") "" (Config.cm config)
        in
 
            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;
            TextIO.output (outf, libList);
            TextIO.output (outf, "Compiler.compileTemplates (Config.read \"mlt.conf\" (Config.default ())) ([");
            printMlts mlts;


@@ -153,6 +155,7 @@ struct
        
     fun compileTemplates config (mlts, smls) =
        let
        
     fun compileTemplates config (mlts, smls) =
        let

+           val err_flag = ref false

            val _ = ErrorMsg.reset ()
 
            val path = Config.inPath config
            val _ = ErrorMsg.reset ()
 
            val path = Config.inPath config


@@ -180,8 +183,9 @@ struct
                let
                    val _ = print ("Compiling " ^ fname ^ "....\n")
                    val (name, output) = compileTemplate (config, env, templates) fname
                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 scriptName = removeExt (getFname fname)

-                   val outName = scriptName ^ ".sml"
+                   val outName = "__" ^ scriptName ^ ".sml"

                    val outf = TextIO.openOut (outPath ^ "/" ^ outName)
                in
                    TextIO.output (outf, output);
                    val outf = TextIO.openOut (outPath ^ "/" ^ outName)
                in
                    TextIO.output (outf, output);


@@ -217,7 +221,7 @@ struct
                    Posix.FileSys.chmod (name, cgiMode)
                end
        in
                    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
                (TextIO.print "Errors compiling templates.\n";
                 OS.Process.failure)
            else

diff --git a/src/lib/main.sml b/src/lib/main.sml
index 0533912..b058cce 100644 (file)
--- a/src/lib/main.sml
+++ b/src/lib/main.sml
@@ -27,7 +27,7 @@ struct
        let
            val _ = Cgi.init ()
            val cgiFields = Cgi.cgi_fieldnames ()
        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
        in
            Web.pushParams (map mapper cgiFields);
            case args of


@@ -40,7 +40,10 @@ struct
                   | SOME f => (f ();
                                Web.output ();
                                OS.Process.success))
                   | 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
                          app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex);
                          OS.Process.failure)
 end
\ No newline at end of file

diff --git a/src/lib/sources.cm b/src/lib/sources.cm
index d1e717c..e602505 100644 (file)
--- a/src/lib/sources.cm
+++ b/src/lib/sources.cm
@@ -22,7 +22,9 @@ Library
        signature TEMPLATES
        signature MAIN
        signature WEB
        signature TEMPLATES
        signature MAIN
        signature WEB

+       signature SQL

 
 

+       structure Sql

        structure Web
 
        functor MainFn
        structure Web
 
        functor MainFn


@@ -40,6 +42,8 @@ is
 
        web.sig
        web.sml
 
        web.sig
        web.sml

+       sql.sig
+       sql.sml

 
        main.sml
        
\ No newline at end of file
 
        main.sml
        
\ No newline at end of file

diff --git a/src/lib/web.sig b/src/lib/web.sig
index c22603e..1b1e690 100644 (file)
--- a/src/lib/web.sig
+++ b/src/lib/web.sig
@@ -21,13 +21,28 @@
 
 signature WEB =
 sig
 
 signature WEB =
 sig

+    val for : (int -> unit) -> int * int -> unit
+

     val print : string -> unit
     val output : unit -> 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 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 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
 end
\ No newline at end of file

diff --git a/src/lib/web.sml b/src/lib/web.sml
index 4b256a5..6d81d5b 100644 (file)
--- a/src/lib/web.sml
+++ b/src/lib/web.sml
@@ -21,16 +21,47 @@
 
 structure Web :> WEB =
 struct
 
 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 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 => ""
 
     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 pushParams nvs =
        (paramStack := (!params) :: (!paramStack);


@@ -54,4 +85,47 @@ struct
     fun output () =
        (TextIO.print "Status: 200\nContent-type: text/html\n\n";
         TextIO.print (String.concat (List.rev (!text))))
     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 #"<" = "&lt;"
+             | xch #">" = "&gt;"
+             | xch #"&" = "&amp;"
+             | xch #"\"" = "&quot;"
+             | xch ch = str ch
+       in
+           foldr op^ "" (map xch (String.explode s))
+       end
+
+    fun htmlNl s =
+       let
+           fun xch #"<" = "&lt;"
+             | xch #">" = "&gt;"
+             | xch #"&" = "&amp;"
+             | xch #"\"" = "&quot;"
+             | 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
 end
\ No newline at end of file

diff --git a/src/mlt.grm b/src/mlt.grm
index a559649..6a584f5 100644 (file)
--- a/src/mlt.grm
+++ b/src/mlt.grm
@@ -38,18 +38,23 @@ fun addNumbers L =
 %term 
    EOF
  | HTML of string
 %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
  | 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
  | 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
 
 %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
  | appsL of exp list
  | apps of exp
  | term of exp


@@ -59,7 +64,7 @@ fun addNumbers L =
  | path of ident list
  | pathList of ident list list
  | blockItem of blockItem
  | 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
  | matches of (pat * block) list withext
  | pexp of exp
  | ppat of pat


@@ -103,10 +108,10 @@ ilist     : IDENT ilist                   (IDENT :: ilist)
 ivlist : IDENT EQ exp COMMA ivlist     ((IDENT, exp) :: ivlist)
        | IDENT EQ exp                  ([(IDENT, exp)])
 
 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)))
 
 blockItem      : HTML                  (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
                | REF ivlist            (BITEM (Ref_i ivlist, (REFleft, ivlistright)))


@@ -114,27 +119,22 @@ blockItem : HTML                  (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
                | 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)))
                | 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),
                        (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),
                        (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)))
 
 block  : blockItem                     (BLOCK ([blockItem], (blockItemleft, blockItemright)))
        | blockItem SEMI block          (BLOCK (blockItem :: (unblock block), (blockItemleft, blockright)))


@@ -180,6 +180,7 @@ term        : LBRACE erseq RBRACE           (EXP (Record_e (false, sortRcs erseq), (LBRACEleft,
        | pexp                          (pexp)
        | STRING                        (EXP (String_e STRING, (STRINGleft, STRINGright)))
        | CHAR                          (EXP (Char_e CHAR, (CHARleft, CHARright)))
        | 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)))
        | path                          (EXP (Ident_e path, (pathleft, pathright)))
        | INT                           (EXP (Int_e INT, (INTleft, INTright)))
        | NEG                           (EXP (Neg_e, (NEGleft, NEGright)))


@@ -206,9 +207,16 @@ exp        : apps                          (apps)
        | 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)))
        | 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)
 
 rseq   : IDENT EQ pat COMMA rseq               ((IDENT, pat) :: rseq)
        | IDENT COMMA rseq                      ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: rseq)


@@ -234,6 +242,8 @@ pterm       : path                                  (PAT (Ident_p path, (pathleft, pathright)))
        | UNDER                                 (PAT (Wild_p, (UNDERleft, UNDERright)))
        | INT                                   (PAT (Int_p INT, (INTleft, INTright)))
        | STRING                                (PAT (String_p STRING, (STRINGleft, STRINGright)))
        | 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)))
        | 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)))

diff --git a/src/mlt.lex b/src/mlt.lex
index 568c1a3..c64ea0c 100644 (file)
--- a/src/mlt.lex
+++ b/src/mlt.lex
@@ -66,6 +66,7 @@ val strStart = ref 0
 
 id = ([A-Za-z_][A-Za-z0-9_]*)|([:]+);
 intconst = [0-9]+;
 
 id = ([A-Za-z_][A-Za-z0-9_]*)|([:]+);
 intconst = [0-9]+;

+realconst = [0-9]+\.[0-9]*;

 ws = [\ \t\012];
 bo = [^<]+;
 
 ws = [\ \t\012];
 bo = [^<]+;
 


@@ -143,27 +144,41 @@ bo = [^<]+;
 <CODE> "@"         => (Tokens.AT (yypos, yypos + size yytext));
 
 <CODE> "if"        => (Tokens.IF (yypos, yypos + 2));
 <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> "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> "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
 
 <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));
 
 
 <CODE> "\"" {id} "\"" => (Tokens.STRING (String.substring(yytext, 1, String.size yytext - 2), yypos, yypos + size yytext));
 

diff --git a/src/mlt.sml b/src/mlt.sml
index 38848e7..eecf08d 100644 (file)
--- a/src/mlt.sml
+++ b/src/mlt.sml
@@ -125,19 +125,19 @@ struct
            (*end*)
            handle Unify.Unify msg =>
                   (PrettyPrint.begin_block ppstream PrettyPrint.CONSISTENT 0;
            (*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.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.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.end_block ppstream;

+                   PrettyPrint.add_break ppstream (1, 0);

                    PrettyPrint.flush_ppstream ppstream;
                    error (SOME pos, Unify.failMessage msg))
                                      
                    PrettyPrint.flush_ppstream ppstream;
                    error (SOME pos, Unify.failMessage msg))
                                      


@@ -254,6 +254,8 @@ struct
        (case e of
             Int_e n =>
                 (BasicTypes.intTy, Int.toString n)
        (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 =>
           | String_e s =>
                 (BasicTypes.stringTy, "\"" ^ s ^ "\"")
           | Char_e s =>


@@ -437,6 +439,31 @@ struct
                        unify state (pos, dom, xt);
                        (ran, "(" ^ fs ^ ") (" ^ xs ^ ")")
                    end
                        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)) =>
           | Record_e (ist, cs) =>
                 let
                     val (cs, str) = foldl (fn ((id, e), (cs, str)) =>


@@ -457,6 +484,37 @@ struct
                 in
                     (BasicTypes.recordTy cs, str)
                 end
                 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
           | RecordUpd_e (e, cs) =>
                 let
                     val (ty, es) = xexp state e


@@ -491,13 +549,13 @@ struct
                 end)
             handle Skip => (errorTy, "<error>")
 
                 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
 
        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] =>
        (case p of
             Ident_p [] => raise Fail "Impossible empty Ident_p"
           | Ident_p [id] =>


@@ -512,7 +570,9 @@ struct
             (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)
             (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 ^ "\"")
           | 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
           | App_p ([], _) => raise Fail "Impossible App_p"
           | App_p ([id], p) =>
             let


@@ -649,20 +709,15 @@ struct
                         in
                             (state, str ^ "val _ = " ^ printFn ^ " (" ^ s ^ ")\n")
                         end
                         in
                             (state, str ^ "val _ = " ^ printFn ^ " (" ^ s ^ ")\n")
                         end

-                  | Ifthenelse_i (ifs, els) =>
+                  | Ifthenelse_i (e, b, els) =>

                         let
                             val str = str ^ "val _ = "
                         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 str =
                                 case els of
                                     NONE =>


@@ -691,8 +746,8 @@ struct
                             val state = addVar (state, id, VAR parm)
                             val (_, bs) = xblock state b
                         in
                             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")
                              bs ^
                              "in () end\n" ^
                              "val _ = app foreach (" ^ es ^ ")\n")


@@ -711,7 +766,7 @@ struct
                             (state, str ^ "fun forFunc " ^ id ^ " = let\n" ^
                              bs ^
                              "in () end\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
                         end
                   | Case_i (e, matches) =>
                         let

diff --git a/src/tree.sml b/src/tree.sml
index 05b84d6..c74df19 100644 (file)
--- a/src/tree.sml
+++ b/src/tree.sml
@@ -30,7 +30,7 @@ struct
 
     (* Pattern *)
     datatype pat' =
 
     (* 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
       | Ident_p of path
       | Record_p of bool * (ident * pat) list
       | FlexRecord_p of (ident * pat) list


@@ -40,7 +40,7 @@ struct
 
     (* Expression *)
     and exp' =
 
     (* 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
       | 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


@@ -53,6 +53,9 @@ struct
       | Record_e of bool * (ident * exp) list
       | RecordUpd_e of exp * (ident * exp) list
       | Proj_e of ident | App_e of exp * exp
       | 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' =
     and exp = EXP of exp' withext
 
     and blockItem' =


@@ -62,7 +65,7 @@ struct
       | 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 *)
       | 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 *)
       | 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 *)