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

[r2002-10-26 20:45:22 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-26 20:45:22+00:00
parent 2d490884
...@@ -3,14 +3,16 @@ parser/ast.cmx: parser/location.cmx types/patterns.cmx types/types.cmx ...@@ -3,14 +3,16 @@ parser/ast.cmx: parser/location.cmx types/patterns.cmx types/types.cmx
parser/location.cmo: parser/location.cmi parser/location.cmo: parser/location.cmi
parser/location.cmx: parser/location.cmi parser/location.cmx: parser/location.cmi
parser/parser.cmo: parser/ast.cmo types/atoms.cmi types/chars.cmi \ parser/parser.cmo: parser/ast.cmo types/atoms.cmi types/chars.cmi \
parser/lexer.cmo parser/location.cmi types/sequence.cmi types/types.cmi \ types/intervals.cmi parser/lexer.cmo parser/location.cmi \
parser/parser.cmi types/sequence.cmi types/types.cmi parser/parser.cmi
parser/parser.cmx: parser/ast.cmx types/atoms.cmx types/chars.cmx \ parser/parser.cmx: parser/ast.cmx types/atoms.cmx types/chars.cmx \
parser/lexer.cmx parser/location.cmx types/sequence.cmx types/types.cmx \ types/intervals.cmx parser/lexer.cmx parser/location.cmx \
parser/parser.cmi types/sequence.cmx types/types.cmx parser/parser.cmi
parser/parser.cmi: parser/ast.cmo parser/parser.cmi: parser/ast.cmo
typing/typed.cmo: parser/location.cmi types/patterns.cmi types/types.cmi typing/typed.cmo: parser/location.cmi types/patterns.cmi types/sortedMap.cmi \
typing/typed.cmx: parser/location.cmx types/patterns.cmx types/types.cmx types/types.cmi
typing/typed.cmx: parser/location.cmx types/patterns.cmx types/sortedMap.cmx \
types/types.cmx
typing/typer.cmo: parser/ast.cmo types/intervals.cmi parser/location.cmi \ typing/typer.cmo: parser/ast.cmo types/intervals.cmi parser/location.cmi \
types/patterns.cmi types/sequence.cmi types/sortedList.cmi \ types/patterns.cmi types/sequence.cmi types/sortedList.cmi \
typing/typed.cmo types/types.cmi typing/typer.cmi typing/typed.cmo types/types.cmi typing/typer.cmi
...@@ -59,12 +61,14 @@ types/sortedMap.cmi: types/sortedList.cmi ...@@ -59,12 +61,14 @@ types/sortedMap.cmi: types/sortedList.cmi
types/syntax.cmi: types/patterns.cmi types/types.cmi types/syntax.cmi: types/patterns.cmi types/types.cmi
types/types.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \ types/types.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \
types/sortedMap.cmi types/sortedMap.cmi
runtime/value.cmi: types/chars.cmi typing/typed.cmo types/types.cmi runtime/value.cmi: types/patterns.cmi typing/typed.cmo
runtime/value.cmo: types/chars.cmi typing/typed.cmo types/types.cmi \ runtime/value.cmo: types/chars.cmi types/patterns.cmi types/sequence.cmi \
runtime/value.cmi types/sortedMap.cmi typing/typed.cmo types/types.cmi runtime/value.cmi
runtime/value.cmx: types/chars.cmx typing/typed.cmx types/types.cmx \ runtime/value.cmx: types/chars.cmx types/patterns.cmx types/sequence.cmx \
runtime/value.cmi types/sortedMap.cmx typing/typed.cmx types/types.cmx runtime/value.cmi
driver/cduce.cmo: parser/ast.cmo types/builtin.cmo parser/location.cmi \ driver/cduce.cmo: parser/ast.cmo types/builtin.cmo parser/location.cmi \
parser/parser.cmi types/patterns.cmi typing/typer.cmi types/types.cmi parser/parser.cmi types/patterns.cmi typing/typer.cmi types/types.cmi \
runtime/value.cmi
driver/cduce.cmx: parser/ast.cmx types/builtin.cmx parser/location.cmx \ driver/cduce.cmx: parser/ast.cmx types/builtin.cmx parser/location.cmx \
parser/parser.cmx types/patterns.cmx typing/typer.cmx types/types.cmx parser/parser.cmx types/patterns.cmx typing/typer.cmx types/types.cmx \
runtime/value.cmx
...@@ -100,7 +100,7 @@ let phrase ph = ...@@ -100,7 +100,7 @@ let phrase ph =
let t = Typer.type_check Typer.Env.empty e Types.any true in let t = Typer.type_check Typer.Env.empty e Types.any true in
Format.fprintf ppf "|- %a@\n" print_norm t; Format.fprintf ppf "|- %a@\n" print_norm t;
let v = Value.eval Value.empty_env e in let v = Value.eval Value.empty_env e in
Format.fprintf ppf "=> %a@\n" Value.print v Format.fprintf ppf "=> @[%a@]@\n" Value.print v
| Ast.TypeDecl _ -> () | Ast.TypeDecl _ -> ()
| Ast.Debug l -> debug l | Ast.Debug l -> debug l
| _ -> assert false | _ -> assert false
......
...@@ -67,10 +67,6 @@ EXTEND ...@@ -67,10 +67,6 @@ EXTEND
mk loc (Match (e1,[p,e2])) mk loc (Match (e1,[p,e2]))
] ]
|
[ LIDENT "flatten"; e = expr -> mk loc (Op ("flatten",[e]))
| e1 = expr; e2 = expr -> mk loc (Apply (e1,e2))
]
| |
[ e1 = expr; op = ["+" | "-" | "@"]; e2 = expr -> mk loc (Op (op,[e1;e2])) [ e1 = expr; op = ["+" | "-" | "@"]; e2 = expr -> mk loc (Op (op,[e1;e2]))
...@@ -82,6 +78,11 @@ EXTEND ...@@ -82,6 +78,11 @@ EXTEND
[ e = expr; "."; l = [LIDENT | UIDENT] -> mk loc (Dot (e,Types.label l)) [ e = expr; "."; l = [LIDENT | UIDENT] -> mk loc (Dot (e,Types.label l))
] ]
|
[ LIDENT "flatten"; e = expr -> mk loc (Op ("flatten",[e]))
| e1 = expr; e2 = expr -> mk loc (Apply (e1,e2))
]
| "no_appl" | "no_appl"
[ c = const -> mk loc (Cst c) [ c = const -> mk loc (Cst c)
| "("; l = LIST1 expr SEP ","; ")" -> tuple loc l | "("; l = LIST1 expr SEP ","; ")" -> tuple loc l
...@@ -185,7 +186,16 @@ EXTEND ...@@ -185,7 +186,16 @@ EXTEND
| i = INT ; "--"; j = INT -> | i = INT ; "--"; j = INT ->
let i = Big_int.big_int_of_string i let i = Big_int.big_int_of_string i
and j = Big_int.big_int_of_string j in and j = Big_int.big_int_of_string j in
mk loc (Internal (Types.interval i j)) mk loc (Internal (Types.interval (Intervals.bounded i j)))
| i = INT ->
let i = Big_int.big_int_of_string i in
mk loc (Internal (Types.interval (Intervals.atom i)))
| "*--"; j = INT ->
let j = Big_int.big_int_of_string j in
mk loc (Internal (Types.interval (Intervals.left j)))
| i = INT; "--*" ->
let i = Big_int.big_int_of_string i in
mk loc (Internal (Types.interval (Intervals.right i)))
| i = char -> | i = char ->
mk loc (Internal (Types.char (Chars.char_class i i))) mk loc (Internal (Types.char (Chars.char_class i i)))
| i = char ; "--"; j = char -> | i = char ; "--"; j = char ->
......
...@@ -15,24 +15,60 @@ and abstr = { ...@@ -15,24 +15,60 @@ and abstr = {
fun_body : Typed.branches; fun_body : Typed.branches;
} }
let rec print ppf = function let rec is_seq = function
| Pair (x,y) -> | Pair (_, y) when is_seq y -> true
Format.fprintf ppf "(%a,%a)" print x print y | Atom a when a = Sequence.nil_atom -> true
| Record l -> | _ -> false
Format.fprintf ppf "{%a}" print_record l
| Atom a -> let is_xml = function
Format.fprintf ppf "`%s" (Types.atom_name a) | Pair (Atom _, Pair (Record _, s)) when is_seq s -> true
| Integer i -> | _ -> false
Format.fprintf ppf "%s" (Big_int.string_of_big_int i)
| Char c -> let rec is_str = function
Chars.Unichar.print ppf c | Pair (Char _, y) when is_str y -> true
| Fun c -> | Atom a when a = Sequence.nil_atom -> true
Format.fprintf ppf "<fun>" | _ -> false
let rec print ppf v =
if is_str v then Format.fprintf ppf "\"%a\"" print_quoted_str v
else if is_xml v then print_xml ppf v
else if is_seq v then Format.fprintf ppf "[ %a]" print_seq v
else match v with
| Pair (x,y) -> Format.fprintf ppf "(%a,%a)" print x print y
| Record l -> Format.fprintf ppf "{%a }" print_record l
| Atom a -> Format.fprintf ppf "`%s" (Types.atom_name a)
| Integer i -> Format.fprintf ppf "%s" (Big_int.string_of_big_int i)
| Char c -> Chars.Unichar.print ppf c
| Fun c -> Format.fprintf ppf "<fun>"
and print_quoted_str ppf = function
| Pair (Char c, y) ->
Chars.Unichar.print_in_string ppf c;
print_quoted_str ppf y
| _ -> ()
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
| _ -> ()
and print_str ppf = function
| Pair (Char c,y) ->
Chars.Unichar.print_in_string ppf c;
print_str ppf y
| v ->
Format.fprintf ppf "\' ";
print_seq ppf v
and print_xml ppf = function
| Pair(Atom tag, Pair (Record attr,content)) ->
Format.fprintf ppf "@[<hv2><%s%a>[@ %a@]]"
(Types.atom_name tag)
print_record attr
print_seq content
| _ -> assert false
and print_record ppf = function and print_record ppf = function
| [] -> () | [] -> ()
| [f] -> print_field ppf f | [f] -> Format.fprintf ppf " %a" print_field f
| f :: rem -> Format.fprintf ppf "%a; %a" print_field f print_record rem | f :: rem -> Format.fprintf ppf " %a;%a" print_field f print_record rem
and print_field ppf (l,v) = and print_field ppf (l,v) =
Format.fprintf ppf "%s = %a" (Types.label_name l) print v Format.fprintf ppf "%s = %a" (Types.label_name l) print v
...@@ -144,11 +180,10 @@ and run_disp_field v bindings fields l vl = function ...@@ -144,11 +180,10 @@ and run_disp_field v bindings fields l vl = function
(* Evaluation of expressions *) (* Evaluation of expressions *)
let rec eval env e = let rec eval env e0 =
match e.Typed.exp_descr with match e0.Typed.exp_descr with
| Typed.Var s -> Env.find s env | Typed.Var s -> Env.find s env
| Typed.Apply (f,arg) -> | Typed.Apply (f,arg) -> eval_apply (eval env f) (eval env arg)
eval_apply (eval env f) (eval env arg)
| Typed.Abstraction a -> | Typed.Abstraction a ->
let a' = { let a' = {
fun_env = env; fun_env = env;
...@@ -160,8 +195,7 @@ let rec eval env e = ...@@ -160,8 +195,7 @@ let rec eval env e =
| Some f -> a'.fun_env <- Env.add f self a'.fun_env | Some f -> a'.fun_env <- Env.add f self a'.fun_env
| None -> ()); | None -> ());
self self
| Typed.RecordLitt r -> | Typed.RecordLitt r -> Record (List.map (fun (l,e) -> (l, eval env e)) r)
Record (List.map (fun (l,e) -> (l, eval env e)) r)
| Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2) | Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2)
| Typed.Cst c -> const c | Typed.Cst c -> const c
| Typed.Match (arg,brs) -> eval_branches env brs (eval env arg) | Typed.Match (arg,brs) -> eval_branches env brs (eval env arg)
......
...@@ -4,7 +4,7 @@ type Name = <name>[String];; ...@@ -4,7 +4,7 @@ type Name = <name>[String];;
type Addr = <addr>[String];; type Addr = <addr>[String];;
type Tel = <tel>[String];; type Tel = <tel>[String];;
(*
<addrbook>[ <addrbook>[
<name>["Haruo Hosoya"] <name>["Haruo Hosoya"]
<addr>["Tokyo"] <addr>["Tokyo"]
...@@ -41,7 +41,7 @@ type Tel = <tel>[String];; ...@@ -41,7 +41,7 @@ type Tel = <tel>[String];;
<name>["Peter Buneman"] <name>["Peter Buneman"]
<addr>["Scotland"] <addr>["Scotland"]
];; ];;
*)
(* (*
......
...@@ -19,6 +19,19 @@ let cup t s = ...@@ -19,6 +19,19 @@ let cup t s =
List.filter (fun (p,n) -> not (List.exists (may_remove (p,n)) s)) t in List.filter (fun (p,n) -> not (List.exists (may_remove (p,n)) s)) t in
SortedList.cup s t SortedList.cup s t
let clean t =
let rec aux accu = function
| (p,n) :: rem ->
if (List.exists (may_remove (p,n)) accu)
|| (List.exists (may_remove (p,n)) rem)
then aux accu rem
else aux((p,n) :: accu) rem
| [] -> accu
in
List.rev (aux [] t)
let rec fold2_aux f a x = function let rec fold2_aux f a x = function
| [] -> x | [] -> x
| h :: t -> fold2_aux f a (f x a h) t | h :: t -> fold2_aux f a (f x a h) t
...@@ -45,7 +58,7 @@ let cap s t = ...@@ -45,7 +58,7 @@ let cap s t =
lines1 lines1
lines2 lines2
in in
SortedList.cup common (SortedList.from_list lines) clean (SortedList.cup common (SortedList.from_list lines))
let diff c1 c2 = let diff c1 c2 =
if c2 == full then empty if c2 == full then empty
......
...@@ -17,6 +17,9 @@ module Unichar = struct ...@@ -17,6 +17,9 @@ module Unichar = struct
if (c < 128) if (c < 128)
then Format.fprintf ppf "%C" (Char.chr c) then Format.fprintf ppf "%C" (Char.chr c)
else Format.fprintf ppf "#x%x" c else Format.fprintf ppf "#x%x" c
let print_in_string ppf c =
Format.fprintf ppf "%c" (Char.chr c)
end end
type t = (Unichar.t * Unichar.t) list type t = (Unichar.t * Unichar.t) list
......
...@@ -5,6 +5,7 @@ module Unichar : sig ...@@ -5,6 +5,7 @@ module Unichar : sig
val to_int: t -> int val to_int: t -> int
val print : Format.formatter -> t -> unit val print : Format.formatter -> t -> unit
val print_in_string : Format.formatter -> t -> unit
end end
type t = (Unichar.t * Unichar.t) list type t = (Unichar.t * Unichar.t) list
......
...@@ -38,9 +38,13 @@ let hash = function ...@@ -38,9 +38,13 @@ let hash = function
let empty = [] let empty = []
let any = [Any] let any = [Any]
let atom a b = let bounded a b =
if le_big_int a b then [Bounded (a,b)] else empty if le_big_int a b then [Bounded (a,b)] else empty
let left a = [Left a]
let right a = [Right a]
let atom a = bounded a a
let rec iadd_left l b = match l with let rec iadd_left l b = match l with
| [] -> [Left b] | [] -> [Left b]
......
...@@ -9,7 +9,10 @@ val cup : t -> t -> t ...@@ -9,7 +9,10 @@ val cup : t -> t -> t
val cap : t -> t -> t val cap : t -> t -> t
val diff : t -> t -> t val diff : t -> t -> t
val atom : Big_int.big_int -> Big_int.big_int -> t val bounded : Big_int.big_int -> Big_int.big_int -> t
val left : Big_int.big_int -> t
val right : Big_int.big_int -> t
val atom : Big_int.big_int -> t
val is_empty : t -> bool val is_empty : t -> bool
......
...@@ -451,6 +451,7 @@ struct ...@@ -451,6 +451,7 @@ struct
let p = pl.(i) in let p = pl.(i) in
let tp = p.Normal.na in let tp = p.Normal.na in
let v = p.Normal.nfv in let v = p.Normal.nfv in
(* let tp = Types.normalize tp in *)
`Switch `Switch
(num arity v, (num arity v,
aux (Types.cap t tp) (arity + (List.length v)) (i+1), aux (Types.cap t tp) (arity + (List.length v)) (i+1),
...@@ -565,6 +566,7 @@ struct ...@@ -565,6 +566,7 @@ struct
) yes; ) yes;
unselect.(i) <- no @ unselect.(i) in unselect.(i) <- no @ unselect.(i) in
Array.iteri (fun i -> List.iter (aux i)) pl; Array.iteri (fun i -> List.iter (aux i)) pl;
let sorted = Array.of_list (SortedMap.from_list SortedList.cup !accu) in let sorted = Array.of_list (SortedMap.from_list SortedList.cup !accu) in
let infos = Array.map snd sorted in let infos = Array.map snd sorted in
let disp = dispatcher t (Array.map fst sorted) in let disp = dispatcher t (Array.map fst sorted) in
...@@ -574,6 +576,7 @@ struct ...@@ -574,6 +576,7 @@ struct
List.iter (fun (j,r) -> List.iter (add r) infos.(j)) m; List.iter (fun (j,r) -> List.iter (add r) infos.(j)) m;
d t selected unselect d t selected unselect
in in
let res = Array.map result disp.codes in let res = Array.map result disp.codes in
post (disp,res) post (disp,res)
...@@ -585,7 +588,7 @@ struct ...@@ -585,7 +588,7 @@ struct
let t = Types.diff t (p.Normal.a) in let t = Types.diff t (p.Normal.a) in
(t, (p,e) :: brs) (t, (p,e) :: brs)
) (t,[]) brs in ) (t,[]) brs in
let pl = Array.map (fun x -> [x]) (Array.of_list brs) in let pl = Array.map (fun x -> [x]) (Array.of_list brs) in
get_tests get_tests
pl pl
......
...@@ -36,14 +36,14 @@ module I = struct ...@@ -36,14 +36,14 @@ module I = struct
chars = Chars.any; chars = Chars.any;
} }
let interval i j = { empty with ints = Intervals.atom i j } let interval i = { empty with ints = i }
let times x y = { empty with times = Boolean.atom (x,y) } let times x y = { empty with times = Boolean.atom (x,y) }
let arrow x y = { empty with arrow = Boolean.atom (x,y) } let arrow x y = { empty with arrow = Boolean.atom (x,y) }
let record label opt t = { empty with record = Boolean.atom (label,opt,t) } let record label opt t = { empty with record = Boolean.atom (label,opt,t) }
let atom a = { empty with atoms = a } let atom a = { empty with atoms = a }
let char c = { empty with chars = c } let char c = { empty with chars = c }
let constant = function let constant = function
| Integer i -> interval i i | Integer i -> interval (Intervals.atom i)
| Atom a -> atom (Atoms.atom a) | Atom a -> atom (Atoms.atom a)
| Char c -> char (Chars.atom c) | Char c -> char (Chars.atom c)
......
...@@ -33,7 +33,7 @@ val any : descr ...@@ -33,7 +33,7 @@ val any : descr
(** Constructors **) (** Constructors **)
val interval : Big_int.big_int -> Big_int.big_int -> descr val interval : Intervals.t -> descr
val atom : atom Atoms.t -> descr val atom : atom Atoms.t -> descr
val times : node -> node -> descr val times : node -> node -> descr
val arrow : node -> node -> descr val arrow : node -> node -> descr
......
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