Commit f00863af authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-06-17 05:33:21 by cvscast] Clean -- Alain

Original author: cvscast
Date: 2003-06-17 05:33:21+00:00
parent 50a2cf01
......@@ -5,17 +5,13 @@ open Ident
exception MultipleDeclaration of id
type env = t Env.t
(* Evaluation of expressions *)
(* To write tail-recursive map-like iteration *)
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 map f v = let acc0 = make_accu () in set_cdr (f acc0 v) nil; get_accu acc0
let dummy () = Absent
(* Evaluation of expressions *)
let rec eval env e0 = match e0.Typed.exp_descr with
| Typed.Forget (e,_) -> eval env e
......@@ -75,9 +71,6 @@ and eval_apply f arg = match f with
| Abstraction (_,clos) -> clos arg
| _ -> assert false
and eval_branches' env_ref brs arg =
eval_branches !env_ref brs arg
and eval_branches env brs arg =
let (disp, rhs) = Typed.dispatcher brs in
let (code, bindings) = run_dispatcher disp arg in
......@@ -114,16 +107,6 @@ and eval_rec_funs env l =
env slots in
List.map (fun (f, e, s) -> s := eval env' e; (f, !s)) slots
(*
and eval_map env brs = function
| Pair (x,y) ->
let x = eval_branches env brs x in
Pair (x, eval_map env brs y)
| String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v ->
eval_map env brs (normalize v)
| q -> q
*)
and eval_map env brs v =
map (eval_map_aux env brs) v
......@@ -137,31 +120,14 @@ and eval_map_aux env brs acc = function
eval_map_aux env brs acc (normalize v)
| _ -> acc
(*
and eval_transform env brs = function
| Pair (x,y) ->
(match eval_branches env brs x with
| Value.Absent -> eval_transform env brs y
| x -> concat x (eval_transform env brs y))
| String_latin1 (_,_,_,q) | String_utf8 (_,_,_,q) as v ->
if Types.Char.is_empty (brs.Typed.br_accept)
then eval_transform env brs q
else eval_transform env brs (normalize v)
| q -> q
*)
and eval_transform env brs v =
map (eval_transform_aux env brs) v
and eval_transform_aux env brs acc = function
| Pair (x,y) ->
let acc =
match eval_branches env brs x with
| Value.Absent -> acc
| x -> append_cdr acc x
(* Need to copy in general; optimization: detect fresh
constructors ... *)
let acc = match eval_branches env brs x with
| Value.Absent -> acc
| x -> append_cdr acc x
in
eval_transform_aux env brs acc y
| String_latin1 (_,_,_,q) | String_utf8 (_,_,_,q) as v ->
......@@ -170,32 +136,6 @@ and eval_transform_aux env brs acc = function
else eval_transform_aux env brs acc (normalize v)
| _ -> acc
(*
and eval_xtrans env brs = function
| String_utf8 (s,i,j,q) as v ->
if Types.Char.is_empty (brs.Typed.br_accept)
then String_utf8 (s,i,j, eval_xtrans env brs q)
else eval_xtrans env brs (normalize v)
| String_latin1 (s,i,j,q) as v ->
if Types.Char.is_empty (brs.Typed.br_accept)
then String_latin1 (s,i,j, eval_xtrans env brs q)
else eval_xtrans env brs (normalize v)
| Pair (x,y) ->
(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 y = eval_xtrans env brs y in
Pair (x,y)
| x ->
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
......@@ -232,8 +172,6 @@ and eval_xtrans_aux env brs acc = function
eval_xtrans_aux env brs acc y
| _ -> acc
and eval_dot l = function
| Record r -> LabelMap.assoc l r
| _ -> assert false
......@@ -241,3 +179,53 @@ and eval_dot l = function
and eval_remove_field l = function
| Record r -> Record (LabelMap.remove l r)
| _ -> assert false
(* Non tail-rec version:
and eval_transform env brs = function
| Pair (x,y) ->
(match eval_branches env brs x with
| Value.Absent -> eval_transform env brs y
| x -> concat x (eval_transform env brs y))
| String_latin1 (_,_,_,q) | String_utf8 (_,_,_,q) as v ->
if Types.Char.is_empty (brs.Typed.br_accept)
then eval_transform env brs q
else eval_transform env brs (normalize v)
| q -> q
and eval_xtrans env brs = function
| String_utf8 (s,i,j,q) as v ->
if Types.Char.is_empty (brs.Typed.br_accept)
then String_utf8 (s,i,j, eval_xtrans env brs q)
else eval_xtrans env brs (normalize v)
| String_latin1 (s,i,j,q) as v ->
if Types.Char.is_empty (brs.Typed.br_accept)
then String_latin1 (s,i,j, eval_xtrans env brs q)
else eval_xtrans env brs (normalize v)
| Pair (x,y) ->
(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 y = eval_xtrans env brs y in
Pair (x,y)
| x ->
let y = eval_xtrans env brs y in
concat x y)
| q -> q
and eval_map env brs = function
| Pair (x,y) ->
let x = eval_branches env brs x in
Pair (x, eval_map env brs y)
| String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v ->
eval_map env brs (normalize v)
| q -> q
*)
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