1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* only by permission. *)
(* *)
(***********************************************************************)
type expression =
| Variable of string
| Fonction of (motif * expression) list
| Application of expression * expression
| Let of dfinition * expression
| Boolen of bool
| Nombre of int
| Paire of expression * expression
| Nil
| Cons of expression * expression
and motif =
| Motif_variable of string
| Motif_boolen of bool
| Motif_nombre of int
| Motif_paire of motif * motif
| Motif_nil
| Motif_cons of motif * motif
and dfinition =
{ rcursive: bool;
nom: string;
expr: expression };;
type phrase =
| Expression of expression
| Dfinition of dfinition;;
open Lexuniv;;
let est_un_oprateur oprateurs op = List.mem op oprateurs;;
let lire_oprateur oprateurs = parser
| [< 'MC op when est_un_oprateur oprateurs op >] -> op;;
let lire_opration lire_base oprateurs =
let rec lire_reste e1 = parser
| [< op = lire_oprateur oprateurs;
e2 = lire_base;
e = lire_reste (Application(Variable op, Paire(e1, e2))) >] -> e
| [< >] -> e1 in
parser [< e1 = lire_base; e = lire_reste e1 >] -> e;;
let lire_infixe lire_base infixe construire_syntaxe flux =
let rec lire_dbut = parser
[< e1 = lire_base; e2 = lire_reste e1 >] -> e2
and lire_reste e1 = parser
| [< 'MC op when op = infixe; e2 = lire_dbut>] ->
construire_syntaxe e1 e2
| [< >] -> e1 in
lire_dbut flux;;
let rec phrase = parser
| [< d = dfinition; p = fin_de_dfinition d; 'MC ";;" >] -> p
| [< e = expression; 'MC ";;" >] -> Expression e
and fin_de_dfinition d = parser
| [< 'MC "in"; e = expression >] -> Expression (Let(d, e))
| [< >] -> Dfinition d
and expression = parser
| [< d = dfinition; 'MC "in"; e = expression >] -> Let(d, e)
| [< 'MC "function"; liste = liste_de_cas >] ->
Fonction(liste)
| [< 'MC "match"; e = expression; 'MC "with";
liste = liste_de_cas >] ->
Application(Fonction(liste), e)
| [< e = expr5 >] -> e
and expr_simple = parser
| [< 'Entier i >] -> Nombre i
| [< 'MC "true" >] -> Boolen true
| [< 'MC "false" >] -> Boolen false
| [< 'Ident id >] -> Variable id
| [< 'MC "["; 'MC "]" >] -> Nil
| [< 'MC "("; e = expression; 'MC ")" >] -> e
and expr0 = parser
| [< es = expr_simple; e = suite_d'applications es >] -> e
and suite_d'applications f = parser
| [< arg = expr_simple;
e = suite_d'applications (Application(f, arg)) >] -> e
| [<>] -> f
and expr1 flux =
lire_opration expr0 ["*"; "/"] flux
and expr2 flux =
lire_opration expr1 ["+"; "-"] flux
and expr3 flux =
lire_opration expr2 ["="; "<>"; "<"; ">"; "<="; ">="] flux
and expr4 flux =
lire_infixe expr3 "::" (fun e1 e2 -> Cons(e1, e2)) flux
and expr5 flux =
lire_infixe expr4 "," (fun e1 e2 -> Paire(e1, e2)) flux
and dfinition = parser
| [< 'MC "let"; r = rcursive; 'Ident nom; 'MC "="; e = expression >] ->
{rcursive = r; nom = nom; expr = e}
and rcursive = parser
| [< 'MC "rec" >] -> true
| [< >] -> false
and liste_de_cas = parser
| [< m = motif; 'MC "->"; e = expression; reste = autres_cas >] ->
(m, e) :: reste
and autres_cas = parser
| [< 'MC "|"; m = motif; 'MC "->"; e = expression;
reste = autres_cas >] -> (m, e) :: reste
| [< >] -> []
and motif_simple = parser
| [< 'Ident id >] -> Motif_variable id
| [< 'Entier n >] -> Motif_nombre n
| [< 'MC "true" >] -> Motif_boolen true
| [< 'MC "false" >] -> Motif_boolen false
| [< 'MC "["; 'MC "]" >] -> Motif_nil
| [< 'MC "("; m = motif; 'MC ")" >] -> m
and motif1 flux =
lire_infixe motif_simple "::" (fun m1 m2 -> Motif_cons(m1, m2)) flux
and motif flux =
lire_infixe motif1 "," (fun m1 m2 -> Motif_paire(m1, m2)) flux;;
let analyseur_lexical = construire_analyseur
["function"; "let"; "rec"; "in"; "match"; "with"; "->"; ";;";
"true"; "false"; "["; "]"; "("; ")"; "::"; "|"; ",";
"*"; "/"; "-"; "+"; "="; "<>"; "<"; ">"; "<="; ">="; "::"];;
let lire_phrase f = phrase (analyseur_lexical f);;
|
