Skip to content

GitLab

C
cduce
Commit c778e2e1 authored by Pietro Abate's avatar Pietro Abate
Browse files
Options

[r2005-03-04 13:10:27 by afrisch] Prepare for 0.2.3 

Original author: afrisch
Date: 2005-03-04 13:10:28+00:00
parent 658fa165
Hide whitespace changes
Inline Side-by-side
Showing with 65 additions and 220 deletions
CHANGES
View file @ c778e2e1
......@@ -3,6 +3,22 @@ Since 0.2.2
- Warning for capture variables and projections that always return the empty
sequence.
- Bug fixes when printing location in source code.
- Major rewrite of the support for XML Schema
* removed print_schema directive
- removed the syntax "external {...}", replaced with
"unit.val with { ty1 ty2 ... }"
- removed the syntax H:val, replaced with H.val
- removed the syntax S#t, replaced with S.t
- overloaded the dot (record field acces, CDuce, OCaml, Schema units)
- identifiers (for types, values) are now qualified names
- A new tool cduce_mktop produce CDuce toplevels with embeded OCaml functions
- several bug fixes
- validate renamed to cduce_validate
- more efficient hash-consing of types
- better error message with script on stdin
- a dot in an identifier must be escaped with a backslash, e.g. x\.y
- improved #print_type (does not use the abbreviation for the printed type)
- float_of: String -> Float
0.2.2
......
INSTALL
View file @ c778e2e1
......@@ -130,14 +130,14 @@ You need a GNU Make (or equivalent). The Makefile defines the following goals:
- make dtd2cduce
compiles the dtd2cduce tools (converts DTD to CDuce types)
- make validate
- make cduce_validate
compiles the schema validation tool
- make doc
compiles in the subdirectory web/doc the HTML documentation for CDuce
- make all
equivalent to (make cduce dtd2cduce validate)
equivalent to (make cduce dtd2cduce cduce_validate)
- make install
installs binaries into $(BINDIR), manpages into $(MANDIR)/man1,
......
Makefile.distrib
View file @ c778e2e1
......@@ -216,12 +216,11 @@ CDUCE = $(OBJECTS) driver/start.cmo
DTD2CDUCE = tools/dtd2cduce.cmo
ALL_OBJECTS = $(OBJECTS) $(NEW_SCHEMA_OBJS) \
driver/run.cmo driver/examples.cmo driver/webiface.cmo driver/evaluator.cmo \
driver/start.cmo driver/examples.cmo driver/webiface.cmo driver/evaluator.cmo \
tools/dtd2cduce.cmo tools/validate.cmo \
$(ML_INTERFACE_OBJS) parser/cduce_curl.cmo \
parser/cduce_netclient.cmo \
runtime/cduce_expat.cmo \
$(CQL_OBJECTS_RUN)
ALL_INTERFACES = schema/schema_types.mli
DEPEND = $(ALL_OBJECTS:.cmo=.ml) $(ALL_OBJECTS:.cmo=.mli) $(ALL_INTERFACES)
......@@ -259,9 +258,9 @@ cduce_validate: $(VALIDATE_OBJECTS:.cmo=.$(EXTENSION)) tools/validate.$(EXTENSIO
@echo "Build $@"
$(HIDE)$(LINK) $(INCLUDES) -o $@ $^
mlcduce_wrapper: $(OBJECTS:.cmo=.$(EXTENSION)) ocamliface/mlcduce_wrapper.ml
mlcduce_wrapper: $(OBJECTS) ocamliface/mlcduce_wrapper.ml
@echo "Build $@"
$(HIDE)$(LINK) $(INCLUDES) -o $@ odyl.cma camlp4.cma pr_o.cmo $^ $(EXTRA_LINK_OPTS)
$(HIDE)$(CAMLC) -linkpkg $(INCLUDES) -o $@ odyl.cma camlp4.cma pr_o.cmo $^ $(EXTRA_LINK_OPTS)
cdo2ml: ocamliface/cdo2ml.ml
@echo "Build $@"
......
depend
View file @ c778e2e1
......@@ -156,16 +156,16 @@ typing/typed.cmx: types/ident.cmx parser/location.cmx misc/ns.cmx \
types/patterns.cmx types/types.cmx
typing/typer.cmo: parser/ast.cmo types/atoms.cmi types/builtin_defs.cmi \
types/chars.cmi misc/encodings.cmi types/externals.cmi misc/html.cmi \
types/ident.cmo driver/librarian.cmi parser/location.cmi misc/ns.cmi \
types/patterns.cmi schema/schema_builtin.cmi schema/schema_common.cmi \
types/ident.cmo parser/location.cmi misc/ns.cmi types/patterns.cmi \
schema/schema_builtin.cmi schema/schema_common.cmi \
schema/schema_parser.cmi schema/schema_types.cmi \
schema/schema_validator.cmi schema/schema_xml.cmi types/sequence.cmi \
misc/serialize.cmi typing/typed.cmo types/types.cmi runtime/value.cmi \
typing/typer.cmi
typing/typer.cmx: parser/ast.cmx types/atoms.cmx types/builtin_defs.cmx \
types/chars.cmx misc/encodings.cmx types/externals.cmx misc/html.cmx \
types/ident.cmx driver/librarian.cmx parser/location.cmx misc/ns.cmx \
types/patterns.cmx schema/schema_builtin.cmx schema/schema_common.cmx \
types/ident.cmx parser/location.cmx misc/ns.cmx types/patterns.cmx \
schema/schema_builtin.cmx schema/schema_common.cmx \
schema/schema_parser.cmx schema/schema_types.cmx \
schema/schema_validator.cmx schema/schema_xml.cmx types/sequence.cmx \
misc/serialize.cmx typing/typed.cmx types/types.cmx runtime/value.cmx \
......@@ -294,6 +294,14 @@ query/query_parse.cmo: parser/ast.cmo types/atoms.cmi types/ident.cmo \
query/query_parse.cmx: parser/ast.cmx types/atoms.cmx types/ident.cmx \
parser/location.cmx parser/parser.cmx query/query.cmx types/sequence.cmx \
types/types.cmx
query/query_run.cmo: driver/cduce.cmi query/query.cmi
query/query_run.cmx: driver/cduce.cmx query/query.cmx
driver/run.cmo: types/builtin.cmi driver/cduce.cmi driver/config.cmi \
misc/html.cmi types/ident.cmo driver/librarian.cmi parser/location.cmi \
misc/state.cmi misc/stats.cmi parser/ulexer.cmi runtime/value.cmi
driver/run.cmx: types/builtin.cmx driver/cduce.cmx driver/config.cmx \
misc/html.cmx types/ident.cmx driver/librarian.cmx parser/location.cmx \
misc/state.cmx misc/stats.cmx parser/ulexer.cmx runtime/value.cmx
schema/schema_components.cmo: misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi
schema/schema_components.cmx: misc/encodings.cmx misc/ns.cmx \
......@@ -302,12 +310,8 @@ schema/schema_import.cmo: misc/encodings.cmi misc/ns.cmi \
schema/schema_components.cmo
schema/schema_import.cmx: misc/encodings.cmx misc/ns.cmx \
schema/schema_components.cmx
driver/run.cmo: types/builtin.cmi driver/cduce.cmi driver/config.cmi \
misc/html.cmi types/ident.cmo driver/librarian.cmi parser/location.cmi \
misc/state.cmi misc/stats.cmi parser/ulexer.cmi runtime/value.cmi
driver/run.cmx: types/builtin.cmx driver/cduce.cmx driver/config.cmx \
misc/html.cmx types/ident.cmx driver/librarian.cmx parser/location.cmx \
misc/state.cmx misc/stats.cmx parser/ulexer.cmx runtime/value.cmx
driver/start.cmo: driver/run.cmo
driver/start.cmx: driver/run.cmx
driver/webiface.cmo: driver/cduce.cmi driver/examples.cmo misc/html.cmi \
parser/location.cmi misc/state.cmi
driver/webiface.cmx: driver/cduce.cmx driver/examples.cmx misc/html.cmx \
......@@ -346,8 +350,8 @@ runtime/cduce_expat.cmo: driver/config.cmi runtime/load_xml.cmi \
parser/location.cmi parser/url.cmi runtime/cduce_expat.cmi
runtime/cduce_expat.cmx: driver/config.cmx runtime/load_xml.cmx \
parser/location.cmx parser/url.cmx runtime/cduce_expat.cmi
query/query_run.cmo: driver/cduce.cmi query/query.cmi
query/query_run.cmx: driver/cduce.cmx query/query.cmx
schema/schema_types.cmi: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi
misc/pool.cmi: misc/custom.cmo
misc/encodings.cmi: misc/custom.cmo misc/serialize.cmi
misc/bool.cmi: misc/custom.cmo
......
driver/librarian.ml
View file @ c778e2e1
......@@ -281,7 +281,6 @@ let import_and_run id = import id; run id
let import_from_string id str dig dep = ignore (load_from_string id str dig dep)
let static_externals = Hashtbl.create 17
let register_static_external n v =
print_endline ("Builtin " ^ n);
Hashtbl.add static_externals n v
let () =
......@@ -299,10 +298,3 @@ let set_externals cu a = (load cu).exts <- a
let registered_types cu = (load cu).types
let pack_types typs =
Serialize.Put.run (Serialize.Put.array Types.serialize) typs
let unpack_types typs =
Serialize.Get.run (Serialize.Get.array Types.deserialize) typs
driver/librarian.mli
View file @ c778e2e1
......@@ -28,8 +28,5 @@ type stub_ml
val stub_ml : (string -> Typer.t -> Compile.env ->
stub_ml option * Types.t array) ref
val pack_types: Types.t array -> string
val unpack_types: string -> Types.t array
val register_static_external: string -> Value.t -> unit
ocamliface/mltypes.ml
View file @ c778e2e1
......@@ -190,23 +190,25 @@ let has_cmi name =
try ignore (Misc.find_in_path_uncap !Config.load_path (name ^ ".cmi")); true
with Not_found -> false
let find_value v =
Config.load_path := Config.standard_library :: !Librarian.obj_path;
let li = Longident.parse v in
ocaml_env := Env.initial;
let (p,vd) = Env.lookup_value li Env.initial in
unfold vd.val_type
let load_cmi name =
Config.load_path := Config.standard_library :: !Librarian.obj_path;
let filename = Misc.find_in_path_uncap !Config.load_path (name ^ ".cmi") in
let sg = Env.read_signature name filename in
ocaml_env := Env.add_signature sg Env.initial;
let values = ref [] in
List.iter
(function
| Tsig_value (id, {val_type=t;val_kind=Val_reg|Val_prim _}) ->
List.fold_left
(fun accu v -> match v with
| Tsig_value (id,_) ->
let n = name ^ "." ^ (Ident.name id) in
(try
let (t,_) = unfold t in
values := (name ^ "." ^ (Ident.name id), t) :: !values
with PolyAbstract _ -> ())
| _ -> ()
) sg;
!values
(try (n, (fst (find_value n))) :: accu
with PolyAbstract _ -> accu)
| _ -> accu
) [] sg
let load_cmi name =
try load_cmi name
......@@ -260,8 +262,3 @@ let rec dump_li = function
| Longident.Ldot (li,s) -> dump_li li; print_endline s
| _ -> assert false
let find_value v =
Config.load_path := Config.standard_library :: !Librarian.obj_path;
let li = Longident.parse v in
let (p,vd) = Env.lookup_value li Env.initial in
unfold vd.val_type
parser/parser.ml
View file @ c778e2e1
......@@ -21,8 +21,6 @@ let error loc s = error (tloc loc) s
let gram = Grammar.gcreate Ulexer.lex
let parse_ident = U.mk
let id_dummy = U.mk "$$$"
let ident s =
......@@ -36,7 +34,6 @@ let ident s =
aux 0
let label s = U.mk (ident s)
(*let ident s = ident (parse_ident s)*)
let ident s = U.mk (ident s)
let prog = Grammar.Entry.create gram "prog"
......@@ -117,7 +114,7 @@ let logical_and e1 e2 = if_then_else e1 e2 cst_false
let logical_or e1 e2 = if_then_else e1 cst_true e2
let logical_not e = if_then_else e cst_false cst_true
let apply_op2_noloc op e1 e2 = Apply (Apply (Var (parse_ident op), e1), e2)
let apply_op2_noloc op e1 e2 = Apply (Apply (Var (ident op), e1), e2)
let apply_op2 loc op e1 e2 = exp loc (apply_op2_noloc op e1 e2)
......@@ -142,7 +139,7 @@ EXTEND
| "using"; name = IDENT; "="; cu = [ IDENT | STRING2 ] ->
[ mk loc (Using (U.mk name, U.mk cu)) ]
| "schema"; name = IDENT;
p = OPT [ "("; name = [ IDENT | keyword ]; ")" -> parse_ident name ];
p = OPT [ "("; name = [ IDENT | keyword ]; ")" -> ident name ];
"="; uri = STRING2 ->
protect_op "schema";
[ mk loc (SchemaDecl (U.mk name, uri, p)) ]
......@@ -324,7 +321,7 @@ EXTEND
| s = STRING2 ->
let s = U.mk s in
exp loc (String (U.start_index s, U.end_index s, s, cst_nil))
| a = IDENT -> exp loc (Var (U.mk a))
| a = IDENT -> exp loc (Var (ident a))
| "!"; e = expr ->
exp loc (Apply (Dot (e, U.mk "get", []), cst_nil))
| i = INT -> exp loc (Integer (Intervals.V.mk i))
......@@ -334,12 +331,12 @@ EXTEND
];
tag: [ [ a = [ IDENT | keyword ] -> exp loc (Atom (parse_ident a)) ] ];
tag: [ [ a = [ IDENT | keyword ] -> exp loc (Atom (ident a)) ] ];
tag_type: [
[ IDENT "_" -> mk loc (Internal (Types.atom Atoms.any))
| a = [ IDENT | keyword ] -> mk loc (Cst (Atom (parse_ident a)))
| t = ANY_IN_NS -> mk loc (NsT (parse_ident t))
| a = [ IDENT | keyword ] -> mk loc (Cst (Atom (ident a)))
| t = ANY_IN_NS -> mk loc (NsT (ident t))
]
];
......@@ -355,10 +352,10 @@ EXTEND
namespace_binding: [
[ "namespace";
name = [ name = [ IDENT | keyword ]; "=" ->
parse_ident name
ident name
| -> U.mk "" ];
uri = STRING2 ->
let ns = Ns.mk (parse_ident uri) in
let ns = Ns.mk (ident uri) in
(name,ns)
]
];
......@@ -509,7 +506,7 @@ EXTEND
];
schema_ref: [
[ schema = IDENT; "."; typ = [ IDENT | keyword ] -> (U.mk schema, U.mk typ)
[ schema = IDENT; "."; typ = [ IDENT | keyword ] -> (U.mk schema, ident typ)
]
];
......@@ -539,7 +536,7 @@ EXTEND
| "!"; a = IDENT ->
mk loc (Internal (Types.abstract (Types.Abstract.atom a)))
| cu = OPT [ cu = IDENT; "." -> U.mk cu ]; a = IDENT ->
mk loc (PatVar (cu, U.mk a))
mk loc (PatVar (cu, ident a))
| i = INT ; "--"; j = INT ->
let i = Intervals.V.mk i
and j = Intervals.V.mk j in
......@@ -600,7 +597,7 @@ EXTEND
[ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat ->
let (o,x,y) =
match f with
| None -> (false, mknoloc (PatVar (None,U.mk l)), None)
| None -> (false, mknoloc (PatVar (None,ident l)), None)
| Some z -> z
in
let x = if o then mk loc (Optional x) else x in
......@@ -619,7 +616,7 @@ EXTEND
[ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat; OPT ";" ->
let (o,x,y) =
match f with
| None -> (false, mknoloc (PatVar (None,U.mk l)), None)
| None -> (false, mknoloc (PatVar (None,ident l)), None)
| Some z -> z
in
let x = if o then mk loc (Optional x) else x in
......@@ -637,7 +634,7 @@ EXTEND
[ [ r = LIST1
[ l = [IDENT | keyword ];
x = opt_field_expr ->
let x = match x with Some x -> x | None -> Var (U.mk l) in
let x = match x with Some x -> x | None -> Var (ident l) in
(label l,x) ]
SEP ";" ->
exp loc (RecordLitt r)
......@@ -647,7 +644,7 @@ EXTEND
[ [ r = LIST1
[ l = [IDENT | keyword ];
x = opt_field_expr; OPT ";" ->
let x = match x with Some x -> x | None -> Var (U.mk l) in
let x = match x with Some x -> x | None -> Var (ident l) in
(label l,x) ] ->
exp loc (RecordLitt r)
]
......
toplevel/toploop.ml deleted 100644 → 0
View file @ 658fa165
open Printf
open Parser
type line_buffer =
{ mutable buffer : string ;
mutable length : int;
mutable abs_pos: int ;
maxlength: int;
}
(* this function fills the line buffer printing
the prompt ?> at the first line and returning
the number of characters in the line '\n' included*)
let first_line = ref true
let got_eof = ref false
let refill_buf buffer len =
if !got_eof then (got_eof := false; 0) else begin
let prompt =
if !first_line then "?> "
else " "
in
output_string stdout prompt; flush stdout;
first_line := false;
let i = ref 0 in
try
while true do
if !i >= len then raise Exit;
let c = input_char stdin in
buffer.[!i] <- c;
incr i;
if c = '\n' then raise Exit;
done;
!i
with
| Exit -> !i
end
(* The function scan takes a linebuffer buffer
and returns a function (from the current stream count
to a char option) that is used to create the Stream
*)
let rec scan line_buf count =
let element = count-(line_buf.abs_pos) in
if element < line_buf.length then (* send to stream the character *)
Some line_buf.buffer.[element]
else ( (* read another line*)
line_buf.abs_pos <- (line_buf.abs_pos) + line_buf.length;
line_buf.length <- (refill_buf line_buf.buffer line_buf.maxlength)-1;
scan line_buf count)
(* JUST FOR TESTING *)
let loop =
fprintf stdout " CDuce version 0.2a1\n\n";
let line_buffer =
{ buffer = " ";
length = 0;
abs_pos = 0;
maxlength = 60;
} in
let input = Stream.from (scan line_buffer) in
Sys.catch_break true;
while true do
try
first_line := true;
let semicolon = ref 0 in
while !semicolon < 2 do
try
let c = Stream.next input in
if c = ';' then incr semicolon
else semicolon := 0
with
| End_of_file ->
if !first_line then exit 0
done
with
| End_of_file -> exit 0
| Sys.Break -> fprintf stdout "Chang d'avis?\n"
done
(* JUST FOR TESTING 2
let loop x =
fprintf stdout " CDuce version 0.2a1\n\n";
let line_buffer =
{ buffer = " ";
length = 0;
abs_pos = 0;
maxlength = 60;
} in
let input = Stream.from (scan line_buffer) in
Sys.catch_break true;
while true do
first_line := true;
Parser.prog input
done
*)
(* THE REAL LOOP
let loop ppf =
fprintf ppf " CDuce version 0.2a1";
(*
initialize_toplevel_env ();
*)
let line_buffer =
{ buffer = ref " ";
lenth = ref 0;
abs_pos = ref 0;
maxlength = 60;
}
let input = Stream.from scan line_buffer
Sys.catch_break true;
while true do
try
empty_buf line_buffer;
first_line := true;
try Parser.prog input
with
| Stdpp.Exc_located (loc, e) -> raise (Location (loc, e))
(*
while not lexed ";;"
Parse and catch ";;" to end inner loop
update_toplevel_env(????)
print type line
print execution line
*)
with
| End_of_file -> exit 0
| Sys.Break -> fprintf ppf "Interrupted.@."
| PPerror -> ()
| x -> Errors.report_error ppf x
done
*)
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