typed.ml 2.86 KB
Newer Older
1
2
(* Typed abstract syntax *) 

3
4
(*  Some sub-expression may have to be type-checked several times.
    We first build the ``skeleton'' of the typed ast
5
    (basically the parsed ast with types and patterns replaced with their
6
7
8
9
10
11
    internal representation), then type check it.

    The exp_typ and br_typ fields are updated to capture all the possible
    values than can result from the expression or flow to the branch
*)

12
open Location
13
open Ident
14
15

type tpat = Patterns.node
16
type ttyp = Types.Node.t
17

18
19
type texpr  = 
    { exp_loc : loc; 
20
21
      mutable exp_typ : Types.t;  
      (* Currently exp_typ is not used. It will be used for compilation ! *)
22
23
      exp_descr : texpr';
    }
24
and  texpr' = 
25
  | Forget of texpr * ttyp
26
  | Check of (Types.t ref) * texpr * ttyp
27
  (* CDuce is a Lambda-calculus ... *)
28
  | Var of id
29
  | ExtVar of Types.CompUnit.t * id * Types.t
30
31
32
33
34
35
  | Apply of texpr * texpr
  | Abstraction of abstr
      
  (* Data constructors *)
  | Cst of Types.const
  | Pair of texpr * texpr
36
  | Xml of texpr * texpr
37
  | RecordLitt of texpr label_map
38
  | String of U.uindex * U.uindex * U.t * texpr
39
40
41
      
  (* Data destructors *)
  | Match of texpr * branches
42
43
  | Map of texpr * branches
  | Transform of texpr * branches
44
  | Xtrans of texpr * branches
45
  | Validate of texpr * string * Ns.qname (* exp, schema uri, element name *)
46
  | RemoveField of texpr * label
47
  | Dot of texpr * label
48
      
49

50
51
  (* Exception *)
  | Try of texpr * branches
52

53
  | Ref of texpr * ttyp
54
  | External of Types.t * int
55
  | Op of string * int * texpr list
56
  | NsTable of Ns.table * texpr'
57

58
and abstr = { 
59
  fun_name : id option; 
60
  fun_iface : (Types.t * Types.t) list;
61
  fun_body : branches;
62
  fun_typ  : Types.t;
63
  fun_fv   : fv
64
65
}

66
67
68
69
and let_decl = {
  let_pat : tpat;
  let_body : texpr;
  mutable let_compiled : 
70
    (Patterns.Compile.dispatcher * (id * int) list) option
71
72
}

73
and branches = { 
74
75
  mutable br_typ : Types.t; (* Type of values that can flow to branches *)
  br_accept : Types.t;  (* Type accepted by all branches *)
76
77
78
  br_branches: branch list;

  mutable br_compiled : compiled_branches option;
79
80
}
and branch = { 
81
  br_loc : loc;
82
  mutable br_used : bool; 
83
  mutable br_vars_empty : fv;
84
85
86
  br_pat : tpat; 
  br_body :  texpr 
}
87
and compiled_branches =  
88
    Patterns.Compile.dispatcher * texpr Patterns.Compile.rhs array
89
90
91
92
93
94


let dispatcher brs =
  match brs.br_compiled with
    | Some d -> d
    | None ->
95
	let aux b = b.br_pat, b.br_body in
96
97
98
99
100
101
	let x = Patterns.Compile.make_branches
		  brs.br_typ
		  (List.map aux brs.br_branches) in
	brs.br_compiled <- Some x;
	x
		     
102
103
104
105
106
107
let dispatcher_let_decl l =
  match l.let_compiled with
    | Some d -> d
    | None ->
	let comp = Patterns.Compile.make_branches
		     (Types.descr (Patterns.accept l.let_pat))
108
		     [ l.let_pat, () ]  in
109
	let x = match comp with
110
	  | (disp, [| Patterns.Compile.Match (l, ()) |]) -> (disp,l)
111
112
113
114
	  | _ -> assert false
	in
	l.let_compiled <- Some x;
	x
115