Commit 8ef8b821 authored by Pietro Abate's avatar Pietro Abate

[r2004-12-31 00:28:02 by afrisch] Empty log message

Original author: afrisch
Date: 2004-12-31 00:28:02+00:00
parent 5acabc1e
......@@ -176,7 +176,8 @@ OBJECTS = \
\
types/builtin.cmo \
driver/librarian.cmo \
driver/cduce.cmo
driver/cduce.cmo \
runtime/system.cmo
schema/schema_types.ml: schema/schema_types.mli
cp $^ $@
......
open Operators
open Builtin_defs
let len = 1024;;
register_fun "system"
string_latin1 string_latin1
(fun v ->
Location.protect_op "system";
let s = Value.get_string_latin1 v in
let ic = Unix.open_process_in s in
let b = Buffer.create (1024*10) in
let buf = String.create len in
let rec aux () =
let i = input ic buf 0 len in
if i = 0 then () else (Buffer.add_string b (String.sub buf 0 i); aux ())
in
aux ();
let s = Value.string_latin1 (Buffer.contents b) in
match Unix.close_process_in ic with
| Unix.WEXITED n ->
if (n = 0) then s
else
Value.raise'
(Value.tagged_tuple "exited" [ Value.ocaml2cduce_int n; s ])
| Unix.WSTOPPED n ->
Value.raise'
(Value.tagged_tuple "stopped" [ Value.ocaml2cduce_int n; s ])
| Unix.WSIGNALED n ->
Value.raise'
(Value.tagged_tuple "signaled" [ Value.ocaml2cduce_int n; s ])
)
......@@ -495,6 +495,13 @@ let map_xml map_pcdata map_other =
| Xml (tag,attrs,cont) -> Xml (tag, attrs, aux cont)
| _ -> raise (Invalid_argument "Value.map_xml")
let tagged_tuple tag vl =
let ct = sequence vl in
let at = Record LabelMap.empty in
let tag = Atom (Atoms.V.mk_ascii tag) in
Xml (tag, at, ct)
(** set of values *)
type tmp = t
......
......@@ -26,6 +26,7 @@ module ValueSet: Set.S with type elt = t
exception CDuceExn of t
val raise': t -> 'a (* "raise" for CDuce exceptions *)
val failwith': string -> 'a (* "failwith" for CDuce exceptions *)
val tagged_tuple: string -> t list -> t
val print: Format.formatter -> t -> unit
val dump_xml: Format.formatter -> t -> unit
......
......@@ -188,6 +188,7 @@ register_fun "print_xml_utf8"
Types.any string
(fun v -> Print_xml.print_xml ~utf8:true !Eval.ns_table v);;
register_fun "print"
string_latin1 nil
(fun v ->
......
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