Commit 59c2baee authored by Pietro Abate's avatar Pietro Abate
Browse files

[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
parent 902a086b
......@@ -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
......
......@@ -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
......
......@@ -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
......
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>[] ] ];;
*)
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment