Skip to content

Commit

Permalink
Overhaul of type annotations for generated OCaml code. Printing beta-…
Browse files Browse the repository at this point in the history
…redexes as `match-with` expressions. Some cleanup of logging code.
  • Loading branch information
lukstafi committed Dec 10, 2013
1 parent 5b64a5f commit e40e0fd
Show file tree
Hide file tree
Showing 18 changed files with 546 additions and 286 deletions.
Binary file modified doc/invargent.pdf
Binary file not shown.
26 changes: 18 additions & 8 deletions doc/invargent.tm
Original file line number Diff line number Diff line change
Expand Up @@ -1119,7 +1119,7 @@
<math|Split<around*|(|<wide|\<alpha\>|\<bar\>>,A,<wide|A<rsub|\<beta\><rsub|\<chi\>>><rsup|0>|\<bar\>>|)>>.

<\eqnarray*>
<tformat|<table|<row|<cell|\<alpha\>\<prec\>\<beta\>>|<cell|\<equiv\>>|<cell|\<alpha\>\<less\><rsub|\<cal-Q\>>\<beta\>\<vee\><around*|(|\<alpha\>\<leqslant\><rsub|\<cal-Q\>>\<beta\>\<wedge\>\<beta\>\<nless\><rsub|\<cal-Q\>>\<alpha\>\<wedge\>\<alpha\>\<in\><wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>\<wedge\>\<beta\>\<nin\><wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>|)>>>|<row|<cell|A<rsub|0>>|<cell|=>|<cell|A\\<around*|{|\<beta\><wide|=|\<dot\>>\<alpha\>\<in\>A<mid|\|>\<beta\>\<in\><wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>\<wedge\><around*|(|\<exists\>\<alpha\>|)>\<in\>\<cal-Q\>\<wedge\>\<beta\>\<prec\>\<alpha\>|}>>>|<row|<cell|A<rsub|\<chi\>><rsup|1>>|<cell|=>|<cell|Connected<around*|(|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>,A<rsub|0>|)>>>|<row|<cell|A<rsub|\<chi\>><rsup|2>>|<cell|=>|<cell|<around*|{|c\<in\>A<rsub|\<chi\>><rsup|1><mid|\|>c<with|mode|text|
<tformat|<table|<row|<cell|\<alpha\>\<prec\>\<beta\>>|<cell|\<equiv\>>|<cell|\<alpha\>\<less\><rsub|\<cal-Q\>>\<beta\>\<vee\><around*|(|\<alpha\>\<leqslant\><rsub|\<cal-Q\>>\<beta\>\<wedge\>\<beta\>\<nless\><rsub|\<cal-Q\>>\<alpha\>\<wedge\>\<alpha\>\<in\><wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>\<wedge\>\<beta\>\<nin\><wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>|)>>>|<row|<cell|A<rsub|\<alpha\>\<beta\>>>|<cell|=>|<cell|<around*|{|\<beta\><wide|=|\<dot\>>\<alpha\>\<in\>A<mid|\|>\<beta\>\<in\><wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>\<wedge\><around*|(|\<exists\>\<alpha\>|)>\<in\>\<cal-Q\>\<wedge\>\<beta\>\<prec\>\<alpha\>|}>>>|<row|<cell|A<rsub|0>>|<cell|=>|<cell|A\\A<rsub|\<alpha\>\<beta\>>>>|<row|<cell|A<rsub|\<chi\>><rsup|1>>|<cell|=>|<cell|Connected<around*|(|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>,A<rsub|0>|)>>>|<row|<cell|A<rsub|\<chi\>><rsup|2>>|<cell|=>|<cell|<around*|{|c\<in\>A<rsub|\<chi\>><rsup|1><mid|\|>c<with|mode|text|
is not localized in branch without >\<chi\><with|mode|text| in
premise>|}>>>|<row|<cell|A<rsub|\<chi\>><rsup|3>>|<cell|=>|<cell|A<rsub|\<chi\>><rsup|2>\\\<cup\><rsub|\<chi\><rprime|'>\<gtr\><rsub|\<cal-Q\>>\<chi\>>A<rsub|\<chi\><rprime|'>><rsup|2>>>|<row|<cell|A<rsup|4><rsub|\<chi\>>>|<cell|=>|<cell|<around*|{|c\<in\>A<rsub|0><mid|\|>card<around*|(|<around*|(|FV<around*|(|c|)>\<cap\><wide|\<zeta\>|\<bar\>>|)>\\FV<around*|(|A<rsub|\<chi\>><rsup|3>|)>|)>=1\<wedge\><next-line><with|mode|text|
\ \ \ \ \ >\<forall\>\<alpha\>\<in\>FV<around*|(|c|)>\\FV<around*|(|A<rsub|\<chi\>><rsup|3>|)>.<around*|(|\<exists\>\<alpha\>|)>\<in\>\<cal-Q\>|}>>>|<row|<cell|<with|mode|text|if>>|<cell|>|<cell|\<nvDash\>\<forall\><wide|\<alpha\>|\<bar\>>\<cal-Q\>.A\<setminus\>A<rsup|4><rsub|\<chi\>>>>|<row|<cell|<with|mode|text|then
Expand All @@ -1130,8 +1130,8 @@
>\<chi\>>>|<row|<cell|<with|mode|text|then
return>>|<cell|>|<cell|\<bot\>>>|<row|<cell|<with|mode|text|else
\ ><wide|\<alpha\>|\<bar\>><rsub|+><rsup|\<chi\>>,A<rsub|\<chi\>><rsup|L>,A<rsup|R><rsub|\<chi\>>>|<cell|=>|<cell|Strat<around*|(|Connected<around*|(|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>,A<rsup|+><rsub|\<chi\>>|)>,<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|)>>>|<row|<cell|A<rsub|\<chi\>>>|<cell|=>|<cell|A<rsub|\<chi\>><rsup|0>\<cup\>A<rsub|\<chi\>><rsup|L>>>|<row|<cell|<wide|\<alpha\>|\<bar\>><rsup|\<chi\>><rsub|0>>|<cell|=>|<cell|<wide|\<alpha\>|\<bar\>>\<cap\>FV<around*|(|A<rsub|\<chi\>>|)>>>|<row|<cell|<wide|\<alpha\>|\<bar\>><rsup|\<chi\>>>|<cell|=>|<cell|<around*|(|<wide|\<alpha\>|\<bar\>><rsup|\<chi\>><rsub|0>\<setminus\><big|cup><rsub|\<chi\><rprime|'>\<less\><rsub|\<cal-Q\>>\<chi\>><wide|\<alpha\>|\<bar\>><rsup|\<chi\><rprime|'>><rsub|0>|)><wide|\<alpha\>|\<bar\>><rsub|+><rsup|\<chi\>>>>|<row|<cell|A<rsub|+>>|<cell|=>|<cell|\<cup\><rsub|\<chi\>>A<rsub|\<chi\>><rsup|R>>>|<row|<cell|A<rsub|res>>|<cell|=>|<cell|A<rsub|+>\<cup\><wide|A<rsub|+>|~><around*|(|A\<setminus\>\<cup\><rsub|\<chi\>>A<rsub|\<chi\>><rsup|+>|)>>>|<row|<cell|<with|mode|text|if>>|<cell|>|<cell|\<cup\><rsub|\<chi\>><wide|\<alpha\>|\<bar\>><rsup|\<chi\>><rsub|+>\<neq\>\<varnothing\><with|mode|text|
\ then>>>|<row|<cell|\<cal-Q\><rprime|'>,<wide|<wide|\<alpha\><rsub|>|\<bar\>><rsup|\<chi\>><rsub|+><rprime|'>|\<bar\>>,A<rsub|res><rprime|'>,<wide|\<exists\><wide|\<alpha\>|\<bar\>><rprime|'><rsup|\<chi\>>.A<rsub|\<chi\>><rprime|'>|\<bar\>>>|<cell|\<in\>>|<cell|Split<around*|(|\<cal-Q\><around*|[|<wide|\<forall\><wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>\<assign\><wide|\<forall\><around*|(|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>\<cup\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>|)>|\<bar\>>|]>,<wide|\<alpha\>|\<bar\>>\<setminus\>\<cup\><rsub|\<chi\>><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>,A<rsub|res>,<wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>\<cup\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>|\<bar\>>,<wide|A<rsub|\<chi\>>|\<bar\>>|)>>>|<row|<cell|<with|mode|text|return>>|<cell|>|<cell|\<cal-Q\><rprime|'>,<wide|<wide|\<alpha\>|\<bar\>><rsub|+><rsup|\<chi\>><wide|\<alpha\><rsub|>|\<bar\>><rsup|\<chi\>><rsub|+><rprime|'>|\<bar\>>,A<rsub|res><rprime|'>,<wide|\<exists\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>><wide|\<alpha\>|\<bar\>><rprime|'><rsup|\<chi\>>.A<rsub|\<chi\>><rprime|'>|\<bar\>>>>|<row|<cell|<with|mode|text|else
return>>|<cell|>|<cell|\<forall\><around*|(|<wide|\<alpha\>|\<bar\>>\<setminus\>\<cup\><rsub|\<chi\>><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>|)>\<cal-Q\>,<wide|<wide|\<alpha\><rsub|>|\<bar\>><rsup|\<chi\>><rsub|+>|\<bar\>>,A<rsub|res>,<wide|\<exists\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>.A<rsub|\<chi\>>|\<bar\>>>>>>
\ then>>>|<row|<cell|\<cal-Q\><rprime|'>,<wide|<wide|\<alpha\><rsub|>|\<bar\>><rsup|\<chi\>><rsub|+><rprime|'>|\<bar\>>,A<rsub|res><rprime|'>,<wide|\<exists\><wide|\<alpha\>|\<bar\>><rprime|'><rsup|\<chi\>>.A<rsub|\<chi\>><rprime|'>|\<bar\>>>|<cell|\<in\>>|<cell|Split<around*|(|\<cal-Q\><around*|[|<wide|\<forall\><wide|\<beta\>|\<bar\>><rsup|\<chi\>>|\<bar\>>\<assign\><wide|\<forall\><around*|(|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>\<cup\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>|)>|\<bar\>>|]>,<wide|\<alpha\>|\<bar\>>\<setminus\>\<cup\><rsub|\<chi\>><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>,A<rsub|res>,<wide|<wide|\<beta\>|\<bar\>><rsup|\<chi\>>\<cup\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>|\<bar\>>,<wide|A<rsub|\<chi\>>|\<bar\>>|)>>>|<row|<cell|<with|mode|text|return>>|<cell|>|<cell|\<cal-Q\><rprime|'>,<wide|<wide|\<alpha\>|\<bar\>><rsub|+><rsup|\<chi\>><wide|\<alpha\><rsub|>|\<bar\>><rsup|\<chi\>><rsub|+><rprime|'>|\<bar\>>,A<rsub|\<alpha\>\<beta\>>\<wedge\>A<rsub|res><rprime|'>,<wide|\<exists\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>><wide|\<alpha\>|\<bar\>><rprime|'><rsup|\<chi\>>.A<rsub|\<chi\>><rprime|'>|\<bar\>>>>|<row|<cell|<with|mode|text|else
return>>|<cell|>|<cell|\<forall\><around*|(|<wide|\<alpha\>|\<bar\>>\<setminus\>\<cup\><rsub|\<chi\>><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>|)>\<cal-Q\>,<wide|<wide|\<alpha\><rsub|>|\<bar\>><rsup|\<chi\>><rsub|+>|\<bar\>>,A<rsub|\<alpha\>\<beta\>>\<wedge\>A<rsub|res>,<wide|\<exists\><wide|\<alpha\>|\<bar\>><rsup|\<chi\>>.A<rsub|\<chi\>>|\<bar\>>>>>>
</eqnarray*>

where <math|Strat<around*|(|A,<wide|\<beta\>|\<bar\>><rsup|\<chi\>>|)>> is
Expand Down Expand Up @@ -1514,11 +1514,21 @@
introduced names, and source code annotated with type schemes at recursive
definition nodes. We use <verbatim|type a.> syntax instead of
<verbatim|'a.> syntax because the former supports inference for GADTs in
OCaml. Currently we only annotate <verbatim|let rec> nodes. For
completeness we would also need to annotate all <verbatim|function> nodes,
we do not to avoid clutter. Another benefit of the nicer <verbatim|type a.>
syntax is that nested type schemes can have free variables, which will be
correctly captured by the outer type scheme.
OCaml. A benefit of the nicer <verbatim|type a.> syntax is that nested type
schemes can have free variables, which will be correctly captured by the
outer type scheme. For completeness we sometimes need to annotate all
<verbatim|function> nodes with types. To avoid clutter, we start by only
annotating <verbatim|let rec> nodes, and in case <verbatim|ocamlc -c> fails
on generated code, we re-annotate by putting type schemes on <verbatim|let
rec> nodes and types on <verbatim|function> nodes. If need arises,
<verbatim|let-in> node annotations can also be introduced in this fallback
-- the corresponding <verbatim|Lam> constructors store the types. We
provide an option to annotate the definitions on <verbatim|let-in> nodes.
Type annotations are optional because they introduce a slight burden on the
solver -- the corresponding variables cannot be removed by the initial
simplification of the constraints, in <verbatim|Infer>. <verbatim|let-in>
node annotations are more burdensome than <verbatim|function> node
annotations.

Annotated items <verbatim|annot_item> use ``nice'' named variables instead
of identifier-based variables. The renaming is computed by
Expand Down
2 changes: 2 additions & 0 deletions examples/equational_reas.gadt
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@ newtype B
newcons LocA : Place A
newcons LocB : Place B
newtype Boolean
newcons True : Boolean
newcons False : Boolean
external is_nearby : ∀a,b. Nearby (a, b) → Boolean
newcons Here : ∀a. Place a * Place a ⟶ Nearby (a, a)
newcons Transitive : ∀a,b,c. Nearby (a, b) * Nearby (b, c) ⟶ Nearby (a, c)
Expand Down
4 changes: 4 additions & 0 deletions examples/equational_reas.gadti.target
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,10 @@ newcons LocB : Place B

newtype Boolean

newcons True : Boolean

newcons False : Boolean

external is_nearby : ∀a, b. Nearby (a, b) → Boolean

newcons Here : ∀b.Place b * Place b ⟶ Nearby (b, b)
Expand Down
35 changes: 35 additions & 0 deletions examples/equational_reas.ml.target
Original file line number Diff line number Diff line change
@@ -0,0 +1,35 @@
type num = int
type _ place =
| LocA : a place
| LocB : b place
and a

and b

type (_,
_) nearby =
| Here : (*∀'b.*)'b place * 'b place -> ('b, 'b) nearby
| Transitive : (*∀'a, 'b, 'c.*)('a, 'b) nearby * ('b, 'c) nearby ->
('a, 'c) nearby
type boolean =
| True : boolean
| False : boolean
let assert_boolean b = assert (b = True)
external is_nearby : (('a, 'b) nearby -> boolean) = "is_nearby"
type _ ex1 =
| Ex1 : (*∀'a, 'b.*)('b place * ('a, 'b) nearby) -> 'a ex1
external wander : ('a place -> 'a ex1) = "wander"
type (_,
_) meet =
| Same : (*∀'b.*) ('b, 'b) meet
| NotSame : (*∀'a, 'b.*) ('a, 'b) meet
external compare : ('a place -> 'b place -> ('a, 'b) meet) = "compare"
let rec walk : type a b . (a place -> b place -> (a, b) nearby) =
(fun x goal ->
((match (compare x goal: (a, b) meet) with
Same -> Here (x, goal)
| NotSame ->
let Ex1 ((y, to_y)) = wander x in Transitive (to_y, walk y goal)) :
(a, b) nearby))
let () = assert_boolean (is_nearby (walk LocA LocB)); ()

24 changes: 24 additions & 0 deletions examples/eval.ml.target
Original file line number Diff line number Diff line change
@@ -0,0 +1,24 @@
type num = int
type _ term =
| Lit : integer -> integer term
| Plus : integer term * integer term -> integer term
| IsZero : integer term -> boolean term
| If : (*∀'a.*)boolean term * 'a term * 'a term -> 'a term
| Pair : (*∀'a, 'b.*)'a term * 'b term -> (('a * 'b)) term
| Fst : (*∀'a, 'b.*)(('a * 'b)) term -> 'a term
| Snd : (*∀'a, 'b.*)(('a * 'b)) term -> 'b term
and integer

and boolean

external plus : (integer -> integer -> integer) = "plus"
external is_zero : (integer -> boolean) = "is_zero"
external if_then : (boolean -> 'a -> 'a -> 'a) = "if_then"
let rec eval : type a . (a term -> a) =
((function Lit i -> i | IsZero x -> is_zero (eval x)
| Plus (x, y) -> plus (eval x) (eval y)
| If (b, t, e) -> if_then (eval b) (eval t) (eval e)
| Pair (x, y) -> (eval x, eval y)
| Fst p -> let ((x, y): (a * 't47)) = eval p in x
| Snd p -> let ((x, y): ('t59 * a)) = eval p in y): a term -> a)

18 changes: 18 additions & 0 deletions examples/simple_eval.ml.target
Original file line number Diff line number Diff line change
@@ -0,0 +1,18 @@
type num = int
type _ term =
| Lit : integer -> integer term
| Plus : integer term * integer term -> integer term
| IsZero : integer term -> boolean term
| If : (*∀'a.*)boolean term * 'a term * 'a term -> 'a term
and integer

and boolean

external plus : (integer -> integer -> integer) = "plus"
external is_zero : (integer -> boolean) = "is_zero"
external if_then : (boolean -> 'a -> 'a -> 'a) = "if_then"
let rec eval : type a . (a term -> a) =
((function Lit i -> i | IsZero x -> is_zero (eval x)
| Plus (x, y) -> plus (eval x) (eval y)
| If (b, t, e) -> if_then (eval b) (eval t) (eval e)): a term -> a)

42 changes: 21 additions & 21 deletions src/Abduction.ml
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ open Terms
open Aux
open Joint

let timeout_count = ref 700(* 1000 *)(* 5000 *)(* 50000 *)
let timeout_count = ref 700(* 5000 *)(* 50000 *)
let fail_timeout_count = ref 5
let no_alien_prem = ref (* true *)false

Expand Down Expand Up @@ -63,17 +63,17 @@ let rich_return_type_heur bvs ans cand =
(function
| v, (t, lc) when VarSet.mem v bvs ->
(*[* Format.printf "ret_typ_heur: %s= %a := %a@\n%!"
(var_str v) (pr_ty false) t (pr_ty false) (subst_typ b_sb t);
(var_str v) pr_ty t pr_ty (subst_typ b_sb t);
*]*)
v, (subst_typ b_sb t, lc)
| v, (t, lc) when VarSet.mem v ret_only_vars ->
(*[* Format.printf "ret_typ_heur: %s= %a := %a@\n%!"
(var_str v) (pr_ty false) t (pr_ty false) (subst_typ sb t);
(var_str v) pr_ty t pr_ty (subst_typ sb t);
*]*)
v, (subst_typ sb t, lc)
| v1, (TVar v2, lc) when VarSet.mem v2 ret_only_vars ->
(*[* Format.printf "ret_typ_heur: %s= %s := %a@\n%!"
(var_str v2) (var_str v1) (pr_ty false)
(var_str v2) (var_str v1) pr_ty
(subst_typ sb (TVar v1)); *]*)
v2, (subst_typ sb (TVar v1), lc)
| sx -> sx)
Expand Down Expand Up @@ -320,34 +320,34 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
ddepth pr_subst (List.map (fun (x,y) -> y,(x,dummy_loc)) repls)
pr_vars bvs
(String.concat ","(List.map var_str vs))
pr_subst ans (var_str x) (pr_ty false) t
pr_subst ans (var_str x) pr_ty t
(List.length (fst cand)) pr_subst (fst cand); *]*)
(* Choice 1: drop premise/conclusion atom from answer *)
if implies_concl vs (ans @ fst cand)
then (
(*[* Format.printf
"abd_simple: [%d] choice 1@ drop %s = %a@ (%s = %a)@\n%!"
ddepth (var_str x) (pr_ty false) t
(var_str c6x) (pr_ty false) c6t; *]*)
ddepth (var_str x) pr_ty t
(var_str c6x) pr_ty c6t; *]*)
(*[* try *]*)
abstract deep repls bvs pms vs ans cand
(*[*; Format.printf "abd_simple: [%d] choice 1 failed@\n%!"
ddepth; *]*)
(*[* with Result (bvs, pms, vs, ans) as e ->
Format.printf "abd_simple: [%d] preserve choice 1@ %s =@ %a@ -- returned@ ans=%a@\n%!"
ddepth (var_str x) (pr_ty false) t pr_subst ans;
ddepth (var_str x) pr_ty t pr_subst ans;
raise e *]*) );
(*[* Format.printf
"abd_simple: [%d]@ recover after choice 1@ %s =@ %a (%s = %a)@\ncand=%a@\n%!"
ddepth (var_str x) (pr_ty false) t
(var_str c6x) (pr_ty false) c6t pr_subst (fst cand); *]*)
ddepth (var_str x) pr_ty t
(var_str c6x) pr_ty c6t pr_subst (fst cand); *]*)
(* Choice 6: preserve atom in a "generalized" form *)
if not !more_general && implies_concl vs (ans @ c6sx::fst cand)
then (
(*[* Format.printf
"abd_simple: [%d]@ choice 6@ keep %s = %a@ (%s = %a)@\n%!"
ddepth (var_str c6x) (pr_ty false) c6t
(var_str x) (pr_ty false) t; *]*)
ddepth (var_str c6x) pr_ty c6t
(var_str x) pr_ty t; *]*)
try
let bvs' =
if is_p then VarSet.union
Expand All @@ -368,7 +368,7 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
(* FIXME: remove try-with case after debug over *)
Format.printf "abd_simple: [%d]@ preserve choice 6@ %s =@ %a@ -- returned@ ans=%a@\n%!"
ddepth (var_str c6x)
(pr_ty false) c6t pr_subst ans;
pr_ty c6t pr_subst ans;
raise e *]*)
| Contradiction _ (*[* as e *]*) ->
(*[* Format.printf
Expand All @@ -377,15 +377,15 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
());
(*[* Format.printf
"abd_simple: [%d]@ recover after choice 6@ %s =@ %a@\n%!"
ddepth (var_str c6x) (pr_ty false) c6t; *]*)
ddepth (var_str c6x) pr_ty c6t; *]*)
step deep x lc {typ_sub=t; typ_ctx=[]} repls
is_p bvs pms vs ans cand
and step deep x lc loc repls is_p bvs pms vs ans cand =
incr counter; if !counter > !timeout_count then raise Timeout;
(*[* let ddepth = incr Joint.debug_dep; !Joint.debug_dep in *]*)
(*[* Format.printf
"abd_simple-step: [%d] @ loc=%a@ repls=%a@ vs=%s@ ans=%a@ x=%s@ cand=%a@\n%!"
ddepth (pr_ty false) (typ_out loc) pr_subst (List.map (fun (x,y) -> y,(x,dummy_loc)) repls)
ddepth pr_ty (typ_out loc) pr_subst (List.map (fun (x,y) -> y,(x,dummy_loc)) repls)
(String.concat ","(List.map var_str vs))
pr_subst ans (var_str x) pr_subst (fst cand); *]*)
(* Choice 2: remove subterm from answer *)
Expand All @@ -398,7 +398,7 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
let loc' = {loc with typ_sub = TVar a} in
let t' = typ_out loc' in
(*[* Format.printf "abd_simple: [%d]@ choice 2@ remove subterm %s =@ %a@\n%!"
ddepth (var_str x) (pr_ty false) t'; *]*)
ddepth (var_str x) pr_ty t'; *]*)
(* FIXME: add [a] to [cparams]? *)
match typ_next loc' with (* x bound when leaving step *)
| None ->
Expand All @@ -425,7 +425,7 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
let choice3 () =
(*[* Format.printf
"abd_simple: [%d] approaching choice 3@ for@ %a@ @@ %s =@ %a@\n%!"
ddepth (pr_ty false) loc.typ_sub (var_str x) (pr_ty false)
ddepth pr_ty loc.typ_sub (var_str x) pr_ty
(typ_out loc); *]*)
if typ_sort loc.typ_sub = Type_sort
then match typ_up loc with
Expand Down Expand Up @@ -456,7 +456,7 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
(*[* (_, msg, Some (ty1, ty2), *]*) _ (*[* ) *]*) ->
(*[*Format.printf
"abd_simple: [%d] @ c.4 failed:@ %s@ %a@ %a@\n%!" ddepth
msg (pr_ty true) ty1 (pr_ty true) ty2;
msg pr_ty ty1 pr_ty ty2;
(match ty1 with
TVar v1 ->
VarSet.iter (fun v2 ->
Expand All @@ -483,7 +483,7 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
ddepth (var_str x)
pr_subst (List.map (fun (x,y) -> y,(x,dummy_loc)) repls); *]*)
(*[* Format.printf "abd_simple: [%d]@ choice 5@ sub=@ %a@ repl=@ %s@\n%!"
ddepth (pr_ty false) loc.typ_sub
ddepth pr_ty loc.typ_sub
(String.concat ", " (List.map var_str repl)); *]*)
List.iter
(fun b ->
Expand All @@ -494,7 +494,7 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
(try
(*[* Format.printf
"abd_simple: [%d]@ c.5 unify x=%s@ t'=%a@ sb=@ %a@\n%!"
ddepth (var_str x) (pr_ty false) t' pr_subst ans; *]*)
ddepth (var_str x) pr_ty t' pr_subst ans; *]*)
let bvs' =
if is_p then VarSet.union
(VarSet.filter (not % q.uni_v)
Expand Down Expand Up @@ -523,7 +523,7 @@ let abd_simple q ?without_quant ~bvs ~pms ~dissociate
assert (so = []);
(*[* Format.printf
"abd_simple: [%d]@ choice 5@ match earlier %s =@ %a@\n%!"
ddepth (var_str x) (pr_ty false) t'; *]*)
ddepth (var_str x) pr_ty t'; *]*)
abstract deep repls bvs' pms vs ans' cand
with Contradiction _ ->
incr counter;
Expand Down
Loading

0 comments on commit e40e0fd

Please sign in to comment.