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

[r2003-06-17 05:10:58 by cvscast] map-transform => tail-rec -- Alain

Original author: cvscast
Date: 2003-06-17 05:10:58+00:00
parent ad00799c
include Makefile.conf
VERSION = 0.0.91
PACKAGES = -package "pxp-engine pxp-lex-iso88591 wlexing camlp4 num cgi pcre netstring"
PACKAGES = pxp-engine pxp-lex-iso88591 wlexing camlp4 num cgi pcre netstring
ifeq ($(PXP_WLEX), true)
PACKAGES += -package pxp-wlex-utf8
PACKAGES += pxp-wlex-utf8
else
PACKAGES += -package pxp-lex-utf8
PACKAGES += pxp-lex-utf8
endif
SYNTAX = camlp4o -I misc/ pa_extend.cmo \
......@@ -20,7 +20,7 @@ else
endif
ifeq ($(EXPAT), true)
PACKAGES += -package expat
PACKAGES += expat
SYNTAX += -symbol EXPAT=
endif
......@@ -38,8 +38,8 @@ else
endif
OPT = -warn-error A
CAMLC = ocamlfind $(CAMLC_P) $(OPT) $(PACKAGES)
CAMLOPT = ocamlfind $(CAMLOPT_P) $(OPT) $(PACKAGES)
CAMLC = ocamlfind $(CAMLC_P) $(OPT) -package "$(PACKAGES)"
CAMLOPT = ocamlfind $(CAMLOPT_P) $(OPT) -package "$(PACKAGES)"
ifeq ($(NATIVE), true)
EXTENSION = cmx
......
......@@ -5,17 +5,12 @@ open Ident
exception MultipleDeclaration of id
type env = t Env.t
let set_cdr x q = Obj.set_field (Obj.repr x) 1 (Obj.repr q)
let seq_accu () = Pair (nil,nil)
let append_accu x y = let acc = Pair (y,nil) in set_cdr x acc; acc
let get_accu = function
| Pair (x,y) -> y
| _ -> assert false
(* Evaluation of expressions *)
let make_accu () = Pair(nil,Absent)
let get_accu a = snd (Obj.magic a)
let dummy () = Absent
let rec eval env e0 = match e0.Typed.exp_descr with
| Typed.Forget (e,_) -> eval env e
......@@ -114,6 +109,7 @@ 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
......@@ -121,8 +117,27 @@ and eval_map env brs = function
| String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v ->
eval_map env brs (normalize v)
| q -> q
*)
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
and eval_map_aux env brs acc = function
| Pair (x,y) ->
let x = eval_branches env brs x in
let acc' = Pair (x, Absent) in
set_cdr acc acc';
eval_map_aux env brs acc' y
| String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v ->
eval_map_aux env brs acc (normalize v)
| q -> acc
(*
and eval_transform env brs = function
| Pair (x,y) ->
(match eval_branches env brs x with
......@@ -133,25 +148,29 @@ and eval_transform env brs = function
then eval_transform env brs q
else eval_transform env brs (normalize v)
| q -> q
(*
*)
and eval_transform env brs v =
let acc = seq_accu () in
eval_transform_aux env brs acc v;
get_accu acc
let acc0 = make_accu () in
let acc = eval_transform_aux env brs acc0 v in
set_cdr acc nil;
get_accu acc0
and eval_transform_aux env brs acc = function
| Pair (x,y) ->
let x =
let acc =
match eval_branches env brs x with
| Value.Absent -> Value.nil
| x -> List.fold_left add_accu acc x
x in
concat x (eval_transform env brs y)
| Value.Absent -> acc
| x -> append_cdr acc x
(* Need to copy in general; optimization: detect fresh
constructors ... *)
in
eval_transform_aux env brs acc 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
*)
then eval_transform_aux env brs acc q
else eval_transform_aux env brs acc (normalize v)
| q -> acc
and eval_xtrans env brs = function
| String_utf8 (s,i,j,q) as v ->
......
......@@ -275,16 +275,6 @@ let rec compare x y =
| Integer _,_ -> -1 | _, Integer _ -> 1
(* (* BUGGY *)
let explode_rev s =
let rec aux acc = function
| v when v = nil -> acc
| Pair (v, seq) -> aux (v::acc) seq
| v -> [v]
in
aux [] s
*)
let iter_xml pcdata_callback other_callback =
let rec aux = function
| v when compare v nil = 0 -> ()
......@@ -305,5 +295,33 @@ let iter_xml pcdata_callback other_callback =
function
| Xml (_,_,cont) -> aux cont
| _ -> raise (Invalid_argument "Value.iter_xml")
;;
type pair = { dummy : t; mutable pair_tl : t }
type str = { dummy1 : t; dummy2 : t; dummy3 : t; mutable str_tl : t }
(* Could optimize this function by changing the order of the fields
in String_latin1, String_utf8 *)
let set_cdr cell tl =
match cell with
| Pair (_,_) -> (Obj.magic cell).pair_tl <- tl
| String_latin1 (_,_,_,_)
| String_utf8(_,_,_,_)-> (Obj.magic cell).str_tl <- tl
| _ -> assert false
let rec append_cdr cell tl =
match tl with
| Pair (x,tl) ->
let cell' = Pair (x,Absent) in
set_cdr cell cell';
append_cdr cell' tl
| String_latin1 (s,i,j,tl) ->
let cell' = String_latin1 (s,i,j,Absent) in
set_cdr cell cell';
append_cdr cell' tl
| String_utf8 (s,i,j,tl) ->
let cell' = String_utf8 (s,i,j,Absent) in
set_cdr cell cell';
append_cdr cell' tl
| _ -> cell
......@@ -56,3 +56,7 @@ val get_int : t -> int
val get_fields : t -> (string * t) list
val compare : t -> t -> int
val set_cdr : t -> t -> unit
val append_cdr : t -> t -> t
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