summaryrefslogtreecommitdiff
path: root/parser.mly
diff options
context:
space:
mode:
authorGuillaume Seguin <guillaume@segu.in>2009-01-10 15:18:46 +0100
committerGuillaume Seguin <guillaume@segu.in>2009-01-10 15:18:46 +0100
commit7c9a83390e3094cbed37ccaf98574dff0450c2c5 (patch)
tree27fdf025610858eb2c471a61ddaf08e63b4ead41 /parser.mly
downloadpetitcaml-7c9a83390e3094cbed37ccaf98574dff0450c2c5.tar.gz
petitcaml-7c9a83390e3094cbed37ccaf98574dff0450c2c5.tar.bz2
[petitcaml] Import compiler frontend
Diffstat (limited to 'parser.mly')
-rw-r--r--parser.mly149
1 files changed, 149 insertions, 0 deletions
diff --git a/parser.mly b/parser.mly
new file mode 100644
index 0000000..3b2c0e3
--- /dev/null
+++ b/parser.mly
@@ -0,0 +1,149 @@
+/* Analyseur syntaxique pour Petit Caml */
+
+%{
+open Ast
+open Utils
+%}
+
+%token <int> INTEGER
+%token <string> STRING
+%token TRUE FALSE
+%token UNIT
+%token <string> IDENT
+%token ELSE FUNCTION IF IN LET MATCH NOT REC THEN WITH
+%token EMPTYLIST RIGHTARROW TWOCOLONS CASE UNDERSCORE
+%token PLUS MINUS TIMES DIV AND OR
+%token LE GE LT GT NEQ EQ
+%token LBRACE RBRACE LPAREN RPAREN COMMA SEMICOLON
+%token EOF
+
+/* Définitions des priorités et associativités des tokens */
+
+%nonassoc IN
+%nonassoc ELSE
+%nonassoc RIGHTARROW
+%left AND OR
+%left LT LE GT GE EQ NEQ
+%right TWOCOLONS
+%left MINUS PLUS
+%left TIMES DIV
+%nonassoc UMINUS NOT
+
+/* Point d'entrée de la grammaire */
+%start fichier
+
+/* Type des valeurs retournées par l'analyseur syntaxique */
+%type <Ast.expr> fichier
+
+%%
+
+fichier:
+ decls = list(decl) EOF
+ {
+ let rec reduce_decls = function
+ | [] -> raw_expr (Econst Cunit)
+ | (m, e, loc)::l -> locd_expr (Eletin (m, e, (reduce_decls l))) loc
+ in
+ reduce_decls decls
+ }
+
+const:
+| a = INTEGER { Cint a }
+| s = STRING { Cstring s }
+| TRUE { Cbool true }
+| FALSE { Cbool false }
+| UNIT { Cunit }
+| EMPTYLIST { Cemptylist }
+;
+
+motif:
+| UNDERSCORE { locd_motif Munderscore (make_loc $startpos $endpos) }
+| id = IDENT { locd_motif (Mident id) (make_loc $startpos $endpos) }
+| LPAREN m = motif COMMA motifs = separated_nonempty_list(COMMA, motif) RPAREN
+ { locd_motif (Mtuple (m::motifs)) (make_loc $startpos $endpos) }
+;
+
+decl:
+| LET name = motif EQ e = expr
+ { (name, e, make_loc $startpos $endpos) }
+| LET recur = ioption(REC) id = IDENT args = nonempty_list(motif) EQ e = expr
+ { (locd_motif (Mident id) (make_loc $startpos(id) $endpos(id)),
+ raw_expr (make_func id recur e args),
+ make_loc $startpos $endpos) }
+;
+
+simple_expr:
+| LPAREN e = expr RPAREN { e }
+| id = IDENT { locd_expr (Eident id) (make_loc $startpos $endpos) }
+| c = const { locd_expr (Econst c) (make_loc $startpos $endpos) }
+| LPAREN e = expr COMMA exprs = separated_nonempty_list(COMMA, expr) RPAREN
+ { locd_expr (Etuple (e::exprs)) (make_loc $startpos $endpos) }
+| LBRACE exprs = separated_list(SEMICOLON, expr) RBRACE
+ { List.fold_right (fun expr base -> raw_expr (Elistcons (expr, base)))
+ exprs
+ (locd_expr (Econst (Cemptylist))
+ (make_loc $startpos $endpos)) }
+;
+
+expr:
+| e = simple_expr { e }
+| func = simple_expr args = nonempty_list(simple_expr)
+ { match args with
+ | [] -> failwith "Unreachable matching"
+ | arg::args ->
+ List.fold_left (fun base arg -> raw_expr (Ecall (base, arg)))
+ (locd_expr (Ecall (func, arg))
+ (make_loc $startpos $endpos))
+ args }
+| FUNCTION m = motif RIGHTARROW e = expr
+ { locd_expr (Efunc ({ name = None ;
+ recursive = false ;
+ arg = m ;
+ body = e }))
+ (make_loc $startpos $endpos) }
+| e = unopexpr { locd_expr e (make_loc $startpos $endpos) }
+| left = expr o = binop right = expr
+ { locd_expr (Ebinop (left, o, right))
+ (make_loc $startpos $endpos) }
+| head = expr TWOCOLONS tail = expr
+ { locd_expr (Elistcons (head, tail))
+ (make_loc $startpos $endpos) }
+| IF cond = expr THEN then_expr = expr ELSE else_expr = expr
+ { locd_expr (Eif (cond, then_expr, else_expr))
+ (make_loc $startpos $endpos) }
+| LET m = motif EQ value = expr IN body = expr
+ { locd_expr (Eletin (m, value, body))
+ (make_loc $startpos $endpos) }
+| LET recur = ioption(REC) id = IDENT args = nonempty_list(motif)
+ EQ fbody = expr IN body = expr
+ { locd_expr (Eletin (locd_motif (Mident id) (make_loc $startpos(id)
+ $endpos(id)),
+ raw_expr (make_func id recur fbody args),
+ body))
+ (make_loc $startpos $endpos) }
+| MATCH e = expr WITH
+ EMPTYLIST RIGHTARROW empty_e = expr
+ CASE head = motif TWOCOLONS tail = motif RIGHTARROW match_expr = expr
+ { locd_expr (Ematch (e, empty_e, head, tail, match_expr))
+ (make_loc $startpos $endpos) }
+;
+
+unopexpr:
+| MINUS e = expr %prec UMINUS { Eunop (Neg, e) }
+| NOT e = expr { Eunop (Not, e) }
+;
+
+%inline binop:
+| PLUS { Add }
+| MINUS { Sub }
+| TIMES { Mul }
+| DIV { Div }
+| AND { And }
+| OR { Or }
+| EQ { Eq }
+| NEQ { Neq }
+| LT { Lt }
+| LE { Le }
+| GT { Gt }
+| GE { Ge }
+;