Parsing has never been this much fun

diff --git a/src/ast.sml b/src/ast.sml
index 3fdc22f..6ee4b7b 100644 (file)
--- a/src/ast.sml
+++ b/src/ast.sml
@@ -61,11 +61,15 @@ datatype exp' =
 
        | ELam of string * typ * exp
        (* Function abstraction *)
 
        | ELam of string * typ * exp
        (* Function abstraction *)

+       | EVar of string
+       (* Variable bound by a function *)

        | EApp of exp * exp
        (* Function application *)
 
        | ESet of string * exp
        (* Set an environment variable *)
        | EApp of exp * exp
        (* Function application *)
 
        | ESet of string * exp
        (* Set an environment variable *)

+       | EEnv of string
+       (* Get an environment variable *)

        | ESeq of exp list
        (* Monad sequencer; execute a number of commands in order *)
        | ELocal of exp
        | ESeq of exp list
        (* Monad sequencer; execute a number of commands in order *)
        | ELocal of exp

diff --git a/src/domtool.cm b/src/domtool.cm
index a3ee84f..acf15a7 100644 (file)
--- a/src/domtool.cm
+++ b/src/domtool.cm
@@ -13,3 +13,6 @@ ast.sml
 
 domtool.lex
 domtool.grm
 
 domtool.lex
 domtool.grm

+
+parse.sig
+parse.sml

diff --git a/src/domtool.grm b/src/domtool.grm
index 79d13a1..3384492 100644 (file)
--- a/src/domtool.grm
+++ b/src/domtool.grm
@@ -27,10 +27,10 @@ open Ast
  | SYMBOL of string | CSYMBOL of string
  | STRING of string
  | INT of int
  | SYMBOL of string | CSYMBOL of string
  | STRING of string
  | INT of int

- | ARROW | DARROW | COLON
+ | ARROW | DARROW | COLON | CARET | BANG | AND

  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | EQ | COMMA | BSLASH | SEMI | LET | IN | END
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | EQ | COMMA | BSLASH | SEMI | LET | IN | END

-
+ | ROOT

 
 %nonterm 
    file of exp
 
 %nonterm 
    file of exp


@@ -41,6 +41,9 @@ open Ast
  | elistNe of exp list
  | clist of exp list
  | typ of typ
  | elistNe of exp list
  | clist of exp list
  | typ of typ

+ | ctxt of context
+ | recd of record
+ | recdNe of record

 
 %verbose                                (* print summary of errors *)
 %pos int                                (* positions *)
 
 %verbose                                (* print summary of errors *)
 %pos int                                (* positions *)


@@ -52,17 +55,20 @@ open Ast
 %name Domtool
 
 %right SEMI
 %name Domtool
 
 %right SEMI

+%nonassoc COLON

 %nonassoc IN
 %nonassoc IN

-%right ARROW
+%right ARROW DARROW

 %right COMMA
 %nonassoc EQ
 %right COMMA
 %nonassoc EQ

+%right AND
+%nonassoc CARET BANG

 
 %%
 
 file   : exp                               (exp)
 
 exp    : apps                              (apps)
 
 %%
 
 file   : exp                               (exp)
 
 exp    : apps                              (apps)

-       | BSLASH SYMBOL COLON typ ARROW exp (ELam (SYMBOL, typ, exp), (BSLASHleft, expright))
+       | BSLASH SYMBOL COLON LPAREN typ RPAREN ARROW exp (ELam (SYMBOL, typ, exp), (BSLASHleft, expright))

        | CSYMBOL EQ exp                    (ESet (CSYMBOL, exp), (CSYMBOLleft, expright))
        | exp SEMI exp                      (let
                                                val ls = case #1 exp2 of
        | CSYMBOL EQ exp                    (ESet (CSYMBOL, exp), (CSYMBOLleft, expright))
        | exp SEMI exp                      (let
                                                val ls = case #1 exp2 of


@@ -86,8 +92,11 @@ term   : LPAREN exp RPAREN                 (exp)
                                                           | (_, ESeq ls) => exp1 :: ls
                                                           | _ => [exp1, exp2]
                                            in
                                                           | (_, ESeq ls) => exp1 :: ls
                                                           | _ => [exp1, exp2]
                                            in

-                                               (ESeq ls, (exp1left, exp2right))
+                                               (ELocal (ESeq ls, (exp1left, exp2right)),
+                                                (exp1left, exp2right))

                                            end)
                                            end)

+       | SYMBOL                            (EVar SYMBOL, (SYMBOLleft, SYMBOLright))
+       | CSYMBOL                           (EEnv CSYMBOL, (CSYMBOLleft, CSYMBOLright))

 
 elist  :                                   ([])
        | elistNe                           (elistNe)
 
 elist  :                                   ([])
        | elistNe                           (elistNe)


@@ -96,3 +105,24 @@ elistNe: exp                               ([exp])
        | exp COMMA elistNe                 (exp :: elistNe)
 
 typ    : SYMBOL                            (TBase SYMBOL, (SYMBOLleft, SYMBOLright))
        | exp COMMA elistNe                 (exp :: elistNe)
 
 typ    : SYMBOL                            (TBase SYMBOL, (SYMBOLleft, SYMBOLright))

