Commits

Anonymous committed 5765237

Removed the ill-considered 'type' field from variables.

  • Participants
  • Parent commits c38a235

Comments (0)

Files changed (4)

   fun name ->
     incr cur_index;
     { var_name=name; 
-      var_uname="%" ^ name ^ "." ^ (string_of_int !cur_index);
-      var_type=typevar () }
+      var_uname="%" ^ name ^ "." ^ (string_of_int !cur_index) }
 ;;
   
 let mkglobal name =
   { var_name=name;
-    var_uname=name;
-    var_type=typevar () }
+    var_uname=name }
 ;;
 
 let _pp_list ppe f = function

blub_typecheck.ml

   | Sunbound -> typevar ()
   | x -> 
       printf "Unsupported sval %a\n%!" pp_sval x;
-      raise (Tcheck_failed "")
+      typevar ()
 
 let tcheck globals env (e:ast) : (ast * type_) list =
   let typedict = Hashtbl.create 256 in
   and vardeclcheck var e r =
     PMap.add var (schema (tcheck r e) r) r
   in
+
+  (* Add the types of everything in the environment *)
+
   let env = List.fold_left
     (fun env frame ->
+       let frame = Array.mapi 
+	 (fun idx var -> (var, frame.vals.(idx))) frame.vars in
        Array.fold_right
-	 (fun var env -> 
-	    let ts = schema var.var_type PMap.empty in
-	    PMap.add var ts env) frame.vars env)
+	 (fun (var, value) env -> 
+	    let ts = schema (type_of_sval value) PMap.empty in
+	    PMap.add var ts env) frame env)
     PMap.empty env
   in
 
+  let globals = Array.mapi (fun idx var ->
+			      (var, globals.vals.(idx))) globals.vars in
+
   let env = Array.fold_right
-    (fun var env -> 
-	 let ts = schema var.var_type PMap.empty in
+    (fun (var, value) env -> 
+	 let ts = schema (type_of_sval value) PMap.empty in
 	 PMap.add var ts env)
-    globals.vars env
+    globals env
   in
 
   let t = tcheck env e in
 type variable = {
   var_name : string;
   var_uname : string;  (* unique id *)
-  var_type : type_;
 }  
 
 type binding = 
     in
     let () = try
       let type_assoc = Blub_typecheck.tcheck globals env ast in
-      ()
-      (* List.iter (fun (ast, typ) ->
-	 printf "type: %a\n%!" pp_type typ) 
-	type_assoc; *)
+      List.iter (fun (ast, typ) ->
+	 printf "type: %a => %a\n%!" pp_ast ast pp_type typ) 
+	type_assoc;
     with Blub_typecheck.Tcheck_failed _ -> 
       printf "Failed to typecheck\n%!"
     in