(***********************************************************************) (* *) (* 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. *) (* *) (***********************************************************************) open Crayon;; let recule d = avance (-. d) and tourne_à_droite a = tourne (-. a) and tourne_à_gauche = tourne;; let baisse_le_crayon () = fixe_crayon false and lève_le_crayon () = fixe_crayon true;; let répète n l = for i = 1 to n do l done;; répète 4 [print_int 1; print_char '*'];; let répète n liste_d'ordres = for i = 1 to n do liste_d'ordres () done;; répète 4 (function () -> print_int 1; print_char '*');; type nombre = | Entier of int | Flottant of float;; let flottant = function | Entier i -> float_of_int i | Flottant f -> f;; type ordre = | Av of nombre | Re of nombre | Td of nombre | Tg of nombre | Lc | Bc | Ve | Rep of int * ordre list;; let rec exécute_ordre = function | Av n -> avance (flottant n) | Re n -> avance (-. (flottant n)) | Tg a -> tourne (flottant a) | Td a -> tourne (-. (flottant a)) | Lc -> fixe_crayon true | Bc -> fixe_crayon false | Ve -> vide_écran() | Rep (n, l) -> for i = 1 to n do List.iter exécute_ordre l done;; let exécute_programme l = List.iter exécute_ordre l;; let carré c = Rep (4, [Av c; Td (Entier 90)]);; exécute_programme [Ve; carré (Entier 100); carré (Entier 75); carré (Entier 50); carré (Entier 25); carré (Flottant 12.5); carré (Flottant 6.25); carré (Flottant 3.125)];; type lexème = | Mot of string | Symbole of char | Constante_entière of int | Constante_flottante of float;; let flux_car = Stream.of_string "Vive Caml!";; let flux_ent = [< '2; '3; '5; '7 >];; stream_next flux_car;; stream_next flux_car;; let rec saute_blancs flux = match flux with parser | [< '' ' >] -> saute_blancs flux (* ' ' est l'espace *) | [< ''\t' >] -> saute_blancs flux (* '\t' est la tabulation *) | [< ''\n' >] -> saute_blancs flux (* '\n' est la fin de ligne *) | [< >] -> ();; let rec saute_blancs flux = match flux with parser | [< ' (' ' | '\t' | '\n') >] -> saute_blancs flux | [< >] -> ();; let rec lire_entier accumulateur flux = match flux with parser | [< ' ('0' .. '9' as c) >] -> lire_entier (10 * accumulateur + int_of_char c - 48) flux | [< >] -> accumulateur;; let flux_car = Stream.of_string "123/456";; lire_entier 0 flux_car;; stream_next flux_car;; lire_entier 900 flux_car;; let rec lire_décimales accumulateur échelle flux = match flux with parser | [< ' ('0' .. '9' as c) >] -> lire_décimales (accumulateur +. float_of_int(int_of_char c - 48) *. échelle) (échelle /. 10.0) flux | [< >] -> accumulateur;; lire_décimales 123.4 0.01 (Stream.of_string "56789");; let tampon = String.make 16 '-';; let rec lire_mot position flux = match flux with parser | [< '( 'A' .. 'Z' | 'a' .. 'z' | 'é' | 'è' | '_' as c) >] -> if position < string_length tampon then tampon.[position] <- c; lire_mot (position+1) flux | [< >] -> String.sub tampon 0 (min position (string_length tampon));; let rec lire_lexème flux = saute_blancs flux; match flux with parser | [< '( 'A' .. 'Z' | 'a' .. 'z' | 'é' | 'è' as c) >] -> tampon.[0] <- c; Mot(lire_mot 1 flux) | [< '( '0' .. '9' as c) >] -> let n = lire_entier (int_of_char c - 48) flux in begin match flux with parser | [< ''.' >] -> Constante_flottante (lire_décimales (float_of_int n) 0.1 flux) | [< >] -> Constante_entière(n) end | [< 'c >] -> Symbole c;; let flux_car = Stream.of_string "123bonjour ! 45.67";; lire_lexème flux_car;; lire_lexème flux_car;; lire_lexème flux_car;; lire_lexème flux_car;; let rec analyseur_lexical flux = match flux with parser | [< l = lire_lexème >] -> [< 'l; analyseur_lexical flux >] | [< >] -> [< >];; let flux_lexèmes = analyseur_lexical(Stream.of_string "123bonjour ! 45.67");; stream_next flux_lexèmes;; stream_next flux_lexèmes;; stream_next flux_lexèmes;; stream_next flux_lexèmes;; let nombre = parser | [< i = Constante_entière >] -> Entier i | [< f = Constante_flottante >] -> Flottant f;; let flux_lexèmes = analyseur_lexical(Stream.of_string "123 1.05 fini");; nombre flux_lexèmes;; nombre flux_lexèmes;; nombre flux_lexèmes;; let rec ordre = parser | [< 'Mot "baisse_crayon" >] -> Bc | [< 'Mot "bc" >] -> Bc | [< 'Mot "lève_crayon" >] -> Lc | [< 'Mot "lc" >] -> Lc | [< 'Mot "vide_écran" >] -> Ve | [< 'Mot "ve" >] -> Ve | [< 'Mot "avance"; n = nombre >] -> Av n | [< 'Mot "av"; n = nombre >] -> Av n | [< 'Mot "recule"; n = nombre >] -> Re n | [< 'Mot "re"; n = nombre >] -> Re n | [< 'Mot "droite"; n = nombre >] -> Td n | [< 'Mot "td"; n = nombre >] -> Td n | [< 'Mot "gauche"; n = nombre >] -> Tg n | [< 'Mot "tg"; n = nombre >] -> Tg n | [< 'Mot "répète"; n = Constante_entière; l = liste_d'ordres >] -> Rep (n,l) | [< 'Mot "rep"; n = Constante_entière; l = liste_d'ordres >] -> Rep (n,l) and liste_d'ordres = parser | [< 'Symbole '['; l = suite_d'ordres; 'Symbole ']' >] -> l and suite_d'ordres = parser | [< ord = ordre; l_ord = suite_d'ordres >] -> ord :: l_ord | [< >] -> [];; let analyse_programme = parser | [< l = suite_d'ordres; 'Symbole '.' >] -> l;; let lire_code chaîne = analyse_programme (analyseur_lexical (Stream.of_string chaîne));; lire_code "répète 4 [avance 100 droite 90].";; let logo chaîne = exécute_programme (lire_code chaîne);; logo "ve répète 6 [td 60 répète 6 [av 15 tg 60] av 15].";; type expression = | Constante of nombre | Somme of expression * expression | Produit of expression * expression | Différence of expression * expression | Quotient of expression * expression | Variable of string;; let ajoute_nombres = function | (Entier i, Entier j) -> Entier (i + j) | (n1, n2) -> Flottant (flottant n1 +. flottant n2) and soustrais_nombres = function | (Entier i, Entier j) -> Entier (i - j) | (n1, n2) -> Flottant (flottant n1 -. flottant n2) and multiplie_nombres = function | (Entier i, Entier j) -> Entier (i * j) | (n1, n2) -> Flottant (flottant n1 *. flottant n2) and divise_nombres = function | (Entier i, Entier j) -> Entier (i / j) | (n1, n2) -> Flottant (flottant n1 /. flottant n2) and compare_nombres = function | (Entier i, Entier j) -> i >= j | (n1, n2) -> (flottant n1 >=. flottant n2);; let rec valeur_expr env = function | Constante n -> n | Somme (e1, e2) -> ajoute_nombres (valeur_expr env e1, valeur_expr env e2) | Produit (e1, e2) -> multiplie_nombres (valeur_expr env e1, valeur_expr env e2) | Différence (e1, e2) -> soustrais_nombres (valeur_expr env e1, valeur_expr env e2) | Quotient (e1, e2) -> divise_nombres (valeur_expr env e1, valeur_expr env e2) | Variable s -> assoc s env;; type ordre = | Av of expression | Re of expression | Td of expression | Tg of expression | Lc | Bc | Ve | Rep of expression * ordre list | Stop | Si of expression * expression * ordre list * ordre list | Exécute of string * expression list;; type procédure = {paramètres : string list; corps : ordre list};; let procédures_définies = ref ([] : (string * procédure) list);; let définit_procédure (nom, proc as liaison) = procédures_définies := liaison :: !procédures_définies and définition_de nom_de_procédure = assoc nom_de_procédure !procédures_définies;; let valeur_entière = function | Entier i -> i | Flottant f -> failwith "entier attendu";; exception Fin_de_procédure;; let rec exécute_ordre env = function | Av e -> avance (flottant (valeur_expr env e)) | Re e -> avance (-. (flottant (valeur_expr env e))) | Tg a -> tourne (flottant (valeur_expr env a)) | Td a -> tourne (-. (flottant (valeur_expr env a))) | Lc -> fixe_crayon true | Bc -> fixe_crayon false | Ve -> vide_écran() | Rep (n, l) -> for i = 1 to valeur_entière (valeur_expr env n) do List.iter (exécute_ordre env) l done | Si (e1, e2, alors, sinon) -> if compare_nombres (valeur_expr env e1, valeur_expr env e2) then List.iter (exécute_ordre env) alors else List.iter (exécute_ordre env) sinon | Stop -> raise Fin_de_procédure | Exécute (nom_de_procédure, args) -> let définition = définition_de nom_de_procédure in let variables = définition.paramètres and corps = définition.corps in let rec augmente_env = function | [], [] -> env | variable :: vars, expr :: exprs -> (variable, valeur_expr env expr) :: augmente_env (vars, exprs) | _ -> failwith ("mauvais nombre d'arguments pour " ^ nom_de_procédure) in let env_pour_corps = augmente_env (variables, args) in try List.iter (exécute_ordre env_pour_corps) corps with Fin_de_procédure -> ();; type phrase_logo = | Pour of string * procédure | Ordre of ordre;; type programme_logo = Programme of phrase_logo list;; let rec exécute_phrase = function | Ordre ord -> exécute_ordre [] ord | Pour (nom, proc as liaison) -> définit_procédure liaison and exécute_programme = function | Programme phs -> List.iter exécute_phrase phs;; let logo chaîne = List.iter exécute_phrase (analyse_programme (analyseur_lexical (Stream.of_string chaîne)));; logo "pour carré :c répète 4 [av :c td 90]. pour multi_carré :c :n répète :n [carré :c td 10]. ve multi_carré 80 10 .";; logo "pour spirale :d :a :i :n si :n >= 0 [av :d td :a spirale (:d + :i) :a :i (:n - 1)] [stop].";; logo "ve spirale 0 179.5 0.5 360 .";; logo "ve spirale 0 178.5 0.5 360 .";; logo "ve spirale 0 79.8 0.4 360 .";; logo "ve spirale 0 79.5 0.4 360 .";; (* logo "ve spirale -180.0 79.5 0.5 720 .";; *) logo "pour spirala :d :a :i :n si :n >= 0 [av :d td :a spirala :d (:a + :i) :i (:n - 1)] [stop].";; (* logo "ve spirala 10 0 2.5 90 .";; *) logo "ve spirala 5 0 89.5 1440 .";; logo "ve spirala 4 0.5 181.5 1500 .";;