Commit 76ab1ffc authored by Pietro Abate's avatar Pietro Abate

[r2002-11-13 23:21:38 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-13 23:21:39+00:00
parent cb22215d
......@@ -76,8 +76,8 @@ dtd2cduce: tools/dtd2cduce.cmo
pull: tools/pull.cmo
$(OCAMLC) $(DEBUG) -linkpkg -o $@ $<
cduce.opt: all.cmxa $(XDRIVER)
$(OCAMLOPT) -linkpkg -o $@ gramlib.cmxa $(XOBJECTS) $(XDRIVER)
cduce.opt: $(XCDUCE)
$(OCAMLOPT) -linkpkg -o $@ gramlib.cmxa $(XCDUCE)
compute_depend:
@echo "Computing dependencies ..."
......
......@@ -156,7 +156,7 @@ let mk_builtin () =
let () = mk_builtin ()
let run ppf input =
let run ppf ppf_err input =
let insert_type_bindings =
List.iter (fun (x,t) ->
typing_env := Typer.Env.add x t !typing_env;
......@@ -222,6 +222,6 @@ let run ppf input =
with
| (Failure _ | Not_found | Invalid_argument _) as e ->
raise e (* To get ocamlrun stack trace *)
| exn -> print_exn ppf exn; false
| exn -> print_exn ppf_err exn; false
......@@ -4,7 +4,7 @@ val glb_env: Typer.glb ref (* Global types *)
val print_exn: Format.formatter -> exn -> unit
val run : Format.formatter -> char Stream.t -> bool
val run : Format.formatter -> Format.formatter -> char Stream.t -> bool
(* Returns true if everything is ok (no error) *)
val dump_env : Format.formatter -> unit
......@@ -2,22 +2,30 @@ let () = State.close ();;
let dump = ref None
let src = ref []
let quiet = ref false
let specs =
[ "-dump", Arg.String (fun s -> dump := Some s), " specify filename for persistency" ]
[ "-dump", Arg.String (fun s -> dump := Some s),
" specify filename for persistency";
"-quiet", Arg.Set quiet,
"suppress normal output (typing, results)"
]
let () =
Arg.parse specs (fun s -> src := s :: !src)
"cduce [options] [script]\n\nOptions:"
let ppf = Format.std_formatter
let ppf =
if !quiet then Format.formatter_of_buffer (Buffer.create 1023)
else Format.std_formatter
let ppf_err = Format.err_formatter
let do_file s =
let (src, chan) =
if s = "" then (`Stream, stdin) else (`File s, open_in s) in
Location.set_source src;
let input = Stream.of_channel chan in
let ok = Cduce.run ppf input in
let ok = Cduce.run ppf ppf_err input in
if s <> "" then close_in chan;
if not ok then exit 1
......
......@@ -170,7 +170,7 @@ let main (cgi : Netcgi.std_activation) =
Location.set_source (`String src);
Load_xml.set_auth false;
let ok = Cduce.run ppf input in
let ok = Cduce.run ppf ppf input in
if ok then Format.fprintf ppf "@\nOk.@\n";
let res = Format.flush_str_formatter () in
cgi # output # output_string ("<pre>" ^ res ^ "</pre>");
......
......@@ -114,6 +114,7 @@ EXTEND
[ op = [ LIDENT "flatten"
| LIDENT "load_xml"
| LIDENT "print_xml"
| LIDENT "print"
| LIDENT "raise"
| LIDENT "int_of"
];
......
......@@ -62,6 +62,7 @@ let rec eval env e0 =
| Typed.Op ("/", [e1; e2]) -> eval_div (eval env e1) (eval env e2)
| Typed.Op ("load_xml", [e]) -> eval_load_xml (eval env e)
| Typed.Op ("print_xml", [e]) -> eval_print_xml (eval env e)
| Typed.Op ("print", [e]) -> eval_print (eval env e)
| Typed.Op ("int_of", [e]) -> eval_int_of (eval env e)
| Typed.Dot (e, l) -> eval_dot l (eval env e)
| Typed.Op (o,_) -> failwith ("Unknown operator " ^ o)
......@@ -135,3 +136,7 @@ and eval_int_of e =
and eval_print_xml v =
string (Print_xml.string_of_xml v)
and eval_print v =
let s = get_string v in
print_endline s;
v
......@@ -20,7 +20,7 @@ let fun sort (MPerson -> Man ; FPerson -> Woman)
;;
let base : Person =
<person gender="M">[
<nme>"Claude"
<name>"Claude"
<children>[
<person gender="F">[
<name>"Vronique"
......
type Flow = Char | Block | Inline | Misc;;
type Block = P | Heading | Div | Lists | Table | Blocktext;;
type Lists = Ul;;
type Blocktext = Pre | Hr | Blockquote | Address;;
type Inline = Char | A | Special | Fontstyle | Phrase;;
type Fontstyle = Tt | I | B | Big | Small;;
type Phrase = Em | Strong | Code;;
type Special = Br;;
type Misc = Empty;;
type Html = <html>[ Head Body ];;
type Head = <head>[ Title ];;
type Title = <title>[ PCDATA ];;
type Body = <body>[ Block* ];;
type Div = <div>[ Flow* ];;
type P = <p>[ Inline* ];;
type Heading = <(`h1 | `h2)>[ Inline* ];;
type Ul = <ul>[Li+];;
type Li = <li>[ Flow* ];;
type Address = <address>[ Inline* ];;
type Hr = <hr>[];;
type Pre = <pre>[ (PCDATA | A | Fontstyle | Phrase | Br)* ];;
type Blockquote = <blockquote>[ Block* ];;
type A = <a ({ name = String } | { href = String })>[ (Inline \ A)* ];;
type Br = <br>[];;
type Em = <em>[ Inline* ];;
type Code = <code>[ Inline* ];;
type Strong = <strong>[ Inline* ];;
type Tt = <tt>[ Inline* ];;
type I = <i>[ Inline* ];;
type B = <b>[ Inline* ];;
type Big = <big>[ Inline* ];;
type Small = <small>[ Inline* ];;
type Table = Empty;;
let cduce = [ <b>"C" 'Duce' ];;
let website : String = "http://www.cduce.org";;
let presentation : [ Block* ] =
[ <h2>"Presentation of the language"
<p>[ 'Bla bla' ]
];;
let doc : Html =
<html>[
<head>[ <title>"CDuce homepage" ]
<body>[
<h1>"CDuce homepage"
<p>[ 'Welcome to ' !cduce '! Have a look '
'at our main ' <a href=website>"site" '.' ]
!presentation
<h2>"Papers"
<hr>[]
<address>[ 'This page has been generated by a ' !cduce ' program.' ]
]
];;
print (print_xml doc);;
......@@ -521,6 +521,10 @@ and type_check' loc env e constr precise = match e with
if Types.Record.is_empty rconstr then
raise_loc loc (ShouldHave (constr,"but it is a record."));
(* Completely buggy ! Need to check at the end that all required labels
are present ...A better to do it without precise = true ? *)
let precise = true in
let (rconstr,res) =
List.fold_left
(fun (rconstr,res) (l,e) ->
......@@ -543,6 +547,7 @@ and type_check' loc env e constr precise = match e with
(rconstr,res)
) (rconstr, if precise then Types.Record.any else constr) r
in
(* check loc res constr ""; *)
res
| Map (e,b) ->
......@@ -779,6 +784,10 @@ and type_op loc op args =
Types.empty
| "print_xml", [loc1,t1] ->
Sequence.string
| "print", [loc1,t1] ->
check loc1 t1 Sequence.string
"The argument of print";
t1
| "int_of", [loc1,t1] ->
check loc1 t1 Sequence.string
"The argument of int_of must a string";
......
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