[r2002-10-21 19:11:57 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-21 19:13:15+00:00

tests/addrbook.cd

@@ -4,9 +4,7 @@ type Name = <name>[String];;
 type Addr = <addr>[String];;
 type Tel = <tel>[String];;
 
-fun (Int -> Int) 0 
-  -> 1;;
-
+(*
 <addrbook>[
   <name>["Haruo Hosoya"]
   <addr>["Tokyo"]
@@ -43,7 +41,7 @@ fun (Int -> Int) 0
   <name>["Peter Buneman"]
   <addr>["Scotland"]
  ];;
-
+*)
 
 (*
 
@@ -58,6 +56,7 @@ fun mkTelList ([ (Name Addr Tel?)* ] -> [ (Name Tel)* ])
 fun mkTelList (Addrbook -> [ (Name Tel)* ])
 <_>[ ( ( (x::Name) Addr (x::Tel) ) | _ )* ] ->  x
 ;;
+*)
 
 fun (Int -> Addrbook) x ->
 <addrbook>[
@@ -70,7 +69,22 @@ fun (Int -> Addrbook) x ->
   <addr>["Scotland"]
  ] 
 ;;
+(*
+fun (Int -> Addrbook) x ->
+<addrbook>[
+  <name>["Haruo Hosoya"]
+  <addr>["Tokyo"]
+  <name>["Benjamin Pierce"]
+  <addr>["Philadelphia"] 
+  <tel>["123-456-789"]
+  <name>["Peter Buneman"]
+  <addr>["Scotland"]
+ ] 
+;;
+*)
 
+
+(*
 match <addrbook>[
   <name>["Haruo Hosoya"]
   <addr>["Tokyo"]

typing/typer.ml

@@ -424,6 +424,7 @@ and type_check' loc env e constr precise = match e with
   | Match (e,b) ->
       let t = type_check env e b.br_accept true in
       type_check_branches loc env t b constr precise
+
   | Pair (e1,e2) -> 
       let rects = Types.Product.get constr in
       if Types.Product.is_empty rects then 
@@ -438,6 +439,7 @@ and type_check' loc env e constr precise = match e with
 	Types.times (Types.cons t1) (Types.cons t2)
       else
 	constr
+
   | RecordLitt r ->
       let rconstr = Types.Record.get constr in
       if Types.Record.is_empty rconstr then
@@ -498,6 +500,24 @@ and compute_type' loc env = function
   | Map (e,b) ->
       let t = compute_type env e in
       Sequence.map (fun t -> type_check_branches loc env t b Types.any true) t
+
+(* We keep these cases here to allow comparison and benchmarking ...
+   Just comment the corresponding cases in type_check' to
+   activate these ones.
+*)
+  | Pair (e1,e2) -> 
+      let t1 = compute_type env e1 
+      and t2 = compute_type env e2 in
+      Types.times (Types.cons t1) (Types.cons t2)
+  | RecordLitt r ->
+      List.fold_left 
+        (fun accu (l,e) ->
+           let t = compute_type env e in
+           let t = Types.record l false (Types.cons t) in
+           Types.cap accu t
+        ) Types.Record.any r
+
+
   | _ -> assert false
 
 and type_check_branches loc env targ brs constr precise =