Commit d981a9be authored by Pietro Abate's avatar Pietro Abate

[r2002-11-05 16:09:14 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-05 16:09:15+00:00
parent a0a8da35
......@@ -20,6 +20,7 @@ TYPES = types/recursive.cmo \
RUNTIME = runtime/value.cmo \
runtime/load_xml.cmo runtime/run_dispatch.cmo \
runtime/print_xml.cmo \
runtime/eval.cmo
DRIVER = driver/cduce.cmo
......
......@@ -70,7 +70,7 @@ let debug = function
and p = Typer.pat p in
let f = Patterns.filter (Types.descr t) p in
List.iter (fun (x,t) ->
Format.fprintf ppf " x:%a@\n"
Format.fprintf ppf " %s:%a@\n" x
print_norm (Types.descr t)) f
| `Accept p ->
Format.fprintf ppf "[DEBUG:accept]@\n";
......
......@@ -97,6 +97,7 @@ EXTEND
|
[ op = [ LIDENT "flatten"
| LIDENT "load_xml"
| LIDENT "print_xml"
| LIDENT "raise"
| LIDENT "int_of"
];
......
......@@ -59,6 +59,7 @@ let rec eval env e0 =
| Typed.Op ("-", [e1; e2]) -> eval_sub (eval env e1) (eval env e2)
| 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 ("int_of", [e]) -> eval_int_of (eval env e)
| Typed.Dot (e, l) -> eval_dot l (eval env e)
| Typed.DebugTyper t -> failwith "Evaluating a ! expression"
......@@ -130,3 +131,6 @@ and eval_int_of e =
try Integer (Big_int.big_int_of_string s)
with Failure _ -> raise exn_int_of
and eval_print_xml v =
string (Print_xml.string_of_xml v)
......@@ -41,8 +41,9 @@ let is_xml = function
| _ -> false
let rec is_str = function
| Pair (Char _, y) when is_str y -> true
| Pair (Char _, y) -> is_str y
| Atom a when a = Sequence.nil_atom -> true
| String(_,_,_,q) -> is_str q
| _ -> false
let rec print ppf v =
......@@ -59,20 +60,27 @@ let rec print ppf v =
| String (i,j,s,q) ->
Format.fprintf ppf "<string:%i-%i,%S,%a>" i j s print q
and print_quoted_str ppf = function
| Pair (Char c, y) ->
| Pair (Char c, q) ->
Chars.Unichar.print_in_string ppf c;
print_quoted_str ppf y
print_quoted_str ppf q
| String (i,j,s, q) ->
Format.fprintf ppf "%s" (String.escaped (String.sub s i (j-i)));
print_quoted_str ppf q
| _ -> ()
and print_seq ppf = function
| Pair (Char _, _) as s -> Format.fprintf ppf "'%a" print_str s
| Pair (x,y) -> Format.fprintf ppf "@[%a@]@ %a" print x print_seq y
| String (i,j,s,y) ->
Format.fprintf ppf "'%s' %a" (String.escaped (String.sub s i (j-i)))
print_seq y
Format.fprintf ppf "'";
for k = i to j - 1 do
Format.fprintf ppf "%s" (Char.escaped s.[k])
done;
Format.fprintf ppf "' %a" print_seq y
| _ -> ()
and print_str ppf = function
| Pair (Char c,y) ->
Chars.Unichar.print_in_string ppf c;
let c = Chars.Unichar.to_char c in
Format.fprintf ppf "%s" (Char.escaped c);
print_str ppf y
| v ->
Format.fprintf ppf "\' ";
......
......@@ -23,3 +23,4 @@ val string : string -> t
val nil : t
val get_string : t -> string
val is_str : t -> bool
......@@ -7,12 +7,28 @@ type T =
p =? `A; q =? `A; r =? `A };;
(*
debug compile Any T;;
*)
debug compile T
({ a = x } | ( x:= `B)) &
({ b = y } | ( y:= `B)) &
({ c = z } | ( z:= `B))
({ a = a } | ( a:= `B)) &
({ b = b } | ( b:= `B)) &
({ c = c } | ( c:= `B)) &
({ d = d } | ( d:= `B)) &
({ e = e } | ( e:= `B)) (* &
({ f = f } | ( f:= `B)) &
({ g = g } | ( g:= `B)) &
({ h = h } | ( h:= `B)) &
({ i = i } | ( i:= `B)) &
({ j = j } | ( j:= `B)) &
({ k = k } | ( k:= `B)) &
({ l = l } | ( l:= `B)) &
({ m = m } | ( m:= `B)) &
({ n = n } | ( n:= `B)) &
({ o = o } | ( o:= `B)) &
({ p = p } | ( p:= `B)) &
({ q = q } | ( q:= `B)) &
({ r = r } | ( r:= `B)) *)
;;
......@@ -2,9 +2,9 @@ type T = [ `A? `B? `C? `D? `E? `F? `G? `H? `I? `J?
`K? `L? `M? `N? `O? `P? `Q? `R? ];;
debug compile Any T;;
(*
debug compile Any T;;
*)
debug compile T
P1 where
P1 = (`A & (a := 1), P2) | (a := 2) & P2 and
......@@ -13,6 +13,7 @@ P1 where
P4 = (`D & (d := 1), P5) | (d := 2) & P5 and
P5 = `nil;;
(*
match [ `A `B `C ] with (P1 where
P1 = (`A & (a := 1), P2) | (a := 2) & P2 and
P2 = (`B & (b := 1), P3) | (b := 2) & P3 and
......
......@@ -714,6 +714,8 @@ and type_op loc op args =
Types.any
| "raise", [loc1,t1] ->
Types.empty
| "print_xml", [loc1,t1] ->
Sequence.string
| "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