← Back to branch summary

~ubuntu-branches/ubuntu/hardy/ocaml-doc/hardy

« back to all changes in this revision

Viewing changes to examples/pascal/interp.ml

  • Committer: Bazaar Package Importer
  • Author(s): Samuel Mimram
  • Date: 2007-09-08 01:49:22 UTC
  • mfrom: (0.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070908014922-lvihyehz0ndq7suu
Tags: 3.10-1
* New upstream release.
* Removed camlp4 documentation since it is not up-to-date.
* Updated to standards version 3.7.2, no changes needed.
* Updated my email address.

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/pascal/interp.ml
1
 
(***********************************************************************)
2
 
(*                                                                     *)
3
 
(*                           Objective Caml                            *)
4
 
(*                                                                     *)
5
 
(*               Pierre Weis, projet Cristal, INRIA Rocquencourt       *)
6
 
(*                                                                     *)
7
 
(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
8
 
(*  en Automatique.  All rights reserved.  This file is distributed    *)
9
 
(*  only by permission.                                                *)
10
 
(*                                                                     *)
11
 
(***********************************************************************)
12
 
open Syntaxe;;
13
 
open Valeur;;
14
 
open Envir;;
15
 
 
16
 
let rec valeur_initiale = function
17
 
  | Integer | Boolean -> Inconnue
18
 
  | Array(inf, sup, ty) ->
19
 
      let v = Array.make (sup - inf + 1) Inconnue in
20
 
      for i = inf to sup do
21
 
        v.(i - inf) <- valeur_initiale ty
22
 
      done;
23
 
      Tableau(inf, v);;
24
 
 
25
 
let alloue_variable (nom_var, type_var) env =
26
 
  ajoute_variable nom_var (ref (valeur_initiale type_var)) env;;
27
 
 
28
 
let alloue_variables d�cl_var env =
29
 
  List.fold_right alloue_variable d�cl_var env;;
30
 
 
31
 
let rec ajoute_arguments param�tres arguments env =
32
 
  match param�tres, arguments with
33
 
  | [], [] -> env
34
 
  | (nom, typ) :: reste_p, v :: reste_a ->
35
 
      ajoute_arguments reste_p reste_a
36
 
                       (ajoute_variable nom (ref v) env)
37
 
  | _, _ ->
38
 
      raise(Erreur_ex�cution "mauvais nombre d'arguments");;
39
 
 
40
 
let environnement_global =
41
 
  ref (environnement_initial [] [] : valeur ref env);;
42
 
 
43
 
let rec �value_expr env = function
44
 
  | Constante(Enti�re n) -> Ent n
45
 
  | Constante(Bool�enne b) -> Bool b
46
 
  | Variable nom ->
47
 
      let emplacement = cherche_variable nom env in
48
 
      !emplacement
49
 
  | Application(nom_fonc, arguments) ->
50
 
      let fonc = cherche_fonction nom_fonc env in
51
 
      applique_fonc nom_fonc fonc (List.map (�value_expr env) arguments)
52
 
  | Op_unaire(op, argument) ->
53
 
      let v = �value_expr env argument in
54
 
      begin match op with
55
 
      | "-"   -> Ent(- (ent_val v))
56
 
      | "not" -> Bool(not (bool_val v))
57
 
      | _ -> failwith "Op�rateur unaire inconnu"
58
 
      end
59
 
  | Op_binaire(op, argument1, argument2) ->
60
 
      let v1 = �value_expr env argument1 in
61
 
      let v2 = �value_expr env argument2 in
62
 
      begin match op with
63
 
      | "*" -> Ent(ent_val v1 * ent_val v2)
64
 
      | "/" ->
65
 
         let n2 = ent_val v2 in
66
 
         if n2 = 0 then raise(Erreur_ex�cution "division par z�ro")
67
 
         else Ent(ent_val v1 / n2)
68
 
      | "+" -> Ent(ent_val v1 + ent_val v2)
69
 
      | "-" -> Ent(ent_val v1 - ent_val v2)
70
 
      | "=" -> Bool(v1 = v2)
71
 
      | "<>" -> Bool(v1 <> v2)
72
 
      | "<" -> Bool(ent_val v1 < ent_val v2)
73
 
      | ">" -> Bool(ent_val v1 > ent_val v2)
74
 
      | "<="-> Bool(ent_val v1 <= ent_val v2)
75
 
      | ">=" -> Bool(ent_val v1 >= ent_val v2)
76
 
      | "and" -> Bool(bool_val v1 && bool_val v2)
77
 
      | "or" -> Bool(bool_val v1 || bool_val v2)
78
 
      | _ -> failwith "Op�rateur binaire inconnu"
79
 
      end
80
 
  | Acc�s_tableau(argument1, argument2) ->
81
 
      let (inf, tbl) = tableau_val(�value_expr env argument1) in
82
 
      let indice = ent_val(�value_expr env argument2) in
83
 
      if indice >= inf && indice < inf + Array.length tbl
84
 
      then tbl.(indice - inf)
85
 
      else raise(Erreur_ex�cution "acc�s hors bornes")
86
 
 
87
 
and ex�cute_instr env = function
88
 
  | Affectation_var(nom, expr) ->
89
 
      let emplacement = cherche_variable nom env in
90
 
      emplacement := �value_expr env expr
91
 
  | Affectation_tableau(expr1, expr2, expr3) ->
92
 
      let nouvelle_valeur = �value_expr env expr3 in
93
 
      let (inf, tbl) = tableau_val(�value_expr env expr1) in
94
 
      let indice = ent_val(�value_expr env expr2) in
95
 
      if indice >= inf && indice < inf + Array.length tbl
96
 
      then tbl.(indice - inf) <- nouvelle_valeur
97
 
      else raise(Erreur_ex�cution "acc�s hors bornes")
98
 
  | Appel(nom_proc, arguments) ->
99
 
      let proc = cherche_proc�dure nom_proc env in
100
 
      appelle_proc proc (List.map (�value_expr env) arguments)
101
 
  | If(condition, branche_oui, branche_non) ->
102
 
      if bool_val(�value_expr env condition)
103
 
      then ex�cute_instr env branche_oui
104
 
      else ex�cute_instr env branche_non
105
 
  | While(condition, boucle) ->
106
 
      while bool_val(�value_expr env condition) do
107
 
        ex�cute_instr env boucle
108
 
      done
109
 
  | Write expr ->
110
 
      affiche_valeur(�value_expr env expr)
111
 
  | Read nom ->
112
 
      let emplacement = cherche_variable nom env in
113
 
      emplacement := lire_valeur ()
114
 
  | Bloc instructions ->
115
 
      List.iter (ex�cute_instr env) instructions
116
 
 
117
 
and appelle_proc proc arguments =
118
 
  let env =
119
 
    alloue_variables proc.proc_variables
120
 
      (ajoute_arguments proc.proc_param�tres arguments
121
 
        !environnement_global) in
122
 
  ex�cute_instr env proc.proc_corps
123
 
 
124
 
and applique_fonc nom_fonc fonc arguments =
125
 
  let env =
126
 
    alloue_variable (nom_fonc, fonc.fonc_type_r�sultat)
127
 
      (alloue_variables fonc.fonc_variables
128
 
        (ajoute_arguments fonc.fonc_param�tres arguments
129
 
          !environnement_global)) in
130
 
  ex�cute_instr env fonc.fonc_corps;
131
 
  let emplacement_r�sultat = cherche_variable nom_fonc env in
132
 
  !emplacement_r�sultat;;
133
 
 
134
 
let ex�cute_programme prog =
135
 
  environnement_global :=
136
 
    alloue_variables prog.prog_variables
137
 
     (environnement_initial prog.prog_proc�dures prog.prog_fonctions);
138
 
  try
139
 
    ex�cute_instr !environnement_global prog.prog_corps
140
 
  with Pas_trouv� nom ->
141
 
    raise(Erreur_ex�cution("identificateur inconnu: " ^ nom));;