Skip to content
GitLab
Menu
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
5869d4b6
Commit
5869d4b6
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-05-25 11:46:41 by cvscast] Menage
Original author: cvscast Date: 2003-05-25 11:46:41+00:00
parent
417256a7
Changes
5
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
5869d4b6
...
...
@@ -21,8 +21,9 @@ else
SYNTAX_PARSER
=
-pp
'
$(SYNTAX)
'
endif
CAMLC
=
ocamlfind
$(CAMLC_P)
$(PACKAGES)
CAMLOPT
=
ocamlfind
$(CAMLOPT_P)
$(PACKAGES)
OPT
=
-warn-error
A
CAMLC
=
ocamlfind
$(CAMLC_P)
$(OPT)
$(PACKAGES)
CAMLOPT
=
ocamlfind
$(CAMLOPT_P)
$(OPT)
$(PACKAGES)
ifeq
($(NATIVE), true)
EXTENSION
=
cmx
...
...
runtime/eval.ml
View file @
5869d4b6
...
...
@@ -13,13 +13,6 @@ let enter_global x v =
global_env
:=
Env
.
add
x
v
!
global_env
let
exn_load_file_utf8
=
CDuceExn
(
Pair
(
Atom
(
Atoms
.
mk_ascii
"load_file_utf8"
)
,
string_latin1
"File is not a valid UTF-8 stream"
))
(* Evaluation of expressions *)
let
rec
eval
env
e0
=
...
...
runtime/value.ml
View file @
5869d4b6
...
...
@@ -201,7 +201,8 @@ let rec compare x y =
|
Atom
x
,
Atom
y
->
Atoms
.
vcompare
x
y
|
Integer
x
,
Integer
y
->
Intervals
.
vcompare
x
y
|
Char
x
,
Char
y
->
Chars
.
vcompare
x
y
|
Abstraction
(
_
,_
)
,
Abstraction
(
_
,_
)
->
|
Abstraction
(
_
,_
)
,
_
|
_
,
Abstraction
(
_
,_
)
->
raise
(
CDuceExn
(
string_latin1
"comparing functional values"
))
|
Absent
,_
|
_
,
Absent
->
assert
false
|
String_latin1
(
ix
,
jx
,
sx
,
qx
)
,
String_latin1
(
iy
,
jy
,
sy
,
qy
)
->
...
...
@@ -242,7 +243,13 @@ let rec compare x y =
|
_
,
String_latin1
(
i
,
j
,
s
,
q
)
->
compare
x
(
normalize_string_latin1
i
j
s
q
)
|
String_utf8
(
i
,
j
,
s
,
q
)
,
_
->
compare
(
normalize_string_utf8
i
j
s
q
)
y
|
_
,
String_utf8
(
i
,
j
,
s
,
q
)
->
compare
x
(
normalize_string_utf8
i
j
s
q
)
|
_
,_
->
Obj
.
tag
(
Obj
.
repr
x
)
-
Obj
.
tag
(
Obj
.
repr
y
)
(* TODO: rewrite this case *)
|
Pair
(
_
,_
)
,
_
->
-
1
|
_
,
Pair
(
_
,_
)
->
1
|
Xml
(
_
,_,_
)
,_
->
-
1
|
_
,
Xml
(
_
,_,_
)
->
1
|
Record
_
,_
->
-
1
|
_
,
Record
_
->
1
|
Atom
_
,_
->
-
1
|
_
,
Atom
_
->
1
|
Integer
_
,_
->
-
1
|
_
,
Integer
_
->
1
types/sortedList.ml
View file @
5869d4b6
...
...
@@ -249,15 +249,15 @@ module Map = struct
let
rec
assoc_remove_aux
v
r
=
function
|
((
x
,
y
)
as
a
)
::
l
->
let
c
=
X
.
compare
x
v
in
if
c
=
0
then
(
r
:=
y
;
l
)
if
c
=
0
then
(
r
:=
Some
y
;
l
)
else
if
c
<
0
then
a
::
(
assoc_remove_aux
v
r
l
)
else
raise
Not_found
|
[]
->
raise
Not_found
let
assoc_remove
v
l
=
let
r
=
ref
(
Obj
.
magic
0
)
in
let
r
=
ref
None
in
let
l
=
assoc_remove_aux
v
r
l
in
(
!
r
,
l
)
match
!
r
with
Some
x
->
(
x
,
l
)
|
_
->
assert
false
(* TODO: is is faster to raise exception Not_found and return
original list ? *)
...
...
types/types.ml
View file @
5869d4b6
...
...
@@ -666,28 +666,6 @@ struct
List
.
iter
add
d
;
List
.
map
(
!
)
!
res
(*
This version explodes when dealing with
Any - [ t1? t2? t3? ... tn? ]
==> need partitioning
*)
let
get_aux
any_right
d
=
let
line
accu
(
left
,
right
)
=
let
rec
aux
accu
d1
d2
=
function
|
(
t1
,
t2
)
::
right
->
let
accu
=
let
d1
=
diff_t
d1
t1
in
if
is_empty
d1
then
accu
else
aux
accu
d1
d2
right
in
let
accu
=
let
d2
=
diff_t
d2
t2
in
if
is_empty
d2
then
accu
else
aux
accu
d1
d2
right
in
accu
|
[]
->
(
d1
,
d2
)
::
accu
in
let
(
d1
,
d2
)
=
cap_product
any
any_right
left
in
if
(
is_empty
d1
)
||
(
is_empty
d2
)
then
accu
else
aux
accu
d1
d2
right
in
List
.
fold_left
line
[]
d
(* Partitioning:
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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