+       | LBRACK typ RBRACK                 (TList typ, (LBRACKleft, RBRACKright))
+       | typ ARROW typ                     (TArrow (typ1, typ2), (typleft, typright))
+       | LBRACK ctxt RBRACK recd DARROW recd (TAction (ctxt, recd1, recd2), (ctxtleft, recd2right))
+       | LBRACK ctxt RBRACK recd           (TAction (ctxt, recd, StringMap.empty),
+                                           (ctxtleft, recdright))
+       | LBRACK ctxt RBRACK                (TAction (ctxt, StringMap.empty, StringMap.empty),
+                                           (ctxtleft, ctxtright))
+       | LPAREN typ RPAREN                 (typ)
+
+recd   : LBRACE RBRACE                     (StringMap.empty)
+       | LBRACE recdNe RBRACE              (recdNe)
+
+recdNe : CSYMBOL COLON typ                 (StringMap.insert (StringMap.empty, CSYMBOL, typ))
+       | CSYMBOL COLON typ COMMA recdNe    (StringMap.insert (recdNe, CSYMBOL, typ))
+
+ctxt   : ROOT                              (CRoot, (ROOTleft, ROOTright))
+       | CSYMBOL                           (CConst CSYMBOL, (CSYMBOLleft, CSYMBOLright))
+       | CARET ctxt                        (CPrefix ctxt, (CARETleft, ctxtright))
+       | BANG ctxt                         (CNot ctxt, (BANGleft, ctxtright))
+       | ctxt AND ctxt                     (CAnd (ctxt1, ctxt2), (ctxt1left, ctxt2right))
+       | LPAREN ctxt RPAREN                (ctxt)

diff --git a/src/domtool.lex b/src/domtool.lex
index 91af342..765a6ab 100644 (file)
--- a/src/domtool.lex
+++ b/src/domtool.lex
@@ -109,11 +109,16 @@ lineComment = #[^\n]*\n;
 <INITIAL> "\\"        => (Tokens.BSLASH (yypos, yypos + size yytext));
 <INITIAL> ":"         => (Tokens.COLON (yypos, yypos + size yytext));
 <INITIAL> ";"         => (Tokens.SEMI (yypos, yypos + size yytext));
 <INITIAL> "\\"        => (Tokens.BSLASH (yypos, yypos + size yytext));
 <INITIAL> ":"         => (Tokens.COLON (yypos, yypos + size yytext));
 <INITIAL> ";"         => (Tokens.SEMI (yypos, yypos + size yytext));

+<INITIAL> "^"         => (Tokens.CARET (yypos, yypos + size yytext));
+<INITIAL> "!"         => (Tokens.BANG (yypos, yypos + size yytext));
+<INITIAL> "&"         => (Tokens.AND (yypos, yypos + size yytext));

 
 <INITIAL> "let"       => (Tokens.LET (yypos, yypos + size yytext));
 <INITIAL> "in"        => (Tokens.IN (yypos, yypos + size yytext));
 <INITIAL> "end"       => (Tokens.END (yypos, yypos + size yytext));
 
 
 <INITIAL> "let"       => (Tokens.LET (yypos, yypos + size yytext));
 <INITIAL> "in"        => (Tokens.IN (yypos, yypos + size yytext));
 <INITIAL> "end"       => (Tokens.END (yypos, yypos + size yytext));
 

+<INITIAL> "Root"      => (Tokens.ROOT (yypos, yypos + size yytext));
+

 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
 <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext));
 <INITIAL> {intconst}  => (case Int.fromString yytext of
 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
 <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext));
 <INITIAL> {intconst}  => (case Int.fromString yytext of

diff --git a/src/parse.sig b/src/parse.sig
new file mode 100644 (file)
index 0000000..a708344
--- /dev/null
+++ b/src/parse.sig
@@ -0,0 +1,24 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+*)
+
+(* Domtool configuration language parser *)
+
+signature PARSE =
+  sig
+    val parse : string -> Ast.exp
+  end

diff --git a/src/parse.sml b/src/parse.sml
new file mode 100644 (file)
index 0000000..5a5ce3f
--- /dev/null
+++ b/src/parse.sml
@@ -0,0 +1,43 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+*)
+
+(* Domtool configuration language parser *)
+
+structure Parse :> PARSE =
+  struct 
+
+    structure DomtoolLrVals = DomtoolLrValsFn(structure Token = LrParser.Token)
+    structure Lex = DomtoolLexFn(structure Tokens = DomtoolLrVals.Tokens)
+    structure DomtoolP = Join(structure ParserData = DomtoolLrVals.ParserData
+                           structure Lex = Lex
+                           structure LrParser = LrParser)
+
+  (* The main parsing routine *)
+  fun parse filename =
+    let val _ = (ErrorMsg.reset(); ErrorMsg.fileName := filename)
+       val file = TextIO.openIn filename
+       fun get _ = TextIO.input file
+       fun parseerror(s,p1,p2) = ErrorMsg.error (SOME (p1,p2)) s
+       val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
+       val (absyn, _) = DomtoolP.parse(30,lexer, parseerror, ())
+    in
+      TextIO.closeIn file;
+      absyn
+    end
+      handle LrParser.ParseError => raise ErrorMsg.Error
+end

diff --git a/tests/test.dtl b/tests/test.dtl
new file mode 100644 (file)
index 0000000..c026ea2
--- /dev/null
+++ b/tests/test.dtl
@@ -0,0 +1,6 @@
+\x : ([int] -> [Root]) -> x X;
+let
+       Day = "Tuesday"
+in
+       Kill monkeys
+end