1%{
2open Basic_types ;;
3
4let phrase_of_cmd c =
5 match c with
6   "RUN" -> Run
7 | "LIST" -> List
8 | "END" -> End
9 | _ -> failwith "line : unexpected command"
10;;
11
12let op_bin_of_rel r =
13 match r with
14   "=" -> EGAL
15 | "<" -> INF
16 | "<=" -> INFEQ
17 | ">" -> SUP
18 | ">=" -> SUPEQ
19 | "<>" -> DIFF
20 | _ -> failwith "line : unexpected relation symbol"
21;;
22
23%}
24
25
26%token <int> Lint
27%token <string> Lident
28%token <string> Lstring
29%token <string> Lcmd
30%token Lplus Lmoins Lmult Ldiv Lmod
31%token <string> Lrel
32%token Land Lor Lneg
33%token Lpar Rpar
34%token <string> Lrem
35%token Lrem Llet Lprint Linput Lif Lthen Lgoto
36%token Legal
37%token Leol
38
39%right Lneg
40%left Land Lor
41%left Legal Lrel
42%left Lmod
43%left Lplus Lmoins
44%left Lmult Ldiv
45%nonassoc Lopp
46
47%start line
48%type <Basic_types.phrase> line
49
50
51%%
52line :
53   Lint inst Leol               { Ligne {num=$1; inst=$2} }
54 | Lcmd        Leol                    { phrase_of_cmd $1 }
55 ;
56
57inst :
58   Lrem                         { Rem $1 }
59 | Lgoto Lint                   { Goto $2 }
60 | Lprint exp                   { Print $2 }
61 | Linput Lident                { Input $2 }
62 | Lif exp Lthen Lint           { If ($2, $4) }
63 | Llet Lident Legal exp        { Let ($2, $4) }
64 ;
65
66exp :
67   Lint                         { ExpInt $1 }
68 | Lident                       { ExpVar $1 }
69 | Lstring                      { ExpStr $1 }
70 | Lneg exp                     { ExpUnr (NON, $2) }
71 | exp Lplus exp                { ExpBin ($1, PLUS, $3) }
72 | exp Lmoins exp               { ExpBin ($1, MOINS, $3) }
73 | exp Lmult exp                { ExpBin ($1, MULT, $3) }
74 | exp Ldiv exp                        { ExpBin ($1, DIV, $3) }
75 | exp Lmod exp                        { ExpBin ($1, MOD, $3) }
76 | exp Legal exp                { ExpBin ($1, EGAL, $3) }
77 | exp Lrel exp                        { ExpBin ($1, (op_bin_of_rel $2), $3) }
78 | exp Land exp                 { ExpBin ($1, ET, $3) }
79 | exp Lor exp                  { ExpBin ($1, OU, $3) }
80 | Lmoins exp %prec Lopp        { ExpUnr(OPPOSE, $2) }
81 | Lpar exp Rpar                { $2 }
82 ;
83%%
84