[r2003-05-11 11:36:01 by cvscast] Changed ttree into xtransform. BEPPE

Original author: cvscast
Date: 2003-05-11 11:36:01+00:00

parser/ast.ml

@@ -43,7 +43,7 @@ and pexpr =
   | Op of string * pexpr list
   | Match of pexpr * branches
   | Map of pexpr * branches
-  | Ttree of pexpr * branches
+  | Xtrans of pexpr * branches
   | Dot of pexpr* label
   | RemoveField of pexpr * label
 

parser/parser.ml

@@ -134,7 +134,7 @@ EXTEND
 	  Op ("raise",[Var (ident "x")]) in
 	exp loc (Try (e,b@[default]))
     | "map"; e = SELF; "with"; b = branches -> exp loc (Map (e,b))
-    | "ttree"; e = SELF; "with"; b = branches -> exp loc (Ttree (e,b))
+    | "xtransform"; e = SELF; "with"; b = branches -> exp loc (Xtrans (e,b))
     | "if"; e = SELF; "then"; e1 = SELF; "else"; e2 = SELF ->
 	let p1 = mk loc (Internal (Builtin.true_type))
 	and p2 = mk loc (Internal (Builtin.false_type)) in

runtime/eval.ml

@@ -53,7 +53,7 @@ let rec eval env e0 =
     | Typed.Cst c -> const c
     | Typed.Match (arg,brs) -> eval_branches env brs (eval env arg)
     | Typed.Map (arg,brs) -> eval_map env brs (eval env arg)
-    | Typed.Ttree (arg,brs) -> eval_ttree env brs (eval env arg)
+    | Typed.Xtrans (arg,brs) -> eval_xtrans env brs (eval env arg)
     | Typed.Op ("raise", [e]) -> raise (CDuceExn (eval env e))
     | Typed.Try (arg,brs) -> 
 	(try eval env arg with CDuceExn v -> eval_branches env brs v)
@@ -128,9 +128,9 @@ and eval_transform env brs = function
   | String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v -> eval_transform env brs (normalize v)
   | q -> q
 
-and eval_ttree env brs = function
+and eval_xtrans env brs = function
   | Pair (x,y) -> 
-      let y = eval_ttree env brs y in (* Beware of evaluation order !! Reverse it ? *)
+      let y = eval_xtrans env brs y in (* Beware of evaluation order !! Reverse it ? *)
       (try
 	 let x = eval_branches env brs x in
 (* TODO: avoid raising exceptions (for each character/element !) *)
@@ -138,12 +138,12 @@ and eval_ttree env brs = function
        with EMatchFail ->
 	 let x = match x with
 	   | Xml (tag, Pair (attr, child)) -> 
-	       let child = eval_ttree env brs child in
+	       let child = eval_xtrans env brs child in
 	       Xml (tag, Pair (attr, child))
 	   | Xml (_,_) -> assert false
 	   | x -> x in
 	 Pair (x,y))
-  | String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v -> eval_ttree env brs (normalize v)
+  | String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v -> eval_xtrans env brs (normalize v)
 (* TODO: optimize for strings, to avoid decomposing compound String values *)
   | q -> q
 

tests/ttree.cd → tests/xtrans.cd

 include "../web/xhtml-strict.cd";;
 
-(*
+
 let fun f (x : Xhtml) : [ Xhtml ] =
-  ttree [ x ] with <a>t -> [];;
-*)
+  xtransform [ x ] with <a>t -> [];;
+
+
 
-(*
 let fun g (x : Xhtml) : [ Xhtml ] =
-  ttree [ x ] with <a>t -> [ <b>t ];;
-*)
+  xtransform [ x ] with <a>t -> [ <b>t ];;
+
+
 
 
-(*
 
 type T = <a>[ <b>[] T* <b>[] ];;
 type S = <a>[ <x>[] S* <x>[] ];;
 
 let fun f (x : [ T ]) : [ S ] =
-  ttree x with <b>_ -> [ <x>[] ];;
+  xtransform x with <b>_ -> [ <x>[] ];;
 
 let x = f [ <a>[ <b>[] <b>[] ] ];;
-*)
+

typing/typed.ml

@@ -36,7 +36,7 @@ and  texpr' =
   | Op of string * texpr list
   | Match of texpr * branches
   | Map of texpr * branches
-  | Ttree of texpr * branches
+  | Xtrans of texpr * branches
   | RemoveField of texpr * label
   | Dot of texpr * label
       

typing/typer.ml

@@ -567,11 +567,11 @@ let rec expr loc = function
       let (fv1,e) = expr loc e
       and (fv2,b) = branches b in
       exp loc (Fv.cup fv1 fv2) (Typed.Map (e, b))
-  | Ttree (e,b) ->
+  | Xtrans (e,b) ->
       let b = b @ [ mknoloc (Internal Types.any), MatchFail ] in
       let (fv1,e) = expr loc e
       and (fv2,b) = branches b in
-      exp loc (Fv.cup fv1 fv2) (Typed.Ttree (e, b))
+      exp loc (Fv.cup fv1 fv2) (Typed.Xtrans (e, b))
   | MatchFail -> 
       exp loc (Fv.empty) Typed.MatchFail
   | Try (e,b) ->
@@ -837,7 +837,7 @@ and compute_type' loc env = function
   | Op (op, el) ->
       let args = List.map (fun e -> (e.exp_loc, compute_type env e)) el in
       type_op loc op args
-  | Ttree (e,b) ->
+  | Xtrans (e,b) ->
       let t = type_check env e Sequence.any true in
       let r = 
 	Sequence.map_tree