[r2004-07-08 16:18:13 by afrisch] Empty log message

Original author: afrisch
Date: 2004-07-08 16:18:13+00:00

compile/lambda.ml

@@ -60,6 +60,7 @@ type expr =
   | Dot of expr * label
   | Ref of expr * Types.Node.t
   | Op of string * expr list
+  | OpResolved of Obj.t * expr list
   | NsTable of Ns.table * expr
 
 and branches = {
@@ -205,6 +206,8 @@ module Put = struct
 	bits nbits s 19;
 	string s op;
 	list expr s args
+    | OpResolved _ ->
+	assert false
     | NsTable (ns,e) ->
 	bits nbits s 20;
 	Ns.serialize_table s ns;

compile/lambda.mli

@@ -32,7 +32,10 @@ type expr =
   | RemoveField of expr * label
   | Dot of expr * label
   | Ref of expr * Types.Node.t
-  | Op of string * expr list  (* the string is replaced at runtime by eval function *)
+  | Op of string * expr list  
+  | OpResolved of Obj.t * expr list
+      (* the first arg is the eval function *)
+      (* type Value.t is not available here ... *)
   | NsTable of Ns.table * expr
 
 and branches = {

runtime/eval.ml

@@ -92,6 +92,8 @@ let eval_var env = function
 	Obj.set_field x 1 (Obj.repr (-1));
 	v
 
+let tag_op_resolved = Obj.tag (Obj.repr (OpResolved (Obj.repr 0, [])))
+
 let rec eval env = function
   | Var x -> eval_var env x
   | Apply (false,e1,e2) -> 
@@ -126,14 +128,12 @@ let rec eval env = function
   | Validate (e, kind, schema, name) -> eval_validate env e kind schema name
   | Ref (e,t) -> eval_ref env e t
   | Op (op,args) as e -> 
-      let args = List.map (eval env) args in
-      (* eval_op op args *)
-      if Obj.tag (Obj.repr op) = Obj.string_tag then
-	let eval_fun = eval_op op in
-	Obj.set_field (Obj.repr e) 0 (Obj.repr eval_fun);
-	eval_fun args
-      else 
-	(Obj.magic op) args
+      let eval_fun = eval_op op in
+      Obj.set_field (Obj.repr e) 0 (Obj.repr eval_fun);
+      Obj.set_tag (Obj.repr e) tag_op_resolved;
+      eval_fun (List.map (eval env) args)
+  | OpResolved (f,args) ->
+      (Obj.magic f) (List.map (eval env) args)
   | NsTable (ns,e) -> ns_table := ns; eval env e