From a22c187b7b983dad6b0e2c34cd0ab74e95c2411b Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Mon, 24 Jul 2006 00:39:07 +0000 Subject: [PATCH] Parsing has never been this much fun --- src/ast.sml | 4 ++++ src/domtool.cm | 3 +++ src/domtool.grm | 40 +++++++++++++++++++++++++++++++++++----- src/domtool.lex | 5 +++++ src/parse.sig | 24 ++++++++++++++++++++++++ src/parse.sml | 43 +++++++++++++++++++++++++++++++++++++++++++ tests/test.dtl | 6 ++++++ 7 files changed, 120 insertions(+), 5 deletions(-) create mode 100644 src/parse.sig create mode 100644 src/parse.sml create mode 100644 tests/test.dtl diff --git a/src/ast.sml b/src/ast.sml index 3fdc22f..6ee4b7b 100644 --- a/src/ast.sml +++ b/src/ast.sml @@ -61,11 +61,15 @@ datatype exp' = | 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 *) + | EEnv of string + (* Get an environment variable *) | 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 --- a/src/domtool.cm +++ b/src/domtool.cm @@ -13,3 +13,6 @@ ast.sml domtool.lex domtool.grm + +parse.sig +parse.sml diff --git a/src/domtool.grm b/src/domtool.grm index 79d13a1..3384492 100644 --- 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 - | ARROW | DARROW | COLON + | ARROW | DARROW | COLON | CARET | BANG | AND | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | EQ | COMMA | BSLASH | SEMI | LET | IN | END - + | ROOT %nonterm file of exp @@ -41,6 +41,9 @@ open Ast | 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 *) @@ -52,17 +55,20 @@ open Ast %name Domtool %right SEMI +%nonassoc COLON %nonassoc IN -%right ARROW +%right ARROW DARROW %right COMMA %nonassoc EQ +%right AND +%nonassoc CARET BANG %% 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 @@ -86,8 +92,11 @@ term : LPAREN exp RPAREN (exp) | (_, ESeq ls) => exp1 :: ls | _ => [exp1, exp2] in - (ESeq ls, (exp1left, exp2right)) + (ELocal (ESeq ls, (exp1left, exp2right)), + (exp1left, exp2right)) end) + | SYMBOL (EVar SYMBOL, (SYMBOLleft, SYMBOLright)) + | CSYMBOL (EEnv CSYMBOL, (CSYMBOLleft, CSYMBOLright)) elist : ([]) | elistNe (elistNe) @@ -96,3 +105,24 @@ elistNe: exp ([exp]) | 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 --- a/src/domtool.lex +++ b/src/domtool.lex @@ -109,11 +109,16 @@ lineComment = #[^\n]*\n; "\\" => (Tokens.BSLASH (yypos, yypos + size yytext)); ":" => (Tokens.COLON (yypos, yypos + size yytext)); ";" => (Tokens.SEMI (yypos, yypos + size yytext)); + "^" => (Tokens.CARET (yypos, yypos + size yytext)); + "!" => (Tokens.BANG (yypos, yypos + size yytext)); + "&" => (Tokens.AND (yypos, yypos + size yytext)); "let" => (Tokens.LET (yypos, yypos + size yytext)); "in" => (Tokens.IN (yypos, yypos + size yytext)); "end" => (Tokens.END (yypos, yypos + size yytext)); + "Root" => (Tokens.ROOT (yypos, yypos + size yytext)); + {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext)); {cid} => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext)); {intconst} => (case Int.fromString yytext of diff --git a/src/parse.sig b/src/parse.sig new file mode 100644 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 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 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 -- 2.20.1