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
| (*
Interpréteur d'expressions mathématiques (OCaml)
Mode d'emploi : compiler ce fichier tout d'un bloc dans l'interpréteur OCaml, ensuite lancer ` eval "1+1";; ` pour évaluer une unique chaîne de caractères ou encore ` eval_it();; ` pour en évaluer plusieurs d'affilée.
Portable sous Caml light sans problème, il faut juste remplacer les "String.length" par "string_length" et les "'" par "`"
*)
(* Définitions des types *)
type lexeme = (* Comprend les "vrais" lexèmes (nombres et symboles), 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 (* peut être '+', '-', '*', '/', '(', ')', 'c' ou 's' *)
| List of lexeme list;;
type expr = (* Type d'une expression mathématique sous forme d'un arbre *)
| 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;;
(* Analyseur lexical : il y rentre une chaîne de caractères, il en ressort une liste de Lexeme ne contenant pas de Nil ni de List : attention, la liste de lexèmes est dans le sens inverse par rapport à la chaîne de caractères *)
let valeur c = float_of_int( (int_of_char c) - 48 );;
let lex str =
let rec lexi str i lexlist = (* trie la chaîne str à partir du caractère i et place les lexèmes obtenus à la suite de lexlist *)
if i >= String.length str then lexlist
else let c = str.[i] in match c with
|'+' |'-' |'*' |'/' |'(' |')' -> lexi str (i+1) ((Symb c)::lexlist)
|('0'..'9') -> let rec nombre str i nb is_flott eps = (* nombre renvoie le nombre dans la chaîne de caractères str commencant au caractère i, ainsi que l'indice du caractère suivant ce nombre *)
if i = String.length str then (nb,i)
else begin
let c = str.[i] in match c with
|('0'..'9') -> if is_flott then nombre str (i+1) (nb +. (valeur c)*.eps) true (eps /. 10.)
else nombre str (i+1) (10. *. nb +. (valeur c)) false eps
|'.' -> if is_flott then failwith "Erreur de syntaxe" else nombre str (i+1) nb true 0.1
|_ -> (nb,i)
end
in let (nb,j) = (nombre str i 0. false 57.) in lexi str j ((Num (nb))::lexlist)
|'s' -> if (String.length str) > (i + 2) && str.[i+1] = 'i' && str.[i+2] = 'n' then lexi str (i+3) ((Symb 's')::lexlist) else failwith "Erreur de syntaxe"
|'c' -> if (String.length str) > (i + 2) && str.[i+1] = 'o' && str.[i+2] = 's' then lexi str (i+3) ((Symb 'c')::lexlist) else failwith "Erreur de syntaxe"
|' ' -> lexi str (i+1) lexlist
|_ -> failwith "Erreur de syntaxe"
in lexi str 0 [];;
(* Prédécoupage selon les parenthèses : on remplace tout couple de parenthèses par la liste des lexèmes situés entre, il y rentre une liste de Lexeme ne contenant pas de Nil ni de List, et en ressort une liste de Lexeme ne contenant pas de (Symb '(') ni de (Symb')') même dans les sous listes *)
(* Fonction auxiliaire : é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 *)
let rec add lexlist lex = match lexlist with
| [] -> [lex]
| Nil::_ -> failwith "Erreur de syntaxe"
| (Num _)::_ | (Symb _)::_ -> lex::lexlist
| (List [])::t -> (List [lex])::t
| (List (Nil::l))::t -> lex::(List (Nil::l))::t
| (List l)::t -> (List (add l lex))::t;;
(* Prédécoupage, attention, la liste de lexèmes entrante est dans le sens inverse, à cause de l'analyse lexicale *)
let decoup liste =
let rec decoupage fait reste = match reste with
| [] -> fait
| h::t when (h = Symb ')') -> decoupage (add fait (List [])) t (* On ouvre une parenthèse *)
| h::t when (h = Symb '(') -> decoupage (add fait Nil) t (* On la ferme *)
| h::t -> decoupage (add fait h) t; (* On la remplit *)
in (decoupage [] liste);;
let rec purge liste = match liste with (* On supprime tous les Nil de la 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)
;;
(* Résolution des opérateurs unaires : après les opérations précédentes, s'il n'y a pas d'erreur de syntaxe, la liste et toute ses sous-listes sont de la forme {s}c{{s}^+ c} où s représente un symbole binaire ou unaire (+ - * / sin cos), c désigne soit un Nil soit une List et {.} signifie que . peut-être répété zéro, une ou plusieurs fois (et le ^+ indique qu'il en faut au moins un).
En effet quelque chose comme +---(--1-sin cos-3) doit être compilé correctement. unaires se charge simplement de tout parenthéser (avec des sous-listes) comme il faut de façon à n'obtenir que sc ou c{sc} pour les sous-listes et la liste complète*)
let rec unaires lexlist = match lexlist with
| [] -> []
| Nil::t -> t
| [Num _] -> lexlist
| [List l] -> [List (unaires l)]
| [Symb _] -> failwith "Erreur de syntaxe"
| (List l)::b::t -> (List (unaires l))::b::(unaires t)
| (Num n)::b::t -> (Num n)::b::(unaires t)
| (Symb c)::h::t -> let rec unary_solve lexlist = match lexlist with (* parenthèse comme il faut tous les s à partir de celui du début de lexlist avec le prochain c *)
| [] | (Num _)::_ | (List _)::_ | Nil::_ -> failwith "Impossible"
| [Symb _] -> failwith "Erreur de syntaxe"
| (Symb c)::(Num n)::t -> ([Symb c; Num n], t)
| (Symb c)::(List l)::t -> ([Symb c; List (unaires l)], t)
| (Symb c)::t -> let r = unary_solve t in ([Symb c; List (fst r)], (snd r))
in let r = unary_solve lexlist in match (snd r) with
| [] -> [List (fst r)]
| Nil::_ | (Num _)::_ | (List _)::_ -> failwith "Erreur de syntaxe"
| h::t -> (List (fst r))::h::(unaires t)
;;
(* Convertisseur en expression : la liste de lexèmes en entrée est normalisée : toute sous-liste est de la forme sc ou c{sc} et on le convertit en expression.
prior et priority servent à recueillir la priorité respectivement d'un opérateur ou d'une liste de lexèmes : 1 pour +-, 2 pour */ et 3 pour les expressions parenthésées *)
let prior c = if (c = '+') || (c = '-') then 1 else 2;; (* si (prior c) = 2, c'est que c = '*' ou '/' vu qu'on ne l'utilisera que sur des opérateurs binaires *)
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 '+'; n] -> 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; List.hd apres])::(List.tl apres));
| _ -> failwith "Erreur de syntaxe";;
(* Évaluateur : il y rentre une expression et il en ressort sa valeur calculée (en float) *)
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)
;;
(* Fonctions finales d'évaluation d'une chaîne de caractères *)
let eval str =
print_float (calc (syntax (unaires (purge (decoup (lex str))))));
print_newline();;
let eval_it () =
while true do
eval (read_line ());
done;; |
Partager