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 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
| (* Interpréteur d'expressions mathématiques *)
(* Définitions des types, fonctions d'affichage et autres fonctions diverses *)
type Lexeme = (* Comprend les lexèmes, les listes de lexèmes ainsi qu'un symbole particulier Nil qui sert lors de la reconnaissance des parenthèses *)
| Nil
| Num of float
| Symb of char
| List of Lexeme list;;
type Expr =
| Nb of float
| Add of Expr * Expr
| Sub of Expr * Expr
| Mul of Expr * Expr
| Div of Expr * Expr
| Neg of Expr
| Sin of Expr
| Cos of Expr;;
let rec print = function (* Affiche une liste de Lexeme *)
|[] -> ()
|h::t -> match h with
| Nil -> print t
| Num i -> (print_float i; print_string " "; print t)
| Symb c -> (print_char c; print_string " "; print t)
| List l -> (print_char `[`; print l; print_char `]`; print_string " "; print t)
;;
let rec print_expr expr = match expr with (* Affiche une expression *)
| Nb n -> print_float n
| Add(a,b) -> (print_char `(`; print_expr a; print_char `+`; print_expr b; print_char `)`)
| Sub(a,b) -> (print_char `(`; print_expr a; print_char `-`; print_expr b; print_char `)`)
| Mul(a,b) -> (print_char `(`; print_expr a; print_char `*`; print_expr b; print_char `)`)
| Div(a,b) -> (print_char `(`; print_expr a; print_char `/`; print_expr b; print_char `)`)
| Neg a -> (print_char `(`; print_char `-`; print_expr a; print_char `)`)
| Sin a -> (print_string "(sin"; print_expr a; print_char `)`)
| Cos a -> (print_string "(cos"; print_expr a; print_char `)`)
;;
let rec add lexlist lex = match lexlist with (* Étant donnés une liste de Lexeme et un Lexeme, rajoute ce dernier à la fin de la liste et le plus profondément, ie si la fin de la liste est aussi une liste, on le rajoute à la fin de celle-ci et ainsi de suite, mais en considérant que les listes se terminant par Nil sont pleines *)
| [] -> [lex]
| Nil::_ -> lexlist
| (Num _)::_ | (Symb _)::_ -> lex::lexlist
| (List [])::t -> (List [lex])::t
| (List l)::t when hd(l) = Nil -> lex::(List l)::t
| (List l)::t -> (List (add l lex))::t;;
let rec purge liste = match liste with (* Supprime tous les Nil d'une liste de lexèmes (y compris ceux dans les sous-listes) *)
| [] -> []
| h::t -> match h with
|Nil -> purge t
|Num _ | Symb _ -> h::(purge t)
|List l -> (List (purge l))::(purge t)
;;
let rec miroir lexlist = match lexlist with (* Renvoi un miroir de la liste de lexèmes, y compris des sous-listes *)
| [] -> []
| h::t -> match h with
|Nil |Num _ |Symb _ -> (miroir t) @ [h]
|List l -> (miroir t) @ [List (miroir l)]
;;
(* Analyseur lexical : il rentre une chaîne de caractères, il ressort une liste de Lexeme ne contenant pas de Nil ni de List *)
let is_num c = let c' = int_of_char c in (47 < c') && (c' < 58);;
let valeur c = float_of_int( (int_of_char c) - 48 );;
let is_symb c = (c = `+`) || (c = `-`) || (c = `*`) || (c = `/`) || (c = `(`) || (c = `)`) ;;
let lex str =
let sortie = ref [] and
num_now = ref false and (* true si on est entrain de lire un nombre *)
num = ref 0. and (* si num_now = true, le nombre qu'on est entrain de lire *)
is_flott = ref false and (* true si on est entrain de lire un flottant *)
eps = ref 18.57 in
for i = 0 to (string_length str) - 1 do
let c = str.[i] in
if is_symb c then
if !num_now then (sortie := (Symb c)::(Num !num)::!sortie; num_now := false)
else sortie := (Symb c)::!sortie
else if is_num c then
if !num_now then (if !is_flott then (num := !num +. (valeur c) *. !eps; eps := !eps /. 10.) else num := 10. *. !num +. (valeur c))
else (num_now := true; num := valeur c)
else if c = `.` then
if !num_now && (not !is_flott) then (is_flott := true; eps := 0.1) else failwith "Erreur de syntaxe"
else if !num_now then (sortie := (Num !num)::!sortie; num_now := false; is_flott := false)
else if c = `s` then
if (string_length str) > (i + 2) && str.[i+1] = `i` && str.[i+2] = `n` then (sortie := (Symb `s`)::!sortie; str.[i+1] <- ` `; str.[i+2] <- ` `) else failwith "Erreur de syntaxe"
else if c = `c` then
if (string_length str) > (i + 2) && str.[i+1] = `o` && str.[i+2] = `s` then (sortie := (Symb `c`)::!sortie; str.[i+1] <- ` `; str.[i+2] <- ` `) else (print_int i; print_string str; failwith "Erreur de syntaxe")
else if c!=` ` then failwith("Erreur de syntaxe !");
done;
if !num_now then sortie := ((Num !num):: !sortie);
rev !sortie;;
(* Prédécoupage selon les parenthèses : on remplace tout couple de parenthèses par la liste des lexèmes situés entre, il rentre une liste de Lexeme ne contenant pas de Nil ni de List, et ressort une liste de Lexeme ne contenant pas de Symb `(` ni de Symb`)` même dans les sous listes *)
let decoup liste =
let rec decoupage fait sefait reste = match reste with
| [] -> (sefait)@fait
| h::t when h = Symb `(` -> (decoupage fait (add sefait (List [])) t)
| h::t when h = Symb `)` -> if sefait = [] then failwith "Erreur de syntaxe" else
(match (hd sefait) with
| Nil -> failwith "Erreur de syntaxe"
| Num _ | Symb _ -> decoupage ((List (sefait))::fait) [] t
| List l -> decoupage fait (add sefait Nil) t;)
| h::t -> (decoupage fait (add sefait h) t);
in (decoupage [] [] liste);;
(* Résolution des opérateurs unaires : si U est un opérateur unaire (moins négatif, sin ou cos) on parenthèse (Ux) (avec une sous liste)*)
let rec unaires lexlist = match lexlist with
| [] -> []
| [Num _] -> lexlist
| [Symb _] -> failwith "Erreur de syntaxe"
| [List l] -> [List (unaires l)]
| [Symb _; _] -> [List lexlist]
| (Symb c)::h::t when c = `-` || c = `c` || c = `s` -> (unaires ((List [Symb c; h])::t))
| a::b::t -> a::b::(unaires t)
| _ -> failwith "Erreur de syntaxe";;
(* Convertisseur en expression : la liste de lexèmes est normalisée : toute sous-liste est de la forme
- un truc calculable (nombre ou sous-liste)
ou - un opérateur unaire + un truc calculable
ou - une liste de trucs calculables et d'opérateurs binaires cbcbcbcb...c
et on le convertit en expression*)
let prior c = if (c = `+`) || (c = `-`) then 1 else 2;; (* si (prior c) = 2, c'est que c = `*` ou `/` *)
let rec priority liste = match liste with
|[] | [_] -> 3
|[a;b] -> failwith "Erreur de syntaxe"
|t::(Symb o)::q -> if (priority q) = 3 then (prior o) else (max (prior o) (priority q))
|_ -> failwith "Erreur de syntaxe";;
let rec syntax liste = match liste with
| [] | [Symb _] -> failwith "Erreur de syntaxe"
| [Num n] -> Nb n
| [List l] -> syntax l
| [Symb `-`; n] -> Neg (syntax [n])
| [Symb `c`; n] -> Cos (syntax [n])
| [Symb `s`; n] -> Sin (syntax [n])
| avant::(Symb c)::apres -> if (prior c) < priority apres then (match c with
| `+` -> Add ((syntax [avant]),(syntax apres))
| `-` -> Sub ((syntax [avant]),(syntax apres))
| `*` -> Mul ((syntax [avant]),(syntax apres))
| `/` -> Div ((syntax [avant]),(syntax apres))
| _ -> failwith "Erreur de syntaxe")
else syntax ((List [avant; Symb c; hd apres])::(tl apres));
| _ -> failwith "Erreur de syntaxe";;
(* Évaluateur : il rentre une expression et il ressort sa valeur calculée *)
let rec calc expr = match expr with
| Nb n -> n
| Add(a,b) -> (calc a) +. (calc b)
| Sub(a,b) -> (calc a) -. (calc b)
| Mul(a,b) -> (calc a) *. (calc b)
| Div(a,b) -> let cb = calc b in (if cb = 0. then (failwith "Division par zéro !") else (calc a) /. (calc b))
| Neg a -> -.(calc a)
| Sin a -> sin (calc a)
| Cos a -> cos (calc a)
;;
(* Fonction finale d'évaluation d'une chaîne de caractères *)
let eval str =
let lexlist = lex str in
(*print lexlist;
print_newline();
print_newline();
print (miroir (purge (decoup lexlist)));
print_newline();
print_newline();
print_expr (syntax (unaires (miroir (purge (decoup lexlist)))));
print_newline();
print_newline();*)
print_float (calc (syntax (unaires (miroir (purge (decoup lexlist))))));
print_newline();;
eval "(1+ (2) * 3 + cos(3 + 2)/sin(1))";; |
Partager