parser.mly 2.35 KB
Newer Older
1
2
%{
  open Parsetree
3
  let rec insert (k, v) = function
4
5
6
7
8
9
10
11
    | [] -> [(k, v)]
    | (k', v') :: l when k < k' -> (k, v) :: (k', v') :: l
    | (k', _) :: l when k = k' -> (k, v) :: l
    | (k', v') :: l -> (k', v') :: (k, v) :: l


  let parse_error s = print_endline s

12
13
14
15
16
17
18
19
20
  let rec insert1 k = function
    | [] -> [k]
    | k' :: l when k < k' -> k :: k' :: l
    | k' :: l when k = k' -> k :: l
    | k' :: l -> k' :: k :: l

  let label l =
    let l' = Label l in
    Base.labels := insert1 l' !Base.labels; l'
21
22
%}

23
24
%token <string> ID CID SELECT UPDATE FUPD
%token LBRACK RBRACK COLUMN SEMICOLUMN LPAR RPAR SIGMA EQUAL DEF DOT
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
%token LAMBDA ARR
%token <Lexing.position> TYPE VAR CHECK NORM

%right ARR

%start line
%type <Lexing.position * Parsetree.line> line

%%

line:   TYPE CID DEF ty DOT           { ($1, Typedef (Cid ($2), $4)) }
      | VAR ID COLUMN ty DEF term DOT { ($1, Vardef (Id ($2), $4, $6)) }
      | CHECK term COLUMN ty DOT      { ($1, Check ($2, $4)) }
      | NORM term DOT                 { ($1, Norm ($2)) }
;

ty:   CID                         { Tcid (Cid ($1)) }
    | LBRACK type_elems RBRACK    { Tlist ($2) }
    | ty ARR ty                   { Tarr ($1, $3) }
;

46
47
48
49
50
51
52
53
type_elem: ID COLUMN ty { (label ($1), $3) };

several_type_elems:   type_elem                               { [$1] }
                    | type_elem SEMICOLUMN several_type_elems { insert ($1) ($3) }
;

type_elems:   /* empty */             { [] }
            | several_type_elems      { $1 }
54
55
;

Raphaël Cauderlier's avatar
Raphaël Cauderlier committed
56
57
58
59
60
obj:   ID                                 { Var (Id ($1)) }
     | LPAR term RPAR                     { Par ($2) }
     | LBRACK obj_elems RBRACK            { Obj ($2) }
;

Raphaël Cauderlier's avatar
Raphaël Cauderlier committed
61
62
63
64
65
66
term:   obj                                { $1 }
/*      | term term                           { App ($1, $2) } */
      | LAMBDA LPAR ID COLUMN ty RPAR term { Abst (Id ($3), $5, $7)}
      | obj SELECT                         { Select ($1, label ($2)) }
      | obj UPDATE meth                    { Update ($1, label ($2), $3) }
      | obj FUPD term                      { Field_update ($1, label ($2), $3) }
67
68
69
70
71
;

meth:   SIGMA LPAR ID COLUMN ty RPAR term { Method (Id ($3), $5, $7) }
;

72
73
74
75
76
77
78
79
obj_elem: ID EQUAL meth { (label ($1), $3) };

several_obj_elems:   obj_elem { [ $1 ]}
                   | obj_elem SEMICOLUMN several_obj_elems { insert ($1) ($3) }
;

obj_elems:   /* empty */       { [] }
           | several_obj_elems { $1 }
80
81
82
;

%%