Commit 24523591 authored by Kim Nguyễn's avatar Kim Nguyễn

Add a println builtin function that prints a newline.

parent d9edaee1
......@@ -5,11 +5,11 @@ let eval = ref (fun ppf err s -> assert false)
(* Types *)
let stringn = Types.cons string
let namespaces =
let namespaces =
Sequence.star (Types.times stringn stringn)
let types =
[
[
"Empty", Types.empty;
"Any", any;
"Int", int;
......@@ -30,7 +30,7 @@ let types =
let env =
List.fold_left
(fun accu (n,t) ->
(fun accu (n,t) ->
let n = (Ns.empty, Ident.U.mk n) in
Types.Print.register_global ("",n,[||]) t;
Typer.enter_type (Ident.ident n) t accu
......@@ -60,7 +60,7 @@ let binary_op_cst = register_op2
let binary_op_warning2 name t1 t2 w2 t run =
binary_op_gen name
(fun arg1 arg2 constr precise ->
ignore (arg1 t1 false);
ignore (arg1 t1 false);
let r = arg2 t2 true in
if not (Types.subtype r w2) then
raise (Typer.Warning ("This operator may fail", t));
......@@ -127,9 +127,9 @@ let eval_load_file ~utf8 e =
Cduce_loc.protect_op "load_file";
let fn = Value.get_string_latin1 e in
let s = Url.load_url fn in
if utf8 then
match U.mk_check s with
| Some s -> Value.string_utf8 s
if utf8 then
match U.mk_check s with
| Some s -> Value.string_utf8 s
| None -> raise (Lazy.force exn_load_file_utf8)
else Value.string_latin1 s
......@@ -138,30 +138,30 @@ let () = ();;
(* Comparison operators *)
binary_op "="
any any
binary_op "="
any any
(fun t1 t2 ->
if Types.is_empty (Types.cap t1 t2) then false_type
else bool)
(fun v1 v2 ->
Value.vbool (Value.compare v1 v2 == 0));;
binary_op_cst "<="
binary_op_cst "<="
any any bool
(fun v1 v2 -> Value.vbool (Value.compare v1 v2 <= 0));;
binary_op_cst "<"
binary_op_cst "<"
any any bool
(fun v1 v2 -> Value.vbool (Value.compare v1 v2 < 0));;
binary_op_cst ">="
binary_op_cst ">="
any any bool
(fun v1 v2 ->
(fun v1 v2 ->
Value.vbool (Value.compare v1 v2 >= 0));;
binary_op_cst ">"
binary_op_cst ">"
any any bool
(fun v1 v2 ->
(fun v1 v2 ->
Value.vbool (Value.compare v1 v2 > 0));;
(* I/O *)
......@@ -181,10 +181,10 @@ register_fun "int_of_char"
Value.Integer (Intervals.V.from_int (Chars.V.to_int x))
| _ -> assert false);;
register_fun "string_of"
register_fun "string_of"
any string_latin1
(fun v ->
(fun v ->
let b = Buffer.create 16 in
let ppf = Format.formatter_of_buffer b in
Value.print ppf v;
......@@ -195,7 +195,7 @@ register_fun "string_of"
register_fun "load_xml"
string_latin1 any_xml
(fun v -> Cduce_loc.protect_op "load_xml"; Load_xml.load_xml (Value.get_string_latin1 v));;
register_fun "!load_xml"
string_latin1 any_xml
(fun v -> Cduce_loc.protect_op "load_xml"; Load_xml.load_xml ~ns:true
......@@ -206,12 +206,12 @@ register_fun "load_html"
string_latin1 Sequence.any
(fun v -> Cduce_loc.protect_op "load_html"; Load_xml.load_html (Value.get_string_latin1 v));;
register_fun "load_file_utf8"
string_latin1 string
register_fun "load_file_utf8"
string_latin1 string
(eval_load_file ~utf8:true);;
register_fun "load_file"
string_latin1 string_latin1
register_fun "load_file"
string_latin1 string_latin1
(eval_load_file ~utf8:false);;
......@@ -219,24 +219,24 @@ let argv = ref Value.Absent;;
register_fun "print_xml"
register_fun "print_xml"
Types.any string_latin1
(fun v -> Print_xml.print_xml ~utf8:false !Eval.ns_table v);;
register_fun "print_xml_utf8"
register_fun "print_xml_utf8"
Types.any string
(fun v -> Print_xml.print_xml ~utf8:true !Eval.ns_table v);;
register_fun "dump_xml"
register_fun "dump_xml"
Types.any nil
(fun v ->
Cduce_loc.protect_op "print";
Cduce_loc.protect_op "print";
Print_xml.dump_xml ~utf8:false !Eval.ns_table v);;
register_fun "dump_xml_utf8"
register_fun "dump_xml_utf8"
Types.any nil
(fun v ->
(fun v ->
Cduce_loc.protect_op "print";
Print_xml.dump_xml ~utf8:true !Eval.ns_table v);;
......@@ -250,6 +250,15 @@ register_fun "print"
Value.nil
);;
register_fun "println"
string_latin1 nil
(fun v ->
Cduce_loc.protect_op "println";
print_endline (Value.get_string_latin1 v);
flush stdout;
Value.nil
);;
register_fun "print_utf8"
string nil
(fun v ->
......@@ -271,12 +280,12 @@ unary_op_warning "int_of"
modifier = 'b' ||
modifier = 'B' ||
modifier = 'o' ||
modifier = 'O')
then
modifier = 'O')
then
Value.Integer (Intervals.V.from_int (int_of_string(str)))
else
Value.Integer (Intervals.V.mk (str))
with _ ->
with _ ->
(try Value.Integer (Intervals.V.mk (str))
with Failure _ -> raise (Lazy.force exn_int_of)));;
......@@ -290,13 +299,13 @@ unary_op_warning "int_of"
register_fun "atom_of"
string atom
(fun v ->
let (s,_) = Value.get_string_utf8 v in
let (s,_) = Value.get_string_utf8 v in
Value.Atom (Atoms.V.mk Ns.empty s));;
*)
register_fun "split_atom"
atom (Types.times stringn stringn)
(function
(function
| Value.Atom q ->
let (ns,l) = Atoms.V.value q in
Value.Pair(
......@@ -314,7 +323,7 @@ register_fun "make_atom"
Value.Atom (Atoms.V.mk (Ns.Uri.mk ns, l)));;
binary_op_warning2 "dump_to_file"
string_latin1 string string_latin1 nil
......@@ -325,7 +334,7 @@ binary_op_warning2 "dump_to_file"
close_out oc;
Value.nil
with exn -> raise_gen exn);;
binary_op_cst "dump_to_file_utf8"
string_latin1 string nil
(fun f v -> try
......@@ -348,24 +357,24 @@ let intop f x y =
binary_op_gen "+"
(fun arg1 arg2 constr precise ->
let t1 = arg1 (Types.cup int Types.Record.any) true in
if Types.subtype t1 int
if Types.subtype t1 int
then (
let t2 = arg2 int true in
Types.interval
Types.interval
(intop Intervals.add (Types.Int.get t1) (Types.Int.get t2))
)
else if Types.subtype t1 Types.Record.any
else if Types.subtype t1 Types.Record.any
then (
let t2 = arg2 Types.Record.any true in
let t2 = arg2 Types.Record.any true in
Types.Record.merge t1 t2
)
else raise (Typer.Error "The first argument mixes integers and records"))
Value.add;;
binary_op "-"
int int
(fun t1 t2 ->
Types.interval
Types.interval
(intop Intervals.sub (Types.Int.get t1) (Types.Int.get t2)))
(fun v1 v2 -> match (v1,v2) with
| (Value.Integer x, Value.Integer y) -> Value.Integer (Intervals.V.sub x y)
......@@ -374,7 +383,7 @@ binary_op "-"
binary_op "*"
int int
(fun t1 t2 ->
Types.interval
Types.interval
(intop Intervals.mul (Types.Int.get t1) (Types.Int.get t2)))
(fun v1 v2 -> match (v1,v2) with
| (Value.Integer x, Value.Integer y) -> Value.Integer (Intervals.V.mult x y)
......@@ -413,17 +422,17 @@ binary_op_gen "@"
unary_op_gen "flatten"
Typer.flatten
Value.flatten;;
register_fun "raise" any Types.empty
(fun v -> raise (Value.CDuceExn v));;
register_fun "namespaces" any_xml
register_fun "namespaces" any_xml
namespaces
(function
(function
Value.XmlNs (_,_,_,ns,s) ->
Value.sequence_rev
(List.map
Value.sequence_rev
(List.map
(fun (pr,ns) ->
Value.Pair (Value.string_utf8 pr,
Value.string_utf8 (Ns.Uri.value ns), s))
......
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