Commit 8dfc863f authored by Kim Nguyễn's avatar Kim Nguyễn

Multiple application test.

parent 9c70e7b8
......@@ -17,3 +17,4 @@ true: -traverse
<tests/libtest/*Test.*>: pp(camlp4orf.opt), package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
<tests/eval/src/main.*>: pp(camlp4orf.opt), package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
<kim*.native>: pp(camlp4orf.opt), package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
This diff is collapsed.
#!/bin/sh
PREF=0
# echo "let funs_h0 = ["
for i in `seq 1 20`
do
echo -n '"'
for j in `seq 1 $i`
do
echo -n '`$A'${PREF}${j}' -> '
done
echo 'Int", ['
for j in `seq 1 $i`
do
echo '"`$B'${PREF}${j}'";'
#echo '"Int";'
done
echo "];"
PREF=$(($PREF + 1 ))
done
echo "];;"
exit 0
echo "let funs_hh = ["
for i in `seq 1 15`
do
echo -n '"( `$A'${PREF}1' -> `$B'${PREF}1' ) '
for j in `seq 2 $i`
do
echo -n '-> ( `$A'${PREF}${j}' -> `$B'${PREF}${j}' ) '
done
echo -n '-> `$A'${PREF}1' '
for j in `seq 2 $i`
do
echo -n '-> `$A'${PREF}${j}' '
done
echo -n ' -> ('
echo -n '`$B'${PREF}1
for j in `seq 2 $i`
do
echo -n ', `$B'${PREF}${j}
done
echo ')", ['
for j in `seq 1 $i`
do
echo '" (`$C'${PREF}${j}' -> `$D'${PREF}${j}' ) ";' # & (`$E'${PREF}${j}' -> `$F'${PREF}${j}') ";'
done
for j in `seq 1 $i`
do
echo '" (`$C'${PREF}${j}' )";' # |`$E'${PREF}${j}') ";'
done
echo "];"
PREF=$(($PREF + 1 ))
done
echo "]"
......@@ -2986,25 +2986,34 @@ module Tallying = struct
let tallying l =
let n = List.fold_left (fun acc (s,t) -> CS.prod acc (norm(diff s t))) CS.sat l in
Format.printf "Norm : %a\n" CS.pp_s n;
(* Format.printf "Norm : %a\n" CS.pp_s n; *)
if CS.S.is_empty n then raise Step1Fail else
let m = CS.S.fold (fun c acc -> try CS.ES.union (solve (merge c)) acc with UnSatConstr -> acc) n CS.ES.empty in
Format.printf "Union/Merge : %a \n" CS.ES.print m;
(* Format.printf "Union/Merge : %a \n" CS.ES.print m;*)
if CS.ES.is_empty m then raise Step2Fail else
let el = CS.ES.fold (fun e acc -> CS.ES.add (unify e) acc) m CS.ES.empty in
Format.printf "Unify : %a\n" CS.ES.print el;
(* Format.printf "Unify : %a\n" CS.ES.print el;*)
List.map (CS.E.bindings) (CS.ES.elements el)
let domain ll =
List.fold_left (fun acc l ->
List.fold_left (fun acc (v,_) ->
Var.Set.add v acc
) acc l
) Var.Set.empty ll
end
exception KeepGoing
let apply s t =
let apply_raw s t =
DescrHash.clear Tallying.memo_norm;
let q = Queue.create () in
let gamma = var (Var.mk ~variance:`Covariant "Gamma") in
let rec aux (i,acc1) (j,acc2) t1 t2 () =
let acc1 = Lazy.force acc1 and acc2 = Lazy.force acc2 in
try Tallying.tallying [(acc1,arrow (cons acc2) (cons gamma))]
try (Tallying.tallying [(acc1,arrow (cons acc2) (cons gamma))]) , (acc1, acc2)
with
|Tallying.Step1Fail -> raise Tallying.UnSatConstr
|Tallying.Step2Fail -> begin
......@@ -3015,9 +3024,27 @@ let apply s t =
in
Queue.add (aux (1,lazy(Positive.substitutefree s)) (0,lazy(t)) s t) q;
Queue.add (aux (0,lazy(s)) (1,lazy(Positive.substitutefree t)) s t) q;
let result = ref [] in
while (List.length !result) = 0 && not(Queue.is_empty q) do
let result = ref ([],(any,any)) in
while (List.length (fst !result)) = 0 && not(Queue.is_empty q) do
try result := (Queue.pop q) ()
with KeepGoing -> ()
done;
!result
let apply_full s t =
let subst_lst,(s,t) = apply_raw s t in
let ss =
List.fold_left (fun tacc constr_lst ->
cap tacc (List.fold_left (fun tacc subst ->
Positive.substitute tacc subst) s constr_lst)) any subst_lst
in
let tt =
List.fold_left (fun tacc constr_lst ->
cap tacc (List.fold_left (fun tacc subst ->
Positive.substitute tacc subst) t constr_lst)) any subst_lst
in
let arr = Arrow.get ss in
Arrow.apply arr (tt)
let apply s t = fst (apply_raw s t)
......@@ -411,3 +411,5 @@ module Tallying : sig
end
val apply : t -> t -> Tallying.CS.sl
val apply_full : t -> t -> t
val apply_raw : t -> t -> Tallying.CS.sl * (t*t)
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