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
6a782887
Commit
6a782887
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-11-25 09:27:34 by cmiachon] nothing -
Original author: cmiachon Date: 2003-11-25 09:27:35+00:00
parent
a9083b5e
Changes
6
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
6a782887
...
...
@@ -125,17 +125,17 @@ OBJECTS = \
compile/compile.cmo
\
compile/operators.cmo
\
\
types/builtin.cmo driver/librarian.cmo driver/cduce.cmo
\
\
#
query/query_parse.cmo
types/builtin.cmo driver/librarian.cmo driver/cduce.cmo
CQL_OBJECTS
=
query/query.cmo
query/query_parse.cmo
VALIDATE_OBJECTS
:=
$(
shell
for
o
in
$(OBJECTS)
;
do
echo
$$
o
;
if
[
"
$$
o"
=
"schema/schema_parser.cmo"
]
;
then
exit
0
;
fi
;
done
)
# all objects until schema_parser.cmo
CDUCE
=
$(OBJECTS)
driver/run.cmo
CDUCE
=
$(OBJECTS)
driver/run.cmo
$(CQL_OBJECTS)
WEBIFACE
=
$(OBJECTS)
driver/examples.cmo driver/webiface.cmo
DTD2CDUCE
=
tools/dtd2cduce.cmo
ALL_OBJECTS
=
$(OBJECTS)
\
ALL_OBJECTS
=
$(OBJECTS)
$(CQL_OBJECTS)
\
driver/run.cmo driver/examples.cmo driver/webiface.cmo
\
tools/dtd2cduce.cmo tools/validate.cmo
ALL_INTERFACES
=
schema/schema_types.mli
...
...
depend
View file @
6a782887
...
...
@@ -212,12 +212,24 @@ driver/cduce.cmx: misc/q_symbol.cmo parser/ast.cmx types/builtin.cmx compile/com
types/patterns.cmx types/sample.cmx schema/schema_common.cmx \
misc/state.cmx typing/typed.cmx typing/typer.cmx types/types.cmx \
parser/ulexer.cmx runtime/value.cmx driver/cduce.cmi
query/query.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/chars.cmi \
types/ident.cmo types/intervals.cmi parser/location.cmi parser/parser.cmi \
driver/run.cmi types/types.cmi query/query.cmi
query/query.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/chars.cmx \
types/ident.cmx types/intervals.cmx parser/location.cmx parser/parser.cmx \
driver/run.cmx types/types.cmx query/query.cmi
query/query_parse.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/ident.cmo \
parser/location.cmi parser/parser.cmi query/query.cmi types/types.cmi
query/query_parse.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/ident.cmx \
parser/location.cmx parser/parser.cmx query/query.cmx types/types.cmx
driver/run.cmo: misc/q_symbol.cmo driver/cduce.cmi types/ident.cmo driver/librarian.cmi \
runtime/load_xml.cmi parser/location.cmi types/sequence.cmi \
misc/state.cmi misc/stats.cmi parser/ulexer.cmi runtime/value.cmi
misc/state.cmi misc/stats.cmi parser/ulexer.cmi runtime/value.cmi \
driver/run.cmi
driver/run.cmx: misc/q_symbol.cmo driver/cduce.cmx types/ident.cmx driver/librarian.cmx \
runtime/load_xml.cmx parser/location.cmx types/sequence.cmx \
misc/state.cmx misc/stats.cmx parser/ulexer.cmx runtime/value.cmx
misc/state.cmx misc/stats.cmx parser/ulexer.cmx runtime/value.cmx \
driver/run.cmi
driver/webiface.cmo: misc/q_symbol.cmo driver/cduce.cmi driver/examples.cmo parser/location.cmi \
misc/state.cmi
driver/webiface.cmx: misc/q_symbol.cmo driver/cduce.cmx driver/examples.cmx parser/location.cmx \
...
...
@@ -268,5 +280,6 @@ compile/operators.cmi: misc/q_symbol.cmo misc/custom.cmo parser/location.cmi mis
types/builtin.cmi: misc/q_symbol.cmo typing/typer.cmi
driver/librarian.cmi: misc/q_symbol.cmo types/types.cmi runtime/value.cmi
driver/cduce.cmi: misc/q_symbol.cmo types/ident.cmo types/types.cmi runtime/value.cmi
query/query.cmi: misc/q_symbol.cmo parser/ast.cmo
schema/schema_types.cmi: misc/q_symbol.cmo misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
runtime/value.cmi
driver/cduce.ml
View file @
6a782887
...
...
@@ -19,6 +19,7 @@ let prefix filename suff =
let
quiet
=
ref
false
let
toplevel
=
ref
false
let
typing_env
=
State
.
ref
"Cduce.typing_env"
Builtin
.
env
let
eval_env
=
State
.
ref
"Cduce.eval_env"
Eval
.
empty
let
compile_env
=
State
.
ref
"Cduce.compile_env"
Compile
.
empty
...
...
driver/cduce.mli
View file @
6a782887
...
...
@@ -2,6 +2,8 @@ val quiet: bool ref
val
toplevel
:
bool
ref
val
do_compile
:
bool
ref
val
enter_global_value
:
Ident
.
id
->
Value
.
t
->
Types
.
descr
->
unit
val
script
:
Format
.
formatter
->
Format
.
formatter
->
char
Stream
.
t
->
bool
val
topinput
:
Format
.
formatter
->
Format
.
formatter
->
char
Stream
.
t
->
bool
...
...
driver/run.ml
View file @
6a782887
...
...
@@ -27,7 +27,7 @@ been modified from the original Q Public.\n\n
"
;
exit
0
let
specs
=
let
specs
=
ref
[
"--load"
,
Arg
.
String
(
fun
s
->
load_dump
:=
Some
s
)
,
" load persistency file before running CDuce program"
;
"--save"
,
Arg
.
String
(
fun
s
->
save_dump
:=
Some
s
)
,
...
...
@@ -64,28 +64,29 @@ let ppf =
else
Format
.
std_formatter
let
ppf_err
=
Format
.
err_formatter
let
specs
=
let
()
=
if
Load_xml
.
expat_support
then
specs
:=
(
"--expat"
,
Arg
.
Unit
(
fun
()
->
Load_xml
.
use_parser
:=
`Expat
)
,
" use expat parser (default)"
)
::
(
"--pxp"
,
Arg
.
Unit
(
fun
()
->
Load_xml
.
use_parser
:=
`Pxp
)
,
" use PXP parser"
)
::
specs
!
specs
else
specs
:=
(
"--expat"
,
Arg
.
Unit
(
fun
()
->
(
Format
.
fprintf
ppf
"WARNING: --expat unused option. CDuce compiled without expat support
\n\n
"
))
,
" option not available: CDuce was compiled without expat support"
)
::
(
"--pxp"
,
Arg
.
Unit
(
fun
()
->
(
Format
.
fprintf
ppf
"WARNING: --pxp useless option. CDuce compiled without expat support
\n\n
"
))
,
" useless option: CDuce was compiled without expat support"
)
::
specs
!
specs
let
err
s
=
prerr_endline
s
;
exit
1
let
mode
=
Arg
.
parse
specs
(
fun
s
->
src
:=
s
::
!
src
)
let
mode
()
=
Arg
.
parse
!
specs
(
fun
s
->
src
:=
s
::
!
src
)
"Usage:
\n
cduce [OPTIONS ...] [FILE ...] [--arg argument ...]
\n\n
Options:"
;
match
(
!
compile
,!
out_dir
,!
run
,!
src
,!
args
)
with
|
false
,
_
::_,
_
,
_
,
_
->
...
...
@@ -209,7 +210,7 @@ let save () =
|
None
->
()
let
main
()
=
match
mode
with
match
mode
()
with
|
`Toplevel
args
->
restore
(
argv
args
);
toploop
()
;
...
...
@@ -221,8 +222,10 @@ let main () =
|
`Run
(
f
,
args
)
->
Cduce
.
run
f
(
argv
args
)
let
()
=
at_exit
(
fun
()
->
Stats
.
dump
Format
.
std_formatter
);
main
()
let
()
=
(* Hum... *)
let
b
=
ref
true
in
at_exit
(
fun
()
->
if
!
b
then
(
b
:=
false
;
main
()
));
at_exit
(
fun
()
->
Stats
.
dump
Format
.
std_formatter
)
query/query_parse.ml
View file @
6a782887
open
Parser
.
Hook
open
Location
open
Ast
open
Ident
open
Printf
open
Parser
.
Hook
open
Query
#
load
"pa_extend.cmo"
;;
EXTEND
let
exp
pos
e
=
LocatedExpr
(
loc_of_pos
pos
,
e
)
let
cst_nil
=
Const
(
Types
.
Atom
(
Atoms
.
V
.
mk_ascii
"nil"
))
let
true
_atom
=
Atoms
.
V
.
mk_ascii
"true"
let
false
_atom
=
Atoms
.
V
.
mk_ascii
"false"
let
true
_type
=
Types
.
atom
(
Atoms
.
atom
true
_atom
)
let
false
_type
=
Types
.
atom
(
Atoms
.
atom
false
_atom
)
EXTEND
GLOBAL
:
expr
pat
keyword
;
...
...
@@ -11,12 +27,39 @@ EXTEND
"top"
[
"select"
;
e
=
expr
;
"from"
;
l
=
LIST1
[
x
=
pat
;
"in"
;
e
=
expr
->
(
x
,
e
)]
SEP
","
;
z
=
OPT
[
"where"
;
w
=
cond
->
w
]
->
assert
false
]
];
z
=
OPT
[
"where"
;
w
=
cond
->
w
]
->
let
(
condi
,
fin
)
=
match
z
with
Some
w
->
let
ptrue
=
mk
loc
(
Internal
true
_type
)
and
pfalse
=
mk
loc
(
Internal
false
_type
)
in
(
w
,
exp
loc
(
Match
(
Query
.
ast_of_bool
(
w
,
loc
)
,
[
ptrue
,
exp
loc
(
Pair
(
e
,
cst_nil
));
pfalse
,
cst_nil
])))
|
None
->
(
True
,
exp
loc
(
Pair
(
e
,
cst_nil
)))
in
let
s
=
if
!
Query
.
nooptim
then
Query
.
select
(
loc
,
fin
,
l
)
else
Query
.
selectOpt
(
loc
,
fin
,
l
,
condi
)
in
s
]
];
cond
:
[
[
"`"
;
"true"
->
assert
false
]
];
[
[
"`"
;
"true"
->
Query
.
True
|
"`"
;
"false"
->
Query
.
False
|
a
=
expr
->
Query
.
Varb
(
a
)
|
"not"
;
a
=
cond
->
Query
.
Not
(
a
)
|
a
=
cond
;
"or"
;
b
=
cond
->
Query
.
Ou
(
a
,
b
)
|
a
=
cond
;
"and"
;
b
=
cond
->
Query
.
Et
(
a
,
b
)
|
"("
;
a
=
cond
;
")"
->
a
]
];
keyword
:
[
[
a
=
[
"select"
|
"from"
|
"where"
]
->
a
]
];
END
\ No newline at end of file
END
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