viewcvs.cgi/typing/typed.ml

(* Typed abstract syntax *) 

(*  Some sub-expression may have to be type-checked several times.
    We first build the ``skeleton'' of the typed ast
    (basically the parsed ast with types and patterns replaced with there
    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
*)

open Location

type tpat = Patterns.node
type ttyp = Types.node

type texpr  = { exp_loc : loc; 
                mutable exp_typ : Types.descr; 
                exp_descr : texpr';
              }
and  texpr' = 
  | DebugTyper of ttyp

  (* CDuce is a Lambda-calculus ... *)
  | Var of string
  | Apply of texpr * texpr
  | Abstraction of abstr
      
  (* Data constructors *)
  | Cst of Types.const
  | Pair of texpr * texpr
  | RecordLitt of (Types.label, texpr) SortedMap.t
      
  (* Data destructors *)
  | Op of string * texpr list
  | Match of texpr * branches
  | Map of texpr * branches
  | Dot of (texpr * Types.label)

and abstr = { 
  fun_name : string option; 
  fun_iface : (Types.descr * Types.descr) list;
  fun_body : branches;
  fun_typ  : Types.descr;
  fun_fv   : string list;
}

and branches = { 
  mutable br_typ : Types.descr;
  br_accept : Types.descr;
  br_branches: branch list;

  mutable br_compiled : compiled_branches option;
}
and branch = { 
  mutable br_used : bool; 
  br_pat : tpat; 
  br_body :  texpr 
}
and compiled_branches =  
    Patterns.Compile.dispatcher * ((string * int) list * texpr) array


let dispatcher brs =
  match brs.br_compiled with
    | Some d -> d
    | None ->
        let aux b = Patterns.descr b.br_pat, b.br_body in
        let x = Patterns.Compile.make_branches
                  brs.br_typ
                  (List.map aux brs.br_branches) in
        brs.br_compiled <- Some x;
        x
                     
1	abate	4	(* Typed abstract syntax *)
2
3	abate	5	(* Some sub-expression may have to be type-checked several times.
4			We first build the ``skeleton'' of the typed ast
5			(basically the parsed ast with types and patterns replaced with there
6			internal representation), then type check it.
7
8			The exp_typ and br_typ fields are updated to capture all the possible
9			values than can result from the expression or flow to the branch
10			*)
11
12	abate	4	open Location
13
14			type tpat = Patterns.node
15			type ttyp = Types.node
16
17	abate	9	type texpr = { exp_loc : loc;
18	abate	5	mutable exp_typ : Types.descr;
19			exp_descr : texpr';
20			}
21	abate	4	and texpr' =
22	abate	18	\| DebugTyper of ttyp
23
24	abate	4	(* CDuce is a Lambda-calculus ... *)
25			\| Var of string
26			\| Apply of texpr * texpr
27			\| Abstraction of abstr
28
29			(* Data constructors *)
30			\| Cst of Types.const
31			\| Pair of texpr * texpr
32	abate	47	\| RecordLitt of (Types.label, texpr) SortedMap.t
33	abate	4
34			(* Data destructors *)
35	abate	16	\| Op of string * texpr list
36	abate	4	\| Match of texpr * branches
37			\| Map of texpr * branches
38	abate	26	\| Dot of (texpr * Types.label)
39	abate	4
40			and abstr = {
41			fun_name : string option;
42	abate	9	fun_iface : (Types.descr * Types.descr) list;
43	abate	6	fun_body : branches;
44			fun_typ : Types.descr;
45			fun_fv : string list;
46	abate	4	}
47
48	abate	9	and branches = {
49			mutable br_typ : Types.descr;
50	abate	19	br_accept : Types.descr;
51	abate	45	br_branches: branch list;
52
53			mutable br_compiled : compiled_branches option;
54	abate	9	}
55			and branch = {
56			mutable br_used : bool;
57			br_pat : tpat;
58			br_body : texpr
59			}
60	abate	46	and compiled_branches =
61			Patterns.Compile.dispatcher * ((string * int) list * texpr) array
62
63
64			let dispatcher brs =
65			match brs.br_compiled with
66			\| Some d -> d
67			\| None ->
68			let aux b = Patterns.descr b.br_pat, b.br_body in
69			let x = Patterns.Compile.make_branches
70			brs.br_typ
71			(List.map aux brs.br_branches) in
72			brs.br_compiled <- Some x;
73			x
74