/[svn]/cduce/trunk/typing/typed.ml
ViewVC logotype

Diff of /cduce/trunk/typing/typed.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 16 by abate, Tue Jul 10 16:58:05 2007 UTC revision 1190 by abate, Tue Jul 10 18:30:01 2007 UTC
# Line 2  Line 2 
2    
3  (*  Some sub-expression may have to be type-checked several times.  (*  Some sub-expression may have to be type-checked several times.
4      We first build the ``skeleton'' of the typed ast      We first build the ``skeleton'' of the typed ast
5      (basically the parsed ast with types and patterns replaced with there      (basically the parsed ast with types and patterns replaced with their
6      internal representation), then type check it.      internal representation), then type check it.
7    
8      The exp_typ and br_typ fields are updated to capture all the possible      The exp_typ and br_typ fields are updated to capture all the possible
# Line 10  Line 10 
10  *)  *)
11    
12  open Location  open Location
13    open Ident
14    
15  type tpat = Patterns.node  type tpat = Patterns.node
16  type ttyp = Types.node  type ttyp = Types.Node.t
17    
18  type texpr  = { exp_loc : loc;  type texpr  =
19                  mutable exp_typ : Types.descr;      { exp_loc : loc;
20          mutable exp_typ : Types.t;
21          (* Currently exp_typ is not used. It will be used for compilation ! *)
22                  exp_descr : texpr';                  exp_descr : texpr';
23                }                }
24  and  texpr' =  and  texpr' =
25      | Forget of texpr * ttyp
26    (* CDuce is a Lambda-calculus ... *)    (* CDuce is a Lambda-calculus ... *)
27    | Var of string    | Var of id
28      | ExtVar of Types.CompUnit.t * id
29    | Apply of texpr * texpr    | Apply of texpr * texpr
30    | Abstraction of abstr    | Abstraction of abstr
31    
32    (* Data constructors *)    (* Data constructors *)
33    | Cst of Types.const    | Cst of Types.const
34    | Pair of texpr * texpr    | Pair of texpr * texpr
35    | RecordLitt of (Types.label * texpr) list    | Xml of texpr * texpr
36      | RecordLitt of texpr label_map
37      | String of U.uindex * U.uindex * U.t * texpr
38    
39    (* Data destructors *)    (* Data destructors *)
   | Op of string * texpr list  
40    | Match of texpr * branches    | Match of texpr * branches
41    | Map of texpr * branches    | Map of texpr * branches
42      | Transform of texpr * branches
43      | Xtrans of texpr * branches
44      | Validate of texpr * Schema_types.component_kind * string * U.t
45          (* exp, schema component kind, schema uri, element name *)
46      | RemoveField of texpr * label
47      | Dot of texpr * label
48    
49      (* Exception *)
50      | Try of texpr * branches
51    
52      | UnaryOp of int * texpr
53      | BinaryOp of int * texpr * texpr
54      | Ref of texpr * ttyp
55      | External of Types.t * int
56    
57  and abstr = {  and abstr = {
58    fun_name : string option;    fun_name : id option;
59    fun_iface : (Types.descr * Types.descr) list;    fun_iface : (Types.t * Types.t) list;
60    fun_body : branches;    fun_body : branches;
61    fun_typ  : Types.descr;    fun_typ  : Types.t;
62    fun_fv   : string list;    fun_fv   : fv
63    }
64    
65    and let_decl = {
66      let_pat : tpat;
67      let_body : texpr;
68      mutable let_compiled :
69        (Patterns.Compile.dispatcher * (id * int) list) option
70  }  }
71    
72  and branches = {  and branches = {
73    mutable br_typ : Types.descr;    mutable br_typ : Types.t; (* Type of values that can flow to branches *)
74    br_branches: branch list    br_accept : Types.t;  (* Type accepted by all branches *)
75      br_branches: branch list;
76    
77      mutable br_compiled : compiled_branches option;
78  }  }
79  and branch = {  and branch = {
80      br_loc : loc;
81    mutable br_used : bool;    mutable br_used : bool;
82    br_pat : tpat;    br_pat : tpat;
83    br_body :  texpr    br_body :  texpr
84  }  }
85    and compiled_branches =
86        Patterns.Compile.dispatcher * texpr Patterns.Compile.rhs array
87    
88    
89    let dispatcher brs =
90      match brs.br_compiled with
91        | Some d -> d
92        | None ->
93            let aux b = b.br_pat, b.br_body in
94            let x = Patterns.Compile.make_branches
95                      brs.br_typ
96                      (List.map aux brs.br_branches) in
97            brs.br_compiled <- Some x;
98            x
99    
100    let dispatcher_let_decl l =
101      match l.let_compiled with
102        | Some d -> d
103        | None ->
104            let comp = Patterns.Compile.make_branches
105                         (Types.descr (Patterns.accept l.let_pat))
106                         [ l.let_pat, () ]  in
107            let x = match comp with
108              | (disp, [| Patterns.Compile.Match (l, ()) |]) -> (disp,l)
109              | _ -> assert false
110            in
111            l.let_compiled <- Some x;
112            x
113    
Legend:
Removed from v.16  
changed lines
  Added in v.1190
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5