← Back to branch summary

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

« back to all changes in this revision

Viewing changes to examples/minicaml/synthese.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/minicaml/synthese.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 Types;;
14
 
 
15
 
type environnement = (string * sch�ma_de_types) list;;
16
 
 
17
 
exception Erreur of string;;
18
 
 
19
 
let rec type_motif env = function
20
 
  | Motif_variable id ->
21
 
      let ty = nouvelle_inconnue() in
22
 
      (ty, (id, sch�ma_trivial ty) :: env)
23
 
  | Motif_bool�en b ->
24
 
      (type_bool, env)
25
 
  | Motif_nombre n ->
26
 
      (type_int, env)
27
 
  | Motif_paire(m1, m2) ->
28
 
      let (ty1, env1) = type_motif env m1 in
29
 
      let (ty2, env2) = type_motif env1 m2 in
30
 
      (type_produit ty1 ty2, env2)
31
 
  | Motif_nil ->
32
 
      (type_liste (nouvelle_inconnue()), env)
33
 
  | Motif_cons(m1, m2) ->
34
 
      let (ty1, env1) = type_motif env m1 in
35
 
      let (ty2, env2) = type_motif env1 m2 in
36
 
      unifie (type_liste ty1) ty2;
37
 
      (ty2, env2);;
38
 
 
39
 
let rec type_exp env = function
40
 
  | Variable id ->
41
 
      begin try sp�cialisation (List.assoc id env)
42
 
      with Not_found -> raise (Erreur (id ^ " est inconnu"))
43
 
      end
44
 
  | Fonction liste_de_cas ->
45
 
      let type_argument = nouvelle_inconnue()
46
 
      and type_r�sultat = nouvelle_inconnue() in
47
 
      let type_cas (motif, expr) =
48
 
        let (type_motif, env_�tendu) = type_motif env motif in
49
 
        unifie type_motif type_argument;
50
 
        let type_expr = type_exp env_�tendu expr in
51
 
        unifie type_expr type_r�sultat in
52
 
      List.iter type_cas liste_de_cas;
53
 
      type_fl�che type_argument type_r�sultat
54
 
  | Application(fonction, argument) ->
55
 
      let type_fonction = type_exp env fonction in
56
 
      let type_argument = type_exp env argument in
57
 
      let type_r�sultat = nouvelle_inconnue() in
58
 
      unifie type_fonction (type_fl�che type_argument type_r�sultat);
59
 
      type_r�sultat
60
 
  | Let(d�f, corps) -> type_exp (type_d�f env d�f) corps
61
 
  | Bool�en b -> type_bool
62
 
  | Nombre n -> type_int
63
 
  | Paire(e1, e2) -> type_produit (type_exp env e1) (type_exp env e2)
64
 
  | Nil -> type_liste (nouvelle_inconnue())
65
 
  | Cons(e1, e2) ->
66
 
      let type_e1 = type_exp env e1 in
67
 
      let type_e2 = type_exp env e2 in
68
 
      unifie (type_liste type_e1) type_e2;
69
 
      type_e2
70
 
 
71
 
and type_d�f env d�f =
72
 
  d�but_de_d�finition();
73
 
  let type_expr =
74
 
    match d�f.r�cursive with
75
 
    | false -> type_exp env d�f.expr
76
 
    | true ->
77
 
        let type_provisoire = nouvelle_inconnue() in
78
 
        let type_expr =
79
 
          type_exp ((d�f.nom, sch�ma_trivial type_provisoire) :: env)
80
 
                   d�f.expr in
81
 
        unifie type_expr type_provisoire;
82
 
        type_expr in
83
 
  fin_de_d�finition();
84
 
  (d�f.nom, g�n�ralisation type_expr) :: env;;