[r2002-10-10 15:40:34 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-10 15:41:10+00:00

Makefile

 PARSER = parser/location.cmo parser/ast.cmo parser/parser.cmo
 
-TYPING = typing/parse_pat.cmo typing/typed.cmo
+TYPING = typing/typed.cmo typing/typer.cmo
 
 TYPES  = types/recursive.cmo types/sortedList.cmo \
          types/sortedMap.cmo types/boolean.cmo \
@@ -12,7 +12,7 @@ DIRS = parser typing types
 
 OBJECTS = $(TYPES) $(PARSER) $(TYPING)
 DEPEND = parser/*.ml parser/*.mli typing/*.ml typing/*.mli types/*.ml types/*.mli
-INCLUDES = -I +camlp4 -I parser -I types
+INCLUDES = -I +camlp4 -I parser -I types -I typing
 
 SYNTAX_PARSER = -pp 'camlp4o pa_extend.cmo'
 

depend

@@ -7,13 +7,13 @@ parser/parser.cmo: parser/ast.cmo parser/location.cmi types/types.cmi \
 parser/parser.cmx: parser/ast.cmx parser/location.cmx types/types.cmx \
     parser/parser.cmi 
 parser/parser.cmi: parser/ast.cmo 
-typing/parse_pat.cmo: parser/ast.cmo parser/location.cmi types/patterns.cmi \
-    types/sortedList.cmi types/types.cmi typing/parse_pat.cmi 
-typing/parse_pat.cmx: parser/ast.cmx parser/location.cmx types/patterns.cmx \
-    types/sortedList.cmx types/types.cmx typing/parse_pat.cmi 
 typing/typed.cmo: parser/location.cmi types/patterns.cmi types/types.cmi 
 typing/typed.cmx: parser/location.cmx types/patterns.cmx types/types.cmx 
-typing/parse_pat.cmi: parser/ast.cmo types/patterns.cmi types/types.cmi 
+typing/typer.cmo: parser/ast.cmo parser/location.cmi types/patterns.cmi \
+    types/sortedList.cmi types/types.cmi typing/typer.cmi 
+typing/typer.cmx: parser/ast.cmx parser/location.cmx types/patterns.cmx \
+    types/sortedList.cmx types/types.cmx typing/typer.cmi 
+typing/typer.cmi: parser/ast.cmo types/types.cmi 
 types/atoms.cmo: types/sortedList.cmi types/atoms.cmi 
 types/atoms.cmx: types/sortedList.cmx types/atoms.cmi 
 types/boolean.cmo: types/recursive.cmi types/sortedList.cmi types/boolean.cmi 

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  = { loc : Location.loc; mutable typ : Types.descr; descr : texpr' }
+type texpr  = { loc : Location.loc; 
+		mutable exp_typ : Types.descr; 
+		exp_descr : texpr';
+		fv : string list
+	      }
 and  texpr' = 
-  
   (* CDuce is a Lambda-calculus ... *)
   | Var of string
   | Apply of texpr * texpr
@@ -25,12 +37,16 @@ and  texpr' =
 
 and abstr = { 
   fun_name : string option; 
-  fun_iface : (tpat * tpat) list;
+  fun_iface : (ttyp * ttyp) list;
   fun_body : branches
 }
 
 and branches = branch list
-and branch = { used : bool; mutable typ : Types.descr; body :  texpr }
+and branch = 
+    { mutable used : bool; 
+      mutable br_typ : Types.descr; 
+      br_pat : tpat; 
+      br_body :  texpr }
     
 and op = string
 

typing/parse_pat.ml → typing/typer.ml

-(* Transform the abstract syntax of types and patterns into
-   the internal form *)
+(* I. Transform the abstract syntax of types and patterns into
+      the internal form *)
 
 open Location
 open Ast
@@ -251,15 +251,39 @@ let pat e =
 
 
 
-
-
-
-
-
-
-
-
-
-
-
-
+(* II. Build skeleton *)
+
+let rec expr { loc = loc; descr = d } = 
+  let td = 
+    match d with
+      | Var s -> Typed.Var s
+      | Apply (e1,e2) -> Typed.Apply (expr e1, expr e2)
+      | Abstraction a ->
+	  Typed.Abstraction 
+	    { Typed.fun_name = a.fun_name;
+	      Typed.fun_iface = 
+		List.map (fun (t1,t2) -> (typ t1, typ t2)) a.fun_iface;
+	      Typed.fun_body =
+		branches a.fun_body
+	    }
+      | Cst c -> Typed.Cst c
+      | Pair (e1,e2) -> Typed.Pair (expr e1, expr e2)
+      | RecordLitt r -> Typed.RecordLitt (List.map (fun (l,e) -> (l, expr e)) r)
+      | Op (o,e) -> Typed.Op (o, expr e)
+      | Match (e,b) -> Typed.Match (expr e, branches b)
+      | Map (e,b) -> Typed.Map (expr e, branches b)
+  in
+  { Typed.loc = loc;
+    Typed.exp_typ = Types.empty;
+    Typed.exp_descr = td;
+    Typed.fv = []  (* XXX TODO *)
+  }
+	      
+  and branches b = List.map branch b
+  and branch (p,e) = 
+    { Typed.used = false;
+      Typed.br_typ = Types.empty;
+      Typed.br_pat = pat p;
+      Typed.br_body = expr e }
+
+let compute_type t = failwith "Not yet implemented"

typing/parse_pat.mli → typing/typer.mli

@@ -2,5 +2,8 @@ exception ParsingPattern of string
 
 val compile_regexp : Ast.regexp -> Ast.ppat -> Ast.ppat
 
-val typ : Ast.ppat -> Types.node
-val pat : Ast.ppat -> Patterns.node
+val typ : Ast.ppat -> Typed.ttyp
+val pat : Ast.ppat -> Typed.tpat
+
+val expr: Ast.pexpr -> Typed.texpr
+val compute_type: Typed.texpr -> Types.descr