[r2003-06-17 05:25:24 by cvscast] xtransform => width tail-rec -- Alain

Original author: cvscast
Date: 2003-06-17 05:25:24+00:00

runtime/eval.ml

@@ -9,6 +9,11 @@ type env = t Env.t
 
 let make_accu () = Pair(nil,Absent)
 let get_accu a = snd (Obj.magic a)
+let map f v =
+  let acc0 = make_accu () in
+  set_cdr (f acc0 v) nil;
+  get_accu acc0
+
 
 let dummy () = Absent
 
@@ -120,11 +125,7 @@ and eval_map env brs = function
 *)
 
 and eval_map env brs v =
-  let acc0 = make_accu () in
-  let acc = eval_map_aux env brs acc0 v in
-  set_cdr acc nil;
-  get_accu acc0
-  
+  map (eval_map_aux env brs) v
 
 and eval_map_aux env brs acc = function
   | Pair (x,y) -> 
@@ -134,7 +135,7 @@ and eval_map_aux env brs acc = function
       eval_map_aux env brs acc' y
   | String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v -> 
       eval_map_aux env brs acc (normalize v)
-  | q -> acc
+  | _ -> acc
 
 
 (*  
@@ -151,10 +152,7 @@ and eval_transform env brs = function
 *)
 
 and eval_transform env brs v =
-  let acc0 = make_accu () in
-  let acc = eval_transform_aux env brs acc0 v in
-  set_cdr acc nil;
-  get_accu acc0
+  map (eval_transform_aux env brs) v
 
 and eval_transform_aux env brs acc = function
   | Pair (x,y) -> 
@@ -170,8 +168,9 @@ and eval_transform_aux env brs acc = function
       if Types.Char.is_empty (brs.Typed.br_accept) 
       then eval_transform_aux env brs acc q
       else eval_transform_aux env brs acc (normalize v)
-  | q -> acc
+  | _ -> acc
 
+(*
 and eval_xtrans env brs = function
   | String_utf8 (s,i,j,q) as v ->
       if Types.Char.is_empty (brs.Typed.br_accept) 
@@ -195,6 +194,45 @@ and eval_xtrans env brs = function
 	     let y = eval_xtrans env brs y in
 	     concat x y)
   | q -> q
+*)
+
+
+and eval_xtrans env brs v =
+  map (eval_xtrans_aux env brs) v
+
+and eval_xtrans_aux env brs acc = function
+  | String_utf8 (s,i,j,q) as v ->
+      if Types.Char.is_empty (brs.Typed.br_accept) 
+      then 
+	let acc' = String_utf8 (s,i,j, Absent) in
+	set_cdr acc acc';
+	eval_xtrans_aux env brs acc' q
+      else eval_xtrans_aux env brs acc (normalize v)
+  | String_latin1 (s,i,j,q) as v ->
+      if Types.Char.is_empty (brs.Typed.br_accept) 
+      then 
+	let acc' = String_latin1 (s,i,j, Absent) in
+	set_cdr acc acc';
+	eval_xtrans_aux env brs acc' q
+      else eval_xtrans_aux env brs acc (normalize v)
+  | Pair (x,y) -> 
+      let acc = 
+	match eval_branches env brs x with
+	  | Absent -> 
+	      let x = match x with
+		| Xml (tag, attr, child) -> 
+		    let child = eval_xtrans env brs child in
+		    Xml (tag, attr, child)
+		| x -> x in
+	      let acc' = Pair (x, Absent) in
+	      set_cdr acc acc';
+	      acc'
+	  | x -> append_cdr acc x
+      in
+      eval_xtrans_aux env brs acc y
+  | _ -> acc
+
+
 
 and eval_dot l = function
   | Record r -> LabelMap.assoc l r