Commit f232cfda authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-05-20 13:58:26 by cvscast] Empty log message

Original author: cvscast
Date: 2003-05-20 13:58:26+00:00
parent ac92d939
......@@ -114,17 +114,6 @@ let debug ppf = function
List.iter (fun (x,t) ->
Format.fprintf ppf " %a:%a@\n" U.print (Id.value x)
print_norm (Types.descr t)) f
| `Compile2 (t,pl) ->
Format.fprintf ppf "[DEBUG:compile2]@\n";
(* let t = Types.descr (Typer.typ t) in
let pl = List.map (fun p ->
let p = Typer.pat p in
let a = Types.descr (Patterns.accept p) in
(Some p, Types.cap a t)) pl in
let d = Patterns.Compiler.make_dispatcher t pl in
Patterns.Compiler.print_disp ppf d *)
()
| `Accept p ->
Format.fprintf ppf "[DEBUG:accept]@\n";
let p = Typer.pat p in
......@@ -135,7 +124,6 @@ let debug ppf = function
let t = Typer.typ t
and pl = List.map Typer.pat pl in
Patterns.Compile.debug_compile ppf t pl
| `Normal_record p -> assert false
......
......@@ -17,8 +17,6 @@ and debug_directive =
[ `Filter of ppat * ppat
| `Accept of ppat
| `Compile of ppat * ppat list
| `Normal_record of ppat
| `Compile2 of ppat * ppat list
| `Subtype of ppat * ppat
]
......
......@@ -11,7 +11,10 @@ let gram = Grammar.gcreate (Wlexer.lexer Wlexer.token Wlexer.latin1_engine)
let parse_ident = Encodings.Utf8.mk_latin1
let id_dummy = ident (U.mk "$$$")
let atom s = Atoms.mk (parse_ident s)
let label s = LabelPool.mk (parse_ident s)
let ident s = ident (parse_ident s)
let prog = Grammar.Entry.create gram "prog"
let expr = Grammar.Entry.create gram "expression"
......@@ -124,8 +127,6 @@ EXTEND
[ LIDENT "filter"; t = pat; p = pat -> `Filter(t,p)
| LIDENT "accept"; p = pat -> `Accept p
| LIDENT "compile"; t = pat; p = LIST1 pat -> `Compile (t,p)
| LIDENT "normal_record"; t = pat -> `Normal_record t
| LIDENT "compile2"; t = pat; p = LIST1 pat -> `Compile2 (t,p)
| LIDENT "subtype"; t1 = pat; t2 = pat -> `Subtype (t1,t2)
]
];
......@@ -145,10 +146,9 @@ EXTEND
"top" RIGHTA
[ "match"; e = SELF; "with"; b = branches -> exp loc (Match (e,b))
| "try"; e = SELF; "with"; b = branches ->
let id = ident (U.mk "x") in
let default =
mknoloc (Capture id),
Op ("raise",[Var id]) in
mknoloc (Capture id_dummy),
Op ("raise",[Var id_dummy]) in
exp loc (Try (e,b@[default]))
| "map"; e = SELF; "with"; b = branches -> exp loc (Map (false,e,b))
| "xtransform"; e = SELF; "with"; b = branches -> exp loc (Xtrans (e,b))
......@@ -189,11 +189,10 @@ EXTEND
let tag = mk loc (Internal (Types.atom (Atoms.any))) in
let att = mk loc (Internal Types.Record.any) in
let any = mk loc (Internal (Types.any)) in
let id = ident (U.mk "x") in
let re = Star(Alt(SeqCapture(id,Elem p), Elem any)) in
let re = Star(Alt(SeqCapture(id_dummy,Elem p), Elem any)) in
let ct = mk loc (Regexp (re,any)) in
let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
let b = (p, Var id) in
let b = (p, Var id_dummy) in
exp loc (Op ("flatten", [Map (false,e,[b])]))
]
|
......@@ -236,14 +235,13 @@ EXTEND
exp loc l
| "<"; t = [ "("; e = expr; ")" -> e
| a = [ LIDENT | UIDENT | keyword ] ->
let a = parse_ident a in
exp loc (Cst (Types.Atom (Atoms.mk a))) ];
exp loc (Cst (Types.Atom (atom a))) ];
a = expr_attrib_spec; ">"; c = expr ->
exp loc (Xml (t, Pair (a,c)))
| "{"; r = [ expr_record_spec | -> exp loc (RecordLitt LabelMap.empty) ]; "}" -> r
| s = STRING2 ->
exp loc (tuple (char_list loc s @ [cst_nil]))
| a = LIDENT -> exp loc (Var (ident (parse_ident a)))
| a = LIDENT -> exp loc (Var (ident a))
]
];
......@@ -272,7 +270,7 @@ EXTEND
fun_decl: [
(* need an hack to do this, because both productions would
match [ OPT LIDENT; "("; pat ] .... *)
[ f = OPT [ x = LIDENT -> ident (parse_ident x)]; "("; p1 = pat LEVEL "no_arrow";
[ f = OPT [ x = LIDENT -> ident x]; "("; p1 = pat LEVEL "no_arrow";
res = [ "->"; p2 = pat;
a = [ ";"; a = LIST0 arrow SEP ";" -> a | -> [] ];
")"; b = branches -> `Classic (p2,a,b)
......@@ -314,7 +312,7 @@ EXTEND
| _ -> Alt (x,y)
]
| [ x = regexp; y = regexp -> Seq (x,y) ]
| [ a = LIDENT; "::"; x = regexp -> SeqCapture (ident (parse_ident a),x) ]
| [ a = LIDENT; "::"; x = regexp -> SeqCapture (ident a,x) ]
| [ x = regexp; "*" -> Star x
| x = regexp; "*?" -> WeakStar x
| x = regexp; "+" -> Seq (x, Star x)
......@@ -323,7 +321,7 @@ EXTEND
| x = regexp; "??" -> Alt (Epsilon, x) ]
| [ "("; x = regexp; ")" -> x
| "("; a = LIDENT; ":="; c = const; ")" ->
Elem (mk loc (Constant ((ident (parse_ident a),c))))
Elem (mk loc (Constant ((ident a,c))))
| UIDENT "PCDATA" -> string_regexp
| i = STRING1; "--"; j = STRING1 ->
let i = Chars.mk_int (parse_char loc i)
......@@ -356,9 +354,9 @@ EXTEND
[ "{"; r = record_spec; "}" -> mk loc (Record (true,r))
| "{|"; r = record_spec; "|}" -> mk loc (Record (false,r))
| LIDENT "_" -> mk loc (Internal Types.any)
| a = LIDENT -> mk loc (Capture (ident (parse_ident a)))
| a = LIDENT -> mk loc (Capture (ident a))
| "("; a = LIDENT; ":="; c = const; ")" ->
mk loc (Constant (ident (parse_ident a),c))
mk loc (Constant (ident a,c))
| a = UIDENT -> mk loc (PatVar a)
| i = INT ; "--"; j = INT ->
let i = Intervals.mk i
......@@ -385,7 +383,7 @@ EXTEND
"]" -> mk loc (Regexp (r,q))
| "<"; t =
[ x = [ LIDENT | UIDENT | keyword ] ->
let a = if x = "_" then Atoms.any else Atoms.atom (Atoms.mk (parse_ident x)) in
let a = if x = "_" then Atoms.any else Atoms.atom (atom x) in
mk loc (Internal (Types.atom a))
| "("; t = pat; ")" -> t ];
a = attrib_spec; ">"; c = pat ->
......@@ -423,7 +421,7 @@ EXTEND
const:
[
[ i = INT -> Types.Integer (Intervals.mk i)
| "`"; a = [LIDENT | UIDENT | keyword ] -> Types.Atom (Atoms.mk (parse_ident a))
| "`"; a = [LIDENT | UIDENT | keyword ] -> Types.Atom (atom a)
| c = char -> Types.Char c ]
];
......
......@@ -77,8 +77,8 @@ let rec eval env e0 =
| Typed.Op ("load_html", [e]) -> eval_load_html (eval env e)
| Typed.Op ("load_file", [e]) -> eval_load_file ~utf8:false (eval env e)
| Typed.Op ("load_file_utf8", [e]) -> eval_load_file ~utf8:true (eval env e)
| Typed.Op ("print_xml", [e]) -> eval_print_xml (eval env e)
| Typed.Op ("print_xml_utf8", [e]) -> eval_print_xml_utf8 (eval env e)
| Typed.Op ("print_xml", [e]) -> Print_xml.print_xml ~utf8:false (eval env e)
| Typed.Op ("print_xml_utf8", [e]) -> Print_xml.print_xml ~utf8:true (eval env e)
| Typed.Op ("print", [e]) -> eval_print (eval env e)
| Typed.Op ("int_of", [e]) -> eval_int_of (eval env e)
| Typed.Op ("atom_of", [e]) -> eval_atom_of (eval env e)
......@@ -234,11 +234,6 @@ and eval_atom_of e =
let (s,_) = get_string_utf8 e in (* TODO: check that s is a correct Name wrt XML *)
Atom (Atoms.mk s)
and eval_print_xml_utf8 v =
string_utf8 (U.mk (Print_xml.string_of_xml ~enc:`Utf8 v))
and eval_print_xml v =
string_latin1 (Print_xml.string_of_xml ~enc:`Latin1 v)
and eval_print v =
Location.protect_op "print";
print_string (get_string_latin1 v);
......
......@@ -10,10 +10,8 @@ let exn_print_xml = CDuceExn (Pair (
Atom (Atoms.mk_ascii "Invalid_argument"),
string_latin1 "print_xml"))
let string_of_xml ~enc v=
let to_enc = match enc with
| `Utf8 -> `Enc_utf8
| `Latin1 -> `Enc_iso88591 in
let string_of_xml ~utf8 v=
let to_enc = if utf8 then `Enc_utf8 else `Enc_iso88591 in
let buffer = Buffer.create 127 in
......@@ -72,3 +70,12 @@ let string_of_xml ~enc v=
document_start ();
print_elt v;
Buffer.contents buffer
let print_xml ~utf8 s =
try
let s = string_of_xml ~utf8 s in
if utf8 then string_utf8 (U.mk s) else string_latin1 s
with exn ->
raise
(Location.Generic (Pxp_types.string_of_exn exn))
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