Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
4e12c465
Commit
4e12c465
authored
Jul 10, 2007
by
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
c75ba1e8
Changes
4
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
4e12c465
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
...
...
runtime/eval.ml
View file @
4e12c465
...
...
@@ -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
->
...
...
runtime/value.ml
View file @
4e12c465
...
...
@@ -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
runtime/value.mli
View file @
4e12c465
...
...
@@ -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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment