~ubuntu-branches/ubuntu/karmic/ocaml-doc/karmic

« back to all changes in this revision

Viewing changes to examples/minicaml/interp.ml

  • Committer: Bazaar Package Importer
  • Author(s): Vanicat Rémi
  • Date: 2002-02-05 10:51:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020205105143-a061tunf8tev07ne
Tags: 3.04-4
* New debian maintainer
* Split doc-base file
* Move to non-free
* Change the copyright file to the copyright of the documentation
* remove FAQs (their license prohibit their redistribution)
* corrected the examples

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
open Syntaxe;;
 
2
open Eval;;
 
3
 
 
4
let code_nombre n =
 
5
    Val_nombre n
 
6
and d�code_nombre = function
 
7
  | Val_nombre n -> n
 
8
  | _ -> raise(Erreur "entier attendu")
 
9
and code_bool�en b =
 
10
    Val_bool�enne b
 
11
and d�code_bool�en = function
 
12
  | Val_bool�enne b -> b
 
13
  | _ -> raise(Erreur "bool�en attendu");;
 
14
 
 
15
(* Pour transformer une fonction Caml en valeur fonctionnelle *)
 
16
 
 
17
let prim1 codeur calcul d�codeur =
 
18
  Val_primitive (function v -> codeur (calcul (d�codeur v)))
 
19
and prim2 codeur calcul d�codeur1 d�codeur2 =
 
20
  Val_primitive (function
 
21
   | Val_paire (v1, v2) ->
 
22
       codeur (calcul (d�codeur1 v1) (d�codeur2 v2))
 
23
   | _ -> raise (Erreur "paire attendue"));;
 
24
 
 
25
(* L'environnement initial *)
 
26
 
 
27
let env_initial =
 
28
  ["+",  prim2 code_nombre  ( + ) d�code_nombre d�code_nombre;
 
29
   "-",  prim2 code_nombre  ( - ) d�code_nombre d�code_nombre;
 
30
   "*",  prim2 code_nombre  ( * ) d�code_nombre d�code_nombre;
 
31
   "/",  prim2 code_nombre  ( / ) d�code_nombre d�code_nombre;
 
32
   "=",  prim2 code_bool�en ( = ) d�code_nombre d�code_nombre;
 
33
   "<>", prim2 code_bool�en ( <> ) d�code_nombre d�code_nombre;
 
34
   "<",  prim2 code_bool�en ( < ) d�code_nombre d�code_nombre;
 
35
   ">",  prim2 code_bool�en ( > ) d�code_nombre d�code_nombre;
 
36
   "<=", prim2 code_bool�en ( <= ) d�code_nombre d�code_nombre;
 
37
   ">=", prim2 code_bool�en ( >= ) d�code_nombre d�code_nombre;
 
38
   "not", prim1 code_bool�en ( not ) d�code_bool�en;
 
39
   "read_int", prim1 code_nombre (fun x -> read_int ()) d�code_nombre;
 
40
   "write_int", prim1 code_nombre
 
41
                      (fun x -> print_int x; print_newline (); 0)
 
42
                      d�code_nombre];;
 
43
let boucle () =
 
44
  let env_global = ref env_initial in
 
45
  let flux_d'entr�e = Stream.of_channel stdin in
 
46
  try
 
47
    while true do
 
48
      print_string "# "; flush stdout;
 
49
      try
 
50
        match lire_phrase flux_d'entr�e with
 
51
        | Expression expr ->
 
52
            let r�s = �value !env_global expr in
 
53
            print_string "- = "; imprime_valeur r�s;
 
54
            print_newline ()
 
55
        | D�finition d�f ->
 
56
            let nouvel_env = �value_d�finition !env_global d�f in
 
57
            begin match nouvel_env with
 
58
            | (nom, v) :: _ ->
 
59
                print_string nom; print_string " = ";
 
60
                imprime_valeur v; print_newline ()
 
61
            | _ -> failwith "mauvaise gestion des d�finitions"
 
62
            end;
 
63
            env_global := nouvel_env
 
64
      with
 
65
      | Stream.Error s ->
 
66
          print_string ("Erreur de syntaxe: " ^ s); print_newline ()
 
67
      | Erreur msg ->
 
68
          print_string "Erreur � l'�valuation: "; print_string msg;
 
69
          print_newline ()
 
70
    done
 
71
  with Stream.Failure -> ();;
 
72
 
 
73
if not !Sys.interactive then boucle ();;