| 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
domtool.lex
domtool.grm
+
+parse.sig
+parse.sml
| 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
| 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 *)
%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
| (_, 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)
| 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)
<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> "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
--- /dev/null
+(* 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
--- /dev/null
+(* 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
--- /dev/null
+\x : ([int] -> [Root]) -> x X;
+let
+ Day = "Tuesday"
+in
+ Kill monkeys
+end