src/domtool.grm

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006, Adam Chlipala
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  17  *)
  18
  19 (* Parser for Domtool configuration files *)
  20
  21 open Ast
  22
  23 %%
  24 %header (functor DomtoolLrValsFn(structure Token : TOKEN))
  25
  26 %term
  27    EOF
  28  | SYMBOL of string | CSYMBOL of string
  29  | STRING of string | DOC of string
  30  | INT of int
  31  | ARROW | DARROW | LARROW
  32  | COLON | CARET | BANG | AND
  33  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  34  | EQ | COMMA | BSLASH | BSLASHBSLASH | SEMI | LET | IN | BEGIN | END
  35  | IF | THEN | ELSE
  36  | ROOT | SKIP
  37  | EXTERN | TYPE | VAL | ENV | WITH | WHERE | CONTEXT
  38
  39 %nonterm
  40    file of file
  41  | decls of decl list
  42  | decl of decl
  43  | decl' of decl'
  44  | docOpt of string option
  45  | expOpt of exp option
  46  | exp of exp
  47  | apps of exp
  48  | term of exp
  49  | sets of exp list
  50  | elist of exp list
  51  | elistNe of exp list
  52  | clist of exp list
  53  | typ of typ
  54  | ctxt of pred
  55  | recd of record
  56  | recdNe of record
  57  | SEMIopt of unit
  58
  59 %verbose                                (* print summary of errors *)
  60 %pos int                                (* positions *)
  61 %start file
  62 %pure
  63 %eop EOF
  64 %noshift EOF
  65
  66 %name Domtool
  67
  68 %nonassoc THEN ELSE
  69 %right SEMI
  70 %nonassoc COLON
  71 %nonassoc IN
  72 %right ARROW DARROW
  73 %right COMMA
  74 %nonassoc EQ
  75 %right WITH
  76 %right WHERE
  77 %right AND
  78 %nonassoc CARET BANG
  79
  80 %%
  81
  82 file   : docOpt decls expOpt               (docOpt, decls, expOpt)
  83
  84 decls  :                                   ([])
  85        | decl decls                        (decl :: decls)
  86
  87 decl   : decl' SEMI docOpt                 (decl', docOpt, (decl'left, docOptright))
  88
  89 decl'  : EXTERN TYPE SYMBOL                (DExternType SYMBOL)
  90        | EXTERN VAL SYMBOL COLON typ       (DExternVal (SYMBOL, typ))
  91        | VAL SYMBOL EQ exp                 (DVal (SYMBOL, NONE, exp))
  92        | VAL SYMBOL COLON typ EQ exp       (DVal (SYMBOL, SOME typ, exp))
  93        | ENV CSYMBOL EQ exp                (DEnv (CSYMBOL, NONE, exp))
  94        | ENV CSYMBOL COLON typ EQ exp      (DEnv (CSYMBOL, SOME typ, exp))
  95        | CONTEXT CSYMBOL                   (DContext CSYMBOL)
  96
  97 docOpt :                                   (NONE)
  98        | DOC                               (SOME DOC)
  99
 100 expOpt :                                   (NONE)
 101        | exp                               (SOME exp)
 102
 103
 104 exp    : apps                              (apps)
 105        | apps WHERE sets END               (ELocal ((ESeq sets, (setsleft, setsright)), apps),
 106                                             (appsleft, ENDright))
 107        | apps WITH END                     (EWith (apps, (ESkip, (WITHleft, ENDright))),
 108                                             (appsleft, ENDright))
 109        | apps WITH exp END                 (EWith (apps, exp), (appsleft, ENDright))
 110        | apps WHERE sets WITH END          (ELocal ((ESeq sets, (setsleft, setsright)),
 111                                                     (EWith (apps, (ESkip, (WITHleft, ENDright))),
 112                                                      (appsleft, ENDright))),
 113                                             (appsleft, ENDright))
 114        | apps WHERE sets WITH exp END      (ELocal ((ESeq sets, (setsleft, setsright)),
 115                                                     (EWith (apps, exp), (appsleft, ENDright))),
 116                                             (appsleft, ENDright))
 117
 118        | BSLASH SYMBOL COLON LPAREN typ RPAREN ARROW exp (ELam (SYMBOL, SOME typ, exp),
 119                                                           (BSLASHleft, expright))
 120        | BSLASH SYMBOL ARROW exp           (ELam (SYMBOL, NONE, exp), (BSLASHleft, expright))
 121        | BSLASHBSLASH SYMBOL COLON ctxt ARROW exp (EALam (SYMBOL, ctxt, exp),
 122                                                           (BSLASHBSLASHleft, expright))
 123        | CSYMBOL EQ exp                    (ESet (CSYMBOL, exp), (CSYMBOLleft, expright))
 124        | exp SEMI exp                      (let
 125                                                 val ls = case #1 exp2 of
 126                                                              ESeq ls => exp :: ls
 127                                                            | _ => [exp1, exp2]
 128                                             in
 129                                                 (ESeq ls, (exp1left, exp2right))
 130                                             end)
 131        | exp SEMI                          (exp)
 132        | SYMBOL LARROW CSYMBOL SEMI exp    (EGet (SYMBOL, NONE, CSYMBOL, exp), (SYMBOLleft, expright))
 133        | SYMBOL COLON typ LARROW CSYMBOL SEMI exp (EGet (SYMBOL, SOME typ, CSYMBOL, exp), (SYMBOLleft, expright))
 134        | IF exp THEN exp ELSE exp END      (EIf (exp1, exp2, exp3), (IFleft, ENDright))
 135
 136 apps   : term                              (term)
 137        | apps term                         (EApp (apps, term), (appsleft, termright))
 138
 139 term   : LPAREN exp RPAREN                 (exp)
 140        | BEGIN exp END                     (exp)
 141        | INT                               (EInt INT, (INTleft, INTright))
 142        | STRING                            (EString STRING, (STRINGleft, STRINGright))
 143        | LBRACK elist RBRACK               (EList elist, (LBRACKleft, RBRACKright))
 144        | LET exp IN exp END                (ELocal (exp1, exp2), (LETleft, ENDright))
 145        | SYMBOL                            (EVar SYMBOL, (SYMBOLleft, SYMBOLright))
 146        | SKIP                              (ESkip, (SKIPleft, SKIPright))
 147
 148 sets   : CSYMBOL EQ apps SEMIopt           ([(ESet (CSYMBOL, apps), (CSYMBOLleft, appsright))])
 149        | CSYMBOL EQ apps SEMI sets         ((ESet (CSYMBOL, apps), (CSYMBOLleft, appsright))
 150                                             :: sets)
 151
 152 SEMIopt: SEMI                              ()
 153        |                                   ()
 154
 155 elist  :                                   ([])
 156        | elistNe                           (elistNe)
 157
 158 elistNe: exp                               ([exp])
 159        | exp COMMA elistNe                 (exp :: elistNe)
 160
 161 typ    : SYMBOL                            (TBase SYMBOL, (SYMBOLleft, SYMBOLright))
 162        | LBRACK typ RBRACK                 (TList typ, (LBRACKleft, RBRACKright))
 163        | typ ARROW typ                     (TArrow (typ1, typ2), (typleft, typright))
 164        | LBRACK ctxt RBRACK recd DARROW recd (TAction (ctxt, recd1, recd2), (LBRACKleft, recd2right))
 165        | LBRACK ctxt RBRACK recd           (TAction (ctxt, recd, StringMap.empty),
 166                                             (LBRACKleft, recdright))
 167        | LBRACK ctxt RBRACK                (TAction (ctxt, StringMap.empty, StringMap.empty),
 168                                             (LBRACKleft, ctxtright))
 169        | LPAREN typ RPAREN                 (typ)
 170        | ctxt DARROW typ                   (TNested (ctxt, typ), (ctxtleft, typright))
 171
 172 recd   : LBRACE RBRACE                     (StringMap.empty)
 173        | LBRACE recdNe RBRACE              (recdNe)
 174
 175 recdNe : CSYMBOL COLON typ                 (StringMap.insert (StringMap.empty, CSYMBOL, typ))
 176        | CSYMBOL COLON typ COMMA recdNe    (StringMap.insert (recdNe, CSYMBOL, typ))
 177
 178 ctxt   : ROOT                              (CRoot, (ROOTleft, ROOTright))
 179        | CSYMBOL                           (CConst CSYMBOL, (CSYMBOLleft, CSYMBOLright))
 180        | CARET ctxt                        (CPrefix ctxt, (CARETleft, ctxtright))
 181        | BANG ctxt                         (CNot ctxt, (BANGleft, ctxtright))
 182        | ctxt AND ctxt                     (CAnd (ctxt1, ctxt2), (ctxt1left, ctxt2right))
 183        | LPAREN ctxt RPAREN                (ctxt)