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
d8958714
Commit
d8958714
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2004-07-13 21:15:18 by afrisch] Merge in branch ocaml308
Original author: afrisch Date: 2004-07-13 21:15:19+00:00
parent
4080a54a
Changes
10
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
d8958714
...
...
@@ -254,7 +254,7 @@ validate: $(VALIDATE_OBJECTS:.cmo=.$(EXTENSION)) tools/validate.$(EXTENSION)
cdo2ml
:
ocamliface/cdo2ml.ml
@
echo
"Build
$@
"
$(HIDE)
ocamlc
-o
$@
-pp
camlp4o
-I
+camlp4 camlp4.cma pr_o.cmo
$^
$(HIDE)
ocamlc
-o
$@
-pp
camlp4o
-I
+camlp4
odyl.cma
camlp4.cma pr_o.cmo
$^
.PHONY
:
compute_depend
compute_depend
:
$(DEPEND_OCAMLDEP)
...
...
driver/librarian.ml
View file @
d8958714
...
...
@@ -43,7 +43,7 @@ let mk ((typing,compile,code),types,ext) =
stub
=
None
}
let
magic
=
"CDUCE:compunit:0000
3
"
let
magic
=
"CDUCE:compunit:0000
4
"
let
obj_path
=
ref
[
""
]
...
...
@@ -159,7 +159,8 @@ let rec compile verbose name id src =
try
Parser
.
prog
input
with
|
Stdpp
.
Exc_located
(
_
,
(
Location
_
as
e
))
->
raise
e
|
Stdpp
.
Exc_located
((
i
,
j
)
,
e
)
->
raise_loc
i
j
e
(* | Stdpp.Exc_located ((i,j), e) -> raise_loc i j e *)
|
Stdpp
.
Exc_located
((
i
,
j
)
,
e
)
->
raise_loc
i
.
Lexing
.
pos_cnum
j
.
Lexing
.
pos_cnum
e
in
close_in
ic
;
let
argv
=
ident
(
U
.
mk
"argv"
)
in
...
...
ocamliface/cdo2ml.ml
View file @
d8958714
#
load
"q_MLast.cmo"
;;
let
loc
=
(
-
1
,-
1
)
let
loc
=
(
Lexing
.
dummy_pos
,
Lexing
.
dummy_pos
)
let
usage
=
"Usage: cdo2ml [-static] <module>.cdo
...
...
ocamliface/mlstub.ml
View file @
d8958714
...
...
@@ -74,7 +74,7 @@ let mk_var _ =
let
mk_vars
=
List
.
map
mk_var
let
loc
=
(
-
1
,-
1
)
let
loc
=
(
Lexing
.
dummy_pos
,
Lexing
.
dummy_pos
)
let
let_in
p
e
body
=
<:
expr
<
let
$
list
:
[
p
,
e
]
$
in
$
body
$
>>
...
...
ocamliface/mltypes.ml
View file @
d8958714
...
...
@@ -197,14 +197,14 @@ let read_cmi name =
let
(
unf
,
n
)
=
unfold
t
in
if
n
!=
0
then
unsupported
"polymorphic value"
;
values
:=
(
Ident
.
name
id
,
t
,
unf
)
::
!
values
|
Tsig_type
(
id
,
t
)
->
|
Tsig_type
(
id
,
t
,_
)
->
Format
.
fprintf
ppf
"%a@."
(
Printtyp
.
type_declaration
id
)
t
|
Tsig_value
(
_
,_
)
->
unsupported
"external value"
|
Tsig_exception
(
_
,_
)
->
unsupported
"exception"
|
Tsig_module
(
_
,_
)
->
unsupported
"module"
|
Tsig_modtype
(
_
,_
)
->
unsupported
"module type"
|
Tsig_class
(
_
,_
)
->
unsupported
"class"
|
Tsig_cltype
(
_
,_
)
->
unsupported
"class type"
|
Tsig_value
_
->
unsupported
"external value"
|
Tsig_exception
_
->
unsupported
"exception"
|
Tsig_module
_
->
unsupported
"module"
|
Tsig_modtype
_
->
unsupported
"module type"
|
Tsig_class
_
->
unsupported
"class"
|
Tsig_cltype
_
->
unsupported
"class type"
)
sg
;
(
Buffer
.
contents
buf
,
!
values
)
...
...
parser/parser.ml
View file @
d8958714
...
...
@@ -9,8 +9,15 @@ open Printf
let () = Grammar.error_verbose := true
*)
let
tloc
(
i
,
j
)
=
(
i
.
Lexing
.
pos_cnum
,
j
.
Lexing
.
pos_cnum
)
let
nopos
=
(
Lexing
.
dummy_pos
,
Lexing
.
dummy_pos
)
let
mk
loc
x
=
Location
.
mk
(
tloc
loc
)
x
exception
Error
of
string
let
error
(
i
,
j
)
s
=
Location
.
raise_loc
i
j
(
Error
s
)
let
error
loc
s
=
error
(
tloc
loc
)
s
let
gram
=
Grammar
.
gcreate
Ulexer
.
lex
...
...
@@ -28,7 +35,7 @@ let pat = Grammar.Entry.create gram "type/pattern expression"
let
regexp
=
Grammar
.
Entry
.
create
gram
"type/pattern regexp"
let
keyword
=
Grammar
.
Entry
.
create
gram
"keyword"
let
exp
pos
e
=
LocatedExpr
(
loc_of_pos
pos
,
e
)
let
exp
pos
e
=
LocatedExpr
(
loc_of_pos
(
tloc
pos
)
,
e
)
let
rec
multi_prod
loc
=
function
|
[
x
]
->
x
...
...
@@ -71,8 +78,8 @@ let localize_exn f =
try
f
()
with
|
Stdpp
.
Exc_located
(
_
,
(
Location
_
as
e
))
->
raise
e
|
Stdpp
.
Exc_located
((
i
,
j
)
,
e
)
->
raise_loc
i
j
e
(*
| Stdpp.Exc_located ((i,j), e) -> raise_loc i j e
*)
|
Stdpp
.
Exc_located
((
i
,
j
)
,
e
)
->
raise_loc
i
.
Lexing
.
pos_cnum
j
.
Lexing
.
pos_cnum
e
let
is_fun_decl
=
Grammar
.
Entry
.
of_parser
gram
"[is_fun_decl]"
...
...
parser/ulexer.ml
View file @
d8958714
...
...
@@ -150,6 +150,21 @@ let raise_clean e =
(* reinit encoding ? *)
raise e
let pos_of_int i =
{ Lexing.pos_fname = "";
Lexing.pos_lnum = 0;
Lexing.pos_bol = 0;
Lexing.pos_cnum = i }
let make_stream_and_location f =
Token.make_stream_and_flocation
(fun () ->
let (tok,(i,j)) = f () in
(tok, (pos_of_int i, pos_of_int j))
)
let tok_func cs =
let lb = L.from_var_enc_stream enc cs in
(lexer ("
#!
" [^ '
\n
']* "
\
n
")? -> ()) lb;
...
...
@@ -169,7 +184,7 @@ let tok_func cs =
last_tok := fst tok;
tok
in
Token.
make_stream_and_location next
make_stream_and_location next
let register_kw (s1,s2) =
if s1 = "" then
...
...
query/query_parse.ml
View file @
d8958714
...
...
@@ -8,7 +8,10 @@ open Query
#
load
"pa_extend.cmo"
;;
let
exp
pos
e
=
LocatedExpr
(
loc_of_pos
pos
,
e
)
let
tloc
(
i
,
j
)
=
(
i
.
Lexing
.
pos_cnum
,
j
.
Lexing
.
pos_cnum
)
let
mk
loc
x
=
Location
.
mk
(
tloc
loc
)
x
let
exp
pos
e
=
LocatedExpr
(
loc_of_pos
(
tloc
pos
)
,
e
)
let
cst_nil
=
Const
Sequence
.
nil_cst
let
parse_ident
=
U
.
mk
...
...
@@ -39,14 +42,14 @@ EXTEND
match
z
with
Some
w
->
(
w
,
exp
loc
(
Parser
.
if_then_else
(
Query
.
ast_of_bool
(
w
,
loc
))
(
Parser
.
if_then_else
(
Query
.
ast_of_bool
(
w
,
tloc
loc
))
(
Pair
(
e
,
cst_nil
))
cst_nil
))
|
None
->
(
True
,
exp
loc
(
Pair
(
e
,
cst_nil
)))
in
if
!
Query
.
nooptim
then
Query
.
select
(
loc
,
fin
,
l
)
else
Query
.
selectOpt
(
loc
,
Pair
(
e
,
cst_nil
)
,
l
,
condi
)
then
Query
.
select
(
tloc
loc
,
fin
,
l
)
else
Query
.
selectOpt
(
tloc
loc
,
Pair
(
e
,
cst_nil
)
,
l
,
condi
)
|
e
=
expr
;
"/@"
;
a
=
[
IDENT
|
keyword
]
->
(* projection sur 1 attribut *)
...
...
types/atoms.ml
View file @
d8958714
...
...
@@ -48,7 +48,7 @@ let print_symbolset ns ppf = function
(
fun
x
->
V
.
print_quote
ppf
(
ns
,
x
))
l
|
SymbolSet
.
Cofinite
t
->
Format
.
fprintf
ppf
"@[`%a"
V
.
print_any_in_ns
ns
;
List
.
iter
(
fun
x
->
Format
.
fprintf
ppf
"
\
@ %a"
V
.
print_quote
(
ns
,
x
))
t
;
List
.
iter
(
fun
x
->
Format
.
fprintf
ppf
"
\
\
@ %a"
V
.
print_quote
(
ns
,
x
))
t
;
Format
.
fprintf
ppf
"@]"
include
SortedList
.
FiniteCofiniteMap
(
Ns
)(
SymbolSet
)
...
...
@@ -72,7 +72,7 @@ let print s = match get s with
Format
.
fprintf
ppf
"Atom"
;
List
.
iter
(
fun
(
ns
,
s
)
->
Format
.
fprintf
ppf
"
\
@ (%a)"
(
print_symbolset
ns
)
s
)
Format
.
fprintf
ppf
"
\
\
@ (%a)"
(
print_symbolset
ns
)
s
)
l
]
type
'
a
map
=
'
a
Imap
.
s
Imap
.
s
...
...
types/types.ml
View file @
d8958714
...
...
@@ -421,13 +421,27 @@ struct
end
(* See PR#2920 in OCaml BTS *)
and
NodeT
:
Custom
.
T
with
type
t
=
Node
.
t
=
struct
type
t
=
Node
.
t
let
dump
x
=
Node
.
dump
x
let
check
x
=
Node
.
check
x
let
equal
x
=
Node
.
equal
x
let
hash
x
=
Node
.
hash
x
let
compare
x
=
Node
.
compare
x
let
serialize
x
=
Node
.
serialize
x
let
deserialize
x
=
Node
.
deserialize
x
end
(* It is also possible to use Boolean instead of Bool here;
need to analyze when each one is more efficient *)
and
BoolPair
:
Bool
.
S
with
type
elem
=
Node
.
t
*
Node
.
t
=
Bool
.
Make
(
Custom
.
Pair
(
Node
)(
Node
))
Bool
.
Make
(
Custom
.
Pair
(
Node
T
)(
Node
T
))
and
BoolRec
:
Bool
.
S
with
type
elem
=
bool
*
Node
.
t
label_map
=
Bool
.
Make
(
Custom
.
Pair
(
Custom
.
Bool
)(
LabelSet
.
MakeMap
(
Node
)))
Bool
.
Make
(
Custom
.
Pair
(
Custom
.
Bool
)(
LabelSet
.
MakeMap
(
Node
T
)))
module
DescrHash
=
Hashtbl
.
Make
(
Descr
)
module
DescrMap
=
Map
.
Make
(
Descr
)
...
...
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