Playground

This page is used to test hooks in order to run elpi on code snippets and inject its output within sphinx documentation sources.

Prerequisites

Before running the hooks, make sure to have elpi built locally:

eval $(opam env)
make build

It doesn’t hurt to check that dune runs the locally built elpi correctly:

dune exec elpi -- -h

Syntax

Elpi code blocks to be evaluated and which output is to be injected from docs/base to docs/source are conventionally denoted in reStructuredText as .. elpi:: FILE.

 1type app term -> term -> term.
 2type lam (term -> term) -> term.
 3type arr ty -> ty -> ty.
 4type nat ty.
 5type bool ty.
 6mode (term i o).
 7term (app HD ARG) TGT :- term HD (arr SRC TGT), term ARG SRC.
 8term (lam F) (arr SRC TGT) :- pi x\ term x SRC => term (F x) TGT.
 9term (uvar as X) T :- declare_constraint (term X T) [X].
10
11len [] 0.
12len [_|XS] N :- len XS M, N is M + 1.
13
14constraint term {
15  rule
16     \ (term (uvar K LX) _) (term (uvar K LY) _)
17     | (len LX N, len LY M, not(N = M))
18   <=> (print "wrong arity" K, false).
19
20  rule (GX ?- term (uvar K LX) TX)
21     \ (GY ?- term (uvar K LY) TY)
22     | (print "compat" GX "|-" K LX TX "," GY "|-" K LY TY, 
23        compatible GX LX GY LY CTXCONSTR)
24   <=> (print "NEW" CTXCONSTR TX "=" TY, CTXCONSTR, TX = TY).
25
26}
27
28compatible _ [] _ [] [] :- !.
29compatible GX [X|XS] GY [Y|YS] [TX = TY | K] :-
30 (GX => term X TX),
31 (GY => term Y TY),
32 !,
33 compatible GX XS GY YS K.
34compatible _ _ _ _ [false].
35
36main :-
37  (term (lam x\ lam y\ app (app (F x y) x) y) T1_, 
38   term (lam y\ lam x\ app (app (F x y) y) x) T2_),
39  print "1",
40  (term (lam x \ X x) (arr A_ nat),
41   term (lam x \ X x) (arr bool B_)),
42  print "2",
43  not(term (lam x \ Y x) (arr C nat), term (lam x \ Y x) (arr bool C)),
44  not(term (lam x \ Z x) (arr nat nat), term (lam x \ Z x) (arr bool D_)).
45

The injection engine:

  • Retrieves all .. elpi:: directives

  • Changes them into literalinclude in the generated source with relevant options

  • Runs dune exec elpi -- -test FILE on the FILE containing the elpi snippet, test or example.

  • Captures its output (stdout)

  • Creates a code-block:: console just after it to inject the captured console output

  • Captures its output (stderr)

  • Creates a code-block:: console just after it to inject the captured console erros

  • In case of an assertion option for the elpi directive, the output is injected only if matched

Result should look as follows:

Parsing time: 0.000

Compilation time: 0.004
File "/home/jwintz/Development/elpi/tests/sources/chr.elpi", line 7, column 60, character 133: Warning: constant term has no declared type.
File "/home/jwintz/Development/elpi/tests/sources/chr.elpi", line 11, column 8, character 319: Warning: constant len has no declared type. Did you mean std.length ?
File "/home/jwintz/Development/elpi/tests/sources/chr.elpi", line 28, column 28, character 761: Warning: constant compatible has no declared type.

Typechecking time: 0.154
compat [term c1 (uvar frozen--501 []), term c0 (uvar frozen--502 [])] |- frozen--494 [
 c1, c0] arr (uvar frozen--495 [c0, c1]) (arr (uvar frozen--496 [c0, c1]) (uvar frozen--497 [])) , [
 term c3 (uvar frozen--499 []), term c2 (uvar frozen--498 [])] |- frozen--494 [
 c2, c3] arr (uvar frozen--498 []) (arr (uvar frozen--499 []) (uvar frozen--500 []))
NEW [X0 = X1, X2 = X3] arr (X4 c0 c1) (arr (X5 c0 c1) X6) = arr X1 (arr X3 X7)
1
compat [term c0 bool] |- frozen--507 [c0] uvar frozen--508 [] , [term c1 (uvar frozen--509 [])] |- frozen--507 [c1] nat
NEW [bool = X8] X9 = nat
2
compat [term c0 bool] |- frozen--514 [c0] uvar frozen--515 [] , [term c1 (uvar frozen--515 [])] |- frozen--514 [c1] nat
NEW [bool = X10] X10 = nat
compat [term c0 bool] |- frozen--520 [c0] uvar frozen--521 [] , [term c1 nat] |- frozen--520 [c1] nat
NEW [bool = nat] X11 = nat

Success:

Time: 0.001

Constraints:
 {c0} : term c0 bool ?- term (X12 c0) nat  /* suspended on X12 */ {c0 c1} : term c1 X13, term c0 X13 ?- term (X14 c1 c0) (arr X13 (arr X13 X6))  /* suspended on X14 */

State:

Regexp Matching

This elpi directive should pass validation:

.. elpi:: ./a.elpi
   :assert: V = s \(.*\)

./a.elpi :

1type s num -> num.
2type zero num.
3pred ack i:num, i:num, o:num.
4ack zero N V :- !, V = (s N).
5ack M zero V :- !, (s M2) = M, ack M2 (s zero) V.
6ack M N V :- (s M2) = M, (s N2) = N, ack M N2 V2, ack M2 V2 V.
7main :- ack (s (s (s zero))) (s zero) V, print "V =" V.

V = s (s (s (s (s (s (s (s (s (s (s (s (s zero))))))))))))

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.060

Success:

Time: 0.000

Constraints:


State:

This one should fail validation, only a message stating the regexp matching error will be printed:

.. elpi:: ./a.elpi
   :assert: /(?!)/

./a.elpi :

1type s num -> num.
2type zero num.
3pred ack i:num, i:num, o:num.
4ack zero N V :- !, V = (s N).
5ack M zero V :- !, (s M2) = M, ack M2 (s zero) V.
6ack M N V :- (s M2) = M, (s N2) = N, ack M N2 V2, ack M2 V2 V.
7main :- ack (s (s (s zero))) (s zero) V, print "V =" V.

Injection failure: result did not pass regexp check (/(?!)/)

Test Bed

../../tests/sources/accumulate_twice1.elpi :

1pred doomed o:int.
2accumulate accumulated.
3accumulate accumulated.
4main :-
5  doomed 100.

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.055

../../tests/sources/accumulate_twice2.elpi :

1pred doomed o:int.
2accumulate accumulated.
3namespace other { accumulate accumulated. }
4main :-
5  doomed 100,
6  other.doomed 100.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/accumulate_twice2.elpi", line 4, column 0, character 87:
 Warning: constant other.doomed has no declared type.

Parsing time: 0.001

Compilation time: 0.001

Typechecking time: 0.060

../../tests/sources/accumulated.elpi :

1doomed 0 :- fail.
2doomed N :- N > 0, M is N - 1, doomed M.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/accumulated.elpi", line 1, column 0, character 0:
 Warning: constant doomed has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.061

../../tests/sources/ackermann.elpi :

 1% ack (s zero) (s zero) V.              yields V = s(s(s(zero)))   = 3
 2% ack (s (s zero)) (s (s zero)) V.      yields V = s(s...(s zero)) = 7
 3% ack (s (s (s zero))) (s zero) V.      yields V = s(s...(s zero)) = 13
 4% ack (s (s (s zero))) (s (s zero)) V.  yields V = ....            = 29
 5% ack (s (s (s (s zero)))) (s zero) V.  yields  nothing
 6
 7% ack   +int    +int  -int
 8% ack(0, N, V) :- !, V is N + 1.
 9% ack(M, 0, V) :- !, M2 is M - 1, ack(M2, 1, V).
10% ack(M, N, V) :- M2 is M - 1, N2 is N - 1, ack(M, N2, V2), ack(M2, V2, V).
11
12
13ack zero N V :- !, V = (s N).
14
15ack M zero V :- !, (s M2) = M, ack M2 (s zero) V.
16
17ack M N V :- (s M2) = M, (s N2) = N, ack M N2 V2, ack M2 V2 V.
18
19main :- ack (s (s (s zero))) (s zero) V.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/ackermann.elpi", line 13, column 0, character 530:
 Warning: constant zero has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/ackermann.elpi", line 13, column 0, character 530:
 Warning:
 constant s has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.set.make std.set.mem std.set.add std.set.remove std.set.cardinal std.set.elements std.spy std.spy! std.split-at std.spy-do! rex.split random.self_init std.string.concat std.string.map std.string.map.empty std.string.map.mem std.string.map.add std.string.map.remove std.string.map.find std.string.map.bindings std.string.set std.string.set.empty std.string.set.mem std.string.set.add std.string.set.remove std.string.set.union std.string.set.inter std.string.set.diff std.string.set.equal std.string.set.subset std.string.set.elements std.string.set.cardinal std.int.set std.int.set.empty std.int.set.mem std.int.set.add std.int.set.remove std.int.set.union std.int.set.inter std.int.set.diff std.int.set.equal std.int.set.subset std.int.set.elements std.int.set.cardinal std.loc.set std.loc.set.empty std.loc.set.mem std.loc.set.add std.loc.set.remove std.loc.set.union std.loc.set.inter std.loc.set.diff std.loc.set.equal std.loc.set.subset std.loc.set.elements std.loc.set.cardinal std.set std.set gc.set gc.stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/ackermann.elpi", line 13, column 0, character 530:
 Warning: constant ack has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/ackermann.elpi", line 19, column 0, character 676:
 Warning: V is linear: name it _V (discard) or V_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.075

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/asclause.elpi :

1hard (lam x\ _ as P) :- print P.
2
3
4simple (1 as P) :- print P.
5
6main :-
7  simple 1, hard (lam x\ x).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/asclause.elpi", line 5, column 0, character 36:
 Warning: constant simple has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/asclause.elpi", line 2, column 0, character 1:
 Warning: constant lam has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/asclause.elpi", line 2, column 0, character 1:
 Warning: constant hard has no declared type.
1
lam c0 \ c0

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.064

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/beta.elpi :

1main :- X = (x\ y\ f x y), X a b = f a b.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/beta.elpi", line 1, column 0, character 0:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/beta.elpi", line 1, column 0, character 0:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/beta.elpi", line 1, column 0, character 0:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.063

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/block.elpi :

1namespace xxx {
2 foo.

Parsing time: 0.000
Fatal error: File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/block.elpi", line 1, column 0, character 0:matching } is missing

../../tests/sources/chr.elpi :

 1type app term -> term -> term.
 2type lam (term -> term) -> term.
 3type arr ty -> ty -> ty.
 4type nat ty.
 5type bool ty.
 6mode (term i o).
 7term (app HD ARG) TGT :- term HD (arr SRC TGT), term ARG SRC.
 8term (lam F) (arr SRC TGT) :- pi x\ term x SRC => term (F x) TGT.
 9term (uvar as X) T :- declare_constraint (term X T) [X].
10
11len [] 0.
12len [_|XS] N :- len XS M, N is M + 1.
13
14constraint term {
15  rule
16     \ (term (uvar K LX) _) (term (uvar K LY) _)
17     | (len LX N, len LY M, not(N = M))
18   <=> (print "wrong arity" K, false).
19
20  rule (GX ?- term (uvar K LX) TX)
21     \ (GY ?- term (uvar K LY) TY)
22     | (print "compat" GX "|-" K LX TX "," GY "|-" K LY TY, 
23        compatible GX LX GY LY CTXCONSTR)
24   <=> (print "NEW" CTXCONSTR TX "=" TY, CTXCONSTR, TX = TY).
25
26}
27
28compatible _ [] _ [] [] :- !.
29compatible GX [X|XS] GY [Y|YS] [TX = TY | K] :-
30 (GX => term X TX),
31 (GY => term Y TY),
32 !,
33 compatible GX XS GY YS K.
34compatible _ _ _ _ [false].
35
36main :-
37  (term (lam x\ lam y\ app (app (F x y) x) y) T1_, 
38   term (lam y\ lam x\ app (app (F x y) y) x) T2_),
39  print "1",
40  (term (lam x \ X x) (arr A_ nat),
41   term (lam x \ X x) (arr bool B_)),
42  print "2",
43  not(term (lam x \ Y x) (arr C nat), term (lam x \ Y x) (arr bool C)),
44  not(term (lam x \ Z x) (arr nat nat), term (lam x \ Z x) (arr bool D_)).
45

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr.elpi", line 7, column 0, character 133:
 Warning: constant term has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr.elpi", line 11, column 0, character 319:
 Warning: constant len has no declared type. Did you mean std.length ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr.elpi", line 28, column 0, character 761:
 Warning: constant compatible has no declared type.
compat [term c1 (uvar frozen--501 []), term c0 (uvar frozen--502 [])] |-
 frozen--494 [c1, c0]
 arr (uvar frozen--495 [c0, c1])
  (arr (uvar frozen--496 [c0, c1]) (uvar frozen--497 [])) ,
 [term c3 (uvar frozen--499 []), term c2 (uvar frozen--498 [])] |- frozen--494
 [c2, c3]
 arr (uvar frozen--498 []) (arr (uvar frozen--499 []) (uvar frozen--500 []))
NEW [X0 = X1, X2 = X3] arr (X4 c0 c1) (arr (X5 c0 c1) X6) = arr X1 (arr X3 X7)
1
compat [term c0 bool] |- frozen--507 [c0] uvar frozen--508 [] ,
 [term c1 (uvar frozen--509 [])] |- frozen--507 [c1] nat
NEW [bool = X8] X9 = nat
2
compat [term c0 bool] |- frozen--514 [c0] uvar frozen--515 [] ,
 [term c1 (uvar frozen--515 [])] |- frozen--514 [c1] nat
NEW [bool = X10] X10 = nat
compat [term c0 bool] |- frozen--520 [c0] uvar frozen--521 [] , [term c1 nat]
 |- frozen--520 [c1] nat
NEW [bool = nat] X11 = nat

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.071

Success:

Time: 0.001

Constraints:
 {c0} : term c0 bool ?- term (X12 c0) nat  /* suspended on X12 */
 {c0 c1} : term c1 X13, term c0 X13 ?- term (X14 c1 c0) (arr X13 (arr X13 X6))  /* suspended on X14 */

State:

../../tests/sources/chrGCD.elpi :

 1mode (gcd i i).
 2kind group type.
 3type group-1 group.
 4type group-2 group.
 5
 6gcd A (uvar as B) :- !, declare_constraint (gcd A B) [B].
 7
 8% assert result is OK
 9gcd 11 group-1 :- print "group 1 solved".
10gcd 7 group-2 :- print "group 2 solved".
11
12main :- gcd 99 X, gcd 66 X, gcd 14 Y, gcd 22 X, gcd 77 Y,
13        % we then force a resumption to check only GCDs are there
14        X = group-1, Y = group-2.
15
16constraint gcd {
17  rule (gcd A _) \ (gcd B _) | (A = B).
18  rule (gcd A _) \ (gcd B X) | (A < B) <=> (C is (B - A), gcd C X).
19}

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chrGCD.elpi", line 6, column 0, character 74:
 Warning: constant gcd has no declared type.
group 1 solved
group 2 solved

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.058

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/chrLEQ.elpi :

 1mode (leq i i).
 2leq (uvar as A) (uvar as B) :- !,  declare_constraint (leq A B) [A,B].
 3leq A         (uvar as B) :- !,  declare_constraint (leq A B) [B].
 4leq (uvar as A) B         :- !,  declare_constraint (leq A B) [A].
 5
 6mode (ltn i i).
 7ltn (uvar as A) (uvar as B) :- !,  declare_constraint (ltn A B) [A,B].
 8ltn A         (uvar as B) :- !,  declare_constraint (ltn A B) [B].
 9ltn (uvar as A) B         :- !,  declare_constraint (ltn A B) [A].
10
11main :-
12  leq A B, leq B C, not (ltn C A), ltn A B, not(A = C).
13
14constraint leq ltn {
15  % incompat (FIRST!!)
16  rule (leq X Y) (ltn Y X) <=> false.
17  rule (ltn X Y) (ltn Y X) <=> false.
18  rule (ltn X X) <=> false.
19  
20  % refl
21  rule \ (leq X X).
22
23  % atisym
24  rule (leq X Y) \ (leq Y X) <=> (Y = X).
25
26  % trans
27  rule (leq X Y) (leq Y Z) <=> (leq X Z).
28  rule (leq X Y) (ltn Y Z) <=> (ltn X Z).
29  rule (ltn X Y) (leq Y Z) <=> (ltn X Z).
30  rule (ltn X Y) (ltn Y Z) <=> (ltn X Z).
31
32  % idempotence
33  rule (leq X Y) \ (leq X Y).
34  rule (ltn X Y) \ (ltn X Y).
35
36}
37
38% vim:set ft=lprolog:

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chrLEQ.elpi", line 7, column 0, character 238:
 Warning: constant ltn has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chrLEQ.elpi", line 2, column 0, character 16:
 Warning: constant leq has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.062

Success:

Time: 0.001

Constraints:
 ltn X0 X1  /* suspended on X0, X1 */ leq X0 X1  /* suspended on X0, X1 */
 leq X2 X1  /* suspended on X2, X1 */ ltn X0 X2  /* suspended on X0, X2 */
 leq X0 X2  /* suspended on X0, X2 */

State:

../../tests/sources/chr_nokey.elpi :

 1type test int -> prop.
 2
 3main :- declare_constraint (test 1) [_], declare_constraint (test 2) [_].
 4
 5constraint test {
 6
 7 :name "fst"
 8 rule (test 1) \ (test 2).
 9
10 rule (test 2) <=> fail.
11
12}

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.059

Success:

Time: 0.000

Constraints:
 test 1  /* suspended on X0 */

State:

../../tests/sources/chr_nokey2.elpi :

1main :- declare_constraint foo [], declare_constraint (bar X) [], X.
2
3constraint foo bar { rule foo (bar _) <=> false. rule (bar X) <=> (X = true). }

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr_nokey2.elpi", line 1, column 0, character 0:
 Warning: constant foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr_nokey2.elpi", line 1, column 0, character 0:
 Warning: constant bar has no declared type.

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.061

Success:

Time: 0.000

Constraints:
 bar true  /* suspended on  */ foo  /* suspended on  */

State:

../../tests/sources/chr_not_clique.elpi :

1constraint a {
2
3  rule b.
4
5}

Parsing time: 0.000
Fatal error: CHR rule File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr_not_clique.elpi", line 3, column 3, character 19:: matches b which is not a constraint on which it is applied. Check the list of predicates after the "constraint" keyword.

../../tests/sources/chr_sem.elpi :

 1main :- declare_constraint a [_],
 2        declare_constraint b [_],
 3        declare_constraint b [_],
 4        declare_constraint d [_].
 5
 6constraint a b c d {
 7 rule a (d) \ b b <=> (print c, declare_constraint c [_]).
 8 rule c c <=> fail.
 9
10}

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr_sem.elpi", line 1, column 0, character 0:
 Warning:
 constant d has no declared type. Did you mean std.debug-print std.drop std.drop-last std.do! std.do-ok! std.string.set.diff std.int.set.diff std.loc.set.diff ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr_sem.elpi", line 1, column 0, character 0:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/chr_sem.elpi", line 1, column 0, character 0:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?
c

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.069

Success:

Time: 0.000

Constraints:
 c  /* suspended on X0 */ d  /* suspended on X0 */ a  /* suspended on X0 */

State:

../../tests/sources/conj2.elpi :

1main :- test1, test2.
2
3test1 :- true & true & true.
4test2 :- X = [true & true, false], std.length X 2.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/conj2.elpi", line 1, column 0, character 0:
 Warning: constant test2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/conj2.elpi", line 1, column 0, character 0:
 Warning: constant test1 has no declared type.

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.065

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/ctx_loading.elpi :

 1constraint a b c d1 d2 d3 d11 d22 d33 {
 2  rule (C ?- d1 X) | (print C) <=> (C ?- declare_constraint (d11 X) [X]).
 3  rule (C ?- d2 X) | (print C) <=> (C ?- declare_constraint (d22 X) [X]).
 4  rule (C ?- d3 X) | (print C) <=> (C ?- declare_constraint (d33 X) [X]).
 5  rule \ (C ?- d1 X) (C ?- d11 X).
 6  rule \ (C ?- d2 X) (C ?- d22 X).
 7  rule \ (C ?- d3 X) (C ?- d33 X).
 8}
 9type p prop -> prop.
10type a prop.
11type b prop.
12type c prop.
13type d1, d2, d3, d11, d22, d33 prop -> prop.
14
15main :-
16  p b => p a => p W, !, W = a,
17  [p a, p b] => p Y, !, Y = a, 
18  (p a, p b) => p Z, !, Z = a,
19  [a, b, c] =>   declare_constraint (d1 X) [X],
20  c => b => a => declare_constraint (d2 X) [X],
21  (a, b, c) =>   declare_constraint (d3 X) [X],
22  X = a.
23	

[a, b, c]
[a, b, c]
[a, b, c]

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.057

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/cut.elpi :

 1/* To test: query q X. The only answer should be X = ok. */
 2q X :- a X.
 3q ok.
 4
 5a ko :- b Y, !, c Y.
 6a two.
 7
 8b three.
 9b four.
10
11c four.
12
13main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 6, column 0, character 100:
 Warning: constant two has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 8, column 0, character 108:
 Warning: constant three has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 2, column 0, character 60:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 5, column 0, character 79:
 Warning: constant ko has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 9, column 0, character 117:
 Warning: constant four has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 5, column 0, character 79:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 5, column 0, character 79:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut.elpi", line 2, column 0, character 60:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.079

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/cut2.elpi :

 1/* To test run q X; the only expected result is X=ok.
 2   This is different from the brain-damaged semantics of Teyjus
 3   and consistent with the implicit declaration
 4   ; A B :- A.
 5   ; A B :- B
 6*/
 7q X :- c Y, !, x Y X ; e X.
 8q ok.
 9
10c one.
11c two.
12
13x two ko1.
14
15e ko2.
16
17main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 7, column 0, character 198:
 Warning: constant x has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 11, column 0, character 240:
 Warning: constant two has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 7, column 0, character 198:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 10, column 0, character 233:
 Warning: constant one has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 15, column 0, character 260:
 Warning: constant ko2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 13, column 0, character 248:
 Warning: constant ko1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 7, column 0, character 198:
 Warning:
 constant e has no declared type. Did you mean std.set.private.empty std.set.private.elements std.set.elements std.map.private.empty std.exists std.exists2 std.string.map.empty std.int.map.empty std.loc.map.empty std.string.set.empty std.string.set.equal std.string.set.elements std.int.set.empty std.int.set.equal std.int.set.elements std.loc.set.empty std.loc.set.equal std.loc.set.elements ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut2.elpi", line 7, column 0, character 198:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.079

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/cut3.elpi :

 1% Test with q X; should yield X=ok
 2
 3q X :- a X, b, c X.
 4
 5a ko.
 6a ok.
 7
 8b :- !.
 9b.
10
11c ok.
12
13main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut3.elpi", line 3, column 0, character 36:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut3.elpi", line 5, column 0, character 57:
 Warning: constant ko has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut3.elpi", line 3, column 0, character 36:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut3.elpi", line 3, column 0, character 36:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut3.elpi", line 3, column 0, character 36:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.068

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/cut4.elpi :

1% Test: main. Should not fail.
2
3main :- !.

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.054

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/cut5.elpi :

 1/* To test: query q X. The only answer should be X = ok. */
 2q X :- a X.
 3q ok.
 4
 5a ko :- b Y, !, d Z, !, c Z.
 6a two.
 7
 8b three.
 9b four.
10
11c four.
12
13d three.
14d four.
15
16main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 6, column 0, character 108:
 Warning: constant two has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 8, column 0, character 116:
 Warning: constant three has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 2, column 0, character 60:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 5, column 0, character 79:
 Warning: constant ko has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 9, column 0, character 125:
 Warning: constant four has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 5, column 0, character 79:
 Warning:
 constant d has no declared type. Did you mean std.debug-print std.drop std.drop-last std.do! std.do-ok! std.string.set.diff std.int.set.diff std.loc.set.diff ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 5, column 0, character 79:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 5, column 0, character 79:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 2, column 0, character 60:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut5.elpi", line 5, column 0, character 79:
 Warning: Y is linear: name it _Y (discard) or Y_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.081

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/cut6.elpi :

 1% q X should yield X=ok
 2
 3q X :- a X, !.
 4q X :- b X.
 5
 6a X :- c X, !.
 7
 8c ok.
 9c ko.
10
11b ko.
12
13main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut6.elpi", line 3, column 0, character 25:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut6.elpi", line 9, column 0, character 75:
 Warning: constant ko has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut6.elpi", line 6, column 0, character 53:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut6.elpi", line 4, column 0, character 40:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/cut6.elpi", line 3, column 0, character 25:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.070

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/deep_indexing.elpi :

 1% select should only find 2 clauses (the last 2) since indexing at level 3 drops the others
 2% ./elpi -test tests/sources/deep_indexing.elpi -no-tc -trace-on -trace-at run 1 300 -trace-only select
 3
 4kind term type.
 5type f term -> term.
 6type g term.
 7
 8:index(3)
 9pred find i:term.
10find g.
11find (f g).
12find (f (f g)).
13find (f (f (f g))).
14find (f (f (f (f g)))).
15
16
17main :- find (f (f (f g))).

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.058

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/discard.elpi :

1main :-
2  foo = _,
3  _ = 4,
4  _ = "",
5  _ = _,
6  _Foo = bar,
7  pi x \ _Foo = x.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/discard.elpi", line 1, column 0, character 0:
 Warning: constant foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/discard.elpi", line 1, column 0, character 0:
 Warning: constant bar has no declared type.

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.066

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/elpi_only_llam.elpi :

1main :- p (F X) F X => p (f x) f x.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/elpi_only_llam.elpi", line 1, column 0, character 0:
 Warning: constant x has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/elpi_only_llam.elpi", line 1, column 0, character 0:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/elpi_only_llam.elpi", line 1, column 0, character 0:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.067
Fatal error: Unification problem outside the pattern fragment. ((Data.Term.App (f, (Data.Term.Const x), [])) == (Data.Term.AppUVar (
   { Data.Term.contents = please extend this printer; uid_private = 41116 },
   0,
   [(Data.Term.UVar (
       { Data.Term.contents = please extend this printer; uid_private = 41115
         },
       0, 0))
     ]
   ))) Pass -delay-problems-outside-pattern-fragment (elpi command line utility) or set delay_outside_fragment to true (Elpi_API) in order to delay (deprecated, for Teyjus compatibility).

../../tests/sources/end_comment.elpi :

1main.
2% foo 

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.055

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/eta.elpi :

 1kind tm type.
 2type c (tm -> A) -> tm.
 3macro @ctx A :- c (_\ A). % to have depth > 0 in unif
 4
 5% to test the indexing
 6k1 (x\ g x).
 7k2 g.
 8
 9%mode (foo i i).
10pred foo i:(X -> X), i:(X -> X -> X).
11foo X (x1 \ (x2 \ X x2)) :- (print X).
12%% Fails, but should output `y`
13
14main :-
15  pi f y\
16    % 4 branches in unif
17    @ctx (x\ f x) = @ctx f,
18    @ctx f = @ctx (x\ f x),
19    @ctx (x\ f y x) = @ctx (f y),
20    @ctx (f y) = @ctx (x\ f y x),
21
22    % put some uvar around
23    @ctx (f (X y)) = @ctx (x\ f y x), print X,
24    @ctx (x\ f y x) = @ctx (f (Y y)), print Y,
25
26    % index + adepth=2 <> bdepth=0
27    k1 g,
28    k2 (x\ g x),
29    
30    % regression #135
31    foo y (x1 \ (x2 \ y x2))
32.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta.elpi", line 7, column 0, character 129:
 Warning: constant k2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta.elpi", line 6, column 0, character 116:
 Warning: constant k1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta.elpi", line 6, column 0, character 116:
 Warning: constant g has no declared type. Did you mean gc.get ?
c2 \ c2
c2 \ c2
c1

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.064

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/eta_as.elpi :

  1pred as_1 i:any.
  2pred as_2 i:any.
  3pred as_3 i:any.
  4
  5pred uvar_1 i:any.
  6pred uvar_2 i:any.
  7pred uvar_3 i:any.
  8pred uvar_4 i:A.
  9pred uvar_5 i:A.
 10pred uvar_6 i:A.
 11
 12pred test-as.
 13pred test-uvar.
 14pred test-var.
 15pred test-declare-constraint.
 16
 17uvar_1 (bar (uvar K Args)) :- std.assert! (var K) "uvar_1 bar X, not a var", print K Args.
 18uvar_2 (bar X) :- std.assert! (var X K Args) "uvar_2 bar X, not a var", print K Args.
 19uvar_3 (uvar K) :- std.assert! (var K) "uvar_3 X, not a var", print K.
 20uvar_4 (uvar K Args) :- std.assert! (var K) "uvar_4 X, not a var", std.assert! (distinct_names Args) "uvar_4 not in pattern".
 21uvar_5 (uvar K Args) :- std.assert! (var K) "uvar_5 X, not a var", distinct_names Args.
 22
 23uvar_6 X :- fail.
 24uvar_6 (uvar as X) :- print X.
 25
 26as_1 (bar (uvar as K)) :- std.assert! (var K) "bar (uvar as_1 X), not a var", print K.
 27as_2 (uvar as K) :- std.assert! (var K) "uvar as_2 X, not a var", print K.
 28as_3 (uvar as K) :- std.assert! (var K) "uvar as_3 X, not a var", print K.
 29
 30pred unif_1 o:A.
 31pred unif_2 o:A.
 32
 33unif_1 (x\ X x).
 34unif_2 (x\ y\ X x y).
 35
 36
 37tests-uvar :-
 38  print "--------- uvar_1",
 39  not(uvar_1 (bar (x \ u))),
 40  print "--------- uvar_2",
 41  (pi x \ (uvar_2 (bar (X x)))),
 42  print "--------- uvar_3",
 43  not (uvar_3 (x \ X0)),
 44  print "--------- uvar_3 bis",
 45  uvar_3 (x \ y\ X01 x y),
 46  print "--------- uvar_4",
 47  uvar_4 X1,
 48  print "--------- uvar_4 bis",
 49  not(uvar_4 (x \ X2)),
 50  print "--------- uvar_4 ter",
 51  uvar_4 (x \ X3 x),
 52  print "--------- uvar_4 quater",
 53  (pi u\ uvar_4 (x \ X4 u x)),
 54  print "--------- uvar_5",
 55  not (uvar_5 (x \ X5 u x)),
 56  print "--------- uvar_6",
 57  uvar_6 (x \ X6 x), var X6.
 58
 59tests-as :-
 60  print "---------- as_1",
 61  not(as_1 (x \ bar u)), % fails because (bar (uvar as K) x ==!== bar u)
 62  print "---------- as_1 bis",
 63  not(as_1 (x \ bar u x)), % fails because u is not flexible (input mode)
 64  print "---------- as_1 ter",
 65     (as_1 (x \ bar (X2 x) x)), % works but X2 is pruned
 66       (pi a\ var (X2 a) _ []), % assert pruning of X2
 67  print "---------- as_2",
 68     (as_2 (x \ X1 x)) , % works
 69       (pi a\ var (X1 a) _ [a]), % assert X1 was not pruned
 70  print "---------- as_3",
 71  not (as_3 (x \ X0)).
 72
 73test-unif :-
 74    print "---------- unif_1",
 75    unif_1 X,
 76    print "---------- unif_1 bis",
 77    unif_1 (x\ X1 x),
 78    print "---------- unif_1 ter",
 79    unif_1 (x\ y\ X2 x y),
 80    print "---------- unif_2",
 81    unif_2 X3,
 82    print "---------- unif_2 bis",
 83    unif_2 (x\ X4 x),
 84    print "---------- unif_2 ter",
 85    unif_2 (x\ y\ X5 x y),
 86    print "---------- unif_zero",
 87    (x\ X6 x) = X6.
 88
 89test-var :-
 90    print "---------- var 1",
 91   pi x \ (var (y \ X x y)),
 92    print "---------- var 2",
 93   pi x \ (var (y \ X c y)), 
 94    print "---------- var 3",
 95   pi x z \ (var (y \ X x y)).
 96
 97test-declare-constraint :-
 98  declare_constraint false [x\ X x],
 99  not(X = 1).
100
101main :- tests-uvar, tests-as, test-unif, test-var, test-declare-constraint.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning:
 constant u has no declared type. Did you mean std.unsafe-cast std.unzip std.string.set.union std.int.set.union std.loc.set.union ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: constant tests-uvar has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 59, column 0, character 1639:
 Warning: constant tests-as has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 73, column 0, character 2170:
 Warning: constant test-unif has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 89, column 0, character 2567:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 17, column 0, character 237:
 Warning: constant bar has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 59, column 0, character 1639:
 Error: (bar u) has type any but is applied to c3
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 97, column 0, character 2760:
 Error: 1 has type int but is used with type (X24 c1 -> X25)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 97, column 0, character 2760:
 Error: 1 has type int but is used with type (X26 c1 -> X27)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 23, column 0, character 700:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 33, column 0, character 1023:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 34, column 0, character 1040:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X5 is linear: name it _X5 (discard) or X5_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X4 is linear: name it _X4 (discard) or X4_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X3 is linear: name it _X3 (discard) or X3_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X2 is linear: name it _X2 (discard) or X2_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X1 is linear: name it _X1 (discard) or X1_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X01 is linear: name it _X01 (discard) or X01_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X0 is linear: name it _X0 (discard) or X0_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 37, column 0, character 1064:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 59, column 0, character 1639:
 Warning: X0 is linear: name it _X0 (discard) or X0_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 73, column 0, character 2170:
 Warning: X5 is linear: name it _X5 (discard) or X5_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 73, column 0, character 2170:
 Warning: X4 is linear: name it _X4 (discard) or X4_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 73, column 0, character 2170:
 Warning: X3 is linear: name it _X3 (discard) or X3_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 73, column 0, character 2170:
 Warning: X2 is linear: name it _X2 (discard) or X2_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 73, column 0, character 2170:
 Warning: X1 is linear: name it _X1 (discard) or X1_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/eta_as.elpi", line 73, column 0, character 2170:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.081
Type error. To ignore it, pass -no-tc.

../../tests/sources/even-odd.elpi :

 1kind nat type.
 2type zero nat.
 3type succ nat -> nat.
 4
 5pred odd i:nat.
 6pred even i:nat.
 7pred double i:nat, o:nat.
 8
 9even zero.
10odd (succ X) :- even X.
11even (succ X) :- odd X.
12even X :- var X, declare_constraint (even X) [X].
13odd X :- var X, declare_constraint (odd X) [X].
14
15double zero zero.
16double (succ X) (succ (succ Y)) :- double X Y.
17double X Y :- var X, declare_constraint (double X Y) [X].
18
19main :- odd X, not(X = zero), not(double Z X).
20
21constraint even odd double {
22  rule (even X) (odd X) <=> fail.
23  rule (double _ Y) <=> (even Y).
24}

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/even-odd.elpi", line 19, column 0, character 395:
 Warning: Z is linear: name it _Z (discard) or Z_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.056

Success:

Time: 0.000

Constraints:
 odd X0  /* suspended on X0 */

State:

../../tests/sources/findall.elpi :

 1pred p o:int, o:int.
 2p 1 1.
 3p 1 2.
 4p 2 2.
 5
 6test1 :- std.findall (p A B) [p 1 1, p 1 2, p 2 2].
 7test2 :- std.findall (p _ _) [p X 1, p 1 2, p 2 2], not(var X).
 8test3 :-
 9  pi q\
10    q 1 1 =>
11    q 1 2 =>
12    q 2 2 =>
13      (std.findall (q _ _) [q X 2, q 1 2, q 1 1], not (var X)).
14
15
16test4 :-
17  pi q\
18    q 1 A =>
19    q 2 A =>
20      (std.findall (q _ _) [q 2 X, q 1 Y], not(same_var X Y)).
21% this is super tricky but hard to implement differently.
22% q _ _ -> q A^1 B^1
23% q A^1 B^1 == q 1 X0 --restrict--> X0 := X1,  A1 := _\X1
24% when we backtrack the "restriction" on X0 is lost
25
26test5 :-
27  pi q\
28    q 1 A =>
29    q 2 A =>
30      (std.findall (q _ Z) [q 2 X, q 1 Y], same_var X Y).
31% this works because there is no restriction
32
33main :- test1, print 1,
34        test2, print 2,
35        test3, print 3,
36        test4, print 4,
37        test5, print 5.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 26, column 0, character 577:
 Warning: constant test5 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 16, column 0, character 281:
 Warning: constant test4 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 8, column 0, character 159:
 Warning: constant test3 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 7, column 0, character 95:
 Warning: constant test2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 6, column 0, character 43:
 Warning: constant test1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 6, column 0, character 43:
 Warning: B is linear: name it _B (discard) or B_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 6, column 0, character 43:
 Warning: A is linear: name it _A (discard) or A_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/findall.elpi", line 26, column 0, character 577:
 Warning: Z is linear: name it _Z (discard) or Z_ (fresh variable)
1
2
3
4
5

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.073

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/fragment_exit.elpi :

1q Y :- pi d\ r Y.
2
3r _.
4
5main :- pi c\ q (x\ X c x).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit.elpi", line 1, column 0, character 0:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit.elpi", line 1, column 0, character 0:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit.elpi", line 5, column 0, character 25:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.063

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/fragment_exit2.elpi :

1ignore _.
2main :- pi c\ Y c = (x\ X c x), ignore (Y c d).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit2.elpi", line 1, column 0, character 0:
 Warning:
 constant ignore has no declared type. Did you mean std.ignore-failure! ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit2.elpi", line 2, column 0, character 10:
 Warning:
 constant d has no declared type. Did you mean std.debug-print std.drop std.drop-last std.do! std.do-ok! std.string.set.diff std.int.set.diff std.loc.set.diff ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit2.elpi", line 2, column 0, character 10:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.062

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/fragment_exit3.elpi :

1ignore _.
2main :- (pi c\ sigma Y\ X c = Y), ignore (X (f d)).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit3.elpi", line 1, column 0, character 0:
 Warning:
 constant ignore has no declared type. Did you mean std.ignore-failure! ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit3.elpi", line 2, column 0, character 10:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/fragment_exit3.elpi", line 2, column 0, character 10:
 Warning:
 constant d has no declared type. Did you mean std.debug-print std.drop std.drop-last std.do! std.do-ok! std.string.set.diff std.int.set.diff std.loc.set.diff ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.063

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/general_case.elpi :

1app F X :- F X. 
2c.
3ignore _.
4foo P :- pi d\ ignore P.
5main :- app (x\x) c, F = (y\y), F c, (pi d\ F c),
6        foo (G c).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case.elpi", line 3, column 0, character 20:
 Warning:
 constant ignore has no declared type. Did you mean std.ignore-failure! ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case.elpi", line 4, column 0, character 30:
 Warning: constant foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case.elpi", line 2, column 0, character 17:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case.elpi", line 1, column 0, character 0:
 Warning:
 constant app has no declared type. Did you mean std.append std.appendR ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case.elpi", line 5, column 0, character 55:
 Warning: G is linear: name it _G (discard) or G_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.066

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/general_case2.elpi :

1p F :- F (x\ c x).
2
3q (x\ c x).
4
5main :- p (y\ pi z\ q y).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case2.elpi", line 3, column 0, character 20:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case2.elpi", line 1, column 0, character 0:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case2.elpi", line 1, column 0, character 0:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.071

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/general_case3.elpi :

1main :-
2 (pi c\ sigma X\ pi d\ (X d = f c d, Y c = X)),
3 Y = c\ d\ f c d.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/general_case3.elpi", line 1, column 0, character 0:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.057

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/hc_interp.elpi :

 1/*
 2 * An interpreter for the logic of Horn clauses. This code illustrates 
 3 * the usefulness of beta reduction in realizing substitution. Also note
 4 * the use of the logic variable in the third clause for try_clause.
 5 */
 6
 7%module  hc_interp.
 8
 9%accumulate lists.
10
11%reduce (app (lam F) T) R :- pi x\ copy x T => copy (F x) (R' x), R = R' x.
12
13copy (and B1 C1) (and B2 C2) :- copy B1 B2, copy C1 C2.
14copy (or B1 C1) (or B2 C2) :- copy B1 B2, copy C1 C2.
15copy (box F1) (box F2) :- pi x\ copy x x => copy (F1 x) (F2 x).
16copy a a.
17copy b b.
18copy c c.
19copy (f X) (f Y) :- copy X Y.
20copy tru tru.
21copy perp perp.
22
23% a[t/b] = a
24
25% b[t/b] = t
26
27subst B T B1 :- pi x\ copy x T => (copy (B x) (B2 x), B2 x = B1).
28 
29% perp is a fail.
30% hc_interp Cs G means Cs |- G
31%hc_interp _ tru.
32
33%hc_interp Cs (box B) :- !, hc_interp Cs (B T).
34hc_interp Cs (box B)  :- !, subst B T B1, hc_interp Cs B1.
35hc_interp Cs (and B C) :- !, hc_interp Cs B , hc_interp Cs C.
36hc_interp Cs (or B C) :- !, (hc_interp Cs B ; hc_interp Cs C).
37hc_interp Cs A  :-  backchain Cs A.
38% why there is no rule in teyjus: hc_interp Cs (all B) :- .... ?
39
40backchain Cs A :- memb D Cs, try_clause Cs D A.
41
42memb X (xcons X _).
43memb X (xcons Y L) :- memb X L.
44
45
46% try_clause Cs A B means Cs, A |- B
47try_clause Cs (and D1 D2) A :- 
48     !, (try_clause Cs D1 A ; try_clause Cs D2 A).
49% try_clause Cs (all D) A :- !, try_clause Cs (D T) A.
50try_clause Cs (all D) A :- !, subst D T D1, try_clause Cs D1 A.
51try_clause Cs A A.
52try_clause Cs (imp G A) A :- hc_interp Cs G.
53
54%prog (xcons (adj a b) (xcons (adj b c) (xcons (adj c (f c))
55%      (xcons (all X\ (all Y\ (imp (adj X Y) (path X Y))))
56%      (xcons (all X\ (all Y\ (all Z\ (imp (and (adj X Y) (path Y Z)) 
57%                                           (path X Z))))) xnil))))).
58
59%pathfroma X :- prog Cs, hc_interp Cs (path a X).
60
61test1 :- %Cs = (xcons a (xcons b (xcons c xnil))),
62        %try_clause Cs (and a (or b c)) (or (and a b) (and a c)).
63        hc_interp (xcons a (xcons (imp b c) (xcons (imp a b) xnil))) c.
64
65test2 :- Cs = xcons (f a) xnil, 
66        hc_interp Cs (box f).
67
68main :- test1, test2.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 61, column 0, character 1823:
 Warning: constant xnil has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 42, column 0, character 1152:
 Warning: constant xcons has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 40, column 0, character 1103:
 Warning: constant try_clause has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 20, column 0, character 574:
 Warning: constant tru has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 65, column 0, character 2013:
 Warning: constant test2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 61, column 0, character 1823:
 Warning: constant test1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 27, column 0, character 633:
 Warning: constant subst has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 21, column 0, character 588:
 Warning: constant perp has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 14, column 0, character 396:
 Warning: constant or has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 40, column 0, character 1103:
 Warning: constant memb has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 68, column 0, character 2077:
 Warning: [suppressing 12 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 34, column 0, character 817:
 Warning: T is linear: name it _T (discard) or T_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 43, column 0, character 1172:
 Warning: Y is linear: name it _Y (discard) or Y_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 50, column 0, character 1381:
 Warning: T is linear: name it _T (discard) or T_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hc_interp.elpi", line 51, column 0, character 1445:
 Warning: Cs is linear: name it _Cs (discard) or Cs_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.089

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/hdclause.elpi :

 1kind foo type.
 2
 3type a ((int -> foo) -> foo) -> foo.
 4type b foo -> foo.
 5
 6type p (foo -> foo) -> foo -> prop.
 7type q (foo -> foo) -> foo -> prop.
 8
 9p K (a f\ K (f 0)).
10q K R :- R = (a f\ K (f 0)).
11
12main :-
13  (pi y\ p b (F y)),
14  (pi y\ q b (F y)),
15  (pi x y\ q b (F y)),
16  (pi x y\ p b (F y)).

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.055

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/heap_discard.elpi :

1main :-
2  X = [_,2],
3  X = [1,2],
4  not(X = [2,2]),
5  pi a b\ Y b = [_], b = _.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/heap_discard.elpi", line 1, column 0, character 0:
 Warning: Y is linear: name it _Y (discard) or Y_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.056

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/ho.elpi :

1% q(a): OK; q(b): FAIL; q(X): exception; q(a,a): OK; q(true): OK.
2
3q(X) :- X.
4
5a.
6
7main :- q a, q (a,a), q true.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/ho.elpi", line 3, column 0, character 67:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/ho.elpi", line 5, column 0, character 79:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.060

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/hollight.elpi :

   1/* Untrusted predicates called from the kernel:
   2 * next_object            next object to check
   3 * callback_proved        proof completed
   4 * next_tactic            next tactic to use
   5 * update_certificate     get new certificate after tactic application
   6 * end_of_proof           is the certificate/proof empty?
   7 * ppterm                 for pretty-printing messages
   8 * deftac                 tactic definition
   9 */
  10
  11/* Predicates exported from the trusted library:
  12 * append
  13 * fold2_append
  14 * put_binds
  15 */
  16 
  17/* Predicates exported from the kernel:
  18 * proves
  19 * check
  20 */
  21
  22{ /***** Trusted code base *******/
  23
  24/***** Trusted library functions *****/
  25
  26/* The names with ' at the end are trusted; the ones without are
  27   exported and therefore untrusted. */
  28local append', fold2_append', put_binds'.
  29
  30append' [] L L.
  31append' [ X | XS ] L [ X | RES ] :- append' XS L RES.
  32append A B C :- append' A B C.
  33
  34fold2_append' [] [] _ [].
  35fold2_append' [ X | XS ] [ Y | YS ] F OUTS :-
  36 F X Y OUT, fold2_append' XS YS F OUTS2, append' OUT OUTS2 OUTS.
  37fold2_append A B C D :- fold2_append' A B C D.
  38
  39% put_binds : list 'b -> 'a -> 'c -> list (bounded 'b) -> o
  40% put_binds [ f1,...,fn ] x t [ bind t x \ f1,...,bind t x fn ]
  41% binding all the xs that occur in f1,...,fn
  42put_binds' [] _ _ [].
  43put_binds' [ YX | YSX ] X A [ bind A Y | YYS ] :-
  44 YX = Y X, put_binds' YSX X A YYS.
  45put_binds A B C D :- put_binds' A B C D.
  46
  47/***** The HOL kernel *****/
  48
  49local thm, provable, def0, term, typ, typ', loop, prove, check1,
  50 check1def, check1thm, check1axm, check1nbt,
  51 reterm, not_defined, check_hyps.
  52
  53proves T TY :- provable T TY.
  54
  55typ T :- !. % this line temporarily drops checking of well-formedness for types
  56            % to avoid too much slow down. It is ultimately due to re-typing
  57            % terms that should be recognized as already well typed.
  58typ T :- var T, !, declare_constraint (typ T) [ T ].
  59typ T :- typ' T.
  60typ' prop.
  61typ' (univ ## A ## B) :- typ A, typ B.
  62typ' (A --> B) :- typ A, typ B.
  63typ' (disj_union ## A ## B) :- typ A, typ B.
  64
  65mode (term i o).
  66term (lam A F) (A --> B) :- typ A, pi x\ term x A => term (F x) B.
  67term (F # T) B :- term F (A --> B), term T A.
  68term (eq ## A) (A --> A --> prop) :- typ A.
  69term (uvar as T) TY :- declare_constraint (term T TY) T.
  70
  71/* like term, but on terms that are already known to be well-typed */
  72mode (reterm i o).
  73reterm (lam A F) (A --> B) :- pi x\ reterm x A => reterm (F x) B.
  74reterm (F # T) B :- reterm F (A --> B).
  75reterm (eq ## A) (A --> A --> prop).
  76reterm (uvar as T) TY :- declare_constraint (reterm T TY) T.
  77
  78constraint term reterm { /* No propagation rules for now */}
  79
  80% thm : bounded tactic -> bounded sequent -> list (bounded sequent) -> o
  81thm C (seq Gamma G) _ :- debug, print Gamma "|- " G " := " C, fail.
  82
  83/* << HACKS FOR DEBUGGING */
  84thm daemon (seq Gamma F) [].
  85/* >> HACKS FOR DEBUGGING */
  86
  87thm r (seq Gamma (eq ## _ # X # X)) [].
  88thm (t Y) (seq Gamma (eq ## A # X # Z))
  89 [ seq Gamma (eq ## A # X # Y), seq Gamma (eq ## A # Y # Z) ] :- term Y A.
  90thm (m P) (seq Gamma Q) [ seq Gamma (eq ## prop # P # Q), seq Gamma P ] :- term P prop.
  91thm b (seq Gamma (eq ## _ # ((lam _ F) # X) # (F X))) [].
  92thm c (seq Gamma (eq ## B # (F # X) # (G # Y)))
  93 [ seq Gamma (eq ## (A --> B) # F # G) , seq Gamma (eq ## A # X # Y) ] :- reterm X A, reterm Y A.
  94thm k (seq Gamma (eq ## (A --> B) # (lam A S) # (lam A T)))
  95 [ bind A x \ seq Gamma (eq ## B # (S x) # (T x)) ].
  96thm s (seq Gamma (eq ## prop # P # Q)) [ seq (P :: Gamma) Q, seq (Q :: Gamma) P ].
  97thm (h IGN) (seq Gamma P) [] :- append' IGN [ P | Gamma2 ] Gamma.
  98
  99thm d (seq Gamma (eq ## _ # C # A)) [] :- def0 C A.
 100thm (th NAME) (seq _ G) [] :- provable NAME G.
 101
 102thm (thenll TAC1 TACN) SEQ SEQS :-
 103 thm TAC1 SEQ NEW,
 104 deftacl TACN NEW TACL,
 105 fold2_append' TACL NEW thm SEQS.
 106
 107/*debprint _ (then _ _) :- !.
 108debprint _ (thenl _ _) :- !.
 109debprint O T :- print O T.*/
 110
 111thm TAC SEQ SEQS :-
 112 deftac TAC SEQ XTAC,
 113 /*debprint "<<" TAC,
 114 (*/ thm XTAC SEQ SEQS /*, debprint ">>" TAC
 115 ; debprint "XX" TAC, fail)*/.
 116
 117thm (! TAC) SEQ SEQS :-
 118 thm TAC SEQ SEQS,
 119 !.
 120
 121thm id SEQ [ SEQ ].
 122
 123thm (wl Gamma1) (seq Gamma F) [ seq WGamma F ] :-
 124 append' Gamma1 [ P | Gamma2 ] Gamma,
 125 append' Gamma1 Gamma2 WGamma.
 126
 127thm (bind A TAC) (bind A SEQ) NEWL :-
 128 pi x \ term x A => reterm x A => thm (TAC x) (SEQ x) (NEW x), put_binds' (NEW x) x A NEWL.
 129
 130thm ww (bind A x \ SEQ) [ SEQ ].
 131
 132/* debuggin only, remove it */
 133%thm A B C :- print "FAILED " (thm A B C), fail.
 134
 135% loop : list (bounded sequent) -> certificate -> o
 136%loop SEQS TACS :- print "LOOP" (loop SEQS TACS), fail.
 137loop [] CERTIFICATE :- end_of_proof CERTIFICATE.
 138loop [ SEQ | OLD ] CERTIFICATE :-
 139 next_tactic [ SEQ | OLD ] CERTIFICATE ITAC,
 140 thm ITAC SEQ NEW,
 141 append' NEW OLD SEQS,
 142 update_certificate CERTIFICATE ITAC NEW NEW_CERTIFICATE,
 143 loop SEQS NEW_CERTIFICATE.
 144
 145prove G TACS :-
 146 (term G prop, ! ; ppterm PG G, print "Bad statement:" PG, fail),
 147% (TACS = (false,_), ! ;
 148 loop [ seq [] G ] TACS
 149. % ).
 150
 151not_defined P NAME :-
 152 not (P NAME _) ; print "Error:" NAME already defined, fail.
 153
 154check_hyps HS (typ' TYPE) :-
 155 (not (typ' TYPE) ; print "Error:" TYPE already defined, fail), print HS new TYPE.
 156check_hyps HS (def0 NAME DEF) :- ppterm PDEF DEF, print HS NAME "=" PDEF.
 157check_hyps HS (term NAME TYPE) :-
 158 not_defined term NAME, ppterm PTYPE TYPE, print HS NAME ":" PTYPE.
 159check_hyps HS (reterm _ _).
 160check_hyps HS (provable NAME TYPE) :-
 161 not_defined provable NAME, ppterm PTYPE TYPE, print HS NAME ":" PTYPE.
 162check_hyps HS (H1,H2) :- check_hyps HS H1, check_hyps HS H2.
 163check_hyps HS (pi H) :- pi x \ typ' x => check_hyps [x | HS] (H x).
 164check_hyps HS (_ => H2) :- check_hyps HS H2.
 165
 166/* check1 I O
 167   checks the declaration I
 168   returns the new assumption O */
 169check1 (theorem NAME GOALTACTICS) HYPS :- check1thm NAME GOALTACTICS HYPS, !.
 170check1 (axiom NAME ST) HYPS :- check1axm NAME ST HYPS, !.
 171check1 (new_basic_type TYPE REP ABS REPABS ABSREP PREPH P_TACTICS) HYPS :- check1nbt TYPE REP ABS REPABS ABSREP PREPH P_TACTICS true HYPS, !.
 172check1 (def NAME TYPDEF) HYPS :- check1def NAME TYPDEF true HYPS, !.
 173check1 (decl NAME TYP) HYPS :- check1decl NAME TYP true HYPS, !.
 174
 175check1def NAME (pi I) HYPSUCHTHAT (pi HYPS) :-
 176 pi x \ typ' x => check1def (NAME ## x) (I x) (HYPSUCHTHAT, typ x) (HYPS x).
 177check1def NAME (TYP,DEF) HYPSUCHTHAT HYPS :-
 178 typ TYP, term DEF TYP,
 179 HYPS = ((HYPSUCHTHAT => term NAME TYP), reterm NAME TYP, def0 NAME DEF).
 180
 181check1decl NAME (pi I) HYPSUCHTHAT (pi HYPS) :-
 182 pi x \ typ' x => check1decl (NAME ## x) (I x) (HYPSUCHTHAT, typ x) (HYPS x).
 183check1decl NAME TYP HYPSUCHTHAT HYPS :-
 184 typ TYP, HYPS = ((HYPSUCHTHAT => term NAME TYP), reterm NAME TYP).
 185
 186check1thm NAME (pi I) (pi HYPS) :-
 187 pi x \ typ' x => check1thm NAME (I x) (HYPS x).
 188check1thm NAME (GOAL,TACTICS) (provable NAME GOAL) :-
 189  prove GOAL TACTICS,
 190  callback_proved NAME GOAL TACTICS.
 191
 192check1axm NAME (pi I) (pi HYPS) :- !,
 193 pi x \ typ' x => check1axm NAME (I x) (HYPS x).
 194check1axm NAME GOAL (provable NAME GOAL) :-
 195 term GOAL prop, ! ; ppterm PGOAL GOAL, print "Bad statement:" PGOAL, fail.
 196
 197check1nbt TYPE REP ABS REPABS ABSREP PREPH (pi P_TACTICS) HYPSUCHTHAT (pi HYPS) :-
 198 pi x \ typ' x => check1nbt (TYPE ## x) (REP ## x) (ABS ## x) REPABS ABSREP PREPH (P_TACTICS x) (HYPSUCHTHAT, typ x) (HYPS x).
 199check1nbt TYPE REP ABS REPABS ABSREP PREPH (P,TACTICS) HYPSUCHTHAT HYPS :-
 200  term P (X --> prop),
 201  prove (exists ## _ # P ) TACTICS,
 202  callback_proved existence_condition (exists ## _ # P) TACTICS,
 203  REPTYP = (TYPE --> X),
 204  ABSTYP = (X --> TYPE),
 205  ABSREPTYP = (forall ## TYPE # lam TYPE x \ eq ## TYPE # (ABS # (REP # x)) # x),
 206  REPABSTYP = (forall ## X # lam X x \ impl # (P # x) # (eq ## X # (REP # (ABS # x)) # x)),
 207  PREPHTYP = (forall ## TYPE # lam TYPE x \ (P # (REP # x))),
 208  !,
 209  HYPS =
 210   ( (HYPSUCHTHAT => typ' TYPE)
 211   , (HYPSUCHTHAT => term REP REPTYP), reterm REP REPTYP
 212   , (HYPSUCHTHAT => term ABS ABSTYP), reterm ABS ABSTYP
 213   , provable ABSREP ABSREPTYP
 214   , provable REPABS REPABSTYP, provable PREPH PREPHTYP).
 215
 216check WHAT :-
 217 next_object WHAT C CONT,
 218 (C = stop, !, K = true ; check1 C H , check_hyps [] H, print_constraints, K = (H => check CONT)),
 219 !, K.
 220
 221}
 222
 223/************ parsing and pretty-printing ********/
 224% ppterm/parseterm
 225%ppterm X Y :- ppp X Y. parseterm X Y :- ppp X Y.
 226%ppp X Y :- var X, var Y, !, X = Y.
 227%ppp X (F # G) :- var X, (var F ; var G), !, X = (F # G).
 228%ppp X (F # G # H) :- var X, (var F ; var G ; var H), !,
 229% X = (F # G # H).
 230
 231mode (ppp o i) xas ppterm, (ppp i o) xas parseterm.
 232
 233ppp (! F2) (forall ## _ # lam _ F1) :- !, pi x \ ppp (F2 x) (F1 x).
 234ppp (! TY F2) (forall ## TY # lam TY F1) :- !, pi x \ ppp (F2 x) (F1 x).
 235ppp (? F2) (exists ## _ # lam _ F1) :- !, pi x \ ppp (F2 x) (F1 x).
 236ppp (? TY F2) (exists ## TY # lam TY F1) :- !, pi x \ ppp (F2 x) (F1 x).
 237ppp (F2 <=> G2) (eq ## prop # F1 # G1) :- !, ppp F2 F1, ppp G2 G1.
 238ppp (F2 = G2) (eq ## _ # F1 # G1) :- !, ppp F2 F1, ppp G2 G1.
 239ppp (F2 && G2) (and # F1 # G1) :- !, ppp F2 F1, ppp G2 G1.
 240ppp (F2 || G2) (or # F1 # G1) :- !, ppp F2 F1, ppp G2 G1.
 241ppp (F2 ==> G2) (impl # F1 # G1) :- !, ppp F2 F1, ppp G2 G1.
 242ppp (X2 #in S2) (in ## _ # X1 # S1) :- !, ppp X2 X1, ppp S2 S1.
 243ppp (U2 <<= V2) (subseteq ## _ # U1 # V1) :- !, ppp U2 U1, ppp V2 V1.
 244ppp (F2 + G2) (plus # F1 # G1) :- !, ppp F2 F1, ppp G2 G1.
 245ppp (F2 # G2) (F1 # G1) :- !, ppp F2 F1, ppp G2 G1.
 246ppp (lam A F2) (lam A F1) :- !, pi x \ ppp (F2 x) (F1 x).
 247ppp A A.
 248
 249/* safe_list_map that unifies the two lists if they are both flexible
 250   probably only useful for parsing/pretty-printing */
 251safe_list_map L1 _ L2 :- var L1, var L2, !, L1 = L2.
 252safe_list_map L1 F L2 :- list_map L1 F L2.
 253
 254% pptac(ppterm)/parsetac(parseterm)
 255% pptac X Y :- ppptac X Y.  parsetac X Y :- ppptac X Y.
 256
 257mode (ppptac i o) xas parsetac(ppp -> parseterm),
 258     (ppptac o i) xas pptac(ppp -> ppterm).
 259
 260ppptac daemon daemon.
 261ppptac r r.
 262ppptac (t Y) (t PY) :- ppp Y PY.
 263ppptac (m Y) (m PY) :- ppp Y PY.
 264ppptac b b.
 265ppptac c c.
 266ppptac k k.
 267ppptac s s.
 268ppptac (h Gamma) (h PGamma) :- safe_list_map Gamma ppp PGamma.
 269ppptac d d.
 270ppptac (th NAME) (th NAME).
 271ppptac (thenll TAC1 TACN) (thenll PTAC1 PTACN) :-
 272 ppptac TAC1 PTAC1, ppptac TACN PTACN.
 273ppptac (! TAC) (! PTAC) :- ppptac TAC PTAC.
 274ppptac id id.
 275ppptac (wl Gamma) (wl PGamma) :- safe_list_map Gamma ppp PGamma.
 276ppptac (bind A TAC) (bind PA PTAC) :-
 277 ppp A PA, pi x \ ppptac (TAC x) (PTAC x).
 278ppptac ww ww.
 279
 280/************ interactive and non interactive loops ********/
 281
 282ppptac interactive interactive.
 283
 284parse_obj (theorem NAME PSTTAC) [theorem NAME STTAC] :-
 285 parse_thm NAME PSTTAC STTAC.
 286parse_obj (axiom NAME PTYP) [axiom NAME TYP] :- parse_axiom PTYP TYP.
 287parse_obj (new_basic_type TYPE REP ABS REPABS ABSREP PREP PP_TACTICS)
 288 [new_basic_type TYPE REP ABS REPABS ABSREP PREP P_TACTICS] :- parse_nbt PP_TACTICS P_TACTICS.
 289parse_obj (def NAME PTYBO) [def NAME TYBO] :- parse_def PTYBO TYBO.
 290parse_obj (decl NAME TY) [decl NAME TY].
 291parse_obj (inductive_def PRED PREDF PREDF_MON PRED_I PRED_E0 PRED_E K) EXP :-
 292 inductive_def_pkg PRED PREDF PREDF_MON PRED_I PRED_E0 PRED_E K EXP.
 293parse_obj stop [stop].
 294
 295parse_def (pi I) (pi O) :- pi x \ parse_def (I x) (O x).
 296parse_def (TY,PB) (TY,B) :- parseterm PB B.
 297
 298parse_axiom (pi I) (pi O) :- !, pi x \ parse_axiom (I x) (O x).
 299parse_axiom PST ST :- parseterm PST ST.
 300
 301parse_thm NAME (pi I) (pi O) :- pi x \ parse_thm NAME (I x) (O x).
 302parse_thm _ (PST,TAC) (ST,(false,TAC)) :- !, parseterm PST ST.
 303parse_thm NAME PST (ST,(true,[_])) :-
 304 (not (proves NAME _) ; print "Error:" NAME already defined, fail),
 305 parseterm PST ST.
 306
 307parse_nbt (pi I) (pi O) :- !, pi x \ parse_nbt (I x) (O x).
 308parse_nbt (PP,TACTICS) (P,(false,TACTICS)) :- parseterm PP P.
 309parse_nbt PP (P,(true,[_])) :- parseterm PP P.
 310
 311next_object [ C | NEXT ] CT CONTNEXT :-
 312  parse_obj C [ CT | CONT ], append CONT NEXT CONTNEXT.
 313next_object [] C CONT :- 
 314 print "Welcome to HOL extra-light",
 315 toplevel_loop [ C | CONT ].
 316next_object toplevel C CONT :- toplevel_loop [ C | CONT ].
 317
 318read_cmd H :-
 319 print "Enter a command or \"stop.\"",
 320 flush std_out, $readterm std_in H,
 321 !.
 322read_cmd H :- read_cmd H.
 323
 324toplevel_loop G :-
 325 read_cmd H,
 326 ( H = stop, !, G = [stop]
 327 ; parse_obj H PH, !, (append PH toplevel G ; print "error", toplevel_loop G)
 328 ; print "bad command", toplevel_loop G ).
 329
 330callback_proved _ _ (false,_).
 331callback_proved NAME G (true, [ TAC ]) :-
 332 canonical TAC CANONICALTAC,
 333 pptac PCANONICALTAC CANONICALTAC,
 334 ppterm PG G,
 335 print (theorem NAME (PG , [ PCANONICALTAC ] )).
 336
 337end_of_proof (true, []) :- print "proof completed".
 338end_of_proof (false, []).
 339
 340next_tactic0 [ SEQ | OLD ] (true, [ _ | _ ]) ITAC :-
 341 print,
 342 list_iter_rev [ SEQ | OLD ] print_sequent,
 343 read_in_context SEQ ITAC BACKTRACK,
 344 BACKTRACK.
 345next_tactic0 SEQS (true, CERT) ITAC :-
 346 print "error",
 347 next_tactic SEQS (true, CERT) ITAC.
 348next_tactic0 SEQS (true_then_false, (_,INT_TACS,_)) ITAC :-
 349 next_tactic0 SEQS (true, INT_TACS) ITAC.
 350next_tactic0 SEQS (false, [ interactive | _ ]) ITAC :-
 351 next_tactic0 SEQS (true, [ _ ]) ITAC.
 352next_tactic0 [ SEQ | OLD ] (false, [ TAC | _ ]) TAC.
 353next_tactic0 _ (false, _) ITAC :-
 354 print "aborted",
 355 halt.
 356
 357next_tactic SEQS CERT TAC :- next_tactic0 SEQS CERT PTAC, parsetac PTAC TAC.
 358
 359update_certificate (true, [ TAC | OTHER_TACS ]) ITAC NEW (true, TACS) :-
 360 mk_script ITAC NEW NEW_TACS TAC,
 361 append NEW_TACS OTHER_TACS TACS.
 362update_certificate (false, [ interactive | NON_INTERACTIVE_TACS ]) ITAC NEW CERTIFICATE :-
 363 update_certificate (true_then_false, (SCRIPT, [ SCRIPT ], NON_INTERACTIVE_TACS)) ITAC NEW CERTIFICATE.
 364update_certificate (true_then_false, (SCRIPT,[ TAC | OTHER_TACS ],NON_INTERACTIVE_TACS)) ITAC NEW CERTIFICATE :- !,
 365 mk_script ITAC NEW NEW_INTERACTIVE_TACS TAC,
 366 append NEW_INTERACTIVE_TACS OTHER_TACS INTERACTIVE_TACS,
 367 ( INTERACTIVE_TACS = [ _ | _ ], !,
 368   CERTIFICATE =
 369    (true_then_false, (SCRIPT,INTERACTIVE_TACS,NON_INTERACTIVE_TACS))
 370 ; CERTIFICATE = (false, NON_INTERACTIVE_TACS),
 371   print "INTERACTIVE SUBPROOF COMPLETED",
 372   canonical SCRIPT CSCRIPT,
 373   pptac PSCRIPT CSCRIPT,
 374   print PSCRIPT).
 375update_certificate (false, [ _ | OTHER_TACS ]) _ _ (false, OTHER_TACS).
 376
 377mk_script (bind A T) NEW NEW_TACS (bind A T2) :- !,
 378 pi x \
 379  put_binds (NEW2 x) x A NEW,
 380  mk_script (T x) (NEW2 x) (NEWT x) (T2 x),
 381  put_binds (NEWT x) x A NEW_TACS.
 382mk_script ITAC NEW NEW_TACS (thenl ITAC NEW_TACS) :-
 383 mk_list_of_bounded_fresh NEW NEW_TACS.
 384
 385read_in_context (bind A K) (bind A TAC) BACKTRACK :-
 386 pi x \ /* term x A => reterm # x A => */ read_in_context (K x) (TAC x) BACKTRACK.
 387read_in_context (seq A B) TAC BACKTRACK :-
 388 flush std_out, $readterm std_in TAC,
 389 (TAC = backtrack, !, BACKTRACK = (!, fail) ; BACKTRACK = true).
 390
 391print_sequent (seq Gamma G) :-
 392 print,
 393 list_iter_rev Gamma (x \ sigma PX \ ppterm PX x, print PX),
 394 print "|------------------",
 395 ppterm PG G, print PG.
 396print_sequent (bind A F) :- pi x \ print_sequent (F x).
 397
 398/* turns thenl into then */
 399canonical (bind A T1) (bind A T2) :- !,
 400 pi x \ canonical (T1 x) (T2 x).
 401canonical (thenl T L) OTAC :- !,
 402 list_map L canonical L2,
 403 (mk_constant_list L2 S L2, !,
 404  (S = [], !, OTAC = T ; OTAC = then T S)
 405 ; OTAC = thenl T L2).
 406canonical T T.
 407
 408/************ inductive_def package ********/
 409parse_inductive_def_spec (pi F) (pi PF) :- !,
 410 pi A \ parse_inductive_def_spec (F A) (PF A).
 411parse_inductive_def_spec (param TY F) (param PTY PF) :- !,
 412 ppp TY PTY, pi x \ parse_inductive_def_spec (F x) (PF x).
 413parse_inductive_def_spec L PL :-
 414 (pi p \ list_map (L p)
 415  (x \ px \ sigma A \ sigma B \ sigma PB \ x = (A, B), parseterm B PB, px = (A, PB))
 416  (PL p)).
 417
 418build_quantified_predicate (pi I) (pi O) :- !,
 419 pi A \ build_quantified_predicate (I A) (O A).
 420build_quantified_predicate (param TY I) (TY --> TYP, lam TY BO) :- !,
 421 pi x \ build_quantified_predicate (I x) (TYP, BO x).
 422build_quantified_predicate L (_, lam _ p \ lam _ x \ P p x) :-
 423 pi p \ pi x \ build_predicate (L p) p x (P p x).
 424
 425build_predicate [ (_,K) ] P X R :- !,
 426 process_constructor K P X R.
 427build_predicate [ (_,K) | REST ] P X (or # Q # R) :-
 428 process_constructor K P X Q,
 429 build_predicate REST P X R.
 430
 431process_constructor (forall ## TY # lam TY Q) P X (exists ## TY # lam TY R) :-
 432 pi y \ process_constructor (Q y) P X (R y).
 433process_constructor (impl # H # K) P X (and # H # R) :-
 434 process_constructor K P X R.
 435process_constructor (P # T) P X (eq ## _ # X # T).
 436
 437prove_monotonicity_thm (pi F) PREDF APREDF (pi THM) :- !,
 438 pi A \ prove_monotonicity_thm (F A) PREDF (APREDF ## A) (THM A).
 439prove_monotonicity_thm (param TY F) PREDF APREDF (forall ## TY # lam TY STM, PROOF) :- !,
 440 pi x \ prove_monotonicity_thm (F x) PREDF (APREDF # x) (STM x, PROOF).
 441prove_monotonicity_thm _ PREDF APREDF THM :-
 442 THM =
 443  (monotone ## _ # APREDF,
 444   [ then inv (bind* (then (conv (depth_tac (dd [PREDF]))) auto_monotone)) ]).
 445
 446state_fixpoint_def (pi F) PREDF (pi DEF) :- !,
 447 pi A \ state_fixpoint_def (F A) (PREDF ## A) (DEF A).
 448state_fixpoint_def (param TY F) PREDF (_, lam TY BO) :- !,
 449 pi x \ state_fixpoint_def (F x) (PREDF # x) (_, BO x).
 450state_fixpoint_def _ PREDF (_, fixpoint ## _ # PREDF).
 451
 452prove_fix_intro_thm (pi F) PREDF PRED PREDF_MONOTONE (pi THM) :- !,
 453 pi A \ prove_fix_intro_thm (F A) (PREDF ## A) (PRED ## A) PREDF_MONOTONE (THM A).
 454prove_fix_intro_thm (param TY F) PREDF PRED PREDF_MONOTONE (forall ## TY # lam TY STM, [ then forall_i (bind _ PROOF) ]) :- !,
 455 pi x \ prove_fix_intro_thm (F x) (PREDF # x) (PRED # x) PREDF_MONOTONE (STM x, [ PROOF x ]).
 456prove_fix_intro_thm _ PREDF PRED PREDF_MONOTONE THM :-
 457 THM =
 458  ((! x \ PREDF # PRED # x ==> PRED # x),
 459   [then forall_i
 460     (bind _ x13 \
 461       then (conv (rand_tac (rator_tac dd)))
 462        (then (conv (land_tac (rator_tac (rand_tac dd))))
 463          (then inv
 464            (then (cutth fixpoint_is_prefixpoint)
 465              (then (lforall PREDF)
 466                (thenl lapply [applyth PREDF_MONOTONE,
 467                  then
 468                   (g
 469                     (subseteq ## _ '
 470                       (PREDF # (fixpoint ## _ # PREDF)) '
 471                       (fixpoint ## _ # PREDF)))
 472                   (then (conv (depth_tac (dd [subseteq])))
 473                     (then (conv (depth_tac (dd [in])))
 474                       (then (conv (depth_tac (dd [in])))(itaut 4))))]))))))]).
 475
 476prove_fix_elim_thm (pi F) PREDF PRED OPRED (pi THM) :- !,
 477 pi A \ prove_fix_elim_thm (F A) (PREDF ## A) (PRED ## A) OPRED (THM A).
 478prove_fix_elim_thm (param TY F) PREDF PRED OPRED (forall ## TY # lam TY STM, [ then forall_i (bind _ PROOF) ]) :- !,
 479 pi x \ prove_fix_elim_thm (F x) (PREDF # x) (PRED # x) OPRED (STM x, [ PROOF x ]).
 480prove_fix_elim_thm _ PREDF PRED OPRED THM :-
 481 THM =
 482  ((! x13 \
 483     (! x14 \ PREDF # x13 # x14 ==> x13 # x14) ==>
 484      (! x14 \ PRED # x14 ==> x13 # x14)) ,
 485    [then forall_i
 486      (bind _ x23 \
 487        then (cutth fixpoint_subseteq_any_prefixpoint)
 488         (then (lforall PREDF)
 489           (then (lforall x23)
 490             (then (conv (depth_tac (dd [OPRED])))
 491               (then inv
 492                 (bind _ x24 \
 493                   then
 494                    (g
 495                      (impl # (subseteq ## _ # (PREDF # x23) # x23) '
 496                        (subseteq ## _ # (fixpoint ## _ # PREDF) # x23)))
 497                    (then (conv (depth_tac (dd [subseteq])))
 498                      (then (conv (depth_tac (dd [subseteq])))
 499                        (then (conv (depth_tac (dd [in])))
 500                          (then (conv (depth_tac (dd [in])))
 501                            (then (conv (depth_tac (dd [in])))
 502                              (then (conv (depth_tac (dd [in])))
 503                                (then
 504                                  (w
 505                                    (impl '
 506                                      (subseteq ## _ # (PREDF # x23) # x23) '
 507                                      (subseteq ## _ '
 508                                        (fixpoint ## _ # PREDF) # x23)))
 509                                  (then inv
 510                                    (thenl lapply_last [h,
 511                                      then (lforall_last x24)
 512                                       (then lapply_last h)])))))))))))))))]).
 513
 514prove_intro_thms (pi F) PRED PRED_I INTROTHMS :- !,
 515 pi A \
 516  prove_intro_thms (F A) (PRED ## A) PRED_I (OUT A),
 517  list_map (OUT A)
 518   (i \ o \ sigma Y \ i = (theorem NAME (P A)), o = theorem NAME (pi P))
 519   INTROTHMS.
 520prove_intro_thms (param TY F) PRED PRED_I INTROTHMS :- !,
 521 pi x \
 522  prove_intro_thms (F x) (PRED # x) PRED_I (OUT x),
 523  list_map (OUT x)
 524   (i \ o \ sigma Y \
 525     i = (theorem NAME (STM x, [ PROOF x ])),
 526     o = theorem NAME (forall ## TY # lam TY STM, [ then forall_i (bind TY PROOF) ]))
 527   INTROTHMS.
 528prove_intro_thms L PRED PRED_I INTROTHMS :-
 529 list_map (L PRED) (mk_intro_thm PRED_I) INTROTHMS.
 530
 531mk_intro_thm PRED_I (NAME,ST)
 532 (theorem NAME (ST,
 533   [ daemon /*(then inv (bind* (then (applyth PRED_I) (then (conv dd) (itauteq 6)))))*/ /* TOO MANY GOALS DELAYED ON typ (?): USE daemon INSTEAD */ ])).
 534
 535inductive_def_pkg PRED PREDF PREDF_MONOTONE PRED_I PRED_E0 PRED_E L OUT :-
 536 parse_inductive_def_spec L PL,
 537 build_quantified_predicate PL F,
 538 prove_monotonicity_thm PL PREDF PREDF MONTHM,
 539 state_fixpoint_def PL PREDF FIXDEF,
 540 prove_fix_intro_thm PL PREDF PRED PREDF_MONOTONE INTROTHM,
 541 prove_intro_thms PL PRED PRED_I INTROTHMS,
 542 prove_fix_elim_thm PL PREDF PRED PRED ELIMTHM,
 543 OUT1 =
 544  [ def PREDF F
 545  , theorem PREDF_MONOTONE MONTHM
 546  , def PRED FIXDEF
 547  , theorem PRED_I INTROTHM
 548  , theorem PRED_E0 ELIMTHM ],
 549 append OUT1 INTROTHMS OUT.
 550
 551/************ library of basic data types ********/
 552mk_bounded_fresh (bind _ F) (bind _ G) :- !, pi x\ mk_bounded_fresh (F x) (G x).
 553mk_bounded_fresh _ X.
 554
 555mk_list_of_bounded_fresh [] [].
 556mk_list_of_bounded_fresh [S|L] [X|R] :-
 557 mk_bounded_fresh S X, mk_list_of_bounded_fresh L R.
 558
 559/* list functions */
 560
 561list_map [] _ [].
 562list_map [X|XS] F [Y|YS] :- F X Y, list_map XS F YS.
 563
 564list_iter_rev [] _.
 565list_iter_rev [X|XS] F :- list_iter_rev XS F, F X.
 566
 567mem [ X | _ ] X, !.
 568mem [ _ | XS ] X :- mem XS X.
 569
 570mk_constant_list [] _ [].
 571mk_constant_list [_|L] X [X|R] :- mk_constant_list L X R.
 572
 573bang P :- P, !.
 574
 575/********** tacticals ********/
 576
 577% BUG in runtime.ml if the sigma is uncommented out. It does not matter btw.
 578/*sigma ff \*/ deftac fail SEQ ff.
 579
 580ppptac (constant_tacl TACL) (constant_tacl PTACL) :-
 581 list_map TACL ppptac PTACL.
 582deftacl (constant_tacl TACL) SEQS TACL.
 583
 584ppptac (thenl TAC TACL) (thenl PTAC PTACL) :-
 585 ppptac TAC PTAC, list_map TACL ppptac PTACL. 
 586deftac (thenl TAC TACL) SEQ XTAC :-
 587 XTAC = thenll TAC (constant_tacl TACL).
 588
 589ppptac (all_equals_list TAC) (all_equals_list PTAC) :- ppptac TAC PTAC.
 590deftacl (all_equals_list TAC2) SEQS TACL :-
 591 mk_constant_list SEQS TAC2 TACL.
 592
 593ppptac (then TAC1 TAC2) (then PTAC1 PTAC2) :-
 594 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 595deftac (then TAC1 TAC2) SEQ XTAC :-
 596 XTAC = thenll TAC1 (all_equals_list TAC2).
 597
 598ppptac (then! TAC1 TAC2) (then! PTAC1 PTAC2) :-
 599 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 600deftac (then! TAC1 TAC2) _ (then (! TAC1) TAC2).
 601
 602ppptac (orelse TAC1 TAC2) (orelse PTAC1 PTAC2) :-
 603 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 604deftac (orelse TAC1 TAC2) SEQ XTAC :-
 605 XTAC = TAC1 ; XTAC = TAC2.
 606
 607ppptac (orelse! TAC1 TAC2) (orelse! PTAC1 PTAC2) :-
 608 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 609deftac (orelse! TAC1 TAC2) _ (orelse (! TAC1) TAC2).
 610
 611ppptac (bind* TAC) (bind* PTAC) :- ppptac TAC PTAC.
 612deftac (bind* TAC) SEQ (orelse! (bind _ x \ bind* TAC) TAC).
 613
 614ppptac (repeat TAC) (repeat PTAC) :- ppptac TAC PTAC.
 615deftac (repeat TAC) SEQ XTAC :-
 616 ( XTAC = then TAC (repeat (bind* TAC))
 617 ; XTAC = id).
 618
 619ppptac (repeat! TAC) (repeat! PTAC) :- ppptac TAC PTAC.
 620deftac (repeat! TAC) SEQ (orelse! (then! TAC (repeat! (bind* TAC))) id).
 621
 622ppptac (pptac TAC) (pptac PTAC) :- ppptac TAC PTAC.
 623deftac (pptac TAC) SEQ TAC :-
 624 print "SEQ" SEQ ":=" TAC.
 625
 626ppptac (time TAC) (time PTAC) :- ppptac TAC PTAC.
 627deftac (time TAC) SEQ XTAC :-
 628 $gettimeofday B,
 629 XTAC = thenll TAC (time_after TAC B).
 630
 631ppptac (time_after TAC B) (time_after PTAC B) :- ppptac TAC PTAC.
 632deftacl (time_after TAC B) SEQS TACL :-
 633 $gettimeofday A,
 634 D is A - B,
 635 mk_constant_list SEQS id TACL,
 636 print "TIME SPENT " D "FOR" TAC.
 637
 638/* For debugging only (?) For capturing metavariables */
 639ppptac (inspect (seq Gamma F) TAC) (inspect (seq PGamma PF) PTAC) :-
 640 list_map SEQ ppp PSEQ, ppp F PF, ppptac TAC PTAC.
 641deftac (inspect SEQ TAC) SEQ TAC.
 642
 643/********** tactics ********/
 644
 645ppptac (w G) (w PG) :- ppp G PG.
 646deftac (w G) (seq Gamma _) (wl Gamma1) :-
 647 append Gamma1 [ G | _ ] Gamma.
 648
 649ppptac h h.
 650deftac h SEQ (h L).
 651
 652/*** eq ***/
 653
 654ppptac sym sym.
 655deftac sym (seq Gamma (eq ## T # L # R)) TAC :-
 656 TAC = thenl (m (eq ## T # R # R)) [ thenl c [ thenl c [ r , id ] , r ] , r ].
 657
 658ppptac eq_true_intro eq_true_intro.
 659deftac eq_true_intro (seq Gamma (eq ## prop # P # tt)) TAC :-
 660 TAC = thenl s [ th tt_intro, wl [] ].
 661
 662/*** true ***/
 663
 664/*** and ***/
 665
 666ppptac conj conj.
 667deftac conj (seq Gamma (and # P # Q)) TAC :-
 668 TAC =
 669  then
 670   (then (conv dd)
 671     (then k (bind _ x \
 672       thenl c
 673        [ thenl c [ r, eq_true_intro ] ,
 674          eq_true_intro ])))
 675   ww.
 676
 677/* Gamma  "|-"  q    --->   Gamma "|-" and # p # q*/
 678ppptac (andr P) (andr PP) :- ppp P PP.
 679deftac (andr P) (seq Gamma Q) TAC :-
 680 TAC =
 681  (thenl (m ((lam _ f \ f # P # Q) # (lam _ x \ lam _ y \ y)))
 682    [ then
 683       %(repeat (conv (depth_tac b))) ROBUS VERSION LINE BELOW
 684       (then (conv (land_tac b)) (then (conv (land_tac (rator_tac b))) (conv (land_tac b))))
 685      r
 686    , thenl (conv (rator_tac id))
 687       [ then (thenl (t (lam _ f \ f # tt # tt)) [ id, r ])
 688          (thenl (m (and # P # Q)) [ dd , id ])
 689       , then (repeat (conv (depth_tac b))) (th tt_intro) ]]).
 690
 691/* (and # p # q) :: nil  "|-"  q */
 692ppptac andr andr.
 693deftac andr (seq Gamma Q) TAC :-
 694 mem Gamma (and # P # Q),
 695 TAC = then (andr P) h.
 696
 697/* Gamma  "|-"  p    --->   Gamma "|-" and # p # q*/
 698ppptac (andl P) (andl PP) :- ppp P PP.
 699deftac (andl Q) (seq Gamma P) TAC :-
 700 TAC =
 701  (thenl (m ((lam _ f \ f # P # Q) # (lam _ x \ lam _ y \ x)))
 702    [ then
 703       %(repeat (conv (depth_tac b))) ROBUS VERSION LINE BELOW
 704       (then (conv (land_tac b)) (then (conv (land_tac (rator_tac b))) (conv (land_tac b))))
 705      r
 706    , thenl (conv (rator_tac id))
 707       [ then (thenl (t (lam _ f \ f # tt # tt)) [ id, r ])
 708          (thenl (m (and # P # Q)) [ dd , id ])
 709       , then (repeat (conv (depth_tac b))) (th tt_intro) ]]).
 710
 711/* (and # p # q) :: nil  "|-"  p */
 712ppptac andl andl.
 713deftac andl (seq Gamma P) TAC :-
 714 mem Gamma (and # P # Q),
 715 TAC = then (andl Q) h.
 716
 717
 718/*** forall ***/
 719
 720/* |- forall # F  -->   |- F # x */
 721ppptac forall_i forall_i.
 722deftac forall_i (seq Gamma (forall ## _ # lam _ G)) TAC :-
 723 TAC = then (conv dd) (then k (bind _ x \ eq_true_intro)).
 724
 725/* forall # F |- F # T */
 726ppptac forall_e forall_e.
 727deftac forall_e (seq Gamma GX) TAC :-
 728 mem Gamma (forall ## _ # (lam _ G)), GX = G X,
 729 TAC = thenl (m ((lam _ G) # X)) [ b, thenl (m ((lam _ z \ tt) # X))
 730  [ thenl c [ then sym (thenl (m (forall ## _ # lam _ G)) [dd,h ]), r ]
 731  , then (conv b) (th tt_intro) ] ].
 732
 733/* forall # F |- f  -->  F # a, forall # F |- f */
 734ppptac (lforall F A) (lforall PF PA) :- ppp F PF, ppp A PA.
 735deftac (lforall F A) (seq Gamma G) TAC :-
 736 TAC = thenl (m (impl # (F A) # G))
 737  [ thenl s [ then mp forall_e, then i h ] , then (w (forall ## _ # lam _ F)) i ].
 738
 739/* forall # F |- f  -->  F # a, forall # F |- f */
 740ppptac (lforall A) (lforall PA) :- ppp A PA.
 741deftac (lforall A) (seq Gamma G) (lforall F A) :-
 742 mem Gamma (forall ## _ # lam _ F).
 743
 744/* forall # F |- f  -->  F # a, forall # F |- f */
 745ppptac lforall lforall.
 746deftac lforall (seq Gamma G) (lforall A).
 747
 748/* forall # F |- f  -->  F # a, forall # F |- f */
 749ppptac (lforall_last A) (lforall_last PA) :- ppp A PA.
 750deftac (lforall_last A) (seq ((forall ## _ # lam _ F)::Gamma) G) (lforall F A).
 751
 752/*** false ***/
 753              
 754/*** impl ***/
 755
 756/* |- p=>q  -->  p |- q */
 757ppptac i i.
 758deftac i (seq Gamma (impl # P # Q)) TAC :-
 759 TAC = then (conv dd) (thenl s [ andl, thenl conj [ h [], id ]]).
 760
 761/* p=>q |- q  -->  |- p */
 762ppptac (mp P) (mp PP) :- ppp P PP.
 763deftac (mp P) (seq Gamma Q) TAC :-
 764 TAC = then (andr P) (thenl (m P) [ then sym (thenl (m (impl # P # Q)) [ dd , h ]) , id ]).
 765
 766/* p=>q |- q  -->  |- p */
 767ppptac mp mp.
 768deftac mp (seq Gamma Q) (mp P) :-
 769 mem Gamma (impl # P # Q).
 770
 771/* |- q   -->   p |- q  and  |- p */
 772ppptac (cut P) (cut PP) :- ppp P PP.
 773deftac (cut P) (seq Gamma Q) TAC :-
 774 TAC = then (andr P) (thenl (m P) [then sym (thenl (m (impl # P # Q)) [then (conv (land_tac dd)) r, i] ) , id]). 
 775
 776/* |-q  --> p |- q   where the theorem T proves p */
 777ppptac (cutth P) (cutth PP) :- ppp P PP.
 778deftac (cutth T) SEQ TAC :-
 779 proves T X,
 780 TAC = (thenl (cut X) [ id, th T ]).
 781
 782/* applies the theorem T */
 783ppptac (applyth P) (applyth PP) :- ppp P PP.
 784deftac (applyth T) SEQ (then (cutth T) apply_last).
 785
 786/* impl p q, Gamma |- f   --->   /*impl q f*/ Gamma |- p  ,  q, Gamma |- f */
 787ppptac (lapply P Q) (lapply PP PQ) :- ppp P PP, ppp Q PQ.
 788deftac (lapply P Q) (seq Gamma F) TAC :-
 789 TAC =
 790  thenl (m (impl # Q # F)) [ thenl s [ then (mp Q) (then (w (impl # Q # F)) (then (mp P) (w (impl # P # Q)))) , then i (h [A]) ] , then (w (impl # P # Q)) (then i id) ].
 791
 792/* impl p q, Gamma |- f   --->   /*impl q f*/ Gamma |- p  ,  q, Gamma |- f */
 793ppptac lapply lapply.
 794deftac lapply (seq Gamma F) (lapply P Q) :-
 795 mem Gamma (impl # P # Q).
 796
 797/* impl p q, Gamma |- f   --->   /*impl q f*/ Gamma |- p  ,  q, Gamma |- f */
 798ppptac lapply_last lapply_last.
 799deftac lapply_last (seq ((impl # P # Q)::Gamma) F) (lapply P Q).
 800
 801/* p |- f ---> p |- p ==> f */
 802ppptac (g P) (g PP) :- ppp P PP.
 803deftac (g P) (seq _ F) TAC :-
 804 TAC =
 805  (thenl (m (impl # P # F)) [thenl s [then mp h , then i h] , id ]).
 806
 807/*** not ***/
 808
 809/*** exists ***/
 810
 811/**** apply, i.e. forall + impl ****/
 812
 813ppptac (apply X) (apply PX) :- ppp X PX.
 814deftac (apply X) SEQ h :- var X, !.
 815deftac (apply X) SEQ h.
 816deftac (apply (impl # P # Q)) SEQ TAC :-
 817 TAC = thenl (lapply P Q) [ id, apply_last ].
 818deftac (apply (forall ## _ # lam _ G)) SEQ TAC :-
 819 TAC = then (lforall G X) apply_last.
 820
 821ppptac apply_last apply_last.
 822deftac apply_last (seq (H::Gamma) F) (apply H).
 823
 824ppptac apply apply.
 825deftac apply (seq Gamma F) (apply H) :-
 826 mem Gamma H.
 827
 828/********** conversion(als) ***********/
 829
 830strip_constant (I ## _) H :- !, strip_constant I H.
 831strip_constant H H.
 832
 833/* expands definitions, even if applied to arguments */
 834ppptac (dd L) (dd L).
 835deftac (dd L) (seq _ (eq ## _ # T # X)) d :- strip_constant T H, bang (mem L H).
 836deftac (dd L) (seq _ (eq ## _ # (D # T) # X))
 837 (thenl (t A) [thenl c [dd L , r], b]).
 838
 839ppptac dd dd.
 840deftac dd _ (dd L).
 841
 842ppptac beta_expand beta_expand.
 843deftac beta_expand (seq _ (eq ## _ # (lam _ x \ F x) # (lam _ x \ (lam _ F) # x))) TAC :-
 844 TAC = then k (bind _ x \ then sym b).
 845
 846/* folds a definition, even if applied to arguments */
 847/* BUG: it seems to fail with restriction errors in some cases */
 848ppptac f f.
 849deftac f SEQ (then sym dd).
 850
 851ppptac (rand_tac C) (rand_tac PC) :- ppptac C PC.
 852deftac (rand_tac C) SEQ TAC :-
 853  TAC = thenl c [ r , C ].
 854
 855ppptac (rator_tac C) (rator_tac PC) :- ppptac C PC.
 856deftac (rator_tac C) SEQ TAC :-
 857  TAC = thenl c [ C , r ].
 858
 859ppptac (abs_tac C) (abs_tac PC) :- ppptac C PC.
 860deftac (abs_tac C) SEQ TAC :-
 861  TAC = then k (bind A x \ C).
 862
 863ppptac (land_tac C) (land_tac PC) :- ppptac C PC.
 864deftac (land_tac C) SEQ TAC :-
 865  TAC = thenl c [ thenl c [ r, C ] , r ].
 866
 867ppptac (sub_tac C) (sub_tac PC) :- ppptac C PC.
 868deftac (sub_tac C) SEQ TAC :-
 869  TAC = orelse (rand_tac C) (orelse (rator_tac C) (abs_tac C)).
 870
 871ppptac (try TAC) (try PTAC) :- ppptac TAC PTAC.
 872deftac (try TAC) SEQ (orelse TAC id).
 873
 874ppptac (depth_tac C) (depth_tac PC) :- ppptac C PC.
 875deftac (depth_tac C) SEQ TAC :-
 876  TAC = then (try C) (sub_tac (depth_tac C)).
 877
 878ppptac (conv C) (conv PC) :- ppptac C PC.
 879deftac (conv C) (seq Gamma F) TAC :-
 880 TAC = thenl (m G) [ then sym C , id ].
 881
 882/********** Automation ***********/
 883/* TODO:
 884 1) our lforall gets rid of the hypothesis (bad) */
 885/* left tries to reduce the search space via focusing */
 886ppptac left left.
 887deftac left (seq Gamma _) TAC :-
 888 mem Gamma (not # F),
 889 TAC =
 890  (!
 891   (then (cutth not_e)
 892    (then (lforall_last F)
 893     (thenl lapply [ h, (w (not # F)) ])))).
 894deftac left (seq Gamma _) TAC :-
 895 /* A bit long because we want to beta-reduce the produced hypothesis.
 896    Maybe this should be automatized somewhere else. */
 897 mem Gamma (exists ## _ # F),
 898 TAC =
 899  (!
 900   (then (cutth exists_e)
 901    (then (lforall_last F)
 902     (thenl lapply [ h, then (w (exists ## _ # F)) (then apply_last (then forall_i (bind _ x \ then (try (conv (land_tac b))) i))) ])))).
 903deftac left (seq Gamma H) TAC :-
 904 mem Gamma (or # F # G),
 905 TAC =
 906  (!
 907   (then (cutth or_e)
 908    (then (lforall_last F)
 909     (then (lforall_last G)
 910      (then (lforall_last H)
 911       (thenl lapply [ h, then (w (or # F # G)) (then apply_last i)])))))).
 912deftac left (seq Gamma H) TAC :-
 913 mem Gamma (and # F # G),
 914 TAC =
 915  (!
 916   (then (cutth and_e)
 917    (then (lforall_last F)
 918     (then (lforall_last G)
 919      (then (lforall_last H)
 920       (thenl lapply [ h, then (w (and # F # G)) (then apply_last (then i i))])))))).
 921deftac left (seq Gamma H) TAC :-
 922 mem Gamma (eq ## TY # F # G),
 923 not (var TY), TY = prop,
 924 TAC =
 925  (then (g (eq ## TY # F # G))
 926   (then (conv (land_tac (then (applyth eq_to_impl) h)))
 927     (then i (w (eq ## TY # F # G))))).
 928
 929ppptac not_i not_i.
 930deftac not_i (seq _ (not # _)) (applyth not_i).
 931
 932ppptac inv inv.
 933deftac inv _ TAC :-
 934 TAC =
 935 (then!
 936  (repeat!
 937   (orelse! conj (orelse! forall_i (orelse! i (orelse! not_i s)))))
 938  (bind* (repeat! left))).
 939
 940ppptac (sync N) (sync N).
 941deftac (sync N) (seq _ tt) (th tt_intro).
 942deftac (sync N) (seq Gamma _) (then (applyth ff_elim) h) :-
 943 mem Gamma ff.
 944deftac (sync N) (seq _ (or # _ # _))
 945 (orelse (then (applyth orr) (itaut N)) (then (applyth orl) (itaut N))).
 946deftac (sync N) (seq _ (exists ## _ # _)) (then (applyth exists_i) (then (conv b) (itaut N2))) :-
 947 N2 is N - 2.
 948
 949ppptac (itaut N) (itaut N).
 950deftac (itaut N) SEQ fail :- N =< 0, !.
 951deftac (itaut N) SEQ TAC :-
 952 %print (itaut N) SEQ,
 953 N1 is N - 1,
 954 N2 is N - 2,
 955 TAC =
 956 (then! inv
 957  (bind*
 958   (orelse h
 959   (orelse (sync N)
 960   (orelse /* Hypothesis not moved to front */ (then lforall (itaut N2))
 961   (then lapply (itaut N1))))))).
 962
 963ppptac (itauteq N) (itauteq N).
 964deftac (itauteq N) _ (then (cutth eq_reflexive) (itaut N)).
 965
 966/********** inductive predicates package ********/
 967
 968ppptac monotone monotone.
 969deftac monotone (seq _ (impl # X # X)) (! (then i h)) :- !.
 970deftac monotone (seq [forall ## _ # lam _ x \ impl # (F # x) # (G # x)] (impl # (F # T) # (G # T))) (! apply) :- !.
 971deftac monotone (seq _ (impl # (and # _ # _) # _)) TAC :-
 972 TAC = then (applyth and_monotone) monotone.
 973deftac monotone (seq _ (impl # (or # _ # _) # _)) TAC :-
 974 TAC = then (applyth or_monotone) monotone.
 975deftac monotone (seq _ (impl # (impl # _ # _) # _)) TAC :-
 976 TAC = then (applyth impl_monotone) monotone.
 977deftac monotone (seq _ (impl # (not # _) # _)) TAC :-
 978 TAC = then (applyth not_monotone) monotone.
 979deftac monotone (seq _ (impl # (forall ## _ # lam _ _) # _)) TAC :-
 980 TAC =
 981  then (conv (land_tac (rand_tac beta_expand)))
 982   (then (conv (rand_tac (rand_tac beta_expand)))
 983     (then (applyth forall_monotone) (then forall_i (bind _ x \
 984       then (conv (depth_tac b)) (then (conv (depth_tac b)) monotone))))).
 985deftac monotone (seq _ (impl # (exists ## _ # lam _ _) # _)) TAC :-
 986 TAC =
 987  then (conv (land_tac (rand_tac beta_expand)))
 988   (then (conv (rand_tac (rand_tac beta_expand)))
 989     (then (applyth exists_monotone) (then forall_i (bind _ x \
 990       then (conv (depth_tac b)) (then (conv (depth_tac b)) monotone))))).
 991
 992/* expands "monotone # (lam _ f \ lam _ x \ X f x)" into
 993   "! x \ p # x ==> q # x |- X p y ==> X q y"
 994   and then calls the monotone tactic */
 995ppptac auto_monotone auto_monotone.
 996deftac auto_monotone _ TAC :-
 997 TAC =
 998  then (conv dd)
 999   (then forall_i (bind _ p \ (then forall_i (bind _ q \
1000     then (conv (land_tac dd))
1001      (then (conv (land_tac (depth_tac (dd [in]))))
1002        (then (conv (land_tac (depth_tac (dd [in]))))
1003          (then i
1004            (then (conv dd)
1005              (then forall_i (bind _ x \
1006                (then (conv (land_tac dd))
1007                  (then (conv (rand_tac dd))
1008                    (then (conv (land_tac (rator_tac b)))
1009                      (then (conv (land_tac b))
1010                        (then (conv (rand_tac (rator_tac b)))
1011                          (then (conv (rand_tac b))
1012                            monotone)))))))))))))))).
1013
1014/********** the library ********/
1015
1016main :- the_library L, append L [stop] Lstop, check Lstop.
1017
1018go :- the_library L, check L.
1019
1020the_library L :-
1021 L =
1022  [ /******** Primivite operators hard-coded in the kernel ******/
1023  % decl eq (pi A \ A --> A --> prop)
1024
1025  /********** Axiomatization of choice over types ********/
1026    decl choose (pi A \ A)
1027
1028  /*********** Connectives and quantifiers ********/
1029  , def tt (prop,((lam prop x \ x) = (lam prop x \ x)))
1030  , def forall (pi A \ ((A --> prop) --> prop),
1031     (lam (A --> prop) f \ f = (lam A g \ tt)))
1032  , def ff (prop,(! x \ x))
1033  , def and ((prop --> prop --> prop),
1034     (lam _ x \ lam _ y \ (lam (prop --> prop --> prop) f \ f # x # y) = (lam _ f \ f # tt # tt)))
1035  , def impl ((prop --> prop --> prop),(lam _ a \ lam _ b \ a && b <=> a))
1036  , def exists (pi A \ ((A --> prop) --> prop),
1037     (lam (A --> prop) f \ ! c \ (! a \ f # a ==> c) ==> c))
1038  , def not ((prop --> prop),(lam _ x \ x ==> ff))
1039  , def or ((prop --> prop --> prop),
1040     (lam _ x \ lam _ y \ ! c \ (x ==> c) ==> (y ==> c) ==> c))
1041  , theorem tt_intro (tt,[then (conv dd) (then k (bind _ x12 \ r))])
1042  , theorem ff_elim ((! p \ ff ==> p),
1043    [then forall_i (bind prop x3\ then (conv (land_tac dd)) (then i forall_e))])
1044  , theorem sym ((! p \ ! q \ p = q ==> q = p),
1045    [then forall_i
1046     (bind prop x12 \
1047       then forall_i
1048        (bind prop x13 \
1049          then i (then sym h)))])
1050  , theorem not_e ((! p \ not # p ==> p ==> ff),
1051     [then forall_i (bind prop x3 \ then (conv (land_tac dd)) (then i h))])
1052  , theorem conj ((! p \ ! q \ p ==> q ==> p && q),
1053    [then forall_i
1054     (bind prop x12 \
1055      then forall_i (bind prop x13 \ then i (then i (then conj h))))])
1056  , theorem andl ((! p \ ! q \ p && q ==> p),
1057    [then forall_i
1058     (bind prop x12 \
1059      then forall_i (bind prop x13 \ then i (then (andl x13) h)))])
1060  , theorem andr ((! p \ ! q \ p && q ==> q),
1061    [then forall_i
1062     (bind prop x12 \
1063      then forall_i (bind prop x13 \ then i (then (andr x12) h)))])
1064  , theorem and_e ((! p \ ! q \ ! c \ p && q ==> (p ==> q ==> c) ==> c),
1065     [then forall_i
1066       (bind prop x12 \
1067         then forall_i
1068          (bind prop x13 \
1069            then forall_i
1070             (bind prop x14 \ then i (then i (thenl apply [andl, andr])))))])
1071  , theorem not_i ((! p \ (p ==> ff) ==> not # p),
1072     [then forall_i (bind prop x2 \ then i (then (conv dd) h))])
1073  , theorem orl ((! p \ ! q \ p ==> p || q),
1074      [then forall_i
1075        (bind prop x12 \
1076          then forall_i
1077           (bind prop x13 \
1078             then i
1079              (then (conv dd)
1080                (then forall_i (bind prop x14 \ then i (then i (then apply h)))))))])
1081  , theorem orr ((! p \ ! q \ q ==> p || q),
1082      [then forall_i
1083        (bind prop x12 \
1084          then forall_i
1085           (bind prop x13 \
1086             then i
1087              (then (conv dd)
1088                (then forall_i (bind prop x14 \ then i (then i (then apply h)))))))])
1089  , theorem or_e ((! p \ ! q \ ! c \ p || q ==> (p ==> c) ==> (q ==> c) ==> c),
1090     [then forall_i
1091       (bind prop x12 \
1092         then forall_i
1093          (bind prop x13 \
1094            then forall_i
1095             (bind prop x14 \ then (conv (land_tac dd)) (then i forall_e))))])
1096  , theorem exists_e (pi T \
1097     (! f \ (exists ## T # f) ==> (! c \ (! x \ f # x ==> c) ==> c)),
1098     [then forall_i (bind (T --> prop) x12 \ then (conv (land_tac dd)) (then i h))])
1099 , theorem exists_i (pi T \ (! f \ ! w \ f # w ==> (exists ## T # f)),
1100    [then forall_i
1101     (bind (T --> prop) x12 \
1102       then forall_i
1103        (bind T x13 \
1104          then i
1105           (then (conv dd)
1106             (then forall_i
1107               (bind prop x14 \ then i (then (lforall x13) (then apply h)))))))])
1108  , theorem eq_to_impl
1109     ((! x13 \ ! x14 \ (x13 = x14) = ((x13 ==> x14) && (x14 ==> x13))),
1110     [thenl inv [(bind prop x13 \ bind prop x14 \ then (conv (then sym h)) h),
1111       (bind prop x13 \ bind prop x14 \ then (conv h) h),
1112       (bind prop x13 \ bind prop x14 \ itaut 2),
1113       (bind prop x13 \ bind prop x14 \ itaut 2)]])
1114
1115 /*********** Axiomatization of disjoint union ********/
1116  , decl inj1_disj_union (pi A \pi B \ A --> disj_union ## A ## B)
1117  , decl inj2_disj_union (pi A \ pi B \ B --> disj_union ## A ## B)
1118  , decl case_disj_union (pi A \pi B \ pi C \ disj_union ## A ## B --> (A --> C) --> (B --> C) --> C)
1119  , axiom case_disj_union_inj1 (pi A \ pi B \ pi C \ (! b \ ! (A --> C) e1 \ ! (B --> C) e2  \
1120    case_disj_union ## A ## B ## C # (inj1_disj_union ## A ## B # b) # e1 # e2 = e1 # b))
1121  , axiom case_disj_union_inj2 (pi A \ pi B \ pi C \ (! b \ ! (A --> C) e1 \ ! (B --> C) e2  \
1122    case_disj_union ## A ## B ## C # (inj2_disj_union ## A ## B # b) # e1 # e2 = e2 # b))
1123
1124 /*********** Axiomatization of the universe ********/
1125 , decl injection_univ (pi A \pi B \ A --> univ ## A ## B)
1126 , decl ejection_univ (pi A \pi B \ univ ## A ## B --> A)
1127 , decl inject_limit_univ (pi A \pi B \ (B --> univ ## A ## B) --> univ ## A ## B)
1128 , decl eject_limit_univ (pi A \ pi B \ univ ## A ## B --> (B --> univ ## A ## B))
1129 , decl pair_univ (pi A \pi B \ univ ## A ## B --> univ ## A ## B --> univ ## A ## B)
1130 , decl proj1_univ (pi A \ pi B \ univ ## A ## B --> univ ## A ## B)
1131 , decl proj2_univ (pi A \pi B \ univ ## A ## B --> univ ## A ## B)
1132 , decl inj1_univ (pi A \pi B \ univ ## A ## B --> univ ## A ## B)
1133 , decl inj2_univ (pi A \pi B \ univ ## A ## B --> univ ## A ## B)
1134 , decl case_univ (pi A \pi B \ pi C \ univ ## A ## B --> (univ ## A ## B --> C) --> (univ ## A ## B --> C) --> C)
1135 , axiom ejection_injection_univ (pi A \ pi B \
1136    ! A p \ ejection_univ ## A ## B # (injection_univ ## A ## B # p) = p)
1137 , axiom eject_inject_limit_univ (pi A \ pi B \
1138    ! (B --> univ ## A ## B) p \ eject_limit_univ ## A ## B # (inject_limit_univ ## A ## B # p) = p)
1139 , axiom proj1_pair_univ (pi A \ pi B \ ! (univ ## A ## B) p1 \ ! p2 \
1140    proj1_univ ## A ## B # (pair_univ ## A ## B # p1 # p2) = p1)
1141 , axiom proj2_pair_univ (pi A \ pi B \ ! p1 \ ! (univ ## A ## B) p2 \
1142    proj2_univ ## A ## B # (pair_univ ## A ## B # p1 # p2) = p2)
1143 , axiom case_univ_inj1 (pi A \ pi B \ pi C \ (! b \ ! (univ ## A ## B --> C) e1 \ ! e2  \
1144    case_univ ## A ## B ## C # (inj1_univ ## A ## B # b) # e1 # e2 = e1 # b))
1145 , axiom case_univ_inj2 (pi A \ pi B \ pi C \ (! b \ ! (univ ## A ## B --> C) e1 \ ! e2 \
1146    case_univ ## A ## B ## C # (inj2_univ ## A ## B # b) # e1 # e2 = e2 # b))
1147
1148 /******************* Equality *****************/
1149 , theorem eq_reflexive (pi A \ ((! A a \ a = a),
1150   [ then forall_i (bind A x \ r) ]))
1151
1152 /******************* Logic *****************/
1153 , theorem or_commutative ((! a \ ! b \ a || b <=> b || a),
1154   [itaut 1])
1155 , theorem or_ff ((! a \ a || ff <=> a),
1156   [itaut 1])
1157 , theorem or_tt ((! a \ a || tt <=> tt),
1158   [itaut 1])
1159 , theorem or_idempotent ((! a \ a || a <=> a),
1160   [itaut 1])
1161 , theorem or_associative ((! a \ ! b \ ! c \ a || (b || c) <=> (a || b) || c),
1162   [itaut 1])
1163 , theorem and_commutative ((! a \ ! b \ a && b <=> b && a),
1164   [itaut 1])
1165 , theorem and_tt ((! a \ a && tt <=> a),
1166   [itaut 1])
1167 , theorem and_ff ((! a \ a && ff <=> ff),
1168   [itaut 1])
1169 , theorem and_idempotent ((! a \ a && a <=> a),
1170   [itaut 1])
1171 , theorem and_associative ((! a \ ! b \ ! c \ a && (b && c) <=> (a && b) && c),
1172   [itaut 1])
1173 , theorem and_or ((! a \ ! b \ ! c \ a && (b || c) <=> (a && b) || (a && c)),
1174   [itaut 1])
1175 , theorem or_and ((! a \ ! b \ ! c \ a || (b && c) <=> (a || b) && (a || c)),
1176   [itaut 1])
1177 , theorem ads_or_and ((! a \ ! b \ (a && b) || b <=> b),
1178   [itaut 1])
1179 , theorem ads_and_or ((! a \ ! b \ (a || b) && b <=> b),
1180   [itaut 1])
1181 , theorem not_or ((! a \ ! b \ not # a && not # b <=> not # (a || b)),
1182   [itaut 2])
1183 , theorem not_and ((! a \ ! b \ not # a || not # b ==> not # (a && b)),
1184   [itaut 2])
1185 , theorem not_not_not ((! p \ not # (not # (not # p)) <=> not # p),
1186   [itaut 3])
1187 , theorem impl_not_not ((! a \ ! b \ (a ==> b) ==> (not # b ==> not # a)),
1188   [itaut 3])
1189 , theorem eq_to_impl_f ((! p \ ! q \ (p <=> q) ==> p ==> q),
1190    [itaut 2])
1191 , theorem eq_to_impl_b ((! p \ ! q \ (p <=> q) ==> q ==> p),
1192    [itaut 2])
1193
1194/*************** Properties inj/disj/univ ***********/
1195 , theorem pair_univ_inj_l 
1196   (pi A \ pi B \ (! (univ ## A ## B) x20 \ ! x21 \ ! x22 \ ! x23 \ pair_univ ## A ## B # x20 # x22 = pair_univ ## A ## B # x21 # x23 ==> x20 = x21) ,
1197   [then (repeat forall_i)
1198     (bind (univ ## A ## B) x22 \
1199       bind (univ ## A ## B) x23 \
1200        bind (univ ## A ## B) x24 \
1201         bind (univ ## A ## B) x25 \
1202          then i
1203           (then (cutth proj1_pair_univ)
1204             (then (lforall x22)
1205               (then (conv (land_tac (then sym apply)))
1206                 (then (conv (depth_tac h)) (applyth proj1_pair_univ))))))])
1207 , theorem pair_univ_inj_r 
1208   (pi A \ pi B \ (! (univ ## A ## B) x20 \ ! x21 \ ! x22 \ ! x23 \ pair_univ ## A ## B # x20 # x22 = pair_univ ## A ## B # x21 # x23 ==> x22 = x23) ,
1209   [then (repeat forall_i)
1210     (bind (univ ## A ## B) x22 \
1211       bind (univ ## A ## B) x23 \
1212        bind (univ ## A ## B) x24 \
1213         bind (univ ## A ## B) x25 \
1214          then i
1215           (then (cutth proj2_pair_univ)
1216             (then (lforall x22)
1217               (then (conv (land_tac (then sym apply)))
1218                 (then (conv (depth_tac h)) (applyth proj2_pair_univ))))))])
1219 , theorem injection_univ_inj
1220   (pi A \ pi B \ (! A x20 \ ! x21 \ injection_univ ## A ## B # x20 = injection_univ ## A ## B # x21 ==> x20 = x21) ,
1221    [then forall_i
1222     (bind A x20 \
1223       then forall_i
1224        (bind A x21 \
1225          then (then (cutth ejection_injection_univ) (lforall x21))
1226           (then (then (cutth ejection_injection_univ) (lforall x20))
1227             (then i
1228               (thenl
1229                 (cut
1230                   (ejection_univ ## A ## B # (injection_univ ## A ## B # x20) =
1231                     ejection_univ ## A ## B # (injection_univ ## A ## B # x21)))
1232                 [thenl
1233                   (cut
1234                     ((ejection_univ ## A ## B # (injection_univ ## A ## B # x20) =
1235                        ejection_univ ## A ## B # (injection_univ ## A ## B # x21)) =
1236                       (x20 = x21)))
1237                   [then (conv (depth_tac (then sym h))) h,
1238                   thenl c [thenl c [r, h], h]], thenl c [r, h]])))))])
1239 , theorem inj1_univ_inj
1240   (pi A \ pi B \ (! (univ ## A ## B) x20 \ ! x21 \ inj1_univ ## A ## B # x20 = inj1_univ ## A ## B # x21 ==> x20 = x21) ,
1241    [then inv
1242     (bind (univ ## A ## B) x20 \ bind (univ ## A ## B) x21 \
1243        thenl (t (case_univ ## A ## B ## (univ ## A ## B) # (inj1_univ ## A ## B # x20) '
1244             (lam (univ ## A ## B) x22 \ x22) '
1245             (lam (univ ## A ## B) x22 \ x22)))
1246         [then sym
1247           (then (conv (land_tac (applyth case_univ_inj1)))
1248             (then (conv (land_tac b)) r)),
1249         then (conv (depth_tac h))
1250          (then (conv (land_tac (applyth case_univ_inj1)))
1251            (then (conv (land_tac b)) r))])])
1252 , theorem inj2_univ_inj
1253   (pi A \ pi B \ (! (univ ## A ## B) x22 \ ! x23 \ inj2_univ ## A ## B # x22 = inj2_univ ## A ## B # x23 ==> x22 = x23) ,
1254    [then inv
1255     (bind (univ ## A ## B) x20 \ bind (univ ## A ## B) x21 \
1256        thenl (t (case_univ ## A ## B ## (univ ## A ## B) # (inj2_univ ## A ## B # x20) '
1257             (lam (univ ## A ## B) x22 \ x22) '
1258             (lam (univ ## A ## B) x22 \ x22)))
1259         [then sym
1260           (then (conv (land_tac (applyth case_univ_inj2)))
1261             (then (conv (land_tac b)) r)),
1262         then (conv (depth_tac h))
1263          (then (conv (land_tac (applyth case_univ_inj2)))
1264            (then (conv (land_tac b)) r))])])
1265 , theorem not_eq_inj1_inj2_univ 
1266   (pi A \ pi B \ (! (univ ## A ## B) x22 \ ! x23 \ inj1_univ ## A ## B # x22 = inj2_univ ## A ## B # x23 ==> ff) ,
1267    [then inv
1268     (bind (univ ## A ## B) x22 \
1269       bind (univ ## A ## B) x23 \
1270        then (cutth case_univ_inj1)
1271         (then (lforall x22)
1272           (then (lforall (lam (univ ## A ## B) x24 \ ff))
1273             (then (lforall (lam (univ ## A ## B) x24 \ tt))
1274               (thenl (m ((lam (univ ## A ## B) x24 \ ff) # x22)) [b,
1275                 then (conv (then sym h))
1276                  (then (wl [])
1277                    (then (conv (depth_tac h))
1278                      (then (wl [])
1279                        (then (conv (applyth case_univ_inj2))
1280                          (then (conv b) (itaut 1))))))])))))])
1281 , theorem inj1_disj_union_inj (pi A \ pi B \
1282    ((! x \ ! y \
1283     inj1_disj_union ## A ## B # x = inj1_disj_union ## A ## B # y ==> x = y) ,
1284    [then inv
1285      (bind A x23 \
1286        bind A x24 \
1287         then (cutth case_disj_union_inj1)
1288          (then (lforall x23)
1289            (then (lforall (lam A x25 \ x25))
1290              (then (lforall (lam B x25 \ choose ## A))
1291                (thenl (t ((lam A x25 \ x25) # x23))
1292                  [then (conv (rand_tac b)) r,
1293                  then (conv (land_tac (then sym h)))
1294                   (then (wl [])
1295                     (then (conv (depth_tac h))
1296                       (then (wl [])
1297                         (then (conv (land_tac (applyth case_disj_union_inj1)))
1298                           b))))])))))]))
1299 , theorem inj2_disj_union_inj (pi A \ pi B \
1300    ((! x \ ! y \
1301     inj2_disj_union ## A ## B # x = inj2_disj_union ## A ## B # y ==> x = y) ,
1302    [then inv
1303      (bind B x23 \
1304        bind B x24 \
1305         then (cutth case_disj_union_inj2)
1306          (then (lforall x23)
1307            (then (lforall (lam A x25 \ choose ## B))
1308              (then (lforall (lam B x25 \ x25))
1309                (thenl (t ((lam B x25 \ x25) # x23))
1310                  [then (conv (rand_tac b)) r,
1311                  then (conv (land_tac (then sym h)))
1312                   (then (wl [])
1313                     (then (conv (depth_tac h))
1314                       (then (wl [])
1315                         (then (conv (land_tac (applyth case_disj_union_inj2)))
1316                           b))))])))))]))
1317
1318 /********** Monotonicity of logical connectives *********/
1319 , theorem and_monotone ((! a1 \ ! b1 \ ! a2 \ ! b2 \
1320    (a1 ==> b1) ==> (a2 ==> b2) ==> a1 && a2 ==> b1 && b2),
1321    [itaut 2])
1322 , theorem or_monotone ((! a1 \ ! b1 \ ! a2 \ ! b2 \
1323    (a1 ==> b1) ==> (a2 ==> b2) ==> a1 || a2 ==> b1 || b2),
1324    [itaut 2])
1325 , theorem impl_monotone ((! a1 \ ! b1 \ ! a2 \ ! b2 \
1326    (b1 ==> a1) ==> (a2 ==> b2) ==> (a1 ==> a2) ==> (b1 ==> b2)),
1327    [itaut 3])
1328 , theorem not_monotone ((! p \ ! q \ (p ==> q) ==> (not # q) ==> (not # p)),
1329    [itaut 3])
1330 , theorem forall_monotone (pi A \ (! p \ ! q \
1331    (! A x \ p # x ==> q # x) ==> (! x \ p # x) ==> (! x \ q # x)),
1332    [itaut 6])
1333 , theorem exists_monotone (pi A \ (! p \ ! q \
1334    (! A x \ p # x ==> q # x) ==> (? x \ p # x) ==> (? x \ q # x)),
1335    [itaut 6])
1336
1337 /********** Knaster-Tarski theorem *********/
1338  , def in (pi A \ (A --> (A --> prop) --> prop),
1339     (lam A x \ lam (A --> prop) j \ j # x))
1340  , def subseteq (pi A \ ((A --> prop) --> (A --> prop) --> prop),
1341     (lam (A --> prop) x \ lam (A --> prop) y \ ! z \ z #in x ==> z #in y))
1342  , theorem in_subseteq (pi A \ 
1343     (! s \ ! t \ ! x \ s <<= t ==> x #in s ==> x #in t),
1344     [then forall_i
1345       (bind (A --> prop) x9 \
1346         then forall_i
1347          (bind (A --> prop) x10 \
1348            then forall_i (bind A x11 \ then (conv (land_tac dd)) (itaut 4))))])
1349  , def monotone (pi A \ (((A --> prop) --> (A --> prop)) --> prop),
1350      (lam (_ A) f \ ! x \ ! y \ x <<= y ==> f # x <<= f # y))
1351  , def is_fixpoint (pi A \ (((A --> prop) --> (A --> prop)) --> ((A --> prop) --> prop)),
1352     (lam (_ A) f \ lam (_ A) x \ (f # x) <<= x && x <<= (f # x)))
1353  , def fixpoint (pi A \ (((A --> prop) --> (A --> prop)) --> (A --> prop)),
1354     (lam (_ A) f \ lam A a \ ! e \ f # e <<= e ==> a #in e))
1355  , theorem fixpoint_subseteq_any_prefixpoint (pi A \
1356     (! f \ ! x\ f # x <<= x ==> fixpoint ## A # f <<= x),
1357     [then inv
1358       (bind ((A --> prop) --> (A --> prop)) x9 \
1359         (bind (A --> prop) x10 \
1360           then (conv (land_tac dd))
1361            (then (conv dd)
1362              (then forall_i
1363                (bind A x11 \
1364                  then (conv (land_tac dd))
1365                   (then (conv (land_tac b)) (itaut 4)))))))])
1366  , theorem fixpoint_subseteq_any_fixpoint (pi A \
1367     (! f \ ! x\ is_fixpoint ## A # f # x ==> fixpoint ## A # f <<= x),
1368     [then forall_i
1369       (bind ((A --> prop) --> (A --> prop)) x9 \
1370         then forall_i
1371          (bind (A --> prop) x10 \
1372            then (conv (land_tac dd))
1373             (then (cutth fixpoint_subseteq_any_prefixpoint) (itaut 8))))])
1374  , theorem prefixpoint_to_prefixpoint (pi A \
1375     (! f \ ! x \ monotone ## A # f ==> f # x <<= x ==> f # (f # x) <<= f # x),
1376    [then forall_i
1377      (bind ((A --> prop) --> (A --> prop)) x9 \
1378        then forall_i
1379         (bind (A --> prop) x10 \ then (conv (land_tac dd)) (itaut 6)))])
1380  , theorem fixpoint_is_prefixpoint (pi A \
1381     (! f \ monotone ## A # f ==> f # (fixpoint ## A # f)<<= fixpoint ## A # f),
1382     [then inv
1383       (bind ((A --> prop) --> (A --> prop)) x9 \
1384         then (conv dd)
1385          (then inv
1386            (bind A x10 \
1387              then (conv (depth_tac (dd [fixpoint])))
1388               (then (conv dd)
1389                 (then (conv b)
1390                   (then inv
1391                     (bind (A --> prop) x11 \
1392                       thenl (cut (fixpoint ## A # x9 <<= x11))
1393                        [thenl
1394                          (cut (x9 # (fixpoint ## A # x9) <<= x9 # x11))
1395                          [then (cutth in_subseteq)
1396                            (then (lforall_last (x9 # x11))
1397                              (then (lforall_last x11)
1398                                (thenl apply_last [h,
1399                                  then (cutth in_subseteq) (itaut 10)]))),
1400                          thenl
1401                           (m (monotone ## A # x9 ==> x9 # (fixpoint ## A # x9) <<= x9 # x11))
1402                           [itaut 10, then (conv (land_tac dd)) (itaut 10)]],
1403                        then (applyth fixpoint_subseteq_any_prefixpoint) h])))))))])
1404  , theorem fixpoint_is_fixpoint (pi A \
1405    (! f \ monotone ## A # f ==> is_fixpoint ## A # f # (fixpoint ## A # f)),
1406    [then inv
1407      (bind ((A --> prop) --> (A --> prop)) x9 \
1408        then (conv (depth_tac (dd [is_fixpoint])))
1409         (thenl inv [then (applyth fixpoint_is_prefixpoint) h,
1410           then (applyth fixpoint_subseteq_any_prefixpoint)
1411            (then (g (monotone ## A # x9))
1412              (then (conv (land_tac dd))
1413                (then inv
1414                  (then apply (then (applyth fixpoint_is_prefixpoint) h)))))]))])
1415
1416 /*********** Axiomatization of well-founded recursion ********/
1417 , decl rec (pi A \pi B \ ((A --> B) --> (A --> B)) --> (A --> B))
1418 , inductive_def acc accF accF_monotone acc_i0 acc_e0 acc_e
1419    (pi A \ param (A --> A --> prop) lt \ acc \
1420     [ (acc_i, ! x \ (! y \ lt # y # x ==> acc # y) ==> acc # x) ])
1421
1422 , def well_founded (pi A \ ((A --> A --> prop) --> prop,
1423    lam (_ A) lt \ ! x \ acc ## A # lt # x))
1424
1425 , axiom rec_is_fixpoint (pi A \ pi B \
1426   (! lt \ well_founded ## A # lt ==>
1427    ! ((A --> B) --> (A --> B)) h \
1428     (! f \ ! g \ ! i \
1429       (! p \ lt # p # i ==> f # p = g # p) ==> h # f # i = h # g # i) ==>
1430     rec ## A ## B # h = h # (rec ## A ## B # h)))
1431 /******************* TESTS *****************/
1432 /* The first three tests are commented out because they require extra-hacks
1433    in the kernel to avoid quantifying over p, q and g.
1434 , theorem test_apply (p ==> (p ==> p ==> q) ==> q,
1435    [then i (then i (then apply h))])
1436 , theorem test_apply2 (p ==> (! x \ ! y \ x ==> x ==> y) ==> q,
1437    [then i (then i (then apply h))])
1438 , theorem test_itaut_1 (((? x \ g x) ==> ! x \ (! y \ g y ==> x) ==> x),
1439   [itaut 4])*/
1440 , theorem test_monotone1 (monotone ## _ # (lam _ p \ lam _ x \ not # (p # x) ==> tt && p # tt || p # x),
1441   [ auto_monotone ])
1442 , theorem test_monotone2 (monotone ## _ # (lam _ p \ lam _ x \ ? z \ not # (p # x) ==> tt && p # tt || z),
1443   [ auto_monotone ])
1444 , theorem test_monotone3 (monotone ## _ # (lam _ p \ lam _ x \ ! z \ ? y \ (not # (p # x) ==> z && p # y || y)),
1445   [ auto_monotone ])
1446 , inductive_def pnn pnnF pnnF_monotone pnn_i pnn_e0 pnn_e (pnn \
1447     [ (pnn_tt, pnn # tt)
1448     , (pnn_not, ! x \ pnn # x ==> pnn # (not # x))])
1449 , theorem pnn_e
1450    ((! x13 \
1451       x13 # tt && (! x14 \ x13 # x14 ==> x13 # (not # x14)) ==>
1452        (! x14 \ pnn # x14 ==> x13 # x14)) ,
1453   [then forall_i
1454     (bind (prop --> prop) x13 \
1455       then (cutth pnn_e0)
1456        (then (lforall x13)
1457          (then i
1458            (thenl lapply
1459              [then (conv (depth_tac (dd [pnnF])))
1460                (then forall_i
1461                  (bind prop x14 \
1462                    then i
1463                     % from now on the proof is ad-hoc + fragile
1464                     (thenl left [then (conv (depth_tac h)) (itaut 1),
1465                       then left
1466                        (bind prop x15 \
1467                          then left (then (conv (depth_tac h)) (itaut 8)))]))),
1468              h]))))])
1469 , theorem pnn_has_two_values
1470    ((! x13 \ pnn # x13 ==> x13 = tt || x13 = ff) ,
1471    % applying an elimination principle is hard: it should be automatized
1472    [then (cutth pnn_e)
1473      (then (lforall (lam prop x13 \ or # (eq ## prop # x13 # tt) # (eq ## prop # x13 # ff)))
1474        (thenl lapply
1475          [thenl conj [then (conv b) (itaut 1),
1476            then (repeat (conv (depth_tac b)))
1477             (then forall_i (bind prop x13 \ then i (then left (itaut 8))))],
1478          then inv
1479           (bind prop x13 \
1480             then (lforall x13)
1481              (thenl lapply [h,
1482                then
1483                 (g
1484                   ((lam prop x14 \ or # (eq ## prop # x14 # tt) # (eq ## prop # x14 # ff)) '
1485                     x13))
1486                 (then (repeat (conv (depth_tac b)))
1487                   (then
1488                     (w
1489                       ((lam prop x14 \ or # (eq ## prop # x14 # tt) # (eq ## prop # x14 # ff))
1490                         # x13)) (then (w (pnn # x13)) (itaut 2))))]))]))])
1491 , inductive_def in_two in_twoF in_twoF_monotone in_two_i in_two_e0 in_two_e (in_two \
1492     [ (in_two_tt, in_two # tt)
1493     , (in_two_ff, in_two # ff) ])
1494 , new_basic_type bool2 myrep2 myabs2 myrepabs2 myabsrep2 myproprep2
1495    (pnn,
1496    [then (cutth pnn_tt) (then (applyth exists_i) h)])
1497 , def mytt (bool2,(myabs2 # tt))
1498 , def mynot ((bool2 --> bool2),(lam _ x \ myabs2 # (not # (myrep2 # x))))
1499 , theorem mytt_transfer
1500   (myrep2 # mytt = tt ,
1501     [then (conv (depth_tac (dd [mytt])))
1502       (then (applyth myrepabs2) (applyth pnn_tt))])
1503 , theorem mynot_transfer
1504   ((! x18 \ myrep2 # (mynot # x18) = not # (myrep2 # x18)) ,
1505     [then (conv (depth_tac (dd [mynot])))
1506       (then forall_i
1507         (bind bool2 x18 \
1508           then (applyth myrepabs2)
1509            (then (applyth pnn_not) (applyth myproprep2))))])
1510 , theorem mybool2_e
1511 ((! x18 \
1512    x18 # mytt && (! x19 \ x18 # x19 ==> x18 # (mynot # x19)) ==>
1513     (! x19 \ x18 # x19)) ,
1514   [thenl
1515     (cut
1516       (forall ## (bool2 --> prop) '
1517         (lam (bool2 --> prop) x18 \
1518           impl '
1519            (and # (x18 # (myabs2 # (myrep2 # mytt))) '
1520              (forall ## bool2 '
1521                (lam bool2 x19 \
1522                  impl # (x18 # (myabs2 # (myrep2 # x19))) '
1523                   (x18 '
1524                     (myabs2 '
1525                       (myrep2 # (mynot # (myabs2 # (myrep2 # x19)))))))))
1526            '
1527            (forall ## bool2 '
1528              (lam bool2 x19 \ x18 # (myabs2 # (myrep2 # x19)))))))
1529     [then
1530       (g
1531         (forall ## (bool2 --> prop) '
1532           (lam (bool2 --> prop) x18 \
1533             impl '
1534              (and # (x18 # (myabs2 # (myrep2 # mytt))) '
1535                (forall ## bool2 '
1536                  (lam bool2 x19 \
1537                    impl # (x18 # (myabs2 # (myrep2 # x19))) '
1538                     (x18 '
1539                       (myabs2 '
1540                         (myrep2 # (mynot # (myabs2 # (myrep2 # x19)))))))))
1541              '
1542              (forall ## bool2 '
1543                (lam bool2 x19 \ x18 # (myabs2 # (myrep2 # x19)))))))
1544       (then
1545         (w
1546           (forall ## (bool2 --> prop) '
1547             (lam (bool2 --> prop) x18 \
1548               impl '
1549                (and # (x18 # (myabs2 # (myrep2 # mytt))) '
1550                  (forall ## bool2 '
1551                    (lam bool2 x19 \
1552                      impl # (x18 # (myabs2 # (myrep2 # x19))) '
1553                       (x18 '
1554                         (myabs2 '
1555                           (myrep2 # (mynot # (myabs2 # (myrep2 # x19)))))))))
1556                '
1557                (forall ## bool2 '
1558                  (lam bool2 x19 \ x18 # (myabs2 # (myrep2 # x19)))))))
1559         (then (repeat (conv (depth_tac (applyth myabsrep2)))) (then i h))),
1560     then forall_i
1561      (bind (bool2 --> prop) x18 \
1562        then (cutth pnn_e)
1563         (then
1564           (lforall
1565             (lam prop x19 \
1566               exists ## bool2 '
1567                (lam bool2 x20 \
1568                  and # (eq ## _ # x19 # (myrep2 # x20)) '
1569                   (x18 # (myabs2 # x19)))))
1570           (then inv
1571             (bind bool2 x19 \
1572               thenl
1573                (cut
1574                  ((lam prop x20 \
1575                     exists ## bool2 '
1576                      (lam bool2 x21 \
1577                        and # (eq ## _ # x20 # (myrep2 # x21)) '
1578                         (x18 # (myabs2 # x20)))) # (myrep2 # x19)))
1579                [then
1580                  (g
1581                    ((lam prop x20 \
1582                       exists ## bool2 '
1583                        (lam bool2 x21 \
1584                          and # (eq ## _ # x20 # (myrep2 # x21)) '
1585                           (x18 # (myabs2 # x20)))) # (myrep2 # x19)))
1586                  (then (conv (depth_tac b)) inv),
1587                thenl apply
1588                 [then (repeat (conv (depth_tac b)))
1589                   (thenl inv
1590                     [then (cutth exists_i)
1591                       (then
1592                         (lforall_last
1593                           (lam bool2 x20 \
1594                             and # (eq ## _ # tt # (myrep2 # x20)) '
1595                              (x18 # (myabs2 # tt))))
1596                         (then (lforall_last mytt)
1597                           (then apply_last (then (conv b)
1598                            (thenl inv
1599                             [then (cutth mytt_transfer)
1600                               (then (conv (depth_tac h)) (applyth tt_intro)),
1601                             (applyth tt_intro),
1602                             then (cutth mytt_transfer)
1603                              (then (g (x18 # (myabs2 # (myrep2 # mytt))))
1604                                (then (conv (depth_tac h)) (then i h)))]))))),
1605                     (bind prop x20 \
1606                       bind bool2 x21 \
1607                        then (cutth exists_i)
1608                         (then
1609                           (lforall_last
1610                             (lam bool2 x22 \
1611                               and # (eq ## _ # (not # x20) # (myrep2 # x22)) '
1612                                (x18 # (myabs2 # (not # x20)))))
1613                           (then (lforall_last (mynot # x21))
1614                             (then apply_last (then (conv b)
1615    (thenl inv
1616     [then (conv (applyth mynot_transfer))
1617       (then (conv (depth_tac (dd [not]))) (then inv (itaut 3))),
1618     then (g (myrep2 # (mynot # x21)))
1619      (then (conv (land_tac (applyth mynot_transfer)))
1620        (then (conv (depth_tac (dd [not]))) (then inv (itaut 3)))),
1621     then (lforall (myabs2 # x20))
1622      (thenl lapply [then (conv (depth_tac (applyth myabsrep2))) h,
1623        then
1624         (g
1625           (x18 '
1626             (myabs2 '
1627               (myrep2 # (mynot # (myabs2 # (myrep2 # (myabs2 # x20))))))))
1628         (then (conv (depth_tac (applyth myabsrep2)))
1629           (then (conv (depth_tac (applyth myabsrep2)))
1630             (thenl (cut (x20 = myrep2 # x21))
1631               [then (conv (depth_tac h))
1632                 (then (conv (depth_tac h))
1633                   (then (conv (depth_tac (applyth myabsrep2)))
1634                     (then i
1635                       (then
1636                         (conv
1637                           (rand_tac
1638                             (rand_tac (then sym (applyth mynot_transfer)))))
1639                         (then (conv (depth_tac (applyth myabsrep2))) h))))),
1640               itaut 2])))])]))))))]),
1641                 applyth myproprep2]]))))]])
1642
1643, theorem step0
1644    ((! x13 \ mynot # (mynot # (mynot # x13)) = mynot # x13) ,
1645     [then inv
1646      (bind bool2 x13 \
1647        then (repeat (conv (depth_tac (dd [mynot]))))
1648         (thenl (conv (land_tac (rand_tac (rand_tac (applyth myrepabs2)))))
1649          [then (cutth pnn_not)
1650            (then (lforall (myrep2 # (myabs2 # (not # (myrep2 # x13)))))
1651              (then (cutth myproprep2)
1652                (then (lforall (myabs2 # (not # (myrep2 # x13))))
1653                  (then apply h)))),
1654          thenl
1655           (conv
1656             (land_tac
1657               (rand_tac (rand_tac (rand_tac (applyth myrepabs2))))))
1658           [then (cutth pnn_not)
1659             (then (lforall (myrep2 # x13))
1660               (then (cutth myproprep2)
1661                 (then (lforall x13) (then apply h)))),
1662           then (conv (land_tac (rand_tac (applyth not_not_not)))) r]]))])
1663 , theorem mynot_mynot_mytt
1664    (mynot # (mynot # mytt) = mytt ,
1665     [then (conv (depth_tac (dd [mynot])))
1666      (then (cutth mynot_transfer)
1667        (then (lforall mytt)
1668          (then (conv (depth_tac h))
1669            (then (cutth mytt_transfer)
1670              (then (conv (depth_tac h))
1671                (then (conv (depth_tac (dd [mytt]))) (thenl c [r, itaut 3])))))))])
1672 , theorem step1
1673    ((! x18 \ x18 = mytt || x18 = mynot # mytt) ,
1674     [then forall_i
1675      (bind bool2 x18 \
1676       then (cutth mybool2_e)
1677        (thenl
1678          (cut
1679            ((lam bool2 x19 \
1680               or # (eq ## _ # x19 # mytt) # (eq ## _ # x19 # (mynot # mytt))) # x18))
1681          [then
1682            (g
1683              ((lam bool2 x19 \
1684                 or # (eq ## _ # x19 # mytt) # (eq ## _ # x19 # (mynot # mytt))) '
1685                x18)) (then (conv (depth_tac b)) (then i h)),
1686          then apply
1687           (then (repeat (conv (depth_tac b)))
1688             (thenl conj [then (applyth orl) r,
1689               thenl inv
1690                [(bind bool2 x19 \
1691                   then (applyth orr) (then (conv (depth_tac h)) r)),
1692                (bind bool2 x19 \
1693                  then (applyth orl) (then (conv (depth_tac h)) (applyth mynot_mynot_mytt)))]]))]))])
1694
1695 /******* Cartesian product of types ******/
1696 /* TODO: this is an inductive type as well: generalize
1697    inductive_type to type abstractions */
1698 , def is_pair (pi A \ pi B \
1699  (univ ## (disj_union ## A ## B) ## prop --> prop),
1700  lam (_ A B) p \ ? A a \ ? B b \
1701   p =
1702    pair_univ ## (_ A B) ## _ '
1703     (injection_univ ## (_ A B) ## _ # (inj1_disj_union ## A ## B # a)) '
1704     (injection_univ ## (_ A B) ## _ # (inj2_disj_union ## A ## B # b)))
1705 , new_basic_type prod prod_rep prod_abs prod_repabs prod_absrep prod_proprep
1706    (pi A \ pi B \ is_pair ## A ## B, [daemon])
1707 , def pair (pi A \ pi B \
1708    (A --> B --> prod ## A ## B,
1709    lam A a \ lam B b \
1710     prod_abs ## A ## B '
1711      (pair_univ ## (_ A B) ## _ '
1712       (injection_univ ## (_ A B) ## _ # (inj1_disj_union ## A ## B # a)) '
1713       (injection_univ ## (_ A B) ## _ # (inj2_disj_union ## A ## B # b)))
1714    ))
1715 /* TODO: define fst and snd and prove the usual lemmas
1716    fst # (pair # a # b) = a */
1717
1718  /************* Natural numbers ***************/
1719 , inductive_def is_nat is_natF is_nat_monotone is_nat_i is_nat_e0 is_nat_e
1720   (is_nat \
1721     [ (is_nat_z, is_nat # (inj1_univ ## prop ## prop # (injection_univ ## prop ## prop # ff)))
1722     , (is_nat_s, ! x \ is_nat # x ==> is_nat # (inj2_univ ## prop ## prop # x))])
1723 , new_basic_type nat nat_rep nat_abs nat_repabs nat_absrep nat_proprep
1724    (is_nat,
1725    [then (cutth is_nat_z) (then (applyth exists_i) h)])
1726 , def z (nat, nat_abs # (inj1_univ ## prop ## prop # (injection_univ ## prop ## prop # ff)))
1727 , def s (nat --> nat,
1728    (lam _ x \ nat_abs # (inj2_univ ## prop ## prop # (nat_rep # x))))
1729 /* TODO: consequence of is_nat_e by transfer principles */
1730 , theorem nat_e ((! p \ p # z ==> (! n \ p # n ==> p # (s # n)) ==> ! n \ p # n), [ daemon ])
1731 , theorem nat_abs_inj
1732   ((! x18 \
1733      ! x19 \
1734       is_nat # x18 ==>
1735        is_nat # x19 ==> nat_abs # x18 = nat_abs # x19 ==> x18 = x19) ,
1736     [then inv
1737       (bind _ x18 \
1738         bind _ x19 \
1739          thenl (conv (land_tac (then sym (applyth nat_repabs)))) [h,
1740           thenl (conv (rand_tac (then sym (applyth nat_repabs)))) [h,
1741            then (conv (depth_tac h)) r]])])
1742 , theorem nat_rep_inj
1743   ((! x18 \ ! x19 \ nat_rep # x18 = nat_rep # x19 ==> x18 = x19) ,
1744     [then inv
1745       (bind nat x18 \
1746         bind nat x19 \
1747          then (conv (land_tac (then sym (applyth nat_absrep))))
1748           (then (conv (rand_tac (then sym (applyth nat_absrep))))
1749             (then (conv (depth_tac h)) r)))])
1750 , theorem s_inj ((! x18 \ ! x19 \ s # x18 = s # x19 ==> x18 = x19) ,
1751     [then (repeat (conv (depth_tac (dd [s]))))
1752       (then inv
1753         (bind nat x18 \
1754           bind nat x19 \
1755            then (applyth nat_rep_inj)
1756             (then (applyth inj2_univ_inj)
1757               (thenl (applyth nat_abs_inj)
1758                 [then (applyth is_nat_s) (applyth nat_proprep),
1759                 then (applyth is_nat_s) (applyth nat_proprep), h]))))])
1760 , theorem not_equal_z_s ((! x20 \ not # (z = s # x20)) ,
1761     [then (repeat (conv (depth_tac (dd [z]))))
1762       (then (repeat (conv (depth_tac (dd [s]))))
1763         (then (repeat (conv (depth_tac (dd [not]))))
1764           (then inv
1765             (bind nat x20 \
1766               then (applyth not_eq_inj1_inj2_univ)
1767                (thenl (thenl (applyth nat_abs_inj) [id, id, h])
1768                  [applyth is_nat_z,
1769                  then (applyth is_nat_s) (applyth nat_proprep)])))))])
1770 , def nat_case (pi A \ (nat --> A --> (nat --> A) --> A,
1771    lam _ n \ lam (_ A) a \ lam (_ A) f \
1772     case_univ ## prop ## prop ## A # (nat_rep # n) # (lam _ x \ a) # (lam _ p \ f # (nat_abs # p))))
1773 , theorem nat_case_z (pi A \ ((! x21 \ ! x22 \ nat_case ## A # z # x21 # x22 = x21) ,
1774      [then (conv (depth_tac (dd [nat_case])))
1775        (then (conv (depth_tac (dd [z])))
1776          (then forall_i
1777            (bind A x21 \
1778              then forall_i
1779               (bind (nat --> A) x22 \
1780                 thenl
1781                  (conv (land_tac (rator_tac (land_tac (applyth nat_repabs)))))
1782                  [applyth is_nat_z,
1783                   then (conv (depth_tac (applyth case_univ_inj1)))
1784                    (then (conv (depth_tac b)) r)]))))]))
1785 , theorem nat_case_s
1786   (pi A \ (! x21 \ ! x22 \ ! x23 \
1787     nat_case ## A # (s # x21) # x22 # x23 = x23 # x21),
1788     [then (conv (depth_tac (dd [nat_case])))
1789       (then (conv (depth_tac (dd [s])))
1790         (then forall_i
1791           (bind nat x21 \
1792             then forall_i
1793              (bind A x22 \
1794                then forall_i
1795                 (bind (nat --> A) x23 \
1796                   thenl
1797                    (conv (land_tac (rator_tac (land_tac (applyth nat_repabs)))))
1798                    [then (applyth is_nat_s) (applyth nat_proprep),
1799                     then (conv (depth_tac (applyth case_univ_inj2)))
1800                     (then (conv (depth_tac b))
1801                       (then (conv (depth_tac (applyth nat_absrep))) r))])))))])
1802
1803
1804 , theorem pred_well_founded
1805   (well_founded ## nat # (lam nat x21 \ lam nat x22 \ x22 = s # x21) ,
1806   [then (conv dd)
1807     (then forall_i
1808       (bind nat x21 \
1809         thenl (applyth nat_e)
1810          [then (applyth acc_i)
1811            (then (repeat (conv (depth_tac b)))
1812              (then inv
1813                (bind nat x22 \
1814                  then (applyth ff_elim) (then (cutth not_equal_z_s) (itaut 4))))),
1815          then inv
1816           (bind nat x22 \
1817             then (applyth acc_i)
1818              (then (repeat (conv (depth_tac b)))
1819                (then inv
1820                  (bind nat x23 \
1821                    then (cutth s_inj)
1822                     (then (lforall x22)
1823                       (then (lforall x23)
1824                         (thenl lapply [h,
1825                           then (conv (rand_tac (then sym h))) h])))))))]))])
1826 , def nat_recF (pi A \
1827    A --> (nat --> A --> A) --> (nat --> A) --> (nat --> A)
1828    , lam A a \ lam (_ A) f \ lam (_ A) rec \ lam _ n \
1829       nat_case ## A # n # a # (lam _ p \ f # p # (rec # p)))
1830 , def nat_rec (pi A \
1831    A --> (nat --> A --> A) --> nat --> A
1832    , lam A a \ lam (_ A) f \ rec ## nat ## A # (nat_recF ## A # a # f))
1833 , theorem nat_rec_ok0 (pi A \
1834   ((! a \ ! f \
1835     nat_rec ## A # a # f = nat_recF ## A # a # f # (nat_rec ## A # a # f)) ,
1836   [then inv
1837     (bind A x22 \
1838       bind (nat --> A --> A) x23 \
1839        then (repeat (conv (depth_tac (dd [nat_rec]))))
1840         (thenl (applyth rec_is_fixpoint) [applyth pred_well_founded,
1841           then (repeat (conv (depth_tac b)))
1842            (then (repeat (conv (depth_tac (dd [nat_recF]))))
1843              (then forall_i
1844                (bind (nat --> A) x24 \
1845                  then forall_i
1846                   (bind (nat --> A) x25 \
1847                     then (conv (rand_tac beta_expand))
1848                      (thenl (applyth nat_e)
1849                        [then (conv (depth_tac b))
1850                          (then inv
1851                            (then (conv (land_tac (applyth nat_case_z)))
1852                              (then (conv (rand_tac (applyth nat_case_z))) r))),
1853                        then (repeat (conv (depth_tac b)))
1854                         (then inv
1855                           (bind nat x26 \
1856                             then (conv (rand_tac (applyth nat_case_s)))
1857                              (then (conv (land_tac (applyth nat_case_s)))
1858                                (then (repeat (conv (depth_tac b)))
1859                                  (then (lforall x26)
1860                                    (thenl lapply [r,
1861                                      then (conv (land_tac (rand_tac h))) r]))))))])))))]))]))
1862 , theorem nat_rec_ok (pi A \
1863   (! a \ ! f \ ! n \
1864     nat_rec ## A # a # f # n =
1865      nat_case ## A # n # a # (lam _ p \ f # p # (nat_rec ## A # a # f # p))),
1866   [then inv
1867     (bind A x22 \
1868       bind (nat --> A --> A) x23 \
1869        bind nat x24 \
1870         then (conv (land_tac (rator_tac (applyth nat_rec_ok0))))
1871          (then (conv (depth_tac (dd [nat_recF]))) r))])
1872
1873 /************* Arithmetics: plus ***************/
1874 , def plus (nat --> nat --> nat,
1875    lam _ n \ lam _ m \
1876     nat_rec ## _ # m # (lam _ p \ lam _ sum \ s # sum)' n)
1877 , theorem plus_z ((! n \ z + n = n),
1878   [then (conv (depth_tac (dd [plus])))
1879     (then inv
1880       (bind nat x21 \
1881         then (conv (land_tac (applyth nat_rec_ok)))
1882          (then (conv (land_tac (applyth nat_case_z))) r)))])
1883 , theorem plus_s ((! n \ ! m \  s # n + m = s # (n + m)),
1884   [then (repeat (conv (depth_tac (dd [plus]))))
1885     (then inv
1886       (bind nat x21 \
1887         bind nat x22 \
1888          then (conv (land_tac (applyth nat_rec_ok)))
1889           (then (conv (land_tac (applyth nat_case_s)))
1890             (then (repeat (conv (depth_tac b))) r))))])
1891 , theorem plus_n_z ((! n \ n + z = n),
1892   [then (conv (rand_tac beta_expand))
1893     (thenl (applyth nat_e) [then (conv b) (applyth plus_z),
1894       then (repeat (conv (depth_tac b)))
1895        (then inv
1896          (bind nat x21 \
1897            then (conv (land_tac (applyth plus_s)))
1898             (then (conv (depth_tac h)) r)))])])
1899 , theorem plus_n_s ((! n \ ! m \ n + (s # m) = s # (n + m)),
1900   [then (conv (rand_tac beta_expand))
1901     (thenl (applyth nat_e)
1902       [then (conv b)
1903         (then inv
1904           (bind nat x21 \ then (repeat (conv (depth_tac (applyth plus_z)))) r)),
1905       then (repeat (conv (depth_tac b)))
1906        (then inv
1907          (bind nat x21 \
1908            bind nat x22 \
1909             then (conv (land_tac (applyth plus_s)))
1910              (thenl c [r,
1911                then (conv (land_tac apply)) (then sym (applyth plus_s))])))])])
1912 , theorem plus_comm ((! n \ ! m \ n + m = m + n),
1913   [then (conv (rand_tac beta_expand))
1914     (thenl (applyth nat_e)
1915       [then (conv b)
1916         (then inv
1917           (bind nat x21 \
1918             then (conv (land_tac (applyth plus_z)))
1919              (then sym (applyth plus_n_z)))),
1920       then (repeat (conv (depth_tac b)))
1921        (then inv
1922          (bind nat x21 \
1923            bind nat x22 \
1924             then (conv (land_tac (applyth plus_s)))
1925              (then sym
1926                (then (conv (land_tac (applyth plus_n_s)))
1927                  (thenl c [r, then sym apply])))))])])
1928
1929 ].
1930
1931/* Status and dependencies of the tactics:
1932+dd:
1933+sym:
1934+eq_true_intro: (th tt_intro)
1935+forall_i: dd eq_true_intro
1936+conj: dd eq_true_intro
1937+andr: dd tt_intro
1938+andl: dd tt_intro
1939+forall_e: sym dd
1940+mp: andr sym dd
1941+i: dd andl conj
1942+cut: andr sym dd i
1943+cutth: cut
1944+lapply*: mp
1945+lforall*: mp forall_e
1946+apply*: lapply lforall
1947+applyth: cutth apply*
1948
1949- f converional sometimes fails
1950- conv (depth_tac) diverges when applied to terms that contain
1951  metavariables
1952- repeat is not implemented using progress, that is not even there
1953*/
1954
1955/*
1956-2.5) in the proof for myprop, at the end I provide the
1957  witness (and X X) where X remains free (and it is not even pi-quantified).
1958  If prop was empty, then X could not exist. On the other hand, if X was
1959  empty, then there would be no need to provide the proof at all.
1960  In any case, the symptom for X remaining free at the end of a proof is
1961  one or more goals delayed on it. We never check for them and we have
1962  no way atm to do that. See bug -3)
1963
1964-2) the test apply_2 is very slow: why?
1965    same for the witness for myprop
1966
19670) definitions must not be recursive; typing should capture it
1968   (but not if declare_constraint is commented out...)
1969
19700.25) occurr check in bind case still missing :-(
1971
19720.50) case AppUvar vs AppUVar in unification is bugged (e.g.)
1973      X^2 x0 x1 = X^2 x0 x1
1974
19752) we need to fix the ELPI problems about handling of metavariables.
1976 I have already discussed with Enrico about them and he could have a
1977 shot at them. Namely:
1978 a) occur check + optimization to avoid it when possible (IN PROGRESS)
1979 b) unimplemented cases of restriction (IN PROGRESS)
1980
19813) once we let metavariables reach the goals, the current HOL-light 
1982 tactic implementation becomes too fragile. We should let the user 
1983 refer to hypotheses at least by number if not by name. But we better
1984 have a bidirectional successor/predecessor via declare_constraint
1985
19865) we could implement an automated theorem prover in lambdaProlog
1987 that works or is interfaced with the HOL-light code. There are
1988 complete provers like leanCOP 2.0 that are only 10 lines of code,
1989 but use some Prolog tricks.
1990
19916) we should do a small formalization, possibly developing a tactic,
1992 to prove that everything is working. For example, a decision procedure
1993 for rings or for linear inequations.
1994
1995*/

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hollight.elpi", line 231, column 18, character 8433:
Malformed mode declaration. Example:
mode (foo i i o).

../../tests/sources/hollight_legacy.elpi :

   1% vim: set ft=lprolog:
   2
   3infixr --> 126. % type arrow
   4infixl '   255. % infix application
   5infixl ''  255. % infix System-F application
   6infixl &&  128. % and
   7infixl `or  127. % or
   8infixr ==> 126. % implication
   9infixr <=> 125. % iff
  10infix  #in 135. % membership
  11infix  <<= 130. % subseteq
  12
  13/* Untrusted predicates called from the kernel:
  14 * next_object            next object to check
  15 * callback_proved        proof completed
  16 * next_tactic            next tactic to use
  17 * update_certificate     get new certificate after tactic application
  18 * end_of_proof           is the certificate/proof empty?
  19 * ppterm                 for pretty-printing messages
  20 * deftac                 tactic definition
  21 */
  22
  23/* Predicates exported from the trusted library:
  24 * append
  25 * fold2_append
  26 * put_binds
  27 */
  28 
  29/* Predicates exported from the kernel:
  30 * proves
  31 * check
  32 */
  33
  34{ /***** Trusted code base *******/
  35
  36/***** Trusted library functions *****/
  37
  38/* The names with ' at the end are trusted; the ones without are
  39   exported and therefore untrusted. */
  40local append', fold2_append', put_binds'.
  41
  42append' [] L L.
  43append' [ X | XS ] L [ X | RES ] :- append' XS L RES.
  44append A B C :- append' A B C.
  45
  46fold2_append' [] [] _ [].
  47fold2_append' [ X | XS ] [ Y | YS ] F OUTS :-
  48 F X Y OUT, fold2_append' XS YS F OUTS2, append' OUT OUTS2 OUTS.
  49fold2_append A B C D :- fold2_append' A B C D.
  50
  51% put_binds : list 'b -> 'a -> 'c -> list (bounded 'b) -> o
  52% put_binds [ f1,...,fn ] x t [ bind t x \ f1,...,bind t x fn ]
  53% binding all the xs that occur in f1,...,fn
  54put_binds' [] _ _ [].
  55put_binds' [ YX | YSX ] X A [ bind A Y | YYS ] :-
  56 YX = Y X, put_binds' YSX X A YYS.
  57put_binds A B C D :- put_binds' A B C D.
  58
  59/***** The HOL kernel *****/
  60
  61local thm, provable, def0, term, typ, typ', loop, prove, check1,
  62 check1def, check1thm, check1axm, check1nbt,
  63 reterm, not_defined, check_hyps.
  64
  65proves T TY :- provable T TY.
  66
  67typ T :- !. % this line temporarily drops checking of well-formedness for types
  68            % to avoid too much slow down. It is ultimately due to re-typing
  69            % terms that should be recognized as already well typed.
  70typ T :- var T, !, declare_constraint (typ T) [ T ].
  71typ T :- typ' T.
  72typ' prop.
  73typ' (univ '' A '' B) :- typ A, typ B.
  74typ' (A --> B) :- typ A, typ B.
  75typ' (disj_union '' A '' B) :- typ A, typ B.
  76
  77mode (term i o).
  78term (lam A F) (A --> B) :- typ A, pi x\ term x A => term (F x) B.
  79term (F ' T) B :- term F (A --> B), term T A.
  80term (eq '' A) (A --> A --> prop) :- typ A.
  81term (uvar as T) TY :- declare_constraint (term T TY) T.
  82
  83/* like term, but on terms that are already known to be well-typed */
  84mode (reterm i o).
  85reterm (lam A F) (A --> B) :- pi x\ reterm x A => reterm (F x) B.
  86reterm (F ' T) B :- reterm F (A --> B).
  87reterm (eq '' A) (A --> A --> prop).
  88reterm (uvar as T) TY :- declare_constraint (reterm T TY) T.
  89
  90constraint term reterm { /* No propagation rules for now */}
  91
  92% thm : bounded tactic -> bounded sequent -> list (bounded sequent) -> o
  93thm C (seq Gamma G) _ :- debug, print Gamma "|- " G " := " C, fail.
  94
  95/* << HACKS FOR DEBUGGING */
  96thm daemon (seq Gamma F) [].
  97/* >> HACKS FOR DEBUGGING */
  98
  99thm r (seq Gamma (eq '' _ ' X ' X)) [].
 100thm (t Y) (seq Gamma (eq '' A ' X ' Z))
 101 [ seq Gamma (eq '' A ' X ' Y), seq Gamma (eq '' A ' Y ' Z) ] :- term Y A.
 102thm (m P) (seq Gamma Q) [ seq Gamma (eq '' prop ' P ' Q), seq Gamma P ] :- term P prop.
 103thm b (seq Gamma (eq '' _ ' ((lam _ F) ' X) ' (F X))) [].
 104thm c (seq Gamma (eq '' B ' (F ' X) ' (G ' Y)))
 105 [ seq Gamma (eq '' (A --> B) ' F ' G) , seq Gamma (eq '' A ' X ' Y) ] :- reterm X A, reterm Y A.
 106thm k (seq Gamma (eq '' (A --> B) ' (lam A S) ' (lam A T)))
 107 [ bind A x \ seq Gamma (eq '' B ' (S x) ' (T x)) ].
 108thm s (seq Gamma (eq '' prop ' P ' Q)) [ seq (P :: Gamma) Q, seq (Q :: Gamma) P ].
 109thm (h IGN) (seq Gamma P) [] :- append' IGN [ P | Gamma2 ] Gamma.
 110
 111thm d (seq Gamma (eq '' _ ' C ' A)) [] :- def0 C A.
 112thm (th NAME) (seq _ G) [] :- provable NAME G.
 113
 114thm (thenll TAC1 TACN) SEQ SEQS :-
 115 thm TAC1 SEQ NEW,
 116 deftacl TACN NEW TACL,
 117 fold2_append' TACL NEW thm SEQS.
 118
 119/*debprint _ (then _ _) :- !.
 120debprint _ (thenl _ _) :- !.
 121debprint O T :- print O T.*/
 122
 123thm TAC SEQ SEQS :-
 124 deftac TAC SEQ XTAC,
 125 /*debprint "<<" TAC,
 126 (*/ thm XTAC SEQ SEQS /*, debprint ">>" TAC
 127 ; debprint "XX" TAC, fail)*/.
 128
 129thm (! TAC) SEQ SEQS :-
 130 thm TAC SEQ SEQS,
 131 !.
 132
 133thm id SEQ [ SEQ ].
 134
 135thm (wl Gamma1) (seq Gamma F) [ seq WGamma F ] :-
 136 append' Gamma1 [ P | Gamma2 ] Gamma,
 137 append' Gamma1 Gamma2 WGamma.
 138
 139thm (bind A TAC) (bind A SEQ) NEWL :-
 140 pi x \ term x A => reterm x A => thm (TAC x) (SEQ x) (NEW x), put_binds' (NEW x) x A NEWL.
 141
 142thm ww (bind A x \ SEQ) [ SEQ ].
 143
 144/* debuggin only, remove it */
 145%thm A B C :- print "FAILED " (thm A B C), fail.
 146
 147% loop : list (bounded sequent) -> certificate -> o
 148%loop SEQS TACS :- print "LOOP" (loop SEQS TACS), fail.
 149loop [] CERTIFICATE :- end_of_proof CERTIFICATE.
 150loop [ SEQ | OLD ] CERTIFICATE :-
 151 next_tactic [ SEQ | OLD ] CERTIFICATE ITAC,
 152 thm ITAC SEQ NEW,
 153 append' NEW OLD SEQS,
 154 update_certificate CERTIFICATE ITAC NEW NEW_CERTIFICATE,
 155 loop SEQS NEW_CERTIFICATE.
 156
 157prove G TACS :-
 158 (term G prop, ! ; ppterm PG G, print "Bad statement:" PG, fail),
 159% (TACS = (false,_), ! ;
 160 loop [ seq [] G ] TACS
 161. % ).
 162
 163not_defined P NAME :-
 164 not (P NAME _) ; print "Error:" NAME already defined, fail.
 165
 166check_hyps HS (typ' TYPE) :-
 167 (not (typ' TYPE) ; print "Error:" TYPE already defined, fail), print HS new TYPE.
 168check_hyps HS (def0 NAME DEF) :- ppterm PDEF DEF, print HS NAME "=" PDEF.
 169check_hyps HS (term NAME TYPE) :-
 170 not_defined term NAME, ppterm PTYPE TYPE, print HS NAME ":" PTYPE.
 171check_hyps HS (reterm _ _).
 172check_hyps HS (provable NAME TYPE) :-
 173 not_defined provable NAME, ppterm PTYPE TYPE, print HS NAME ":" PTYPE.
 174check_hyps HS (H1,H2) :- check_hyps HS H1, check_hyps HS H2.
 175check_hyps HS (pi H) :- pi x \ typ' x => check_hyps [x | HS] (H x).
 176check_hyps HS (_ => H2) :- check_hyps HS H2.
 177
 178/* check1 I O
 179   checks the declaration I
 180   returns the new assumption O */
 181check1 (theorem NAME GOALTACTICS) HYPS :- check1thm NAME GOALTACTICS HYPS, !.
 182check1 (axiom NAME ST) HYPS :- check1axm NAME ST HYPS, !.
 183check1 (new_basic_type TYPE REP ABS REPABS ABSREP PREPH P_TACTICS) HYPS :- check1nbt TYPE REP ABS REPABS ABSREP PREPH P_TACTICS true HYPS, !.
 184check1 (def NAME TYPDEF) HYPS :- check1def NAME TYPDEF true HYPS, !.
 185check1 (decl NAME TYP) HYPS :- check1decl NAME TYP true HYPS, !.
 186
 187check1def NAME (pi I) HYPSUCHTHAT (pi HYPS) :-
 188 pi x \ typ' x => check1def (NAME '' x) (I x) (HYPSUCHTHAT, typ x) (HYPS x).
 189check1def NAME (TYP,DEF) HYPSUCHTHAT HYPS :-
 190 typ TYP, term DEF TYP,
 191 HYPS = ((HYPSUCHTHAT => term NAME TYP), reterm NAME TYP, def0 NAME DEF).
 192
 193check1decl NAME (pi I) HYPSUCHTHAT (pi HYPS) :-
 194 pi x \ typ' x => check1decl (NAME '' x) (I x) (HYPSUCHTHAT, typ x) (HYPS x).
 195check1decl NAME TYP HYPSUCHTHAT HYPS :-
 196 typ TYP, HYPS = ((HYPSUCHTHAT => term NAME TYP), reterm NAME TYP).
 197
 198check1thm NAME (pi I) (pi HYPS) :-
 199 pi x \ typ' x => check1thm NAME (I x) (HYPS x).
 200check1thm NAME (GOAL,TACTICS) (provable NAME GOAL) :-
 201  prove GOAL TACTICS,
 202  callback_proved NAME GOAL TACTICS.
 203
 204check1axm NAME (pi I) (pi HYPS) :- !,
 205 pi x \ typ' x => check1axm NAME (I x) (HYPS x).
 206check1axm NAME GOAL (provable NAME GOAL) :-
 207 term GOAL prop, ! ; ppterm PGOAL GOAL, print "Bad statement:" PGOAL, fail.
 208
 209check1nbt TYPE REP ABS REPABS ABSREP PREPH (pi P_TACTICS) HYPSUCHTHAT (pi HYPS) :-
 210 pi x \ typ' x => check1nbt (TYPE '' x) (REP '' x) (ABS '' x) REPABS ABSREP PREPH (P_TACTICS x) (HYPSUCHTHAT, typ x) (HYPS x).
 211check1nbt TYPE REP ABS REPABS ABSREP PREPH (P,TACTICS) HYPSUCHTHAT HYPS :-
 212  term P (X --> prop),
 213  prove (exists '' _ ' P ) TACTICS,
 214  callback_proved existence_condition (exists '' _ ' P) TACTICS,
 215  REPTYP = (TYPE --> X),
 216  ABSTYP = (X --> TYPE),
 217  ABSREPTYP = (forall '' TYPE ' lam TYPE x \ eq '' TYPE ' (ABS ' (REP ' x)) ' x),
 218  REPABSTYP = (forall '' X ' lam X x \ impl ' (P ' x) ' (eq '' X ' (REP ' (ABS ' x)) ' x)),
 219  PREPHTYP = (forall '' TYPE ' lam TYPE x \ (P ' (REP ' x))),
 220  !,
 221  HYPS =
 222   ( (HYPSUCHTHAT => typ' TYPE)
 223   , (HYPSUCHTHAT => term REP REPTYP), reterm REP REPTYP
 224   , (HYPSUCHTHAT => term ABS ABSTYP), reterm ABS ABSTYP
 225   , provable ABSREP ABSREPTYP
 226   , provable REPABS REPABSTYP, provable PREPH PREPHTYP).
 227
 228check WHAT :-
 229 next_object WHAT C CONT,
 230 (C = stop, !, K = true ; check1 C H , check_hyps [] H, print_constraints, K = (H => check CONT)),
 231 !, K.
 232
 233}
 234
 235/************ parsing and pretty-printing ********/
 236% ppterm/parseterm
 237%ppterm X Y :- ppp X Y. parseterm X Y :- ppp X Y.
 238%ppp X Y :- var X, var Y, !, X = Y.
 239%ppp X (F ' G) :- var X, (var F ; var G), !, X = (F ' G).
 240%ppp X (F ' G ' H) :- var X, (var F ; var G ; var H), !,
 241% X = (F ' G ' H).
 242
 243mode (ppp o i) xas ppterm, (ppp i o) xas parseterm.
 244
 245ppp (! F2) (forall '' _ ' lam _ F1) :- !, pi x \ ppp (F2 x) (F1 x).
 246ppp (! TY F2) (forall '' TY ' lam TY F1) :- !, pi x \ ppp (F2 x) (F1 x).
 247ppp (? F2) (exists '' _ ' lam _ F1) :- !, pi x \ ppp (F2 x) (F1 x).
 248ppp (? TY F2) (exists '' TY ' lam TY F1) :- !, pi x \ ppp (F2 x) (F1 x).
 249ppp (F2 <=> G2) (eq '' prop ' F1 ' G1) :- !, ppp F2 F1, ppp G2 G1.
 250ppp (F2 = G2) (eq '' _ ' F1 ' G1) :- !, ppp F2 F1, ppp G2 G1.
 251ppp (F2 && G2) (and ' F1 ' G1) :- !, ppp F2 F1, ppp G2 G1.
 252ppp (F2 `or G2) (or ' F1 ' G1) :- !, ppp F2 F1, ppp G2 G1.
 253ppp (F2 ==> G2) (impl ' F1 ' G1) :- !, ppp F2 F1, ppp G2 G1.
 254ppp (X2 #in S2) (in '' _ ' X1 ' S1) :- !, ppp X2 X1, ppp S2 S1.
 255ppp (U2 <<= V2) (subseteq '' _ ' U1 ' V1) :- !, ppp U2 U1, ppp V2 V1.
 256ppp (F2 + G2) (plus ' F1 ' G1) :- !, ppp F2 F1, ppp G2 G1.
 257ppp (F2 ' G2) (F1 ' G1) :- !, ppp F2 F1, ppp G2 G1.
 258ppp (lam A F2) (lam A F1) :- !, pi x \ ppp (F2 x) (F1 x).
 259ppp A A.
 260
 261/* safe_list_map that unifies the two lists if they are both flexible
 262   probably only useful for parsing/pretty-printing */
 263safe_list_map L1 _ L2 :- var L1, var L2, !, L1 = L2.
 264safe_list_map L1 F L2 :- list_map L1 F L2.
 265
 266% pptac(ppterm)/parsetac(parseterm)
 267% pptac X Y :- ppptac X Y.  parsetac X Y :- ppptac X Y.
 268
 269mode (ppptac i o) xas parsetac(ppp -> parseterm),
 270     (ppptac o i) xas pptac(ppp -> ppterm).
 271
 272ppptac daemon daemon.
 273ppptac r r.
 274ppptac (t Y) (t PY) :- ppp Y PY.
 275ppptac (m Y) (m PY) :- ppp Y PY.
 276ppptac b b.
 277ppptac c c.
 278ppptac k k.
 279ppptac s s.
 280ppptac (h Gamma) (h PGamma) :- safe_list_map Gamma ppp PGamma.
 281ppptac d d.
 282ppptac (th NAME) (th NAME).
 283ppptac (thenll TAC1 TACN) (thenll PTAC1 PTACN) :-
 284 ppptac TAC1 PTAC1, ppptac TACN PTACN.
 285ppptac (! TAC) (! PTAC) :- ppptac TAC PTAC.
 286ppptac id id.
 287ppptac (wl Gamma) (wl PGamma) :- safe_list_map Gamma ppp PGamma.
 288ppptac (bind A TAC) (bind PA PTAC) :-
 289 ppp A PA, pi x \ ppptac (TAC x) (PTAC x).
 290ppptac ww ww.
 291
 292/************ interactive and non interactive loops ********/
 293
 294ppptac interactive interactive.
 295
 296parse_obj (theorem NAME PSTTAC) [theorem NAME STTAC] :-
 297 parse_thm NAME PSTTAC STTAC.
 298parse_obj (axiom NAME PTYP) [axiom NAME TYP] :- parse_axiom PTYP TYP.
 299parse_obj (new_basic_type TYPE REP ABS REPABS ABSREP PREP PP_TACTICS)
 300 [new_basic_type TYPE REP ABS REPABS ABSREP PREP P_TACTICS] :- parse_nbt PP_TACTICS P_TACTICS.
 301parse_obj (def NAME PTYBO) [def NAME TYBO] :- parse_def PTYBO TYBO.
 302parse_obj (decl NAME TY) [decl NAME TY].
 303parse_obj (inductive_def PRED PREDF PREDF_MON PRED_I PRED_E0 PRED_E K) EXP :-
 304 inductive_def_pkg PRED PREDF PREDF_MON PRED_I PRED_E0 PRED_E K EXP.
 305parse_obj stop [stop].
 306
 307parse_def (pi I) (pi O) :- pi x \ parse_def (I x) (O x).
 308parse_def (TY,PB) (TY,B) :- parseterm PB B.
 309
 310parse_axiom (pi I) (pi O) :- !, pi x \ parse_axiom (I x) (O x).
 311parse_axiom PST ST :- parseterm PST ST.
 312
 313parse_thm NAME (pi I) (pi O) :- pi x \ parse_thm NAME (I x) (O x).
 314parse_thm _ (PST,TAC) (ST,(false,TAC)) :- !, parseterm PST ST.
 315parse_thm NAME PST (ST,(true,[_])) :-
 316 (not (proves NAME _) ; print "Error:" NAME already defined, fail),
 317 parseterm PST ST.
 318
 319parse_nbt (pi I) (pi O) :- !, pi x \ parse_nbt (I x) (O x).
 320parse_nbt (PP,TACTICS) (P,(false,TACTICS)) :- parseterm PP P.
 321parse_nbt PP (P,(true,[_])) :- parseterm PP P.
 322
 323next_object [ C | NEXT ] CT CONTNEXT :-
 324  parse_obj C [ CT | CONT ], append CONT NEXT CONTNEXT.
 325next_object [] C CONT :- 
 326 print "Welcome to HOL extra-light",
 327 toplevel_loop [ C | CONT ].
 328next_object toplevel C CONT :- toplevel_loop [ C | CONT ].
 329
 330read_cmd H :-
 331 print "Enter a command or \"stop.\"",
 332 flush std_out, $readterm std_in H,
 333 !.
 334read_cmd H :- read_cmd H.
 335
 336toplevel_loop G :-
 337 read_cmd H,
 338 ( H = stop, !, G = [stop]
 339 ; parse_obj H PH, !, (append PH toplevel G ; print "error", toplevel_loop G)
 340 ; print "bad command", toplevel_loop G ).
 341
 342callback_proved _ _ (false,_).
 343callback_proved NAME G (true, [ TAC ]) :-
 344 canonical TAC CANONICALTAC,
 345 pptac PCANONICALTAC CANONICALTAC,
 346 ppterm PG G,
 347 print (theorem NAME (PG , [ PCANONICALTAC ] )).
 348
 349end_of_proof (true, []) :- print "proof completed".
 350end_of_proof (false, []).
 351
 352next_tactic0 [ SEQ | OLD ] (true, [ _ | _ ]) ITAC :-
 353 print,
 354 list_iter_rev [ SEQ | OLD ] print_sequent,
 355 read_in_context SEQ ITAC BACKTRACK,
 356 BACKTRACK.
 357next_tactic0 SEQS (true, CERT) ITAC :-
 358 print "error",
 359 next_tactic SEQS (true, CERT) ITAC.
 360next_tactic0 SEQS (true_then_false, (_,INT_TACS,_)) ITAC :-
 361 next_tactic0 SEQS (true, INT_TACS) ITAC.
 362next_tactic0 SEQS (false, [ interactive | _ ]) ITAC :-
 363 next_tactic0 SEQS (true, [ _ ]) ITAC.
 364next_tactic0 [ SEQ | OLD ] (false, [ TAC | _ ]) TAC.
 365next_tactic0 _ (false, _) ITAC :-
 366 print "aborted",
 367 halt.
 368
 369next_tactic SEQS CERT TAC :- next_tactic0 SEQS CERT PTAC, parsetac PTAC TAC.
 370
 371update_certificate (true, [ TAC | OTHER_TACS ]) ITAC NEW (true, TACS) :-
 372 mk_script ITAC NEW NEW_TACS TAC,
 373 append NEW_TACS OTHER_TACS TACS.
 374update_certificate (false, [ interactive | NON_INTERACTIVE_TACS ]) ITAC NEW CERTIFICATE :-
 375 update_certificate (true_then_false, (SCRIPT, [ SCRIPT ], NON_INTERACTIVE_TACS)) ITAC NEW CERTIFICATE.
 376update_certificate (true_then_false, (SCRIPT,[ TAC | OTHER_TACS ],NON_INTERACTIVE_TACS)) ITAC NEW CERTIFICATE :- !,
 377 mk_script ITAC NEW NEW_INTERACTIVE_TACS TAC,
 378 append NEW_INTERACTIVE_TACS OTHER_TACS INTERACTIVE_TACS,
 379 ( INTERACTIVE_TACS = [ _ | _ ], !,
 380   CERTIFICATE =
 381    (true_then_false, (SCRIPT,INTERACTIVE_TACS,NON_INTERACTIVE_TACS))
 382 ; CERTIFICATE = (false, NON_INTERACTIVE_TACS),
 383   print "INTERACTIVE SUBPROOF COMPLETED",
 384   canonical SCRIPT CSCRIPT,
 385   pptac PSCRIPT CSCRIPT,
 386   print PSCRIPT).
 387update_certificate (false, [ _ | OTHER_TACS ]) _ _ (false, OTHER_TACS).
 388
 389mk_script (bind A T) NEW NEW_TACS (bind A T2) :- !,
 390 pi x \
 391  put_binds (NEW2 x) x A NEW,
 392  mk_script (T x) (NEW2 x) (NEWT x) (T2 x),
 393  put_binds (NEWT x) x A NEW_TACS.
 394mk_script ITAC NEW NEW_TACS (thenl ITAC NEW_TACS) :-
 395 mk_list_of_bounded_fresh NEW NEW_TACS.
 396
 397read_in_context (bind A K) (bind A TAC) BACKTRACK :-
 398 pi x \ /* term x A => reterm ' x A => */ read_in_context (K x) (TAC x) BACKTRACK.
 399read_in_context (seq A B) TAC BACKTRACK :-
 400 flush std_out, $readterm std_in TAC,
 401 (TAC = backtrack, !, BACKTRACK = (!, fail) ; BACKTRACK = true).
 402
 403print_sequent (seq Gamma G) :-
 404 print,
 405 list_iter_rev Gamma (x \ sigma PX \ ppterm PX x, print PX),
 406 print "|------------------",
 407 ppterm PG G, print PG.
 408print_sequent (bind A F) :- pi x \ print_sequent (F x).
 409
 410/* turns thenl into then */
 411canonical (bind A T1) (bind A T2) :- !,
 412 pi x \ canonical (T1 x) (T2 x).
 413canonical (thenl T L) OTAC :- !,
 414 list_map L canonical L2,
 415 (mk_constant_list L2 S L2, !,
 416  (S = [], !, OTAC = T ; OTAC = then T S)
 417 ; OTAC = thenl T L2).
 418canonical T T.
 419
 420/************ inductive_def package ********/
 421parse_inductive_def_spec (pi F) (pi PF) :- !,
 422 pi A \ parse_inductive_def_spec (F A) (PF A).
 423parse_inductive_def_spec (param TY F) (param PTY PF) :- !,
 424 ppp TY PTY, pi x \ parse_inductive_def_spec (F x) (PF x).
 425parse_inductive_def_spec L PL :-
 426 (pi p \ list_map (L p)
 427  (x \ px \ sigma A \ sigma B \ sigma PB \ x = (A, B), parseterm B PB, px = (A, PB))
 428  (PL p)).
 429
 430build_quantified_predicate (pi I) (pi O) :- !,
 431 pi A \ build_quantified_predicate (I A) (O A).
 432build_quantified_predicate (param TY I) (TY --> TYP, lam TY BO) :- !,
 433 pi x \ build_quantified_predicate (I x) (TYP, BO x).
 434build_quantified_predicate L (_, lam _ p \ lam _ x \ P p x) :-
 435 pi p \ pi x \ build_predicate (L p) p x (P p x).
 436
 437build_predicate [ (_,K) ] P X R :- !,
 438 process_constructor K P X R.
 439build_predicate [ (_,K) | REST ] P X (or ' Q ' R) :-
 440 process_constructor K P X Q,
 441 build_predicate REST P X R.
 442
 443process_constructor (forall '' TY ' lam TY Q) P X (exists '' TY ' lam TY R) :-
 444 pi y \ process_constructor (Q y) P X (R y).
 445process_constructor (impl ' H ' K) P X (and ' H ' R) :-
 446 process_constructor K P X R.
 447process_constructor (P ' T) P X (eq '' _ ' X ' T).
 448
 449prove_monotonicity_thm (pi F) PREDF APREDF (pi THM) :- !,
 450 pi A \ prove_monotonicity_thm (F A) PREDF (APREDF '' A) (THM A).
 451prove_monotonicity_thm (param TY F) PREDF APREDF (forall '' TY ' lam TY STM, PROOF) :- !,
 452 pi x \ prove_monotonicity_thm (F x) PREDF (APREDF ' x) (STM x, PROOF).
 453prove_monotonicity_thm _ PREDF APREDF THM :-
 454 THM =
 455  (monotone '' _ ' APREDF,
 456   [ then inv (bind* (then (conv (depth_tac (dd [PREDF]))) auto_monotone)) ]).
 457
 458state_fixpoint_def (pi F) PREDF (pi DEF) :- !,
 459 pi A \ state_fixpoint_def (F A) (PREDF '' A) (DEF A).
 460state_fixpoint_def (param TY F) PREDF (_, lam TY BO) :- !,
 461 pi x \ state_fixpoint_def (F x) (PREDF ' x) (_, BO x).
 462state_fixpoint_def _ PREDF (_, fixpoint '' _ ' PREDF).
 463
 464prove_fix_intro_thm (pi F) PREDF PRED PREDF_MONOTONE (pi THM) :- !,
 465 pi A \ prove_fix_intro_thm (F A) (PREDF '' A) (PRED '' A) PREDF_MONOTONE (THM A).
 466prove_fix_intro_thm (param TY F) PREDF PRED PREDF_MONOTONE (forall '' TY ' lam TY STM, [ then forall_i (bind _ PROOF) ]) :- !,
 467 pi x \ prove_fix_intro_thm (F x) (PREDF ' x) (PRED ' x) PREDF_MONOTONE (STM x, [ PROOF x ]).
 468prove_fix_intro_thm _ PREDF PRED PREDF_MONOTONE THM :-
 469 THM =
 470  ((! x \ PREDF ' PRED ' x ==> PRED ' x),
 471   [then forall_i
 472     (bind _ x13 \
 473       then (conv (rand_tac (rator_tac dd)))
 474        (then (conv (land_tac (rator_tac (rand_tac dd))))
 475          (then inv
 476            (then (cutth fixpoint_is_prefixpoint)
 477              (then (lforall PREDF)
 478                (thenl lapply [applyth PREDF_MONOTONE,
 479                  then
 480                   (g
 481                     (subseteq '' _ '
 482                       (PREDF ' (fixpoint '' _ ' PREDF)) '
 483                       (fixpoint '' _ ' PREDF)))
 484                   (then (conv (depth_tac (dd [subseteq])))
 485                     (then (conv (depth_tac (dd [in])))
 486                       (then (conv (depth_tac (dd [in])))(itaut 4))))]))))))]).
 487
 488prove_fix_elim_thm (pi F) PREDF PRED OPRED (pi THM) :- !,
 489 pi A \ prove_fix_elim_thm (F A) (PREDF '' A) (PRED '' A) OPRED (THM A).
 490prove_fix_elim_thm (param TY F) PREDF PRED OPRED (forall '' TY ' lam TY STM, [ then forall_i (bind _ PROOF) ]) :- !,
 491 pi x \ prove_fix_elim_thm (F x) (PREDF ' x) (PRED ' x) OPRED (STM x, [ PROOF x ]).
 492prove_fix_elim_thm _ PREDF PRED OPRED THM :-
 493 THM =
 494  ((! x13 \
 495     (! x14 \ PREDF ' x13 ' x14 ==> x13 ' x14) ==>
 496      (! x14 \ PRED ' x14 ==> x13 ' x14)) ,
 497    [then forall_i
 498      (bind _ x23 \
 499        then (cutth fixpoint_subseteq_any_prefixpoint)
 500         (then (lforall PREDF)
 501           (then (lforall x23)
 502             (then (conv (depth_tac (dd [OPRED])))
 503               (then inv
 504                 (bind _ x24 \
 505                   then
 506                    (g
 507                      (impl ' (subseteq '' _ ' (PREDF ' x23) ' x23) '
 508                        (subseteq '' _ ' (fixpoint '' _ ' PREDF) ' x23)))
 509                    (then (conv (depth_tac (dd [subseteq])))
 510                      (then (conv (depth_tac (dd [subseteq])))
 511                        (then (conv (depth_tac (dd [in])))
 512                          (then (conv (depth_tac (dd [in])))
 513                            (then (conv (depth_tac (dd [in])))
 514                              (then (conv (depth_tac (dd [in])))
 515                                (then
 516                                  (w
 517                                    (impl '
 518                                      (subseteq '' _ ' (PREDF ' x23) ' x23) '
 519                                      (subseteq '' _ '
 520                                        (fixpoint '' _ ' PREDF) ' x23)))
 521                                  (then inv
 522                                    (thenl lapply_last [h,
 523                                      then (lforall_last x24)
 524                                       (then lapply_last h)])))))))))))))))]).
 525
 526prove_intro_thms (pi F) PRED PRED_I INTROTHMS :- !,
 527 pi A \
 528  prove_intro_thms (F A) (PRED '' A) PRED_I (OUT A),
 529  list_map (OUT A)
 530   (i \ o \ sigma Y \ i = (theorem NAME (P A)), o = theorem NAME (pi P))
 531   INTROTHMS.
 532prove_intro_thms (param TY F) PRED PRED_I INTROTHMS :- !,
 533 pi x \
 534  prove_intro_thms (F x) (PRED ' x) PRED_I (OUT x),
 535  list_map (OUT x)
 536   (i \ o \ sigma Y \
 537     i = (theorem NAME (STM x, [ PROOF x ])),
 538     o = theorem NAME (forall '' TY ' lam TY STM, [ then forall_i (bind TY PROOF) ]))
 539   INTROTHMS.
 540prove_intro_thms L PRED PRED_I INTROTHMS :-
 541 list_map (L PRED) (mk_intro_thm PRED_I) INTROTHMS.
 542
 543mk_intro_thm PRED_I (NAME,ST)
 544 (theorem NAME (ST,
 545   [ daemon /*(then inv (bind* (then (applyth PRED_I) (then (conv dd) (itauteq 6)))))*/ /* TOO MANY GOALS DELAYED ON typ (?): USE daemon INSTEAD */ ])).
 546
 547inductive_def_pkg PRED PREDF PREDF_MONOTONE PRED_I PRED_E0 PRED_E L OUT :-
 548 parse_inductive_def_spec L PL,
 549 build_quantified_predicate PL F,
 550 prove_monotonicity_thm PL PREDF PREDF MONTHM,
 551 state_fixpoint_def PL PREDF FIXDEF,
 552 prove_fix_intro_thm PL PREDF PRED PREDF_MONOTONE INTROTHM,
 553 prove_intro_thms PL PRED PRED_I INTROTHMS,
 554 prove_fix_elim_thm PL PREDF PRED PRED ELIMTHM,
 555 OUT1 =
 556  [ def PREDF F
 557  , theorem PREDF_MONOTONE MONTHM
 558  , def PRED FIXDEF
 559  , theorem PRED_I INTROTHM
 560  , theorem PRED_E0 ELIMTHM ],
 561 append OUT1 INTROTHMS OUT.
 562
 563/************ library of basic data types ********/
 564mk_bounded_fresh (bind _ F) (bind _ G) :- !, pi x\ mk_bounded_fresh (F x) (G x).
 565mk_bounded_fresh _ X.
 566
 567mk_list_of_bounded_fresh [] [].
 568mk_list_of_bounded_fresh [S|L] [X|R] :-
 569 mk_bounded_fresh S X, mk_list_of_bounded_fresh L R.
 570
 571/* list functions */
 572
 573list_map [] _ [].
 574list_map [X|XS] F [Y|YS] :- F X Y, list_map XS F YS.
 575
 576list_iter_rev [] _.
 577list_iter_rev [X|XS] F :- list_iter_rev XS F, F X.
 578
 579mem [ X | _ ] X, !.
 580mem [ _ | XS ] X :- mem XS X.
 581
 582mk_constant_list [] _ [].
 583mk_constant_list [_|L] X [X|R] :- mk_constant_list L X R.
 584
 585bang P :- P, !.
 586
 587/********** tacticals ********/
 588
 589% BUG in runtime.ml if the sigma is uncommented out. It does not matter btw.
 590/*sigma ff \*/ deftac fail SEQ ff.
 591
 592ppptac (constant_tacl TACL) (constant_tacl PTACL) :-
 593 list_map TACL ppptac PTACL.
 594deftacl (constant_tacl TACL) SEQS TACL.
 595
 596ppptac (thenl TAC TACL) (thenl PTAC PTACL) :-
 597 ppptac TAC PTAC, list_map TACL ppptac PTACL. 
 598deftac (thenl TAC TACL) SEQ XTAC :-
 599 XTAC = thenll TAC (constant_tacl TACL).
 600
 601ppptac (all_equals_list TAC) (all_equals_list PTAC) :- ppptac TAC PTAC.
 602deftacl (all_equals_list TAC2) SEQS TACL :-
 603 mk_constant_list SEQS TAC2 TACL.
 604
 605ppptac (then TAC1 TAC2) (then PTAC1 PTAC2) :-
 606 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 607deftac (then TAC1 TAC2) SEQ XTAC :-
 608 XTAC = thenll TAC1 (all_equals_list TAC2).
 609
 610ppptac (then! TAC1 TAC2) (then! PTAC1 PTAC2) :-
 611 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 612deftac (then! TAC1 TAC2) _ (then (! TAC1) TAC2).
 613
 614ppptac (orelse TAC1 TAC2) (orelse PTAC1 PTAC2) :-
 615 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 616deftac (orelse TAC1 TAC2) SEQ XTAC :-
 617 XTAC = TAC1 ; XTAC = TAC2.
 618
 619ppptac (orelse! TAC1 TAC2) (orelse! PTAC1 PTAC2) :-
 620 ppptac TAC1 PTAC1, ppptac TAC2 PTAC2.
 621deftac (orelse! TAC1 TAC2) _ (orelse (! TAC1) TAC2).
 622
 623ppptac (bind* TAC) (bind* PTAC) :- ppptac TAC PTAC.
 624deftac (bind* TAC) SEQ (orelse! (bind _ x \ bind* TAC) TAC).
 625
 626ppptac (repeat TAC) (repeat PTAC) :- ppptac TAC PTAC.
 627deftac (repeat TAC) SEQ XTAC :-
 628 ( XTAC = then TAC (repeat (bind* TAC))
 629 ; XTAC = id).
 630
 631ppptac (repeat! TAC) (repeat! PTAC) :- ppptac TAC PTAC.
 632deftac (repeat! TAC) SEQ (orelse! (then! TAC (repeat! (bind* TAC))) id).
 633
 634ppptac (pptac TAC) (pptac PTAC) :- ppptac TAC PTAC.
 635deftac (pptac TAC) SEQ TAC :-
 636 print "SEQ" SEQ ":=" TAC.
 637
 638ppptac (time TAC) (time PTAC) :- ppptac TAC PTAC.
 639deftac (time TAC) SEQ XTAC :-
 640 $gettimeofday B,
 641 XTAC = thenll TAC (time_after TAC B).
 642
 643ppptac (time_after TAC B) (time_after PTAC B) :- ppptac TAC PTAC.
 644deftacl (time_after TAC B) SEQS TACL :-
 645 $gettimeofday A,
 646 D is A - B,
 647 mk_constant_list SEQS id TACL,
 648 print "TIME SPENT " D "FOR" TAC.
 649
 650/* For debugging only (?) For capturing metavariables */
 651ppptac (inspect (seq Gamma F) TAC) (inspect (seq PGamma PF) PTAC) :-
 652 list_map SEQ ppp PSEQ, ppp F PF, ppptac TAC PTAC.
 653deftac (inspect SEQ TAC) SEQ TAC.
 654
 655/********** tactics ********/
 656
 657ppptac (w G) (w PG) :- ppp G PG.
 658deftac (w G) (seq Gamma _) (wl Gamma1) :-
 659 append Gamma1 [ G | _ ] Gamma.
 660
 661ppptac h h.
 662deftac h SEQ (h L).
 663
 664/*** eq ***/
 665
 666ppptac sym sym.
 667deftac sym (seq Gamma (eq '' T ' L ' R)) TAC :-
 668 TAC = thenl (m (eq '' T ' R ' R)) [ thenl c [ thenl c [ r , id ] , r ] , r ].
 669
 670ppptac eq_true_intro eq_true_intro.
 671deftac eq_true_intro (seq Gamma (eq '' prop ' P ' tt)) TAC :-
 672 TAC = thenl s [ th tt_intro, wl [] ].
 673
 674/*** true ***/
 675
 676/*** and ***/
 677
 678ppptac conj conj.
 679deftac conj (seq Gamma (and ' P ' Q)) TAC :-
 680 TAC =
 681  then
 682   (then (conv dd)
 683     (then k (bind _ x \
 684       thenl c
 685        [ thenl c [ r, eq_true_intro ] ,
 686          eq_true_intro ])))
 687   ww.
 688
 689/* Gamma  "|-"  q    --->   Gamma "|-" and ' p ' q*/
 690ppptac (andr P) (andr PP) :- ppp P PP.
 691deftac (andr P) (seq Gamma Q) TAC :-
 692 TAC =
 693  (thenl (m ((lam _ f \ f ' P ' Q) ' (lam _ x \ lam _ y \ y)))
 694    [ then
 695       %(repeat (conv (depth_tac b))) ROBUS VERSION LINE BELOW
 696       (then (conv (land_tac b)) (then (conv (land_tac (rator_tac b))) (conv (land_tac b))))
 697      r
 698    , thenl (conv (rator_tac id))
 699       [ then (thenl (t (lam _ f \ f ' tt ' tt)) [ id, r ])
 700          (thenl (m (and ' P ' Q)) [ dd , id ])
 701       , then (repeat (conv (depth_tac b))) (th tt_intro) ]]).
 702
 703/* (and ' p ' q) :: nil  "|-"  q */
 704ppptac andr andr.
 705deftac andr (seq Gamma Q) TAC :-
 706 mem Gamma (and ' P ' Q),
 707 TAC = then (andr P) h.
 708
 709/* Gamma  "|-"  p    --->   Gamma "|-" and ' p ' q*/
 710ppptac (andl P) (andl PP) :- ppp P PP.
 711deftac (andl Q) (seq Gamma P) TAC :-
 712 TAC =
 713  (thenl (m ((lam _ f \ f ' P ' Q) ' (lam _ x \ lam _ y \ x)))
 714    [ then
 715       %(repeat (conv (depth_tac b))) ROBUS VERSION LINE BELOW
 716       (then (conv (land_tac b)) (then (conv (land_tac (rator_tac b))) (conv (land_tac b))))
 717      r
 718    , thenl (conv (rator_tac id))
 719       [ then (thenl (t (lam _ f \ f ' tt ' tt)) [ id, r ])
 720          (thenl (m (and ' P ' Q)) [ dd , id ])
 721       , then (repeat (conv (depth_tac b))) (th tt_intro) ]]).
 722
 723/* (and ' p ' q) :: nil  "|-"  p */
 724ppptac andl andl.
 725deftac andl (seq Gamma P) TAC :-
 726 mem Gamma (and ' P ' Q),
 727 TAC = then (andl Q) h.
 728
 729
 730/*** forall ***/
 731
 732/* |- forall ' F  -->   |- F ' x */
 733ppptac forall_i forall_i.
 734deftac forall_i (seq Gamma (forall '' _ ' lam _ G)) TAC :-
 735 TAC = then (conv dd) (then k (bind _ x \ eq_true_intro)).
 736
 737/* forall ' F |- F ' T */
 738ppptac forall_e forall_e.
 739deftac forall_e (seq Gamma GX) TAC :-
 740 mem Gamma (forall '' _ ' (lam _ G)), GX = G X,
 741 TAC = thenl (m ((lam _ G) ' X)) [ b, thenl (m ((lam _ z \ tt) ' X))
 742  [ thenl c [ then sym (thenl (m (forall '' _ ' lam _ G)) [dd,h ]), r ]
 743  , then (conv b) (th tt_intro) ] ].
 744
 745/* forall ' F |- f  -->  F ' a, forall ' F |- f */
 746ppptac (lforall F A) (lforall PF PA) :- ppp F PF, ppp A PA.
 747deftac (lforall F A) (seq Gamma G) TAC :-
 748 TAC = thenl (m (impl ' (F A) ' G))
 749  [ thenl s [ then mp forall_e, then i h ] , then (w (forall '' _ ' lam _ F)) i ].
 750
 751/* forall ' F |- f  -->  F ' a, forall ' F |- f */
 752ppptac (lforall A) (lforall PA) :- ppp A PA.
 753deftac (lforall A) (seq Gamma G) (lforall F A) :-
 754 mem Gamma (forall '' _ ' lam _ F).
 755
 756/* forall ' F |- f  -->  F ' a, forall ' F |- f */
 757ppptac lforall lforall.
 758deftac lforall (seq Gamma G) (lforall A).
 759
 760/* forall ' F |- f  -->  F ' a, forall ' F |- f */
 761ppptac (lforall_last A) (lforall_last PA) :- ppp A PA.
 762deftac (lforall_last A) (seq ((forall '' _ ' lam _ F)::Gamma) G) (lforall F A).
 763
 764/*** false ***/
 765              
 766/*** impl ***/
 767
 768/* |- p=>q  -->  p |- q */
 769ppptac i i.
 770deftac i (seq Gamma (impl ' P ' Q)) TAC :-
 771 TAC = then (conv dd) (thenl s [ andl, thenl conj [ h [], id ]]).
 772
 773/* p=>q |- q  -->  |- p */
 774ppptac (mp P) (mp PP) :- ppp P PP.
 775deftac (mp P) (seq Gamma Q) TAC :-
 776 TAC = then (andr P) (thenl (m P) [ then sym (thenl (m (impl ' P ' Q)) [ dd , h ]) , id ]).
 777
 778/* p=>q |- q  -->  |- p */
 779ppptac mp mp.
 780deftac mp (seq Gamma Q) (mp P) :-
 781 mem Gamma (impl ' P ' Q).
 782
 783/* |- q   -->   p |- q  and  |- p */
 784ppptac (cut P) (cut PP) :- ppp P PP.
 785deftac (cut P) (seq Gamma Q) TAC :-
 786 TAC = then (andr P) (thenl (m P) [then sym (thenl (m (impl ' P ' Q)) [then (conv (land_tac dd)) r, i] ) , id]). 
 787
 788/* |-q  --> p |- q   where the theorem T proves p */
 789ppptac (cutth P) (cutth PP) :- ppp P PP.
 790deftac (cutth T) SEQ TAC :-
 791 proves T X,
 792 TAC = (thenl (cut X) [ id, th T ]).
 793
 794/* applies the theorem T */
 795ppptac (applyth P) (applyth PP) :- ppp P PP.
 796deftac (applyth T) SEQ (then (cutth T) apply_last).
 797
 798/* impl p q, Gamma |- f   --->   /*impl q f*/ Gamma |- p  ,  q, Gamma |- f */
 799ppptac (lapply P Q) (lapply PP PQ) :- ppp P PP, ppp Q PQ.
 800deftac (lapply P Q) (seq Gamma F) TAC :-
 801 TAC =
 802  thenl (m (impl ' Q ' F)) [ thenl s [ then (mp Q) (then (w (impl ' Q ' F)) (then (mp P) (w (impl ' P ' Q)))) , then i (h [A]) ] , then (w (impl ' P ' Q)) (then i id) ].
 803
 804/* impl p q, Gamma |- f   --->   /*impl q f*/ Gamma |- p  ,  q, Gamma |- f */
 805ppptac lapply lapply.
 806deftac lapply (seq Gamma F) (lapply P Q) :-
 807 mem Gamma (impl ' P ' Q).
 808
 809/* impl p q, Gamma |- f   --->   /*impl q f*/ Gamma |- p  ,  q, Gamma |- f */
 810ppptac lapply_last lapply_last.
 811deftac lapply_last (seq ((impl ' P ' Q)::Gamma) F) (lapply P Q).
 812
 813/* p |- f ---> p |- p ==> f */
 814ppptac (g P) (g PP) :- ppp P PP.
 815deftac (g P) (seq _ F) TAC :-
 816 TAC =
 817  (thenl (m (impl ' P ' F)) [thenl s [then mp h , then i h] , id ]).
 818
 819/*** not ***/
 820
 821/*** exists ***/
 822
 823/**** apply, i.e. forall + impl ****/
 824
 825ppptac (apply X) (apply PX) :- ppp X PX.
 826deftac (apply X) SEQ h :- var X, !.
 827deftac (apply X) SEQ h.
 828deftac (apply (impl ' P ' Q)) SEQ TAC :-
 829 TAC = thenl (lapply P Q) [ id, apply_last ].
 830deftac (apply (forall '' _ ' lam _ G)) SEQ TAC :-
 831 TAC = then (lforall G X) apply_last.
 832
 833ppptac apply_last apply_last.
 834deftac apply_last (seq (H::Gamma) F) (apply H).
 835
 836ppptac apply apply.
 837deftac apply (seq Gamma F) (apply H) :-
 838 mem Gamma H.
 839
 840/********** conversion(als) ***********/
 841
 842strip_constant (I '' _) H :- !, strip_constant I H.
 843strip_constant H H.
 844
 845/* expands definitions, even if applied to arguments */
 846ppptac (dd L) (dd L).
 847deftac (dd L) (seq _ (eq '' _ ' T ' X)) d :- strip_constant T H, bang (mem L H).
 848deftac (dd L) (seq _ (eq '' _ ' (D ' T) ' X))
 849 (thenl (t A) [thenl c [dd L , r], b]).
 850
 851ppptac dd dd.
 852deftac dd _ (dd L).
 853
 854ppptac beta_expand beta_expand.
 855deftac beta_expand (seq _ (eq '' _ ' (lam _ x \ F x) ' (lam _ x \ (lam _ F) ' x))) TAC :-
 856 TAC = then k (bind _ x \ then sym b).
 857
 858/* folds a definition, even if applied to arguments */
 859/* BUG: it seems to fail with restriction errors in some cases */
 860ppptac f f.
 861deftac f SEQ (then sym dd).
 862
 863ppptac (rand_tac C) (rand_tac PC) :- ppptac C PC.
 864deftac (rand_tac C) SEQ TAC :-
 865  TAC = thenl c [ r , C ].
 866
 867ppptac (rator_tac C) (rator_tac PC) :- ppptac C PC.
 868deftac (rator_tac C) SEQ TAC :-
 869  TAC = thenl c [ C , r ].
 870
 871ppptac (abs_tac C) (abs_tac PC) :- ppptac C PC.
 872deftac (abs_tac C) SEQ TAC :-
 873  TAC = then k (bind A x \ C).
 874
 875ppptac (land_tac C) (land_tac PC) :- ppptac C PC.
 876deftac (land_tac C) SEQ TAC :-
 877  TAC = thenl c [ thenl c [ r, C ] , r ].
 878
 879ppptac (sub_tac C) (sub_tac PC) :- ppptac C PC.
 880deftac (sub_tac C) SEQ TAC :-
 881  TAC = orelse (rand_tac C) (orelse (rator_tac C) (abs_tac C)).
 882
 883ppptac (try TAC) (try PTAC) :- ppptac TAC PTAC.
 884deftac (try TAC) SEQ (orelse TAC id).
 885
 886ppptac (depth_tac C) (depth_tac PC) :- ppptac C PC.
 887deftac (depth_tac C) SEQ TAC :-
 888  TAC = then (try C) (sub_tac (depth_tac C)).
 889
 890ppptac (conv C) (conv PC) :- ppptac C PC.
 891deftac (conv C) (seq Gamma F) TAC :-
 892 TAC = thenl (m G) [ then sym C , id ].
 893
 894/********** Automation ***********/
 895/* TODO:
 896 1) our lforall gets rid of the hypothesis (bad) */
 897/* left tries to reduce the search space via focusing */
 898ppptac left left.
 899deftac left (seq Gamma _) TAC :-
 900 mem Gamma (not ' F),
 901 TAC =
 902  (!
 903   (then (cutth not_e)
 904    (then (lforall_last F)
 905     (thenl lapply [ h, (w (not ' F)) ])))).
 906deftac left (seq Gamma _) TAC :-
 907 /* A bit long because we want to beta-reduce the produced hypothesis.
 908    Maybe this should be automatized somewhere else. */
 909 mem Gamma (exists '' _ ' F),
 910 TAC =
 911  (!
 912   (then (cutth exists_e)
 913    (then (lforall_last F)
 914     (thenl lapply [ h, then (w (exists '' _ ' F)) (then apply_last (then forall_i (bind _ x \ then (try (conv (land_tac b))) i))) ])))).
 915deftac left (seq Gamma H) TAC :-
 916 mem Gamma (or ' F ' G),
 917 TAC =
 918  (!
 919   (then (cutth or_e)
 920    (then (lforall_last F)
 921     (then (lforall_last G)
 922      (then (lforall_last H)
 923       (thenl lapply [ h, then (w (or ' F ' G)) (then apply_last i)])))))).
 924deftac left (seq Gamma H) TAC :-
 925 mem Gamma (and ' F ' G),
 926 TAC =
 927  (!
 928   (then (cutth and_e)
 929    (then (lforall_last F)
 930     (then (lforall_last G)
 931      (then (lforall_last H)
 932       (thenl lapply [ h, then (w (and ' F ' G)) (then apply_last (then i i))])))))).
 933deftac left (seq Gamma H) TAC :-
 934 mem Gamma (eq '' TY ' F ' G),
 935 not (var TY), TY = prop,
 936 TAC =
 937  (then (g (eq '' TY ' F ' G))
 938   (then (conv (land_tac (then (applyth eq_to_impl) h)))
 939     (then i (w (eq '' TY ' F ' G))))).
 940
 941ppptac not_i not_i.
 942deftac not_i (seq _ (not ' _)) (applyth not_i).
 943
 944ppptac inv inv.
 945deftac inv _ TAC :-
 946 TAC =
 947 (then!
 948  (repeat!
 949   (orelse! conj (orelse! forall_i (orelse! i (orelse! not_i s)))))
 950  (bind* (repeat! left))).
 951
 952ppptac (sync N) (sync N).
 953deftac (sync N) (seq _ tt) (th tt_intro).
 954deftac (sync N) (seq Gamma _) (then (applyth ff_elim) h) :-
 955 mem Gamma ff.
 956deftac (sync N) (seq _ (or ' _ ' _))
 957 (orelse (then (applyth orr) (itaut N)) (then (applyth orl) (itaut N))).
 958deftac (sync N) (seq _ (exists '' _ ' _)) (then (applyth exists_i) (then (conv b) (itaut N2))) :-
 959 N2 is N - 2.
 960
 961ppptac (itaut N) (itaut N).
 962deftac (itaut N) SEQ fail :- N =< 0, !.
 963deftac (itaut N) SEQ TAC :-
 964 %print (itaut N) SEQ,
 965 N1 is N - 1,
 966 N2 is N - 2,
 967 TAC =
 968 (then! inv
 969  (bind*
 970   (orelse h
 971   (orelse (sync N)
 972   (orelse /* Hypothesis not moved to front */ (then lforall (itaut N2))
 973   (then lapply (itaut N1))))))).
 974
 975ppptac (itauteq N) (itauteq N).
 976deftac (itauteq N) _ (then (cutth eq_reflexive) (itaut N)).
 977
 978/********** inductive predicates package ********/
 979
 980ppptac monotone monotone.
 981deftac monotone (seq _ (impl ' X ' X)) (! (then i h)) :- !.
 982deftac monotone (seq [forall '' _ ' lam _ x \ impl ' (F ' x) ' (G ' x)] (impl ' (F ' T) ' (G ' T))) (! apply) :- !.
 983deftac monotone (seq _ (impl ' (and ' _ ' _) ' _)) TAC :-
 984 TAC = then (applyth and_monotone) monotone.
 985deftac monotone (seq _ (impl ' (or ' _ ' _) ' _)) TAC :-
 986 TAC = then (applyth or_monotone) monotone.
 987deftac monotone (seq _ (impl ' (impl ' _ ' _) ' _)) TAC :-
 988 TAC = then (applyth impl_monotone) monotone.
 989deftac monotone (seq _ (impl ' (not ' _) ' _)) TAC :-
 990 TAC = then (applyth not_monotone) monotone.
 991deftac monotone (seq _ (impl ' (forall '' _ ' lam _ _) ' _)) TAC :-
 992 TAC =
 993  then (conv (land_tac (rand_tac beta_expand)))
 994   (then (conv (rand_tac (rand_tac beta_expand)))
 995     (then (applyth forall_monotone) (then forall_i (bind _ x \
 996       then (conv (depth_tac b)) (then (conv (depth_tac b)) monotone))))).
 997deftac monotone (seq _ (impl ' (exists '' _ ' lam _ _) ' _)) TAC :-
 998 TAC =
 999  then (conv (land_tac (rand_tac beta_expand)))
1000   (then (conv (rand_tac (rand_tac beta_expand)))
1001     (then (applyth exists_monotone) (then forall_i (bind _ x \
1002       then (conv (depth_tac b)) (then (conv (depth_tac b)) monotone))))).
1003
1004/* expands "monotone ' (lam _ f \ lam _ x \ X f x)" into
1005   "! x \ p ' x ==> q ' x |- X p y ==> X q y"
1006   and then calls the monotone tactic */
1007ppptac auto_monotone auto_monotone.
1008deftac auto_monotone _ TAC :-
1009 TAC =
1010  then (conv dd)
1011   (then forall_i (bind _ p \ (then forall_i (bind _ q \
1012     then (conv (land_tac dd))
1013      (then (conv (land_tac (depth_tac (dd [in]))))
1014        (then (conv (land_tac (depth_tac (dd [in]))))
1015          (then i
1016            (then (conv dd)
1017              (then forall_i (bind _ x \
1018                (then (conv (land_tac dd))
1019                  (then (conv (rand_tac dd))
1020                    (then (conv (land_tac (rator_tac b)))
1021                      (then (conv (land_tac b))
1022                        (then (conv (rand_tac (rator_tac b)))
1023                          (then (conv (rand_tac b))
1024                            monotone)))))))))))))))).
1025
1026/********** the library ********/
1027
1028main :- the_library L, append L [stop] Lstop, check Lstop.
1029
1030go :- the_library L, check L.
1031
1032the_library L :-
1033 L =
1034  [ /******** Primivite operators hard-coded in the kernel ******/
1035  % decl eq (pi A \ A --> A --> prop)
1036
1037  /********** Axiomatization of choice over types ********/
1038    decl choose (pi A \ A)
1039
1040  /*********** Connectives and quantifiers ********/
1041  , def tt (prop,((lam prop x \ x) = (lam prop x \ x)))
1042  , def forall (pi A \ ((A --> prop) --> prop),
1043     (lam (A --> prop) f \ f = (lam A g \ tt)))
1044  , def ff (prop,(! x \ x))
1045  , def and ((prop --> prop --> prop),
1046     (lam _ x \ lam _ y \ (lam (prop --> prop --> prop) f \ f ' x ' y) = (lam _ f \ f ' tt ' tt)))
1047  , def impl ((prop --> prop --> prop),(lam _ a \ lam _ b \ a && b <=> a))
1048  , def exists (pi A \ ((A --> prop) --> prop),
1049     (lam (A --> prop) f \ ! c \ (! a \ f ' a ==> c) ==> c))
1050  , def not ((prop --> prop),(lam _ x \ x ==> ff))
1051  , def or ((prop --> prop --> prop),
1052     (lam _ x \ lam _ y \ ! c \ (x ==> c) ==> (y ==> c) ==> c))
1053  , theorem tt_intro (tt,[then (conv dd) (then k (bind _ x12 \ r))])
1054  , theorem ff_elim ((! p \ ff ==> p),
1055    [then forall_i (bind prop x3\ then (conv (land_tac dd)) (then i forall_e))])
1056  , theorem sym ((! p \ ! q \ p = q ==> q = p),
1057    [then forall_i
1058     (bind prop x12 \
1059       then forall_i
1060        (bind prop x13 \
1061          then i (then sym h)))])
1062  , theorem not_e ((! p \ not ' p ==> p ==> ff),
1063     [then forall_i (bind prop x3 \ then (conv (land_tac dd)) (then i h))])
1064  , theorem conj ((! p \ ! q \ p ==> q ==> p && q),
1065    [then forall_i
1066     (bind prop x12 \
1067      then forall_i (bind prop x13 \ then i (then i (then conj h))))])
1068  , theorem andl ((! p \ ! q \ p && q ==> p),
1069    [then forall_i
1070     (bind prop x12 \
1071      then forall_i (bind prop x13 \ then i (then (andl x13) h)))])
1072  , theorem andr ((! p \ ! q \ p && q ==> q),
1073    [then forall_i
1074     (bind prop x12 \
1075      then forall_i (bind prop x13 \ then i (then (andr x12) h)))])
1076  , theorem and_e ((! p \ ! q \ ! c \ p && q ==> (p ==> q ==> c) ==> c),
1077     [then forall_i
1078       (bind prop x12 \
1079         then forall_i
1080          (bind prop x13 \
1081            then forall_i
1082             (bind prop x14 \ then i (then i (thenl apply [andl, andr])))))])
1083  , theorem not_i ((! p \ (p ==> ff) ==> not ' p),
1084     [then forall_i (bind prop x2 \ then i (then (conv dd) h))])
1085  , theorem orl ((! p \ ! q \ p ==> p `or q),
1086      [then forall_i
1087        (bind prop x12 \
1088          then forall_i
1089           (bind prop x13 \
1090             then i
1091              (then (conv dd)
1092                (then forall_i (bind prop x14 \ then i (then i (then apply h)))))))])
1093  , theorem orr ((! p \ ! q \ q ==> p `or q),
1094      [then forall_i
1095        (bind prop x12 \
1096          then forall_i
1097           (bind prop x13 \
1098             then i
1099              (then (conv dd)
1100                (then forall_i (bind prop x14 \ then i (then i (then apply h)))))))])
1101  , theorem or_e ((! p \ ! q \ ! c \ p `or q ==> (p ==> c) ==> (q ==> c) ==> c),
1102     [then forall_i
1103       (bind prop x12 \
1104         then forall_i
1105          (bind prop x13 \
1106            then forall_i
1107             (bind prop x14 \ then (conv (land_tac dd)) (then i forall_e))))])
1108  , theorem exists_e (pi T \
1109     (! f \ (exists '' T ' f) ==> (! c \ (! x \ f ' x ==> c) ==> c)),
1110     [then forall_i (bind (T --> prop) x12 \ then (conv (land_tac dd)) (then i h))])
1111 , theorem exists_i (pi T \ (! f \ ! w \ f ' w ==> (exists '' T ' f)),
1112    [then forall_i
1113     (bind (T --> prop) x12 \
1114       then forall_i
1115        (bind T x13 \
1116          then i
1117           (then (conv dd)
1118             (then forall_i
1119               (bind prop x14 \ then i (then (lforall x13) (then apply h)))))))])
1120  , theorem eq_to_impl
1121     ((! x13 \ ! x14 \ (x13 = x14) = ((x13 ==> x14) && (x14 ==> x13))),
1122     [thenl inv [(bind prop x13 \ bind prop x14 \ then (conv (then sym h)) h),
1123       (bind prop x13 \ bind prop x14 \ then (conv h) h),
1124       (bind prop x13 \ bind prop x14 \ itaut 2),
1125       (bind prop x13 \ bind prop x14 \ itaut 2)]])
1126
1127 /*********** Axiomatization of disjoint union ********/
1128  , decl inj1_disj_union (pi A \pi B \ A --> disj_union '' A '' B)
1129  , decl inj2_disj_union (pi A \ pi B \ B --> disj_union '' A '' B)
1130  , decl case_disj_union (pi A \pi B \ pi C \ disj_union '' A '' B --> (A --> C) --> (B --> C) --> C)
1131  , axiom case_disj_union_inj1 (pi A \ pi B \ pi C \ (! b \ ! (A --> C) e1 \ ! (B --> C) e2  \
1132    case_disj_union '' A '' B '' C ' (inj1_disj_union '' A '' B ' b) ' e1 ' e2 = e1 ' b))
1133  , axiom case_disj_union_inj2 (pi A \ pi B \ pi C \ (! b \ ! (A --> C) e1 \ ! (B --> C) e2  \
1134    case_disj_union '' A '' B '' C ' (inj2_disj_union '' A '' B ' b) ' e1 ' e2 = e2 ' b))
1135
1136 /*********** Axiomatization of the universe ********/
1137 , decl injection_univ (pi A \pi B \ A --> univ '' A '' B)
1138 , decl ejection_univ (pi A \pi B \ univ '' A '' B --> A)
1139 , decl inject_limit_univ (pi A \pi B \ (B --> univ '' A '' B) --> univ '' A '' B)
1140 , decl eject_limit_univ (pi A \ pi B \ univ '' A '' B --> (B --> univ '' A '' B))
1141 , decl pair_univ (pi A \pi B \ univ '' A '' B --> univ '' A '' B --> univ '' A '' B)
1142 , decl proj1_univ (pi A \ pi B \ univ '' A '' B --> univ '' A '' B)
1143 , decl proj2_univ (pi A \pi B \ univ '' A '' B --> univ '' A '' B)
1144 , decl inj1_univ (pi A \pi B \ univ '' A '' B --> univ '' A '' B)
1145 , decl inj2_univ (pi A \pi B \ univ '' A '' B --> univ '' A '' B)
1146 , decl case_univ (pi A \pi B \ pi C \ univ '' A '' B --> (univ '' A '' B --> C) --> (univ '' A '' B --> C) --> C)
1147 , axiom ejection_injection_univ (pi A \ pi B \
1148    ! A p \ ejection_univ '' A '' B ' (injection_univ '' A '' B ' p) = p)
1149 , axiom eject_inject_limit_univ (pi A \ pi B \
1150    ! (B --> univ '' A '' B) p \ eject_limit_univ '' A '' B ' (inject_limit_univ '' A '' B ' p) = p)
1151 , axiom proj1_pair_univ (pi A \ pi B \ ! (univ '' A '' B) p1 \ ! p2 \
1152    proj1_univ '' A '' B ' (pair_univ '' A '' B ' p1 ' p2) = p1)
1153 , axiom proj2_pair_univ (pi A \ pi B \ ! p1 \ ! (univ '' A '' B) p2 \
1154    proj2_univ '' A '' B ' (pair_univ '' A '' B ' p1 ' p2) = p2)
1155 , axiom case_univ_inj1 (pi A \ pi B \ pi C \ (! b \ ! (univ '' A '' B --> C) e1 \ ! e2  \
1156    case_univ '' A '' B '' C ' (inj1_univ '' A '' B ' b) ' e1 ' e2 = e1 ' b))
1157 , axiom case_univ_inj2 (pi A \ pi B \ pi C \ (! b \ ! (univ '' A '' B --> C) e1 \ ! e2 \
1158    case_univ '' A '' B '' C ' (inj2_univ '' A '' B ' b) ' e1 ' e2 = e2 ' b))
1159
1160 /******************* Equality *****************/
1161 , theorem eq_reflexive (pi A \ ((! A a \ a = a),
1162   [ then forall_i (bind A x \ r) ]))
1163
1164 /******************* Logic *****************/
1165 , theorem or_commutative ((! a \ ! b \ a `or b <=> b `or a),
1166   [itaut 1])
1167 , theorem or_ff ((! a \ a `or ff <=> a),
1168   [itaut 1])
1169 , theorem or_tt ((! a \ a `or tt <=> tt),
1170   [itaut 1])
1171 , theorem or_idempotent ((! a \ a `or a <=> a),
1172   [itaut 1])
1173 , theorem or_associative ((! a \ ! b \ ! c \ a `or (b `or c) <=> (a `or b) `or c),
1174   [itaut 1])
1175 , theorem and_commutative ((! a \ ! b \ a && b <=> b && a),
1176   [itaut 1])
1177 , theorem and_tt ((! a \ a && tt <=> a),
1178   [itaut 1])
1179 , theorem and_ff ((! a \ a && ff <=> ff),
1180   [itaut 1])
1181 , theorem and_idempotent ((! a \ a && a <=> a),
1182   [itaut 1])
1183 , theorem and_associative ((! a \ ! b \ ! c \ a && (b && c) <=> (a && b) && c),
1184   [itaut 1])
1185 , theorem and_or ((! a \ ! b \ ! c \ a && (b `or c) <=> (a && b) `or (a && c)),
1186   [itaut 1])
1187 , theorem or_and ((! a \ ! b \ ! c \ a `or (b && c) <=> (a `or b) && (a `or c)),
1188   [itaut 1])
1189 , theorem ads_or_and ((! a \ ! b \ (a && b) `or b <=> b),
1190   [itaut 1])
1191 , theorem ads_and_or ((! a \ ! b \ (a `or b) && b <=> b),
1192   [itaut 1])
1193 , theorem not_or ((! a \ ! b \ not ' a && not ' b <=> not ' (a `or b)),
1194   [itaut 2])
1195 , theorem not_and ((! a \ ! b \ not ' a `or not ' b ==> not ' (a && b)),
1196   [itaut 2])
1197 , theorem not_not_not ((! p \ not ' (not ' (not ' p)) <=> not ' p),
1198   [itaut 3])
1199 , theorem impl_not_not ((! a \ ! b \ (a ==> b) ==> (not ' b ==> not ' a)),
1200   [itaut 3])
1201 , theorem eq_to_impl_f ((! p \ ! q \ (p <=> q) ==> p ==> q),
1202    [itaut 2])
1203 , theorem eq_to_impl_b ((! p \ ! q \ (p <=> q) ==> q ==> p),
1204    [itaut 2])
1205
1206/*************** Properties inj/disj/univ ***********/
1207 , theorem pair_univ_inj_l 
1208   (pi A \ pi B \ (! (univ '' A '' B) x20 \ ! x21 \ ! x22 \ ! x23 \ pair_univ '' A '' B ' x20 ' x22 = pair_univ '' A '' B ' x21 ' x23 ==> x20 = x21) ,
1209   [then (repeat forall_i)
1210     (bind (univ '' A '' B) x22 \
1211       bind (univ '' A '' B) x23 \
1212        bind (univ '' A '' B) x24 \
1213         bind (univ '' A '' B) x25 \
1214          then i
1215           (then (cutth proj1_pair_univ)
1216             (then (lforall x22)
1217               (then (conv (land_tac (then sym apply)))
1218                 (then (conv (depth_tac h)) (applyth proj1_pair_univ))))))])
1219 , theorem pair_univ_inj_r 
1220   (pi A \ pi B \ (! (univ '' A '' B) x20 \ ! x21 \ ! x22 \ ! x23 \ pair_univ '' A '' B ' x20 ' x22 = pair_univ '' A '' B ' x21 ' x23 ==> x22 = x23) ,
1221   [then (repeat forall_i)
1222     (bind (univ '' A '' B) x22 \
1223       bind (univ '' A '' B) x23 \
1224        bind (univ '' A '' B) x24 \
1225         bind (univ '' A '' B) x25 \
1226          then i
1227           (then (cutth proj2_pair_univ)
1228             (then (lforall x22)
1229               (then (conv (land_tac (then sym apply)))
1230                 (then (conv (depth_tac h)) (applyth proj2_pair_univ))))))])
1231 , theorem injection_univ_inj
1232   (pi A \ pi B \ (! A x20 \ ! x21 \ injection_univ '' A '' B ' x20 = injection_univ '' A '' B ' x21 ==> x20 = x21) ,
1233    [then forall_i
1234     (bind A x20 \
1235       then forall_i
1236        (bind A x21 \
1237          then (then (cutth ejection_injection_univ) (lforall x21))
1238           (then (then (cutth ejection_injection_univ) (lforall x20))
1239             (then i
1240               (thenl
1241                 (cut
1242                   (ejection_univ '' A '' B ' (injection_univ '' A '' B ' x20) =
1243                     ejection_univ '' A '' B ' (injection_univ '' A '' B ' x21)))
1244                 [thenl
1245                   (cut
1246                     ((ejection_univ '' A '' B ' (injection_univ '' A '' B ' x20) =
1247                        ejection_univ '' A '' B ' (injection_univ '' A '' B ' x21)) =
1248                       (x20 = x21)))
1249                   [then (conv (depth_tac (then sym h))) h,
1250                   thenl c [thenl c [r, h], h]], thenl c [r, h]])))))])
1251 , theorem inj1_univ_inj
1252   (pi A \ pi B \ (! (univ '' A '' B) x20 \ ! x21 \ inj1_univ '' A '' B ' x20 = inj1_univ '' A '' B ' x21 ==> x20 = x21) ,
1253    [then inv
1254     (bind (univ '' A '' B) x20 \ bind (univ '' A '' B) x21 \
1255        thenl (t (case_univ '' A '' B '' (univ '' A '' B) ' (inj1_univ '' A '' B ' x20) '
1256             (lam (univ '' A '' B) x22 \ x22) '
1257             (lam (univ '' A '' B) x22 \ x22)))
1258         [then sym
1259           (then (conv (land_tac (applyth case_univ_inj1)))
1260             (then (conv (land_tac b)) r)),
1261         then (conv (depth_tac h))
1262          (then (conv (land_tac (applyth case_univ_inj1)))
1263            (then (conv (land_tac b)) r))])])
1264 , theorem inj2_univ_inj
1265   (pi A \ pi B \ (! (univ '' A '' B) x22 \ ! x23 \ inj2_univ '' A '' B ' x22 = inj2_univ '' A '' B ' x23 ==> x22 = x23) ,
1266    [then inv
1267     (bind (univ '' A '' B) x20 \ bind (univ '' A '' B) x21 \
1268        thenl (t (case_univ '' A '' B '' (univ '' A '' B) ' (inj2_univ '' A '' B ' x20) '
1269             (lam (univ '' A '' B) x22 \ x22) '
1270             (lam (univ '' A '' B) x22 \ x22)))
1271         [then sym
1272           (then (conv (land_tac (applyth case_univ_inj2)))
1273             (then (conv (land_tac b)) r)),
1274         then (conv (depth_tac h))
1275          (then (conv (land_tac (applyth case_univ_inj2)))
1276            (then (conv (land_tac b)) r))])])
1277 , theorem not_eq_inj1_inj2_univ 
1278   (pi A \ pi B \ (! (univ '' A '' B) x22 \ ! x23 \ inj1_univ '' A '' B ' x22 = inj2_univ '' A '' B ' x23 ==> ff) ,
1279    [then inv
1280     (bind (univ '' A '' B) x22 \
1281       bind (univ '' A '' B) x23 \
1282        then (cutth case_univ_inj1)
1283         (then (lforall x22)
1284           (then (lforall (lam (univ '' A '' B) x24 \ ff))
1285             (then (lforall (lam (univ '' A '' B) x24 \ tt))
1286               (thenl (m ((lam (univ '' A '' B) x24 \ ff) ' x22)) [b,
1287                 then (conv (then sym h))
1288                  (then (wl [])
1289                    (then (conv (depth_tac h))
1290                      (then (wl [])
1291                        (then (conv (applyth case_univ_inj2))
1292                          (then (conv b) (itaut 1))))))])))))])
1293 , theorem inj1_disj_union_inj (pi A \ pi B \
1294    ((! x \ ! y \
1295     inj1_disj_union '' A '' B ' x = inj1_disj_union '' A '' B ' y ==> x = y) ,
1296    [then inv
1297      (bind A x23 \
1298        bind A x24 \
1299         then (cutth case_disj_union_inj1)
1300          (then (lforall x23)
1301            (then (lforall (lam A x25 \ x25))
1302              (then (lforall (lam B x25 \ choose '' A))
1303                (thenl (t ((lam A x25 \ x25) ' x23))
1304                  [then (conv (rand_tac b)) r,
1305                  then (conv (land_tac (then sym h)))
1306                   (then (wl [])
1307                     (then (conv (depth_tac h))
1308                       (then (wl [])
1309                         (then (conv (land_tac (applyth case_disj_union_inj1)))
1310                           b))))])))))]))
1311 , theorem inj2_disj_union_inj (pi A \ pi B \
1312    ((! x \ ! y \
1313     inj2_disj_union '' A '' B ' x = inj2_disj_union '' A '' B ' y ==> x = y) ,
1314    [then inv
1315      (bind B x23 \
1316        bind B x24 \
1317         then (cutth case_disj_union_inj2)
1318          (then (lforall x23)
1319            (then (lforall (lam A x25 \ choose '' B))
1320              (then (lforall (lam B x25 \ x25))
1321                (thenl (t ((lam B x25 \ x25) ' x23))
1322                  [then (conv (rand_tac b)) r,
1323                  then (conv (land_tac (then sym h)))
1324                   (then (wl [])
1325                     (then (conv (depth_tac h))
1326                       (then (wl [])
1327                         (then (conv (land_tac (applyth case_disj_union_inj2)))
1328                           b))))])))))]))
1329
1330 /********** Monotonicity of logical connectives *********/
1331 , theorem and_monotone ((! a1 \ ! b1 \ ! a2 \ ! b2 \
1332    (a1 ==> b1) ==> (a2 ==> b2) ==> a1 && a2 ==> b1 && b2),
1333    [itaut 2])
1334 , theorem or_monotone ((! a1 \ ! b1 \ ! a2 \ ! b2 \
1335    (a1 ==> b1) ==> (a2 ==> b2) ==> a1 `or a2 ==> b1 `or b2),
1336    [itaut 2])
1337 , theorem impl_monotone ((! a1 \ ! b1 \ ! a2 \ ! b2 \
1338    (b1 ==> a1) ==> (a2 ==> b2) ==> (a1 ==> a2) ==> (b1 ==> b2)),
1339    [itaut 3])
1340 , theorem not_monotone ((! p \ ! q \ (p ==> q) ==> (not ' q) ==> (not ' p)),
1341    [itaut 3])
1342 , theorem forall_monotone (pi A \ (! p \ ! q \
1343    (! A x \ p ' x ==> q ' x) ==> (! x \ p ' x) ==> (! x \ q ' x)),
1344    [itaut 6])
1345 , theorem exists_monotone (pi A \ (! p \ ! q \
1346    (! A x \ p ' x ==> q ' x) ==> (? x \ p ' x) ==> (? x \ q ' x)),
1347    [itaut 6])
1348
1349 /********** Knaster-Tarski theorem *********/
1350  , def in (pi A \ (A --> (A --> prop) --> prop),
1351     (lam A x \ lam (A --> prop) j \ j ' x))
1352  , def subseteq (pi A \ ((A --> prop) --> (A --> prop) --> prop),
1353     (lam (A --> prop) x \ lam (A --> prop) y \ ! z \ z #in x ==> z #in y))
1354  , theorem in_subseteq (pi A \ 
1355     (! s \ ! t \ ! x \ s <<= t ==> x #in s ==> x #in t),
1356     [then forall_i
1357       (bind (A --> prop) x9 \
1358         then forall_i
1359          (bind (A --> prop) x10 \
1360            then forall_i (bind A x11 \ then (conv (land_tac dd)) (itaut 4))))])
1361  , def monotone (pi A \ (((A --> prop) --> (A --> prop)) --> prop),
1362      (lam (_ A) f \ ! x \ ! y \ x <<= y ==> f ' x <<= f ' y))
1363  , def is_fixpoint (pi A \ (((A --> prop) --> (A --> prop)) --> ((A --> prop) --> prop)),
1364     (lam (_ A) f \ lam (_ A) x \ (f ' x) <<= x && x <<= (f ' x)))
1365  , def fixpoint (pi A \ (((A --> prop) --> (A --> prop)) --> (A --> prop)),
1366     (lam (_ A) f \ lam A a \ ! e \ f ' e <<= e ==> a #in e))
1367  , theorem fixpoint_subseteq_any_prefixpoint (pi A \
1368     (! f \ ! x\ f ' x <<= x ==> fixpoint '' A ' f <<= x),
1369     [then inv
1370       (bind ((A --> prop) --> (A --> prop)) x9 \
1371         (bind (A --> prop) x10 \
1372           then (conv (land_tac dd))
1373            (then (conv dd)
1374              (then forall_i
1375                (bind A x11 \
1376                  then (conv (land_tac dd))
1377                   (then (conv (land_tac b)) (itaut 4)))))))])
1378  , theorem fixpoint_subseteq_any_fixpoint (pi A \
1379     (! f \ ! x\ is_fixpoint '' A ' f ' x ==> fixpoint '' A ' f <<= x),
1380     [then forall_i
1381       (bind ((A --> prop) --> (A --> prop)) x9 \
1382         then forall_i
1383          (bind (A --> prop) x10 \
1384            then (conv (land_tac dd))
1385             (then (cutth fixpoint_subseteq_any_prefixpoint) (itaut 8))))])
1386  , theorem prefixpoint_to_prefixpoint (pi A \
1387     (! f \ ! x \ monotone '' A ' f ==> f ' x <<= x ==> f ' (f ' x) <<= f ' x),
1388    [then forall_i
1389      (bind ((A --> prop) --> (A --> prop)) x9 \
1390        then forall_i
1391         (bind (A --> prop) x10 \ then (conv (land_tac dd)) (itaut 6)))])
1392  , theorem fixpoint_is_prefixpoint (pi A \
1393     (! f \ monotone '' A ' f ==> f ' (fixpoint '' A ' f)<<= fixpoint '' A ' f),
1394     [then inv
1395       (bind ((A --> prop) --> (A --> prop)) x9 \
1396         then (conv dd)
1397          (then inv
1398            (bind A x10 \
1399              then (conv (depth_tac (dd [fixpoint])))
1400               (then (conv dd)
1401                 (then (conv b)
1402                   (then inv
1403                     (bind (A --> prop) x11 \
1404                       thenl (cut (fixpoint '' A ' x9 <<= x11))
1405                        [thenl
1406                          (cut (x9 ' (fixpoint '' A ' x9) <<= x9 ' x11))
1407                          [then (cutth in_subseteq)
1408                            (then (lforall_last (x9 ' x11))
1409                              (then (lforall_last x11)
1410                                (thenl apply_last [h,
1411                                  then (cutth in_subseteq) (itaut 10)]))),
1412                          thenl
1413                           (m (monotone '' A ' x9 ==> x9 ' (fixpoint '' A ' x9) <<= x9 ' x11))
1414                           [itaut 10, then (conv (land_tac dd)) (itaut 10)]],
1415                        then (applyth fixpoint_subseteq_any_prefixpoint) h])))))))])
1416  , theorem fixpoint_is_fixpoint (pi A \
1417    (! f \ monotone '' A ' f ==> is_fixpoint '' A ' f ' (fixpoint '' A ' f)),
1418    [then inv
1419      (bind ((A --> prop) --> (A --> prop)) x9 \
1420        then (conv (depth_tac (dd [is_fixpoint])))
1421         (thenl inv [then (applyth fixpoint_is_prefixpoint) h,
1422           then (applyth fixpoint_subseteq_any_prefixpoint)
1423            (then (g (monotone '' A ' x9))
1424              (then (conv (land_tac dd))
1425                (then inv
1426                  (then apply (then (applyth fixpoint_is_prefixpoint) h)))))]))])
1427
1428 /*********** Axiomatization of well-founded recursion ********/
1429 , decl rec (pi A \pi B \ ((A --> B) --> (A --> B)) --> (A --> B))
1430 , inductive_def acc accF accF_monotone acc_i0 acc_e0 acc_e
1431    (pi A \ param (A --> A --> prop) lt \ acc \
1432     [ (acc_i, ! x \ (! y \ lt ' y ' x ==> acc ' y) ==> acc ' x) ])
1433
1434 , def well_founded (pi A \ ((A --> A --> prop) --> prop,
1435    lam (_ A) lt \ ! x \ acc '' A ' lt ' x))
1436
1437 , axiom rec_is_fixpoint (pi A \ pi B \
1438   (! lt \ well_founded '' A ' lt ==>
1439    ! ((A --> B) --> (A --> B)) h \
1440     (! f \ ! g \ ! i \
1441       (! p \ lt ' p ' i ==> f ' p = g ' p) ==> h ' f ' i = h ' g ' i) ==>
1442     rec '' A '' B ' h = h ' (rec '' A '' B ' h)))
1443 /******************* TESTS *****************/
1444 /* The first three tests are commented out because they require extra-hacks
1445    in the kernel to avoid quantifying over p, q and g.
1446 , theorem test_apply (p ==> (p ==> p ==> q) ==> q,
1447    [then i (then i (then apply h))])
1448 , theorem test_apply2 (p ==> (! x \ ! y \ x ==> x ==> y) ==> q,
1449    [then i (then i (then apply h))])
1450 , theorem test_itaut_1 (((? x \ g x) ==> ! x \ (! y \ g y ==> x) ==> x),
1451   [itaut 4])*/
1452 , theorem test_monotone1 (monotone '' _ ' (lam _ p \ lam _ x \ not ' (p ' x) ==> tt && p ' tt `or p ' x),
1453   [ auto_monotone ])
1454 , theorem test_monotone2 (monotone '' _ ' (lam _ p \ lam _ x \ ? z \ not ' (p ' x) ==> tt && p ' tt `or z),
1455   [ auto_monotone ])
1456 , theorem test_monotone3 (monotone '' _ ' (lam _ p \ lam _ x \ ! z \ ? y \ (not ' (p ' x) ==> z && p ' y `or y)),
1457   [ auto_monotone ])
1458 , inductive_def pnn pnnF pnnF_monotone pnn_i pnn_e0 pnn_e (pnn \
1459     [ (pnn_tt, pnn ' tt)
1460     , (pnn_not, ! x \ pnn ' x ==> pnn ' (not ' x))])
1461 , theorem pnn_e
1462    ((! x13 \
1463       x13 ' tt && (! x14 \ x13 ' x14 ==> x13 ' (not ' x14)) ==>
1464        (! x14 \ pnn ' x14 ==> x13 ' x14)) ,
1465   [then forall_i
1466     (bind (prop --> prop) x13 \
1467       then (cutth pnn_e0)
1468        (then (lforall x13)
1469          (then i
1470            (thenl lapply
1471              [then (conv (depth_tac (dd [pnnF])))
1472                (then forall_i
1473                  (bind prop x14 \
1474                    then i
1475                     % from now on the proof is ad-hoc + fragile
1476                     (thenl left [then (conv (depth_tac h)) (itaut 1),
1477                       then left
1478                        (bind prop x15 \
1479                          then left (then (conv (depth_tac h)) (itaut 8)))]))),
1480              h]))))])
1481 , theorem pnn_has_two_values
1482    ((! x13 \ pnn ' x13 ==> x13 = tt `or x13 = ff) ,
1483    % applying an elimination principle is hard: it should be automatized
1484    [then (cutth pnn_e)
1485      (then (lforall (lam prop x13 \ or ' (eq '' prop ' x13 ' tt) ' (eq '' prop ' x13 ' ff)))
1486        (thenl lapply
1487          [thenl conj [then (conv b) (itaut 1),
1488            then (repeat (conv (depth_tac b)))
1489             (then forall_i (bind prop x13 \ then i (then left (itaut 8))))],
1490          then inv
1491           (bind prop x13 \
1492             then (lforall x13)
1493              (thenl lapply [h,
1494                then
1495                 (g
1496                   ((lam prop x14 \ or ' (eq '' prop ' x14 ' tt) ' (eq '' prop ' x14 ' ff)) '
1497                     x13))
1498                 (then (repeat (conv (depth_tac b)))
1499                   (then
1500                     (w
1501                       ((lam prop x14 \ or ' (eq '' prop ' x14 ' tt) ' (eq '' prop ' x14 ' ff))
1502                         ' x13)) (then (w (pnn ' x13)) (itaut 2))))]))]))])
1503 , inductive_def in_two in_twoF in_twoF_monotone in_two_i in_two_e0 in_two_e (in_two \
1504     [ (in_two_tt, in_two ' tt)
1505     , (in_two_ff, in_two ' ff) ])
1506 , new_basic_type bool2 myrep2 myabs2 myrepabs2 myabsrep2 myproprep2
1507    (pnn,
1508    [then (cutth pnn_tt) (then (applyth exists_i) h)])
1509 , def mytt (bool2,(myabs2 ' tt))
1510 , def mynot ((bool2 --> bool2),(lam _ x \ myabs2 ' (not ' (myrep2 ' x))))
1511 , theorem mytt_transfer
1512   (myrep2 ' mytt = tt ,
1513     [then (conv (depth_tac (dd [mytt])))
1514       (then (applyth myrepabs2) (applyth pnn_tt))])
1515 , theorem mynot_transfer
1516   ((! x18 \ myrep2 ' (mynot ' x18) = not ' (myrep2 ' x18)) ,
1517     [then (conv (depth_tac (dd [mynot])))
1518       (then forall_i
1519         (bind bool2 x18 \
1520           then (applyth myrepabs2)
1521            (then (applyth pnn_not) (applyth myproprep2))))])
1522 , theorem mybool2_e
1523 ((! x18 \
1524    x18 ' mytt && (! x19 \ x18 ' x19 ==> x18 ' (mynot ' x19)) ==>
1525     (! x19 \ x18 ' x19)) ,
1526   [thenl
1527     (cut
1528       (forall '' (bool2 --> prop) '
1529         (lam (bool2 --> prop) x18 \
1530           impl '
1531            (and ' (x18 ' (myabs2 ' (myrep2 ' mytt))) '
1532              (forall '' bool2 '
1533                (lam bool2 x19 \
1534                  impl ' (x18 ' (myabs2 ' (myrep2 ' x19))) '
1535                   (x18 '
1536                     (myabs2 '
1537                       (myrep2 ' (mynot ' (myabs2 ' (myrep2 ' x19)))))))))
1538            '
1539            (forall '' bool2 '
1540              (lam bool2 x19 \ x18 ' (myabs2 ' (myrep2 ' x19)))))))
1541     [then
1542       (g
1543         (forall '' (bool2 --> prop) '
1544           (lam (bool2 --> prop) x18 \
1545             impl '
1546              (and ' (x18 ' (myabs2 ' (myrep2 ' mytt))) '
1547                (forall '' bool2 '
1548                  (lam bool2 x19 \
1549                    impl ' (x18 ' (myabs2 ' (myrep2 ' x19))) '
1550                     (x18 '
1551                       (myabs2 '
1552                         (myrep2 ' (mynot ' (myabs2 ' (myrep2 ' x19)))))))))
1553              '
1554              (forall '' bool2 '
1555                (lam bool2 x19 \ x18 ' (myabs2 ' (myrep2 ' x19)))))))
1556       (then
1557         (w
1558           (forall '' (bool2 --> prop) '
1559             (lam (bool2 --> prop) x18 \
1560               impl '
1561                (and ' (x18 ' (myabs2 ' (myrep2 ' mytt))) '
1562                  (forall '' bool2 '
1563                    (lam bool2 x19 \
1564                      impl ' (x18 ' (myabs2 ' (myrep2 ' x19))) '
1565                       (x18 '
1566                         (myabs2 '
1567                           (myrep2 ' (mynot ' (myabs2 ' (myrep2 ' x19)))))))))
1568                '
1569                (forall '' bool2 '
1570                  (lam bool2 x19 \ x18 ' (myabs2 ' (myrep2 ' x19)))))))
1571         (then (repeat (conv (depth_tac (applyth myabsrep2)))) (then i h))),
1572     then forall_i
1573      (bind (bool2 --> prop) x18 \
1574        then (cutth pnn_e)
1575         (then
1576           (lforall
1577             (lam prop x19 \
1578               exists '' bool2 '
1579                (lam bool2 x20 \
1580                  and ' (eq '' _ ' x19 ' (myrep2 ' x20)) '
1581                   (x18 ' (myabs2 ' x19)))))
1582           (then inv
1583             (bind bool2 x19 \
1584               thenl
1585                (cut
1586                  ((lam prop x20 \
1587                     exists '' bool2 '
1588                      (lam bool2 x21 \
1589                        and ' (eq '' _ ' x20 ' (myrep2 ' x21)) '
1590                         (x18 ' (myabs2 ' x20)))) ' (myrep2 ' x19)))
1591                [then
1592                  (g
1593                    ((lam prop x20 \
1594                       exists '' bool2 '
1595                        (lam bool2 x21 \
1596                          and ' (eq '' _ ' x20 ' (myrep2 ' x21)) '
1597                           (x18 ' (myabs2 ' x20)))) ' (myrep2 ' x19)))
1598                  (then (conv (depth_tac b)) inv),
1599                thenl apply
1600                 [then (repeat (conv (depth_tac b)))
1601                   (thenl inv
1602                     [then (cutth exists_i)
1603                       (then
1604                         (lforall_last
1605                           (lam bool2 x20 \
1606                             and ' (eq '' _ ' tt ' (myrep2 ' x20)) '
1607                              (x18 ' (myabs2 ' tt))))
1608                         (then (lforall_last mytt)
1609                           (then apply_last (then (conv b)
1610                            (thenl inv
1611                             [then (cutth mytt_transfer)
1612                               (then (conv (depth_tac h)) (applyth tt_intro)),
1613                             (applyth tt_intro),
1614                             then (cutth mytt_transfer)
1615                              (then (g (x18 ' (myabs2 ' (myrep2 ' mytt))))
1616                                (then (conv (depth_tac h)) (then i h)))]))))),
1617                     (bind prop x20 \
1618                       bind bool2 x21 \
1619                        then (cutth exists_i)
1620                         (then
1621                           (lforall_last
1622                             (lam bool2 x22 \
1623                               and ' (eq '' _ ' (not ' x20) ' (myrep2 ' x22)) '
1624                                (x18 ' (myabs2 ' (not ' x20)))))
1625                           (then (lforall_last (mynot ' x21))
1626                             (then apply_last (then (conv b)
1627    (thenl inv
1628     [then (conv (applyth mynot_transfer))
1629       (then (conv (depth_tac (dd [not]))) (then inv (itaut 3))),
1630     then (g (myrep2 ' (mynot ' x21)))
1631      (then (conv (land_tac (applyth mynot_transfer)))
1632        (then (conv (depth_tac (dd [not]))) (then inv (itaut 3)))),
1633     then (lforall (myabs2 ' x20))
1634      (thenl lapply [then (conv (depth_tac (applyth myabsrep2))) h,
1635        then
1636         (g
1637           (x18 '
1638             (myabs2 '
1639               (myrep2 ' (mynot ' (myabs2 ' (myrep2 ' (myabs2 ' x20))))))))
1640         (then (conv (depth_tac (applyth myabsrep2)))
1641           (then (conv (depth_tac (applyth myabsrep2)))
1642             (thenl (cut (x20 = myrep2 ' x21))
1643               [then (conv (depth_tac h))
1644                 (then (conv (depth_tac h))
1645                   (then (conv (depth_tac (applyth myabsrep2)))
1646                     (then i
1647                       (then
1648                         (conv
1649                           (rand_tac
1650                             (rand_tac (then sym (applyth mynot_transfer)))))
1651                         (then (conv (depth_tac (applyth myabsrep2))) h))))),
1652               itaut 2])))])]))))))]),
1653                 applyth myproprep2]]))))]])
1654
1655, theorem step0
1656    ((! x13 \ mynot ' (mynot ' (mynot ' x13)) = mynot ' x13) ,
1657     [then inv
1658      (bind bool2 x13 \
1659        then (repeat (conv (depth_tac (dd [mynot]))))
1660         (thenl (conv (land_tac (rand_tac (rand_tac (applyth myrepabs2)))))
1661          [then (cutth pnn_not)
1662            (then (lforall (myrep2 ' (myabs2 ' (not ' (myrep2 ' x13)))))
1663              (then (cutth myproprep2)
1664                (then (lforall (myabs2 ' (not ' (myrep2 ' x13))))
1665                  (then apply h)))),
1666          thenl
1667           (conv
1668             (land_tac
1669               (rand_tac (rand_tac (rand_tac (applyth myrepabs2))))))
1670           [then (cutth pnn_not)
1671             (then (lforall (myrep2 ' x13))
1672               (then (cutth myproprep2)
1673                 (then (lforall x13) (then apply h)))),
1674           then (conv (land_tac (rand_tac (applyth not_not_not)))) r]]))])
1675 , theorem mynot_mynot_mytt
1676    (mynot ' (mynot ' mytt) = mytt ,
1677     [then (conv (depth_tac (dd [mynot])))
1678      (then (cutth mynot_transfer)
1679        (then (lforall mytt)
1680          (then (conv (depth_tac h))
1681            (then (cutth mytt_transfer)
1682              (then (conv (depth_tac h))
1683                (then (conv (depth_tac (dd [mytt]))) (thenl c [r, itaut 3])))))))])
1684 , theorem step1
1685    ((! x18 \ x18 = mytt `or x18 = mynot ' mytt) ,
1686     [then forall_i
1687      (bind bool2 x18 \
1688       then (cutth mybool2_e)
1689        (thenl
1690          (cut
1691            ((lam bool2 x19 \
1692               or ' (eq '' _ ' x19 ' mytt) ' (eq '' _ ' x19 ' (mynot ' mytt))) ' x18))
1693          [then
1694            (g
1695              ((lam bool2 x19 \
1696                 or ' (eq '' _ ' x19 ' mytt) ' (eq '' _ ' x19 ' (mynot ' mytt))) '
1697                x18)) (then (conv (depth_tac b)) (then i h)),
1698          then apply
1699           (then (repeat (conv (depth_tac b)))
1700             (thenl conj [then (applyth orl) r,
1701               thenl inv
1702                [(bind bool2 x19 \
1703                   then (applyth orr) (then (conv (depth_tac h)) r)),
1704                (bind bool2 x19 \
1705                  then (applyth orl) (then (conv (depth_tac h)) (applyth mynot_mynot_mytt)))]]))]))])
1706
1707 /******* Cartesian product of types ******/
1708 /* TODO: this is an inductive type as well: generalize
1709    inductive_type to type abstractions */
1710 , def is_pair (pi A \ pi B \
1711  (univ '' (disj_union '' A '' B) '' prop --> prop),
1712  lam (_ A B) p \ ? A a \ ? B b \
1713   p =
1714    pair_univ '' (_ A B) '' _ '
1715     (injection_univ '' (_ A B) '' _ ' (inj1_disj_union '' A '' B ' a)) '
1716     (injection_univ '' (_ A B) '' _ ' (inj2_disj_union '' A '' B ' b)))
1717 , new_basic_type prod prod_rep prod_abs prod_repabs prod_absrep prod_proprep
1718    (pi A \ pi B \ is_pair '' A '' B, [daemon])
1719 , def pair (pi A \ pi B \
1720    (A --> B --> prod '' A '' B,
1721    lam A a \ lam B b \
1722     prod_abs '' A '' B '
1723      (pair_univ '' (_ A B) '' _ '
1724       (injection_univ '' (_ A B) '' _ ' (inj1_disj_union '' A '' B ' a)) '
1725       (injection_univ '' (_ A B) '' _ ' (inj2_disj_union '' A '' B ' b)))
1726    ))
1727 /* TODO: define fst and snd and prove the usual lemmas
1728    fst ' (pair ' a ' b) = a */
1729
1730  /************* Natural numbers ***************/
1731 , inductive_def is_nat is_natF is_nat_monotone is_nat_i is_nat_e0 is_nat_e
1732   (is_nat \
1733     [ (is_nat_z, is_nat ' (inj1_univ '' prop '' prop ' (injection_univ '' prop '' prop ' ff)))
1734     , (is_nat_s, ! x \ is_nat ' x ==> is_nat ' (inj2_univ '' prop '' prop ' x))])
1735 , new_basic_type nat nat_rep nat_abs nat_repabs nat_absrep nat_proprep
1736    (is_nat,
1737    [then (cutth is_nat_z) (then (applyth exists_i) h)])
1738 , def z (nat, nat_abs ' (inj1_univ '' prop '' prop ' (injection_univ '' prop '' prop ' ff)))
1739 , def s (nat --> nat,
1740    (lam _ x \ nat_abs ' (inj2_univ '' prop '' prop ' (nat_rep ' x))))
1741 /* TODO: consequence of is_nat_e by transfer principles */
1742 , theorem nat_e ((! p \ p ' z ==> (! n \ p ' n ==> p ' (s ' n)) ==> ! n \ p ' n), [ daemon ])
1743 , theorem nat_abs_inj
1744   ((! x18 \
1745      ! x19 \
1746       is_nat ' x18 ==>
1747        is_nat ' x19 ==> nat_abs ' x18 = nat_abs ' x19 ==> x18 = x19) ,
1748     [then inv
1749       (bind _ x18 \
1750         bind _ x19 \
1751          thenl (conv (land_tac (then sym (applyth nat_repabs)))) [h,
1752           thenl (conv (rand_tac (then sym (applyth nat_repabs)))) [h,
1753            then (conv (depth_tac h)) r]])])
1754 , theorem nat_rep_inj
1755   ((! x18 \ ! x19 \ nat_rep ' x18 = nat_rep ' x19 ==> x18 = x19) ,
1756     [then inv
1757       (bind nat x18 \
1758         bind nat x19 \
1759          then (conv (land_tac (then sym (applyth nat_absrep))))
1760           (then (conv (rand_tac (then sym (applyth nat_absrep))))
1761             (then (conv (depth_tac h)) r)))])
1762 , theorem s_inj ((! x18 \ ! x19 \ s ' x18 = s ' x19 ==> x18 = x19) ,
1763     [then (repeat (conv (depth_tac (dd [s]))))
1764       (then inv
1765         (bind nat x18 \
1766           bind nat x19 \
1767            then (applyth nat_rep_inj)
1768             (then (applyth inj2_univ_inj)
1769               (thenl (applyth nat_abs_inj)
1770                 [then (applyth is_nat_s) (applyth nat_proprep),
1771                 then (applyth is_nat_s) (applyth nat_proprep), h]))))])
1772 , theorem not_equal_z_s ((! x20 \ not ' (z = s ' x20)) ,
1773     [then (repeat (conv (depth_tac (dd [z]))))
1774       (then (repeat (conv (depth_tac (dd [s]))))
1775         (then (repeat (conv (depth_tac (dd [not]))))
1776           (then inv
1777             (bind nat x20 \
1778               then (applyth not_eq_inj1_inj2_univ)
1779                (thenl (thenl (applyth nat_abs_inj) [id, id, h])
1780                  [applyth is_nat_z,
1781                  then (applyth is_nat_s) (applyth nat_proprep)])))))])
1782 , def nat_case (pi A \ (nat --> A --> (nat --> A) --> A,
1783    lam _ n \ lam (_ A) a \ lam (_ A) f \
1784     case_univ '' prop '' prop '' A ' (nat_rep ' n) ' (lam _ x \ a) ' (lam _ p \ f ' (nat_abs ' p))))
1785 , theorem nat_case_z (pi A \ ((! x21 \ ! x22 \ nat_case '' A ' z ' x21 ' x22 = x21) ,
1786      [then (conv (depth_tac (dd [nat_case])))
1787        (then (conv (depth_tac (dd [z])))
1788          (then forall_i
1789            (bind A x21 \
1790              then forall_i
1791               (bind (nat --> A) x22 \
1792                 thenl
1793                  (conv (land_tac (rator_tac (land_tac (applyth nat_repabs)))))
1794                  [applyth is_nat_z,
1795                   then (conv (depth_tac (applyth case_univ_inj1)))
1796                    (then (conv (depth_tac b)) r)]))))]))
1797 , theorem nat_case_s
1798   (pi A \ (! x21 \ ! x22 \ ! x23 \
1799     nat_case '' A ' (s ' x21) ' x22 ' x23 = x23 ' x21),
1800     [then (conv (depth_tac (dd [nat_case])))
1801       (then (conv (depth_tac (dd [s])))
1802         (then forall_i
1803           (bind nat x21 \
1804             then forall_i
1805              (bind A x22 \
1806                then forall_i
1807                 (bind (nat --> A) x23 \
1808                   thenl
1809                    (conv (land_tac (rator_tac (land_tac (applyth nat_repabs)))))
1810                    [then (applyth is_nat_s) (applyth nat_proprep),
1811                     then (conv (depth_tac (applyth case_univ_inj2)))
1812                     (then (conv (depth_tac b))
1813                       (then (conv (depth_tac (applyth nat_absrep))) r))])))))])
1814
1815
1816 , theorem pred_well_founded
1817   (well_founded '' nat ' (lam nat x21 \ lam nat x22 \ x22 = s ' x21) ,
1818   [then (conv dd)
1819     (then forall_i
1820       (bind nat x21 \
1821         thenl (applyth nat_e)
1822          [then (applyth acc_i)
1823            (then (repeat (conv (depth_tac b)))
1824              (then inv
1825                (bind nat x22 \
1826                  then (applyth ff_elim) (then (cutth not_equal_z_s) (itaut 4))))),
1827          then inv
1828           (bind nat x22 \
1829             then (applyth acc_i)
1830              (then (repeat (conv (depth_tac b)))
1831                (then inv
1832                  (bind nat x23 \
1833                    then (cutth s_inj)
1834                     (then (lforall x22)
1835                       (then (lforall x23)
1836                         (thenl lapply [h,
1837                           then (conv (rand_tac (then sym h))) h])))))))]))])
1838 , def nat_recF (pi A \
1839    A --> (nat --> A --> A) --> (nat --> A) --> (nat --> A)
1840    , lam A a \ lam (_ A) f \ lam (_ A) rec \ lam _ n \
1841       nat_case '' A ' n ' a ' (lam _ p \ f ' p ' (rec ' p)))
1842 , def nat_rec (pi A \
1843    A --> (nat --> A --> A) --> nat --> A
1844    , lam A a \ lam (_ A) f \ rec '' nat '' A ' (nat_recF '' A ' a ' f))
1845 , theorem nat_rec_ok0 (pi A \
1846   ((! a \ ! f \
1847     nat_rec '' A ' a ' f = nat_recF '' A ' a ' f ' (nat_rec '' A ' a ' f)) ,
1848   [then inv
1849     (bind A x22 \
1850       bind (nat --> A --> A) x23 \
1851        then (repeat (conv (depth_tac (dd [nat_rec]))))
1852         (thenl (applyth rec_is_fixpoint) [applyth pred_well_founded,
1853           then (repeat (conv (depth_tac b)))
1854            (then (repeat (conv (depth_tac (dd [nat_recF]))))
1855              (then forall_i
1856                (bind (nat --> A) x24 \
1857                  then forall_i
1858                   (bind (nat --> A) x25 \
1859                     then (conv (rand_tac beta_expand))
1860                      (thenl (applyth nat_e)
1861                        [then (conv (depth_tac b))
1862                          (then inv
1863                            (then (conv (land_tac (applyth nat_case_z)))
1864                              (then (conv (rand_tac (applyth nat_case_z))) r))),
1865                        then (repeat (conv (depth_tac b)))
1866                         (then inv
1867                           (bind nat x26 \
1868                             then (conv (rand_tac (applyth nat_case_s)))
1869                              (then (conv (land_tac (applyth nat_case_s)))
1870                                (then (repeat (conv (depth_tac b)))
1871                                  (then (lforall x26)
1872                                    (thenl lapply [r,
1873                                      then (conv (land_tac (rand_tac h))) r]))))))])))))]))]))
1874 , theorem nat_rec_ok (pi A \
1875   (! a \ ! f \ ! n \
1876     nat_rec '' A ' a ' f ' n =
1877      nat_case '' A ' n ' a ' (lam _ p \ f ' p ' (nat_rec '' A ' a ' f ' p))),
1878   [then inv
1879     (bind A x22 \
1880       bind (nat --> A --> A) x23 \
1881        bind nat x24 \
1882         then (conv (land_tac (rator_tac (applyth nat_rec_ok0))))
1883          (then (conv (depth_tac (dd [nat_recF]))) r))])
1884
1885 /************* Arithmetics: plus ***************/
1886 , def plus (nat --> nat --> nat,
1887    lam _ n \ lam _ m \
1888     nat_rec '' _ ' m ' (lam _ p \ lam _ sum \ s ' sum)' n)
1889 , theorem plus_z ((! n \ z + n = n),
1890   [then (conv (depth_tac (dd [plus])))
1891     (then inv
1892       (bind nat x21 \
1893         then (conv (land_tac (applyth nat_rec_ok)))
1894          (then (conv (land_tac (applyth nat_case_z))) r)))])
1895 , theorem plus_s ((! n \ ! m \  s ' n + m = s ' (n + m)),
1896   [then (repeat (conv (depth_tac (dd [plus]))))
1897     (then inv
1898       (bind nat x21 \
1899         bind nat x22 \
1900          then (conv (land_tac (applyth nat_rec_ok)))
1901           (then (conv (land_tac (applyth nat_case_s)))
1902             (then (repeat (conv (depth_tac b))) r))))])
1903 , theorem plus_n_z ((! n \ n + z = n),
1904   [then (conv (rand_tac beta_expand))
1905     (thenl (applyth nat_e) [then (conv b) (applyth plus_z),
1906       then (repeat (conv (depth_tac b)))
1907        (then inv
1908          (bind nat x21 \
1909            then (conv (land_tac (applyth plus_s)))
1910             (then (conv (depth_tac h)) r)))])])
1911 , theorem plus_n_s ((! n \ ! m \ n + (s ' m) = s ' (n + m)),
1912   [then (conv (rand_tac beta_expand))
1913     (thenl (applyth nat_e)
1914       [then (conv b)
1915         (then inv
1916           (bind nat x21 \ then (repeat (conv (depth_tac (applyth plus_z)))) r)),
1917       then (repeat (conv (depth_tac b)))
1918        (then inv
1919          (bind nat x21 \
1920            bind nat x22 \
1921             then (conv (land_tac (applyth plus_s)))
1922              (thenl c [r,
1923                then (conv (land_tac apply)) (then sym (applyth plus_s))])))])])
1924 , theorem plus_comm ((! n \ ! m \ n + m = m + n),
1925   [then (conv (rand_tac beta_expand))
1926     (thenl (applyth nat_e)
1927       [then (conv b)
1928         (then inv
1929           (bind nat x21 \
1930             then (conv (land_tac (applyth plus_z)))
1931              (then sym (applyth plus_n_z)))),
1932       then (repeat (conv (depth_tac b)))
1933        (then inv
1934          (bind nat x21 \
1935            bind nat x22 \
1936             then (conv (land_tac (applyth plus_s)))
1937              (then sym
1938                (then (conv (land_tac (applyth plus_n_s)))
1939                  (thenl c [r, then sym apply])))))])])
1940
1941 ].
1942
1943/* Status and dependencies of the tactics:
1944+dd:
1945+sym:
1946+eq_true_intro: (th tt_intro)
1947+forall_i: dd eq_true_intro
1948+conj: dd eq_true_intro
1949+andr: dd tt_intro
1950+andl: dd tt_intro
1951+forall_e: sym dd
1952+mp: andr sym dd
1953+i: dd andl conj
1954+cut: andr sym dd i
1955+cutth: cut
1956+lapply*: mp
1957+lforall*: mp forall_e
1958+apply*: lapply lforall
1959+applyth: cutth apply*
1960
1961- f converional sometimes fails
1962- conv (depth_tac) diverges when applied to terms that contain
1963  metavariables
1964- repeat is not implemented using progress, that is not even there
1965*/
1966
1967/*
1968-2.5) in the proof for myprop, at the end I provide the
1969  witness (and X X) where X remains free (and it is not even pi-quantified).
1970  If prop was empty, then X could not exist. On the other hand, if X was
1971  empty, then there would be no need to provide the proof at all.
1972  In any case, the symptom for X remaining free at the end of a proof is
1973  one or more goals delayed on it. We never check for them and we have
1974  no way atm to do that. See bug -3)
1975
1976-2) the test apply_2 is very slow: why?
1977    same for the witness for myprop
1978
19790) definitions must not be recursive; typing should capture it
1980   (but not if declare_constraint is commented out...)
1981
19820.25) occurr check in bind case still missing :-(
1983
19840.50) case AppUvar vs AppUVar in unification is bugged (e.g.)
1985      X^2 x0 x1 = X^2 x0 x1
1986
19872) we need to fix the ELPI problems about handling of metavariables.
1988 I have already discussed with Enrico about them and he could have a
1989 shot at them. Namely:
1990 a) occur check + optimization to avoid it when possible (IN PROGRESS)
1991 b) unimplemented cases of restriction (IN PROGRESS)
1992
19933) once we let metavariables reach the goals, the current HOL-light 
1994 tactic implementation becomes too fragile. We should let the user 
1995 refer to hypotheses at least by number if not by name. But we better
1996 have a bidirectional successor/predecessor via declare_constraint
1997
19985) we could implement an automated theorem prover in lambdaProlog
1999 that works or is interfaced with the HOL-light code. There are
2000 complete provers like leanCOP 2.0 that are only 10 lines of code,
2001 but use some Prolog tricks.
2002
20036) we should do a small formalization, possibly developing a tactic,
2004 to prove that everything is working. For example, a decision procedure
2005 for rings or for linear inequations.
2006
2007*/

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/hollight_legacy.elpi", line 3, column 0, character 24:
Mixfix directives are not supported by this parser.

The parser is based on token families.
A family is identified by some starting characters, for example
a token '+-->' belongs to the family of '+'. There is no need
to declare it.

All the tokens of a family are parsed with the same precedence and
associativity, for example 'x +--> y *--> z' is parsed as
'x +--> (y *--> z)' since the family of '*' has higher precedence
than the family of '+'.

Here the table of tokens and token families.
Token families are represented by the start symbols followed by '..'.
Tokens of families marked with [*] cannot end with the starting symbol,
eg `foo` is not an infix, while `foo is.
The listing is ordered by increasing precedence.

fixity                     | tokens / token families
-------------------------- + -----------------------------------
Infix   not   associative  | :-  ?-
Infix   right associative  | ;
Infix   right associative  | ,  &
Infix   right associative  | ->
Infix   right associative  | =>
Infix   not   associative  | =  ==  =<  r<  i<  s<  r=<  i=<  s=<
                             <..  r>  i>  s>  r>=  i>=  s>=  >..
                             is
Infix   right associative  | ::
Infix   not   associative  | '.. [*]
Infix   left  associative  | ^..  r+  i+  s+  +..  -  r-  i-  s-
Infix   left  associative  | r*  i*  s*  *..  /  div  mod
Infix   right associative  | --..
Infix   not   associative  | `.. [*]
Infix   right associative  | ==..
Infix   right associative  | ||..
Infix   right associative  | &&..
Infix   left  associative  | #..
Prefix  not   associative  | r~  i~  ~..
Postfix not   associative  | ?..

If the token is a valid mixfix, and you want the file to stay compatible
with Teyjus, you can ask Elpi to skip the directive. Eg:

% elpi:skip 2  // skips the next two lines
infixr ==> 120.
infixr || 120.

As a debugging facility one can ask Elpi to print the AST in order to
verify how the text was parsed. Eg:

echo 'MyFormula = a || b ==> c && d' | elpi -parse-term

../../tests/sources/hyp_uvar.elpi :

1pred f i:any.
2
3main :-
4  (f uvar :- print "ok") => (f X, not(f 1)), var X.

ok

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.059

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/impl.elpi :

 1% q X Y shoud yield X=ok Y=ok
 2
 3q X Y :- (r a => p X), f X Y.
 4
 5f ok ko :- r a.
 6f ok ok.
 7
 8p ko :- r a.
 9p ok :- r a.
10
11main :- q X Y, X = ok, Y = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl.elpi", line 3, column 0, character 31:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl.elpi", line 3, column 0, character 31:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl.elpi", line 3, column 0, character 31:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl.elpi", line 5, column 0, character 62:
 Warning: constant ko has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl.elpi", line 3, column 0, character 31:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl.elpi", line 3, column 0, character 31:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.072

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/impl2.elpi :

1% q X yields X=ok
2
3q X :- (a, (b :- a), (a => c)) => (b,c => r ok) => r X.
4
5main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl2.elpi", line 3, column 0, character 19:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl2.elpi", line 3, column 0, character 19:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl2.elpi", line 3, column 0, character 19:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl2.elpi", line 3, column 0, character 19:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/impl2.elpi", line 3, column 0, character 19:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.069

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/index2.elpi :

  1% to be traced
  2
  3:index(_ _ _ _ _ _ _ _ 1)
  4pred p i:int, i:int, i:int, i:int, i:int, i:int, i:int, i:int, i:int.
  5p X X X X X X X X 2.
  6p X X X X X X X X 2.
  7p X X X X X X X X 2.
  8p X X X X X X X X 2.
  9p X X X X X X X X 2.
 10p X X X X X X X X 2.
 11p X X X X X X X X 2.
 12p X X X X X X X X 2.
 13p X X X X X X X X 2.
 14p X X X X X X X X 2.
 15p X X X X X X X X 2.
 16p X X X X X X X X 2.
 17p X X X X X X X X 2.
 18p X X X X X X X X 2.
 19p X X X X X X X X 2.
 20p X X X X X X X X 2.
 21p X X X X X X X X 2.
 22p X X X X X X X X 2.
 23p X X X X X X X X 2.
 24p X X X X X X X X 2.
 25p X X X X X X X X 2.
 26p X X X X X X X X 2.
 27p X X X X X X X X 2.
 28p X X X X X X X X 2.
 29p X X X X X X X X 2.
 30p X X X X X X X X 2.
 31p X X X X X X X X 2.
 32p X X X X X X X X 2.
 33p X X X X X X X X 2.
 34p X X X X X X X X 2.
 35p X X X X X X X X 2.
 36p X X X X X X X X 2.
 37p X X X X X X X X 2.
 38p X X X X X X X X 2.
 39p X X X X X X X X 2.
 40p X X X X X X X X 2.
 41p X X X X X X X X 2.
 42p X X X X X X X X 2.
 43p X X X X X X X X 2.
 44p X X X X X X X X 2.
 45p X X X X X X X X 2.
 46p X X X X X X X X 2.
 47p X X X X X X X X 2.
 48p X X X X X X X X 2.
 49p X X X X X X X X 2.
 50p X X X X X X X X 2.
 51p X X X X X X X X 2.
 52p X X X X X X X X 2.
 53p X X X X X X X X 2.
 54p X X X X X X X X 2.
 55p X X X X X X X X 2.
 56p X X X X X X X X 2.
 57p X X X X X X X X 2.
 58p X X X X X X X X 2.
 59p X X X X X X X X 2.
 60p X X X X X X X X 2.
 61p X X X X X X X X 2.
 62p X X X X X X X X 2.
 63p X X X X X X X X 2.
 64p X X X X X X X X 2.
 65p X X X X X X X X 2.
 66p X X X X X X X X 2.
 67p X X X X X X X X 2.
 68p X X X X X X X X 2.
 69p X X X X X X X X 2.
 70p X X X X X X X X 2.
 71p X X X X X X X X 2.
 72p X X X X X X X X 2.
 73p X X X X X X X X 2.
 74p X X X X X X X X 2.
 75p X X X X X X X X 2.
 76p X X X X X X X X 2.
 77p X X X X X X X X 2.
 78p X X X X X X X X 2.
 79p X X X X X X X X 2.
 80p X X X X X X X X 2.
 81p X X X X X X X X 2.
 82p X X X X X X X X 2.
 83p X X X X X X X X 2.
 84p X X X X X X X X 2.
 85p X X X X X X X X 2.
 86p X X X X X X X X 2.
 87p X X X X X X X X 2.
 88p X X X X X X X X 2.
 89p X X X X X X X X 2.
 90p X X X X X X X X 2.
 91p X X X X X X X X 2.
 92p X X X X X X X X 2.
 93p X X X X X X X X 2.
 94p X X X X X X X X 2.
 95p X X X X X X X X 2.
 96p X X X X X X X X 2.
 97p X X X X X X X X 2.
 98p X X X X X X X X 2.
 99p X X X X X X X X 2.
100p X X X X X X X X 2.
101p X X X X X X X X 2.
102p X X X X X X X X 2.
103p X X X X X X X X 2.
104p X X X X X X X X 2.
105p X X X X X X X X 2.
106p X X X X X X X X 2.
107p X X X X X X X X 2.
108p X X X X X X X X 2.
109p X X X X X X X X 1.
110
111iter N P :- N > 0, !, P, M is N - 1, iter M P.
112iter 0 _.
113
114main :-
115  iter 999999 (p 1 1 1 1 1 1 1 1 1).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/index2.elpi", line 111, column 0, character 2318:
 Warning: constant iter has no declared type.

Parsing time: 0.001

Compilation time: 0.002

Typechecking time: 0.066

Success:

Time: 1.267

Constraints:


State:

../../tests/sources/io_colon.elpi :

1main :- (pi i\ f i :- true) => f 1.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/io_colon.elpi", line 1, column 0, character 0:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.066

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/lambda.elpi :

 1% test Z yields Z=impl(impl A B) (impl A B)
 2
 3% Type inference for simply typed lambda terms
 4% Syntax: t ::= appl t t | abs F    where F is a function t -> t
 5% Syntax: ty ::= impl ty ty
 6
 7of (appl T1 T2) B :- of T1 (impl A B), of T2 A.
 8of (lam F) (impl A B) :- pi x\ of x A => of (F x) B.
 9
10test Z :- of (lam f\ lam a\ appl f a) Z.
11
12main :- test Z, Z = impl (impl a b) (impl a b).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda.elpi", line 10, column 0, character 288:
 Warning: constant test has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda.elpi", line 7, column 0, character 186:
 Warning: constant of has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda.elpi", line 8, column 0, character 234:
 Warning: constant lam has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda.elpi", line 7, column 0, character 186:
 Warning: constant impl has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda.elpi", line 12, column 0, character 330:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda.elpi", line 7, column 0, character 186:
 Warning: constant appl has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda.elpi", line 12, column 0, character 330:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.080

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/lambda2.elpi :

1% q X yields X=ok
2
3q X :- r X (x\ p x).
4
5r ko (x\ g x).
6r ok (y\ p y).
7
8main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda2.elpi", line 3, column 0, character 19:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda2.elpi", line 3, column 0, character 19:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda2.elpi", line 3, column 0, character 19:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda2.elpi", line 5, column 0, character 41:
 Warning: constant ko has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda2.elpi", line 5, column 0, character 41:
 Warning: constant g has no declared type. Did you mean gc.get ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.072

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/lambda3.elpi :

 1%%%module lambda3.
 2
 3of (appl T1 T2) B :- of T1 (impl A B), of T2 A.
 4of (lam F) (impl A B) :- pi x\ of x A => of (F x) B.
 5
 6append (xcons X XS) L (xcons X L1)  :- append XS L L1 .
 7append xnil L L .
 8
 9termify xnil (lam x\x).
10termify (xcons X XS) (lam F) :- pi c\ termify XS (F c).
11
12test L :- 
13  X1 = (xcons x0 (xcons x1 (xcons x2 (xcons x3 (xcons x4 (xcons x5 (xcons x6 (xcons x7 (xcons x8 (xcons x9 (xcons x10 xnil))))))))))), 
14  append X1 X1 X2 ,
15  append X2 X2 X3 ,
16  append X3 X3 X4 ,
17  append X4 X4 X5 ,
18  append X5 X5 X6 ,
19  % append X6 X6 X7 ,
20  % append X7 X7 X8 ,
21  % append X8 X8 X9 ,
22  % append X9 X9 X10 ,
23  % append X10 X10 X11 ,
24  % append X11 X11 X12 ,
25  % append X12 X12 X13 ,
26  % append X13 X13 X14 ,
27   % append X14 X14 X15 ,
28   % append X15 X15 X16 ,
29   % append X16 X16 X17 ,
30   % append X17 X17 X18 ,
31   X = X6 ,
32   termify X L.
33
34once L :- of L Z.
35
36iter zero X.
37iter (s N) X :- X, iter N X.
38
39plus zero X X.
40plus (s X) Y (s S) :- plus X Y S.
41
42mult zero X zero.
43mult (s X) Y Z :- mult X Y K, plus Y K Z.
44
45exp zero X (s zero).
46exp (s X) Y Z :- exp X Y K, mult Y K Z.
47
48main :-
49 TEN = s (s (s (s (s (s (s (s (s (s zero))))))))),
50 exp (s (s (s zero))) TEN THOUSAND,
51 test L,
52 iter THOUSAND (once L).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 36, column 0, character 866:
 Warning: constant zero has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 7, column 0, character 178:
 Warning: constant xnil has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 6, column 0, character 122:
 Warning: constant xcons has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: constant x9 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: constant x8 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: constant x7 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: constant x6 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: constant x5 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: constant x4 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: constant x3 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 12, column 0, character 278:
 Warning: [suppressing 29 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 10, column 0, character 221:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 34, column 0, character 847:
 Warning: Z is linear: name it _Z (discard) or Z_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 36, column 0, character 866:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 42, column 0, character 959:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/lambda3.elpi", line 45, column 0, character 1020:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.097

Success:

Time: 0.280

Constraints:


State:

../../tests/sources/list_as_conj.elpi :

1type a,b prop.
2f :- [print a, print b, a].
3a :- (b :- [print "done"]) => b.
4
5main :- f.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/list_as_conj.elpi", line 2, column 0, character 15:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
a
b
done

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.061

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/list_comma.elpi :

1main :-
2  L1 = [1,2,3,],
3  L2 = [1,2,3],
4  std.length L1 = std.length L2.

Parsing time: 0.000

Compilation time: 0.001

Typechecking time: 0.064

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/llam.elpi :

 1spy X :-  counter "run" N, print N "test " X, 
 2  not(not(X)).
 3
 4type test ((A -> A -> prop) -> B -> prop) -> B -> prop.
 5test P T :-
 6  spy(P (x\y\x = y) F, F = T),
 7  spy(P (x\y\y = x) F, F = T),
 8  spy(pi dummy\ sigma F\ P (x\y\x = y) F, F = T),
 9  spy(pi dummy\ sigma F\ P (x\y\y = x) F, F = T)
10  , print "----------------------------------------"
11  .
12
13clause (x\y\F y x) :- F = a\b\b.
14clause1 (x\y\x).
15clause2 (x\y\X x, F y (X x)) :- F = a\b\b.
16
17type r A -> B.
18prune_arg (r F).
19prune_arg2 (r (x\F x)).
20prune_arg3 (r (x\y\F y x)).
21
22main :-
23  test (eq\F\        pi x\ pi y\ eq (F y x) x)             (a\b\b),
24  test (eq\F\   not (pi x\ pi y\ eq (F x) y))              whatever,
25  test (eq\F\        pi x\ pi y\ eq (F y x) (r (w\h w x))) (a\b\r (x\h x b)),
26  test (eq\F\        pi x\ pi y\ sigma R\ R = x, eq (F y x) R)             (a\b\b),
27  test (eq\F\   not (pi x\ pi y\ sigma R\ R = x, eq (F R) y))              whatever,
28  test (eq\F\        pi x\ pi y\ sigma R\ R = x, eq (F y x) (r (w\h w R))) (a\b\r (x\h x b)),
29  spy (pi dummy\ clause (x\y\x)),
30  (pi dummy\ clause1 (x\y\F y x), F = a\b\b),
31  (pi dummy\ clause2 (x\y\x,x)),
32  (clause3 (x\y\G y x) => pi dummy\ clause3 (x\y\x)), (G = a\b\b),
33  test (eq\F\        sigma H\pi x\ pi y\ eq (F y) (r (H y x)), H x x = x, H x y = x)   (a\r a),
34
35  % this is hard because F<H but is applied to y that H can see, so H is restricted to the
36  % level of F (that alone would prune y) but applied to y, so H 1 = y works
37  test (eq\F\        pi x\ pi y\ sigma H\ pi z\pi w\eq (F y) (r (H w)),
38                                                    spy(H 1 = y), not(H 2 = x))
39       (a\r whatever),
40  test (eq\F\        pi x\ pi y\ sigma H\ pi w\eq (F y x) (r (H w)),
41                                               H 1 = f x y)
42       (a\b\r (f b a)),
43 
44  test (eq\F\        pi x\pi y\prune_arg (F y x))  (a\b\r (v a b)),
45  test (eq\F\        pi x\pi y\prune_arg2 (F y x)) (a\b\r (x\v a b)),
46  test (eq\F\        pi x\pi y\prune_arg3 (F y x)) (a\b\r (x\y\v a b)),
47 
48  true.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 22, column 0, character 529:
 Warning: constant whatever has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 22, column 0, character 529:
 Warning: constant v has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 1, column 0, character 0:
 Warning:
 constant spy has no declared type. Did you mean std.spy std.spy! std.spy-do! ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 20, column 0, character 500:
 Warning: constant prune_arg3 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 19, column 0, character 476:
 Warning: constant prune_arg2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 18, column 0, character 459:
 Warning: constant prune_arg has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 22, column 0, character 529:
 Warning:
 constant h has no declared type. Did you mean std.set.private.height std.map.private.height ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 22, column 0, character 529:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 22, column 0, character 529:
 Warning: constant clause3 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 15, column 0, character 400:
 Warning: constant clause2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 14, column 0, character 383:
 Warning: [suppressing 2 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 18, column 0, character 459:
 Warning: F is linear: name it _F (discard) or F_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 19, column 0, character 476:
 Warning: F is linear: name it _F (discard) or F_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llam.elpi", line 20, column 0, character 500:
 Warning: F is linear: name it _F (discard) or F_ (fresh variable)
0 test  pi c0 \ pi c1 \ X0 c1 c0 = c0 , X0 = (c0 \ c1 \ c1)
0 test  pi c0 \ pi c1 \ c0 = X0 c1 c0 , X0 = (c0 \ c1 \ c1)
0 test  pi c0 \ sigma c1 \ pi c2 \ pi c3 \ c1 c3 c2 = c2 , c1 = (c2 \ c3 \ c3)
0 test  pi c0 \ sigma c1 \ pi c2 \ pi c3 \ c2 = c1 c3 c2 , c1 = (c2 \ c3 \ c3)
----------------------------------------
0 test  not (pi c0 \ pi c1 \ X1 c0 = c1) , X1 = whatever
0 test  not (pi c0 \ pi c1 \ c1 = X1 c0) , X1 = whatever
0 test  pi c0 \ sigma c1 \ not (pi c2 \ pi c3 \ c1 c2 = c3) , c1 = whatever
0 test  pi c0 \ sigma c1 \ not (pi c2 \ pi c3 \ c3 = c1 c2) , c1 = whatever
----------------------------------------
0 test
 pi c0 \ pi c1 \ X2 c1 c0 = r c2 \ h c2 c0 , X2 = (c0 \ c1 \ r c2 \ h c2 c1)
0 test
 pi c0 \ pi c1 \ r c2 \ h c2 c0 = X2 c1 c0 , X2 = (c0 \ c1 \ r c2 \ h c2 c1)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ c1 c3 c2 = r c4 \ h c4 c2 , c1 = (c2 \ c3 \ r c4 \ h c4 c3)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ r c4 \ h c4 c2 = c1 c3 c2 , c1 = (c2 \ c3 \ r c4 \ h c4 c3)
----------------------------------------
0 test
 pi c0 \ pi c1 \ sigma c2 \ c2 = c0 , X3 c1 c0 = c2 , X3 = (c0 \ c1 \ c1)
0 test
 pi c0 \ pi c1 \ sigma c2 \ c2 = c0 , c2 = X3 c1 c0 , X3 = (c0 \ c1 \ c1)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ sigma c4 \ c4 = c2 , c1 c3 c2 = c4 , c1 = (c2 \ c3 \ c3)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ sigma c4 \ c4 = c2 , c4 = c1 c3 c2 , c1 = (c2 \ c3 \ c3)
----------------------------------------
0 test  not (pi c0 \ pi c1 \ sigma c2 \ c2 = c0 , X4 c2 = c1) , X4 = whatever
0 test  not (pi c0 \ pi c1 \ sigma c2 \ c2 = c0 , c1 = X4 c2) , X4 = whatever
0 test
 pi c0 \
  sigma c1 \
   not (pi c2 \ pi c3 \ sigma c4 \ c4 = c2 , c1 c4 = c3) , c1 = whatever
0 test
 pi c0 \
  sigma c1 \
   not (pi c2 \ pi c3 \ sigma c4 \ c4 = c2 , c3 = c1 c4) , c1 = whatever
----------------------------------------
0 test
 pi c0 \ pi c1 \ sigma c2 \ c2 = c0 , X5 c1 c0 = r c3 \ h c3 c2 ,
  X5 = (c0 \ c1 \ r c2 \ h c2 c1)
0 test
 pi c0 \ pi c1 \ sigma c2 \ c2 = c0 , r c3 \ h c3 c2 = X5 c1 c0 ,
  X5 = (c0 \ c1 \ r c2 \ h c2 c1)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ sigma c4 \ c4 = c2 , c1 c3 c2 = r c5 \ h c5 c4 ,
    c1 = (c2 \ c3 \ r c4 \ h c4 c3)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ sigma c4 \ c4 = c2 , r c5 \ h c5 c4 = c1 c3 c2 ,
    c1 = (c2 \ c3 \ r c4 \ h c4 c3)
----------------------------------------
0 test  pi c0 \ clause c1 \ c2 \ c1
0 test
 sigma c0 \
  pi c1 \ pi c2 \ , (X6 c2 = r (c0 c2 c1)) (c0 c1 c1 = c1) (c0 c1 c2 = c1) ,
  X6 = (c0 \ r c0)
0 test
 sigma c0 \
  pi c1 \ pi c2 \ , (r (c0 c2 c1) = X6 c2) (c0 c1 c1 = c1) (c0 c1 c2 = c1) ,
  X6 = (c0 \ r c0)
0 test
 pi c0 \
  sigma c1 \
   sigma c2 \
    pi c3 \ pi c4 \ , (c1 c4 = r (c2 c4 c3)) (c2 c3 c3 = c3) (c2 c3 c4 = c3) ,
    c1 = (c2 \ r c2)
0 test
 pi c0 \
  sigma c1 \
   sigma c2 \
    pi c3 \ pi c4 \ , (r (c2 c4 c3) = c1 c4) (c2 c3 c3 = c3) (c2 c3 c4 = c3) ,
    c1 = (c2 \ r c2)
----------------------------------------
0 test
 pi c0 \
  pi c1 \
   sigma c2 \
    pi c3 \ pi c4 \ , (X7 c1 = r (c2 c4)) (spy (c2 1 = c1)) (not (c2 2 = c0)) ,
  X7 = (c0 \ r whatever)
0 test  X8 c1 = c1
0 test
 pi c0 \
  pi c1 \
   sigma c2 \
    pi c3 \ pi c4 \ , (r (c2 c4) = X7 c1) (spy (c2 1 = c1)) (not (c2 2 = c0)) ,
  X7 = (c0 \ r whatever)
0 test  X9 c1 = c1
0 test
 pi c0 \
  sigma c1 \
   pi c2 \
    pi c3 \
     sigma c4 \
      pi c5 \ pi c6 \ , (c1 c3 = r (c4 c6)) (spy (c4 1 = c3)) (not (c4 2 = c2))
    , c1 = (c2 \ r whatever)
0 test  X10^1 c2 = c2
0 test
 pi c0 \
  sigma c1 \
   pi c2 \
    pi c3 \
     sigma c4 \
      pi c5 \ pi c6 \ , (r (c4 c6) = c1 c3) (spy (c4 1 = c3)) (not (c4 2 = c2))
    , c1 = (c2 \ r whatever)
0 test  X11^1 c2 = c2
----------------------------------------
0 test
 pi c0 \ pi c1 \ sigma c2 \ pi c3 \ X12 c1 c0 = r (c2 c3) , c2 1 = f c0 c1 ,
  X12 = (c0 \ c1 \ r (f c1 c0))
0 test
 pi c0 \ pi c1 \ sigma c2 \ pi c3 \ r (c2 c3) = X12 c1 c0 , c2 1 = f c0 c1 ,
  X12 = (c0 \ c1 \ r (f c1 c0))
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ sigma c4 \ pi c5 \ c1 c3 c2 = r (c4 c5) , c4 1 = f c2 c3 ,
    c1 = (c2 \ c3 \ r (f c3 c2))
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ sigma c4 \ pi c5 \ r (c4 c5) = c1 c3 c2 , c4 1 = f c2 c3 ,
    c1 = (c2 \ c3 \ r (f c3 c2))
----------------------------------------
0 test  pi c0 \ pi c1 \ prune_arg (X13 c1 c0) , X13 = (c0 \ c1 \ r (v c0 c1))
0 test  pi c0 \ pi c1 \ prune_arg (X13 c1 c0) , X13 = (c0 \ c1 \ r (v c0 c1))
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ prune_arg (c1 c3 c2) , c1 = (c2 \ c3 \ r (v c2 c3))
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ prune_arg (c1 c3 c2) , c1 = (c2 \ c3 \ r (v c2 c3))
----------------------------------------
0 test
 pi c0 \ pi c1 \ prune_arg2 (X14 c1 c0) , X14 = (c0 \ c1 \ r c2 \ v c0 c1)
0 test
 pi c0 \ pi c1 \ prune_arg2 (X14 c1 c0) , X14 = (c0 \ c1 \ r c2 \ v c0 c1)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ prune_arg2 (c1 c3 c2) , c1 = (c2 \ c3 \ r c4 \ v c2 c3)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ prune_arg2 (c1 c3 c2) , c1 = (c2 \ c3 \ r c4 \ v c2 c3)
----------------------------------------
0 test
 pi c0 \ pi c1 \ prune_arg3 (X15 c1 c0) , X15 = (c0 \ c1 \ r c2 \ c3 \ v c0 c1)
0 test
 pi c0 \ pi c1 \ prune_arg3 (X15 c1 c0) , X15 = (c0 \ c1 \ r c2 \ c3 \ v c0 c1)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ prune_arg3 (c1 c3 c2) , c1 = (c2 \ c3 \ r c4 \ c5 \ v c2 c3)
0 test
 pi c0 \
  sigma c1 \
   pi c2 \ pi c3 \ prune_arg3 (c1 c3 c2) , c1 = (c2 \ c3 \ r c4 \ c5 \ v c2 c3)
----------------------------------------

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.095

Success:

Time: 0.002

Constraints:


State:

../../tests/sources/llamchr.elpi :

 1mode (term i o).
 2
 3term (app X Y) B :- term X (arr A B), term Y A.
 4term (lam A F) (arr A B) :- pi x\ term x A => term (F x) B.
 5term (uvar as X) A :- declare_constraint (term X A) [X].
 6term true bool.
 7term false bool.
 8term zero nat.
 9term succ (arr nat nat).
10
11constraint term {
12  rule (GX ?- term (uvar K LX) TX)
13     \ (GY ?- term (uvar K LY) TY)
14     | (compatible GX LX GY LY CTXCONSTR)
15   <=> [ TX = TY , CTXCONSTR ].
16}
17
18% resilient to dummy ctx variables
19both_or_none P Q :- P, !, Q.
20both_or_none P Q :- not P, not Q.
21
22compatible _ [] _ [] [] :- !.
23compatible GX [X|XS] GY [Y|YS] [TX = TY | K] :-
24 both_or_none (GX => term X TX) (GY => term Y TY),
25 !,
26 compatible GX XS GY YS K.
27compatible _ _ _ _ [false].
28
29spy P :- print "[" P, P, print "]ok", !.
30spy P :- print "]fail", fail.
31
32mode (watch i).
33watch (uvar as X) :- declare_constraint (print "watch" X) [X], !.
34watch X :- print "watch" X.
35
36main :- 
37  % this is tricky becasuse X sees w, so CHR has to deal with a dirty context
38  pi w\ (sigma X A B C A' B' T1 T2 \ pi v\
39    term b2n (arr bool nat) =>
40      (T1 = (lam _ x \ lam _ y\ X x y),
41       T2 = (lam _ x \ lam _ y\ X y x),
42       term T1 (arr A (arr B nat)),
43       term T2 (arr A' (arr B' C)),
44       print A A' B B' C "|" T1 "|" T2,
45       spy (X = x\y\ x),
46       print A A' B B' C "|" T1 "|" T2,
47       spy (term (app T2 false) _),
48       print A A' B B' C "|" T1 "|" T2)),
49  true.
50
51% vim: set ft=lprolog:

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 8, column 0, character 216:
 Warning: constant zero has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 33, column 0, character 798:
 Warning: constant watch has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 3, column 0, character 18:
 Warning: constant term has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 9, column 0, character 231:
 Warning: constant succ has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 29, column 0, character 710:
 Warning:
 constant spy has no declared type. Did you mean std.spy std.spy! std.spy-do! ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 8, column 0, character 216:
 Warning: constant nat has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 4, column 0, character 66:
 Warning: constant lam has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 22, column 0, character 521:
 Warning: constant compatible has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 19, column 0, character 457:
 Warning: constant both_or_none has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 36, column 0, character 893:
 Warning: constant b2n has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 3, column 0, character 18:
 Warning: [suppressing 2 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/llamchr.elpi", line 30, column 0, character 751:
 Warning: P is linear: name it _P (discard) or P_ (fresh variable)
X0 X1 X1 X0 nat | lam X0 c2 \ lam X1 c3 \ X2 c0 c2 c3 |
 lam X1 c2 \ lam X0 c3 \ X2 c0 c3 c2
[ (c2 \ c3 \ X2 c0 c2 c3) = (c2 \ c3 \ c2)
]ok
nat X1 X1 nat nat | lam nat c2 \ lam X1 c3 \ c2 | lam X1 c2 \ lam nat c3 \ c3
[ term (app (lam X1 c2 \ lam nat c3 \ c3) false) _
]ok
nat bool bool nat nat | lam nat c2 \ lam bool c3 \ c2 |
 lam bool c2 \ lam nat c3 \ c3

Parsing time: 0.000

Compilation time: 0.003

Typechecking time: 0.094

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/map.elpi :

 1
 2pred build i:int, i:int, i:std.map int int, o:std.map int int.
 3build N N X X :- !.
 4build N M X X1 :-
 5  N1 is N + 1,
 6  std.map.add N N X XR,
 7  build N1 M XR X1.
 8
 9pred test i:int, i:int, i:(B -> A -> B -> prop), i:A.
10test N N _ _ :- !.
11test N M F X :-
12  N1 is N + 1,
13  std.assert! (F N X N) "not found",
14  test N1 M F X.
15
16pred test2 i:int, i:int, i:(B -> A -> A -> prop), i:A.
17test2 N N _ _ :- !.
18test2 N M F X :-
19  N1 is N + 1,
20  std.assert! (F N X X1) "not found",
21  test2 N1 M F X1.
22
23macro @iters :- 4096.
24
25main :-
26  std.time (build 0 @iters {std.map.make cmp_term} T) Time0, !,
27  std.time (test 0 @iters std.map.find T) Time1, !,
28  std.map.bindings T B,
29  std.assert! ({std.length B} = @iters, B = [pr 0 0|_]) "bindings broken", !,
30  std.time (test2 0 @iters std.map.remove T) Time2, !,
31  print Time0 "+" Time1 "+" Time2.

0.906139 + 0.038838 + 0.639453

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.057

Success:

Time: 1.715

Constraints:


State:

../../tests/sources/map_list.elpi :

 1kind l type.
 2type n l.
 3type c (pair int int) -> l -> l.
 4
 5pred add i:int, i:int, i:l, o:l.
 6add K V n (c (pr K V) n) :- !.
 7add K V (c (pr K _) L) (c (pr K V) L) :- !.
 8add K V (c X L) (c X L1) :- add K V L L1.
 9
10pred bindings i:l, o:list (pair int int).
11bindings n [].
12bindings (c X L) [X|L1] :- bindings L L1.
13
14pred assoc i:int, i:l, o:int.
15assoc K (c (pr K V) _) V :- !.
16assoc K (c _ L) V :- assoc K L V.
17
18pred remove i:int, i:l, o:l.
19remove K (c (pr K _) L) L :- !.
20remove K (c X L) (c X L1) :- remove K L L1.
21
22pred build i:int, i:int, i:l, o:l.
23build N N X X :- !.
24build N M X X1 :-
25  N1 is N + 1,
26  add N N X XR,
27  build N1 M XR X1.
28
29pred test i:int, i:int, i:(B -> A -> B -> prop), i:A.
30test N N _ _ :- !.
31test N M F X :-
32  N1 is N + 1,
33  std.assert! (F N X N) "not found",
34  test N1 M F X.
35
36pred test2 i:int, i:int, i:(B -> A -> A -> prop), i:A.
37test2 N N _ _ :- !.
38test2 N M F X :-
39  N1 is N + 1,
40  std.assert! (F N X X1) "not found",
41  test2 N1 M F X1.
42
43macro @iters :- 4096.
44
45main :-
46  std.time (build 0 @iters n T) Time0, !,
47  std.time (test 0 @iters assoc T) Time1, !,
48  bindings T B,
49  std.assert! ({std.length B} = @iters, B = [pr 0 0|_]) "bindings broken", !,
50  std.time (test2 0 @iters remove T) Time2, !,
51  print Time0 "+" Time1 "+" Time2.

5.650392 + 3.082371 + 0.386618

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.064

Success:

Time: 9.126

Constraints:


State:

../../tests/sources/map_list_opt.elpi :

 1pred add i:int, i:int, i:list (pair int int), o:list (pair int int).
 2add K V [] [pr K V] :- !.
 3add K V [pr K _| L] [pr K V| L] :- !.
 4add K V [X| L] [X| L1] :- add K V L L1.
 5
 6pred bindings i:list (pair int int), o:list (pair int int).
 7bindings X X.
 8
 9pred assoc i:int, i:list (pair int int), o:int.
10assoc K [pr K V| _] V :- !.
11assoc K [_| L] V :- assoc K L V.
12
13pred remove i:int, i:list (pair int int), o:list (pair int int).
14remove K [pr K _| L] L :- !.
15remove K [X| L] [X| L1] :- remove K L L1.
16
17pred build i:int, i:int, i:list (pair int int), o:list (pair int int).
18build N N X X :- !.
19build N M X X1 :-
20  N1 is N + 1,
21  add N N X XR,
22  build N1 M XR X1.
23
24pred test i:int, i:int, i:(B -> A -> B -> prop), i:A.
25test N N _ _ :- !.
26test N M F X :-
27  N1 is N + 1,
28  std.assert! (F N X N) "not found",
29  test N1 M F X.
30
31pred test2 i:int, i:int, i:(B -> A -> A -> prop), i:A.
32test2 N N _ _ :- !.
33test2 N M F X :-
34  N1 is N + 1,
35  std.assert! (F N X X1) "not found",
36  test2 N1 M F X1.
37
38macro @iters :- 4096.
39
40main :-
41  std.time (build 0 @iters [] T) Time0, !,
42  std.time (test 0 @iters assoc T) Time1, !,
43  bindings T B,
44  std.assert! ({std.length B} = @iters, B = [pr 0 0|_]) "bindings broken", !,
45  std.time (test2 0 @iters remove T) Time2, !,
46  print Time0 "+" Time1 "+" Time2.

6.174692 + 3.324478 + 0.302949

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.086

Success:

Time: 9.811

Constraints:


State:

../../tests/sources/name_builtin.elpi :

1main :-
2  (pi f x y\
3    name (f x y) f [x, y]),
4  (pi x\ name x x []),
5  (pi f x y\
6    name (A f x y) f [x,y], print "A=" A, A f x y = (f x y)),
7  (pi x\ name (B x) x [], print "B=" B, B x = x).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/name_builtin.elpi", line 1, column 0, character 0:
 Error: (c2) has type any but is applied to c3 c4

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.101
Type error. To ignore it, pass -no-tc.

../../tests/sources/named_clauses00.elpi :

1:name "name1"
2c1.
3
4:name "name1"
5c2.
6
7main.

Parsing time: 0.000
Fatal error: File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/named_clauses00.elpi", line 4, column 0, character 19:a clause named name1 already exists at File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/named_clauses00.elpi", line 1, column 0, character 0:

../../tests/sources/named_clauses01.elpi :

1:before "c"
2c1 
3
4main.

Parsing time: 0.000
Fatal error: File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/named_clauses01.elpi", line 2, column 0, character 1:unable to graft this clause: no clause named c

../../tests/sources/named_clauses02.elpi :

 1:name "c"
 2c :- !, fail.
 3
 4:before "c"
 5c :- true.
 6
 7:before "c"
 8c :- !, fail, fail.
 9
10main :- c.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/named_clauses02.elpi", line 5, column 0, character 26:
 Warning:
 constant c has no declared type. Did you mean std.set.private.create std.set.private.cardinal std.set.cardinal std.map.private.create std.string.concat std.string.set.cardinal std.int.set.cardinal std.loc.set.cardinal trace.counter gc.compact ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.103

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/namespaces00.elpi :

1namespace rev {
2  pred aux i:list A, i:list A, o:list A.
3  aux [X|XS] ACC R :- aux XS [X|ACC] R.
4  aux [] L L.
5}
6pred rev i:list A, o:list A.
7rev L RL  :- rev.aux L []  RL.
8
9main :- rev [1,2,3] [3,2,1], not(aux [] [] []), rev.aux [] [] [].

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces00.elpi", line 9, column 0, character 174:
 Warning: constant aux has no declared type. Did you mean rev.aux ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.092

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/namespaces01.elpi :

1toto 1.
2
3% We test toto is not put inside the namespace
4namespace foo {
5  bar X :- toto 2 => baz X.
6  baz X :- toto X.
7}
8main :- foo.bar 2, foo.baz 1.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces01.elpi", line 1, column 0, character 0:
 Warning: constant toto has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces01.elpi", line 5, column 3, character 75:
 Warning: constant foo.baz has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces01.elpi", line 5, column 3, character 75:
 Warning: constant foo.bar has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.104

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/namespaces02.elpi :

1namespace x {
2  namespace acc { accumulate namespaces00. }
3  foo :- rev.aux [] [] []. % does not exists, since it is inside acc
4}
5
6main :- x.acc.rev [1,2,3] [3,2,1], x.acc.rev.aux [] [] [], not(x.foo).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces02.elpi", line 3, column 3, character 62:
 Warning: constant x.foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces00.elpi", line 9, column 0, character 174:
 Warning: constant x.acc.main has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces00.elpi", line 9, column 0, character 174:
 Warning: constant aux has no declared type. Did you mean x.acc.rev.aux ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.123

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/namespaces03.elpi :

 1namespace a {
 2
 3  foo1 :- b.c.foo.
 4  foo2 :- b.foo1, b.foo2.
 5
 6  namespace b {
 7
 8    foo1 :- c.foo.
 9
10    namespace c {
11 
12      foo.
13   
14    }
15
16    foo2 :- c.foo.
17
18  }
19
20  foo3 :- b.c.foo.
21  foo4 :- b.foo1, b.foo2.
22
23}
24
25main :- a.foo1, a.foo2, a.foo3, a.foo4.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces03.elpi", line 21, column 3, character 187:
 Warning: constant a.foo4 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces03.elpi", line 20, column 3, character 168:
 Warning: constant a.foo3 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces03.elpi", line 4, column 3, character 37:
 Warning: constant a.foo2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces03.elpi", line 3, column 3, character 18:
 Warning: constant a.foo1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces03.elpi", line 4, column 3, character 37:
 Warning: constant a.b.foo2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces03.elpi", line 4, column 3, character 37:
 Warning: constant a.b.foo1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/namespaces03.elpi", line 3, column 3, character 18:
 Warning: constant a.b.c.foo has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.153

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/nil_cons.elpi :

1main :- [] = nil, 3 :: [] = cons 3 [].

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.096

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/notation.elpi :

 1module test.
 2/*
 3infixl x+,y+ 190.
 4infixr x++ 191.
 5prefixr z+ 191.
 6postfixl w+ 190.
 7infixl x* 200.
 8*/
 9X +x D.
10
11foo xx uu.
12
13~z x ?w.
14
15x *x y +x z *x w.
16
17a +x b +x c +x d +x e.
18a ++x b ++x c ++x d ++x e.
19
20type a A.
21type d A.
22type (+x) A -> B -> C.
23type (+y) A -> B -> C.
24
25main :- print (a a +x [b] +y d), cd +x d.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 13, column 0, character 122:
 Warning: constant ~z has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 15, column 0, character 132:
 Warning: constant z has no declared type. Did you mean std.zip ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 15, column 0, character 132:
 Warning: constant y has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 11, column 0, character 110:
 Warning: constant xx has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 13, column 0, character 122:
 Warning: constant x has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 15, column 0, character 132:
 Warning: constant w has no declared type. Did you mean std.while-ok-do! ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 11, column 0, character 110:
 Warning: constant uu has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 11, column 0, character 110:
 Warning: constant foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 17, column 0, character 151:
 Warning:
 constant e has no declared type. Did you mean std.set.private.empty std.set.private.elements std.set.elements std.map.private.empty std.exists std.exists2 std.string.map.empty std.int.map.empty std.loc.map.empty std.string.set.empty std.string.set.equal std.string.set.elements std.int.set.empty std.int.set.equal std.int.set.elements std.loc.set.empty std.loc.set.equal std.loc.set.elements ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 25, column 0, character 269:
 Warning: constant cd has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 17, column 0, character 151:
 Warning: [suppressing 5 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 9, column 0, character 101:
 Warning: D is linear: name it _D (discard) or D_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation.elpi", line 9, column 0, character 101:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
a a +x [b] +y d

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.160

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/notation_error.elpi :

1infix foo 1.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation_error.elpi", line 1, column 0, character 0:
Mixfix directives are not supported by this parser.

The parser is based on token families.
A family is identified by some starting characters, for example
a token '+-->' belongs to the family of '+'. There is no need
to declare it.

All the tokens of a family are parsed with the same precedence and
associativity, for example 'x +--> y *--> z' is parsed as
'x +--> (y *--> z)' since the family of '*' has higher precedence
than the family of '+'.

Here the table of tokens and token families.
Token families are represented by the start symbols followed by '..'.
Tokens of families marked with [*] cannot end with the starting symbol,
eg `foo` is not an infix, while `foo is.
The listing is ordered by increasing precedence.

fixity                     | tokens / token families
-------------------------- + -----------------------------------
Infix   not   associative  | :-  ?-
Infix   right associative  | ;
Infix   right associative  | ,  &
Infix   right associative  | ->
Infix   right associative  | =>
Infix   not   associative  | =  ==  =<  r<  i<  s<  r=<  i=<  s=<
                             <..  r>  i>  s>  r>=  i>=  s>=  >..
                             is
Infix   right associative  | ::
Infix   not   associative  | '.. [*]
Infix   left  associative  | ^..  r+  i+  s+  +..  -  r-  i-  s-
Infix   left  associative  | r*  i*  s*  *..  /  div  mod
Infix   right associative  | --..
Infix   not   associative  | `.. [*]
Infix   right associative  | ==..
Infix   right associative  | ||..
Infix   right associative  | &&..
Infix   left  associative  | #..
Prefix  not   associative  | r~  i~  ~..
Postfix not   associative  | ?..

If the token is a valid mixfix, and you want the file to stay compatible
with Teyjus, you can ask Elpi to skip the directive. Eg:

% elpi:skip 2  // skips the next two lines
infixr ==> 120.
infixr || 120.

As a debugging facility one can ask Elpi to print the AST in order to
verify how the text was parsed. Eg:

echo 'MyFormula = a || b ==> c && d' | elpi -parse-term

../../tests/sources/notation_legacy.elpi :

 1module test.
 2
 3infixl x+,y+ 190.
 4infixr x++ 191.
 5prefixr z+ 191.
 6postfixl w+ 190.
 7infixl x* 200.
 8
 9X x+ D.
10
11foo xx uu.
12
13z+ x w+.
14
15x x* y x+ z x* w.
16
17a x+ b x+ c x+ d x+ e.
18a x++ b x++ c x++ d x++ e.
19
20type a A.
21type d A.
22type (x+) A -> B -> C.
23type (y+) A -> B -> C.
24
25main :- print (a a x+ [b] y+ d), cd x+ d.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/notation_legacy.elpi", line 3, column 10, character 24:
Mixfix declaration expected (Teyjus compatibility, ignored by Elpi).
Examples:
infixl and 30.
infixr ++ 45.
prefix - 12.

../../tests/sources/patternunif.elpi :

1% q Y should yield Y = \\\f 2
2q Y :- pi b\ pi c\ (r :- pi a\ s (f a) => s (X b c a)) => r, Y = X.
3
4main :- q Y, Y = x\y\z\f z.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/patternunif.elpi", line 2, column 0, character 30:
 Warning:
 constant s has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.set.make std.set.mem std.set.add std.set.remove std.set.cardinal std.set.elements std.spy std.spy! std.split-at std.spy-do! rex.split random.self_init std.string.concat std.string.map std.string.map.empty std.string.map.mem std.string.map.add std.string.map.remove std.string.map.find std.string.map.bindings std.string.set std.string.set.empty std.string.set.mem std.string.set.add std.string.set.remove std.string.set.union std.string.set.inter std.string.set.diff std.string.set.equal std.string.set.subset std.string.set.elements std.string.set.cardinal std.int.set std.int.set.empty std.int.set.mem std.int.set.add std.int.set.remove std.int.set.union std.int.set.inter std.int.set.diff std.int.set.equal std.int.set.subset std.int.set.elements std.int.set.cardinal std.loc.set std.loc.set.empty std.loc.set.mem std.loc.set.add std.loc.set.remove std.loc.set.union std.loc.set.inter std.loc.set.diff std.loc.set.equal std.loc.set.subset std.loc.set.elements std.loc.set.cardinal std.set std.set gc.set gc.stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/patternunif.elpi", line 2, column 0, character 30:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/patternunif.elpi", line 2, column 0, character 30:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/patternunif.elpi", line 2, column 0, character 30:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.119

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/patternunif2.elpi :

1% r Y yields Y=\0
2q (a\ X a) X.
3r A :- pi c\ q (a\a) A.
4
5main :- r Y, Y = x\x.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/patternunif2.elpi", line 3, column 0, character 32:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/patternunif2.elpi", line 2, column 0, character 18:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.093

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/pi.elpi :

1% q X yields X=ok
2
3q X :- pi x\ p x => pi y\ r y => z x y X.
4
5z A B ko :- r A, p B.
6z A B ok :- p A, r B.
7
8main :- q X, X = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi.elpi", line 3, column 0, character 19:
 Warning: constant z has no declared type. Did you mean std.zip ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi.elpi", line 3, column 0, character 19:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi.elpi", line 3, column 0, character 19:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi.elpi", line 3, column 0, character 19:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi.elpi", line 5, column 0, character 62:
 Warning: constant ko has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.113

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/pi3.elpi :

1% q X yields X=\0, i.e. X=b\b
2
3q X :- pi x\ pi y\ z (w\ X).
4
5z (a\ a).
6z (a\ b\ b).
7
8main :- q X, X = b\b.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi3.elpi", line 3, column 0, character 31:
 Warning: constant z has no declared type. Did you mean std.zip ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi3.elpi", line 3, column 0, character 31:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.096

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/pi5.elpi :

 1% q X, r X, s X all yields X=ok
 2
 3of stop.
 4of (bam x\x).
 5of (lam x\F) :- pi w\ of F.
 6
 7q X :- of (lam x\ bam y\ y), X = ok.
 8r X :- of (bam y\ y), X = ok.
 9s X :- of (lam x\ lam y\ stop), X = ok.
10
11main :- q X, r S, s T, X = ok, S = ok, T = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi5.elpi", line 9, column 0, character 152:
 Warning:
 constant s has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.set.make std.set.mem std.set.add std.set.remove std.set.cardinal std.set.elements std.spy std.spy! std.split-at std.spy-do! rex.split random.self_init std.string.concat std.string.map std.string.map.empty std.string.map.mem std.string.map.add std.string.map.remove std.string.map.find std.string.map.bindings std.string.set std.string.set.empty std.string.set.mem std.string.set.add std.string.set.remove std.string.set.union std.string.set.inter std.string.set.diff std.string.set.equal std.string.set.subset std.string.set.elements std.string.set.cardinal std.int.set std.int.set.empty std.int.set.mem std.int.set.add std.int.set.remove std.int.set.union std.int.set.inter std.int.set.diff std.int.set.equal std.int.set.subset std.int.set.elements std.int.set.cardinal std.loc.set std.loc.set.empty std.loc.set.mem std.loc.set.add std.loc.set.remove std.loc.set.union std.loc.set.inter std.loc.set.diff std.loc.set.equal std.loc.set.subset std.loc.set.elements std.loc.set.cardinal std.set std.set gc.set gc.stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi5.elpi", line 8, column 0, character 122:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi5.elpi", line 7, column 0, character 85:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi5.elpi", line 3, column 0, character 33:
 Warning: constant of has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi5.elpi", line 5, column 0, character 56:
 Warning: constant lam has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pi5.elpi", line 4, column 0, character 42:
 Warning: constant bam has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.110

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/pnf.elpi :

 1
 2/*
 3 * Predicates for transforming formulas into prenex normal form 
 4 * assuming classical logic equivalences. This is an example of 
 5 * analyzing formula structure, including recursion over bindings
 6 * and generating modified structure based on this analysis
 7 */
 8
 9%module  pnf.
10
11%type  merge  (form -> form -> o).
12
13type perp, tru formula.
14type and, or, imp formula -> formula -> formula.
15type adj, path term -> term -> formula.
16type all, some (term -> formula) -> formula.
17
18quant_free perp.
19quant_free tru.
20quant_free A :- atom A.
21quant_free (and B C) :- quant_free B, quant_free C.
22quant_free (or B C) :- quant_free B, quant_free C.
23quant_free (imp B C) :- quant_free B, quant_free C.
24
25atom (path X Y) :- termp X, termp Y.
26atom (adj X Y) :- termp X, termp Y.
27
28type a, b, c term.
29type f term -> term.
30
31termp a.
32termp b.
33termp c.
34termp (f X) :- termp X.
35
36(prenex B B) :- (quant_free B), !. 
37(prenex (and B C) D) :- (prenex B U), (prenex C V), (merge (and U V) D).
38(prenex (or B C) D) :- (prenex B U), (prenex C V), (merge (or U V) D).
39(prenex (imp B C) D) :- (prenex B U), (prenex C V), (merge (imp U V) D).
40(prenex (all B) (all D)) :- (pi x\ ((termp x) => (prenex (B x) (D x)))).
41(prenex (some B) (some D)) :- (pi x\ ((termp x) => (prenex (B x) (D x)))).
42
43
44/* This predicate is for moving out quantifiers appearing at the head of the 
45immediate subformulas of a formula with a propositional connective as its 
46top-level symbol */
47(merge (and (all B) (all C)) (all D)) :-
48       (pi x\ ((termp x) => (merge (and (B x) (C x)) (D x)))).
49(merge (and (all B) C) (all D)) :- 
50       (pi x\ ((termp x) => (merge (and (B x) C) (D x)))).
51(merge (and B (all C)) (all D)) :- 
52       (pi x\ ((termp x) => (merge (and B (C x)) (D x)))).
53
54(merge (and (some B) C) (some D)) :- 
55       (pi x\ ((termp x) => (merge (and (B x) C) (D x)))).
56(merge (and B (some C)) (some D)) :-
57       (pi x\ ((termp x) => (merge (and B (C x)) (D x)))).
58
59(merge (or (all B) C) (all D)) :-
60       (pi x\ ((termp x) => (merge (or (B x) C) (D x)))).
61(merge (or B (all C)) (all D)) :-
62       (pi x\ ((termp x) => (merge (or B (C x)) (D x)))).
63(merge (or (some B) (some C)) (some D)) :-
64       (pi x\ ((termp x) => (merge (or (B x) (C x)) (D x)))).
65(merge (or (some B) C) (some D)) :-
66       (pi x\ ((termp x) => (merge (or (B x) C) (D x)))).
67(merge (or B (some C)) (some D)) :-
68       (pi x\ ((termp x) => (merge (or B (C x)) (D x)))).
69
70(merge (imp (all B) (some C)) (some D)) :- 
71       (pi x\ ((termp x) => (merge (imp (B x) (C x)) (D x)))).
72(merge (imp (all B) C) (some D)) :- 
73       (pi x\ ((termp x) => (merge (imp (B x) C) (D x)))).
74(merge (imp (some B) C) (all D)) :-
75       (pi x\ ((termp x) => (merge (imp (B x) C) (D x)))).
76(merge (imp B (all C)) (all D)) :-
77       (pi x\ ((termp x) => (merge (imp B (C x)) (D x)))).
78(merge (imp B (some C)) (some D)) :-
79       (pi x\ ((termp x) => (merge (imp B (C x)) (D x)))).
80
81(merge B B) :- (quant_free B).
82
83type one, two, three, four term.
84type formula term -> formula -> prop.
85
86formula one  (imp (all (x \ (path a x))) tru).
87formula two  (imp (some (x \ (path a x))) tru).
88formula three  (and (all (x \ (path a x))) (all (y \ (path y a)))).
89formula four  (imp (some (x \ (path a x))) ((all (y \ (path a y))))).
90
91(test N F) :- (formula N OF), (prenex OF F).
92
93main :- (test one F1), (test two F2), (test three F3), (test four F4),!.
94

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 91, column 0, character 3225:
 Warning: constant test has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 25, column 0, character 688:
 Warning: constant termp has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 18, column 0, character 475:
 Warning: constant quant_free has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 36, column 0, character 855:
 Warning: constant prenex has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 37, column 0, character 891:
 Warning:
 constant merge has no declared type. Did you mean std.set.private.merge std.map.private.merge ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 20, column 0, character 508:
 Warning: constant atom has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 93, column 0, character 3271:
 Warning: F4 is linear: name it _F4 (discard) or F4_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 93, column 0, character 3271:
 Warning: F3 is linear: name it _F3 (discard) or F3_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 93, column 0, character 3271:
 Warning: F2 is linear: name it _F2 (discard) or F2_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/pnf.elpi", line 93, column 0, character 3271:
 Warning: F1 is linear: name it _F1 (discard) or F1_ (fresh variable)

Parsing time: 0.001

Compilation time: 0.003

Typechecking time: 0.119

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/polymorphic_variants.elpi :

  1% Type inference for a super-constrainted functional langage with
  2% polymorphic variants
  3%
  4% Syntax:    f ::= (<case> constant term)^*    unary functions
  5%         term ::= constant | <app> funname term
  6%      program ::= (<fun> funname f)^*
  7%        types ::= (<fun> funname type type)^*
  8%         type ::= constant^*
  9%
 10%      constant and funnames are distinct lambda-prolog names
 11
 12% check types program types
 13% the functions must be listed in the same order in both
 14%check A B C :- print (check A B C), fail.
 15check [] [] _.
 16check [fun F B | BTL] [fun F D C | TTL] ORIGTYS :-
 17 check_domain B D,
 18 check_codomain B C ORIGTYS,
 19 check BTL TTL ORIGTYS.
 20
 21% check_domain body type
 22%check_domain A B :- print (check_domain A B), fail.
 23check_domain B T :- inputs B I, is_subset T I.
 24
 25%is_subset A B :- print (is_subset A B), fail.
 26is_subset A B :- var A, !, declare_constraint (is_subset A B) [A].
 27is_subset A B :- var B, !, declare_constraint (is_subset A B) [B].
 28is_subset A B :- is_subset_ A B.
 29is_subset_ [] _.
 30is_subset_ [X|TL] TL1 :- mem TL1 X, is_subset TL TL1.
 31
 32mem A B :- var A, !, declare_constraint (mem A B) [A].
 33mem A B :- mem_ A B.
 34mem_ [X|_] X :- !.
 35mem_ [Y|TL] X :- mem TL X.
 36
 37%check_codomain body type types
 38%check_codomain A B C :- print (check_codomain A B C), fail.
 39check_codomain [] _ _.
 40check_codomain [case _ T | TL] TYS ORIGTYS :-
 41  check_term T TYS ORIGTYS,
 42  check_codomain TL TYS ORIGTYS.
 43
 44%check_term term type
 45%check_term A B C :- print "CHECK" (check_term A B C), fail.
 46check_term (app F T) TY ORIGTYS :-
 47 !,
 48 find ORIGTYS F D C,
 49 check_term T D ORIGTYS,
 50 is_subset C TY.
 51check_term X TY _ :-
 52 mem TY X.
 53
 54find [fun F D C | _] F D C :- !.
 55find [ _ | TL ] F D C :- find TL F D C.
 56
 57%inputs A B :- print "INPUT" (inputs A B), fail.
 58inputs [] [].
 59inputs [case A _ | TL] [A | TL'] :- inputs TL TL'.
 60
 61/* Expected output, according to OCaml
 62Note: I use ref to kill Hindley-Milner polymorphism
 63# let g = ref (function `A -> `C | `B -> `D);;
 64# let f = function `A -> `A | `B -> !g `A;;
 65# f,!g;;
 66- : (_[< `A | `B ] -> (_[> `A | `C | `D ] as 'a)) *
 67    (_[< `A | `B > `A ] -> 'a) */
 68
 69% This is an interesting propagation rule we would like to add:
 70% a (non empty) subset of a singleton is a singleton.
 71% We cannot add the propagation rule now because:
 72%  1. we match up to unification
 73%     => the rule turns constraints of the form (is_subset X a::Y) into
 74%        (is_subset X [a])
 75%  2. already unifying the first argument of the rule triggers resumption
 76%     but there is confusion between the two runtimes and a mess happens
 77propagate [] [is_subset X [Y]] (X = [Y]).
 78propagate [is_subset X Y,is_subset Y Z] [] (is_subset X Z).
 79
 80inter [X | A] L [X | B] :- mem L X, !, inter A L B.
 81inter [X | A] L B :- inter A L B.
 82inter [] _ [].
 83 
 84union [X | XS] L L1  :- mem L X, !, union XS L L1.
 85union [X | XS] L [X | L1]  :- union XS L L1.
 86union [] L L .
 87
 88is_ground [].
 89is_ground (_ :: L) :- is_ground L.
 90 
 91propagate [] [is_subset X YS, is_subset X XS] (is_subset X INTER) :-
 92  is_ground YS, is_ground XS, inter YS XS INTER.
 93
 94propagate [X] [X] true.
 95
 96propagate [mem X A,is_subset X Y] [] (mem Y A).
 97
 98propagate [] [mem X A] (is_subset [A] X).
 99propagate [] [is_subset A X, is_subset B X] (is_subset C X) :-
100  is_ground A, is_ground B, union A B C.
101
102main1 :-
103 P = [ fun f [ case a a
104             , case b (app g a) ]
105     , fun g [ case a c
106             , case b d ]
107     ],
108 T = [ fun f [b] [a, c, d, e ]
109     , fun g [a, b] [c, d, e]
110     ],
111 check P T T,
112 print "Type-checking ok",
113
114 I = [ fun f If Of
115     , fun g Ig Og
116     ],
117 check P I I,
118 print "Type-inference ok",
119 print ":::" f ":" If "->" Of,
120 print ":::" g ":" Ig "->" Og,
121 print_constraints,
122 
123 Ig = [a],
124 print "Type specialization ok",
125 print ":::" f ":" If "->" Of,
126 print ":::" g ":" Ig "->" Og,
127 print_constraints.
128
129main2 :-
130 P' = [ fun f [ case a a
131              , case b (app h1 (app g a))
132              , case c (app h2 (app g a)) ]
133      , fun g  [ case a a ]
134      , fun h1 [ case a a
135               , case b b
136               , case d d ]
137      , fun h2 [ case a a
138               , case b b
139               , case c c ]
140      ],
141 I' = [ fun f If' Of'
142      , fun g Ig' Og'
143      , fun h1 Ih1' Oh1'
144      , fun h2 Ih2' Oh2'
145      ],
146 check P' I' I',
147 print "Type-inference ok",
148 print ":::" f ":" If' "->" Of',
149 print ":::" g ":" Ig' "->" Og',
150 print ":::" h1 ":" Ih1' "->" Oh1',
151 print ":::" h2 ":" Ih2' "->" Oh2'.
152
153main :- (main1, print "xxx failing", fail) ; print "xxx failed", main2.
154
155% vim: set ft=lprolog:

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 84, column 0, character 2748:
 Warning:
 constant union has no declared type. Did you mean std.string.set.union std.int.set.union std.loc.set.union ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 77, column 0, character 2542:
 Warning: constant propagate has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 33, column 0, character 1118:
 Warning: constant mem_ has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 30, column 0, character 1008:
 Warning:
 constant mem has no declared type. Did you mean std.set.private.mem std.set.mem std.mem! std.mem std.string.map.mem std.int.map.mem std.loc.map.mem std.string.set.mem std.int.set.mem std.loc.set.mem ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 129, column 0, character 3786:
 Warning: constant main2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 102, column 0, character 3251:
 Warning: constant main1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 28, column 0, character 958:
 Warning: constant is_subset_ has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 23, column 0, character 729:
 Warning: constant is_subset has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 88, column 0, character 2860:
 Warning: constant is_ground has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 80, column 0, character 2645:
 Warning:
 constant inter has no declared type. Did you mean std.intersperse std.string.set.inter std.int.set.inter std.loc.set.inter ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 23, column 0, character 729:
 Warning: [suppressing 18 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 35, column 0, character 1158:
 Warning: Y is linear: name it _Y (discard) or Y_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/polymorphic_variants.elpi", line 81, column 0, character 2697:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
Type-checking ok
Type-inference ok
::: f : X0 -> X1
::: g : X2 -> X3
 mem X3 d  /* suspended on X3 */  mem X3 c  /* suspended on X3 */
 X2 is_subset [a, b]  /* suspended on X2 */
 X3 is_subset X1  /* suspended on X3 */  mem X2 a  /* suspended on X2 */
 mem X1 a  /* suspended on X1 */  X0 is_subset [a, b]  /* suspended on X0 */
Type specialization ok
::: f : X0 -> X1
::: g : [a] -> X3
 mem X3 d  /* suspended on X3 */  mem X3 c  /* suspended on X3 */
 X3 is_subset X1  /* suspended on X3 */  mem X1 a  /* suspended on X1 */
 X0 is_subset [a, b]  /* suspended on X0 */
xxx failing
xxx failed
Type-inference ok
::: f : X4 -> X5
::: g : X6 -> X7
::: h1 : X8 -> X9
::: h2 : X10 -> X11

Parsing time: 0.001

Compilation time: 0.002

Typechecking time: 0.158

Success:

Time: 0.000

Constraints:
 mem X11 c  /* suspended on X11 */ mem X11 b  /* suspended on X11 */
 mem X11 a  /* suspended on X11 */
 X10 is_subset [a, b, c]  /* suspended on X10 */
 mem X9 d  /* suspended on X9 */ mem X9 b  /* suspended on X9 */
 mem X9 a  /* suspended on X9 */ X8 is_subset [a, b, d]  /* suspended on X8 */
 mem X7 a  /* suspended on X7 */ X6 is_subset [a]  /* suspended on X6 */
 X11 is_subset X5  /* suspended on X11 */
 X7 is_subset X10  /* suspended on X7 */ mem X6 a  /* suspended on X6 */
 X9 is_subset X5  /* suspended on X9 */ X7 is_subset X8  /* suspended on X7 */
 mem X6 a  /* suspended on X6 */ mem X5 a  /* suspended on X5 */
 X4 is_subset [a, b, c]  /* suspended on X4 */

State:

../../tests/sources/printer.elpi :

1main :-
2  print (p X :- q X, r x),
3  print (X is f Y mod r X),
4  print (X is f Y + r X * g A),
5  print (X is (f Y + r X) * g A),
6  print (X is f Y ^ r X ^ g A),
7  print (X || A && B ==> G),
8  print [f X, g Y, (a , b), a + b].

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: constant || has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: constant x has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: constant g has no declared type. Did you mean gc.get ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: constant ==> has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: [suppressing 1 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Error: (r X) has type prop but is used with type int
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Error: (, (q X) (r x)) has type prop but is used with type (list prop)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: G is linear: name it _G (discard) or G_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/printer.elpi", line 1, column 0, character 0:
 Warning: B is linear: name it _B (discard) or B_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.123
Type error. To ignore it, pass -no-tc.

../../tests/sources/queens.elpi :

 1% ?- queens(4, Qs).
 2%   produces
 3%   Qs = [3,1,4,2] ;
 4%   Qs = [2,4,1,3]
 5
 6% queens   +int  -[int]
 7
 8%%%%module queens.
 9
10%spy X :- print start X, X, print ok X.
11%spy X :- print ko X, fail.
12
13
14plus zero X X.
15plus (s X) Y (s S) :- plus X Y S.
16
17less zero (s _).
18less (s X) (s Y) :- less X Y.
19
20neq zero (s _).
21neq (s _) zero.
22neq (s X) (s Y) :- neq X Y.
23
24queens N Qs :- range (s zero) N Ns, queens_aux Ns xnil Qs.
25
26queens_aux xnil Qs Qs.
27queens_aux UnplacedQs SafeQs Qs :- 
28        select UnplacedQs UnplacedQs1 Q,
29        not_attack SafeQs Q (s zero),
30        queens_aux UnplacedQs1 (xcons Q SafeQs) Qs.
31
32
33not_attack_aux Xs X :- not_attack Xs X (s zero).
34not_attack xnil DUMMY1 DUMMY2 :- !.
35not_attack (xcons Y Ys) X N :- plus Y N S1, neq X S1, 
36                               plus X N S2, neq Y S2,
37                               N1 = (s N), 
38                               not_attack Ys X N1.
39
40%select A B C :- print first_clause (select A B C), fail.
41select (xcons X Xs) Xs X.
42%select A B C :- print backtrack (select A B C), fail.
43select (xcons Y Ys) (xcons Y Zs) X :- select Ys Zs X.
44%select A B C :- print no_more_chances (select A B C), fail.
45
46range N N (xcons N xnil) :- !.
47range M N (xcons M Ns) :- less M N, M1 = (s M), range M1 N Ns.
48
49once :- queens (s (s (s (s zero)))) L, xxx L.
50xxx (xcons (s (s zero)) (xcons (s (s (s (s zero)))) (xcons (s zero) (xcons (s (s (s zero))) xnil)))).
51
52q L :- queens (s (s (s (s zero)))) L.
53
54iter zero X.
55iter (s N) X :- X, iter N X.
56
57mult zero X zero.
58mult (s X) Y Z :- mult X Y K, plus Y K Z.
59
60exp zero X (s zero).
61exp (s X) Y Z :- exp X Y K, mult Y K Z.
62
63main :-
64 TEN = s (s (s (s (s (s (s (s (s (s zero))))))))),
65 exp (s (s (s (s zero)))) TEN TENTHOUSAND,
66 iter TENTHOUSAND once.
67
68% ----------------------------------------------------------
69%queens(N,Qs) :- range(1,N,Ns), queens(Ns,[],Qs).
70
71%queens([],Qs,Qs).
72%queens(UnplacedQs,SafeQs,Qs) :-  select(UnplacedQs,UnplacedQs1,Q),
73%             not_attack(SafeQs,Q), queens(UnplacedQs1,[Q|SafeQs],Qs).
74
75%not_attack(Xs,X) :- not_attack(Xs,X,1).
76%not_attack([],_,_) :- !.
77%not_attack([Y|Ys],X,N) :-X =\= Y+N,X =\= Y-N,N1 is N+1,not_attack(Ys,X,N1).
78
79%select([X|Xs],Xs,X).
80%select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X).
81
82%range(N,N,[N]) :- !.
83%range(M,N,[M|Ns]) :- M < N, M1 is M+1, range(M1,N,Ns).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 14, column 0, character 189:
 Warning: constant zero has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 49, column 0, character 1240:
 Warning: constant xxx has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 24, column 0, character 348:
 Warning: constant xnil has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 27, column 0, character 431:
 Warning: constant xcons has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 27, column 0, character 431:
 Warning: constant select has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 15, column 0, character 204:
 Warning:
 constant s has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.set.make std.set.mem std.set.add std.set.remove std.set.cardinal std.set.elements std.spy std.spy! std.split-at std.spy-do! rex.split random.self_init std.string.concat std.string.map std.string.map.empty std.string.map.mem std.string.map.add std.string.map.remove std.string.map.find std.string.map.bindings std.string.set std.string.set.empty std.string.set.mem std.string.set.add std.string.set.remove std.string.set.union std.string.set.inter std.string.set.diff std.string.set.equal std.string.set.subset std.string.set.elements std.string.set.cardinal std.int.set std.int.set.empty std.int.set.mem std.int.set.add std.int.set.remove std.int.set.union std.int.set.inter std.int.set.diff std.int.set.equal std.int.set.subset std.int.set.elements std.int.set.cardinal std.loc.set std.loc.set.empty std.loc.set.mem std.loc.set.add std.loc.set.remove std.loc.set.union std.loc.set.inter std.loc.set.diff std.loc.set.equal std.loc.set.subset std.loc.set.elements std.loc.set.cardinal std.set std.set gc.set gc.stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 24, column 0, character 348:
 Warning: constant range has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 24, column 0, character 348:
 Warning: constant queens_aux has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 24, column 0, character 348:
 Warning: constant queens has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 52, column 0, character 1389:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 14, column 0, character 189:
 Warning: [suppressing 10 warnings]
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 34, column 0, character 649:
 Warning:
 DUMMY2 is linear: name it _DUMMY2 (discard) or DUMMY2_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 34, column 0, character 649:
 Warning:
 DUMMY1 is linear: name it _DUMMY1 (discard) or DUMMY1_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 54, column 0, character 1428:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 57, column 0, character 1471:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/queens.elpi", line 60, column 0, character 1532:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.135

Success:

Time: 2.175

Constraints:


State:

../../tests/sources/quote_syntax.elpi :

1main :-
2  quote_syntax "src/builtin.elpi" "main" A B, print B.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/quote_syntax.elpi", line 1, column 0, character 0:
 Warning: A is linear: name it _A (discard) or A_ (fresh variable)
clause File "(quote_syntax): query", line 1, column 0, character 0: []
 (const main)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.089

Success:

Time: 0.016

Constraints:


State:

../../tests/sources/random.elpi :

1main :-
2  random.self_init,
3  random.int 10 R,
4  print R,
5  R >= 0,
6  R < 10.

3

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.079

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/reduce_cbn.elpi :

 1%copy X Y :- print "XXXXXXXXX" (copy X Y), fail.
 2copy (app M N) (app M2 N2) :- copy M M2, copy N N2.
 3copy (lam F) (lam F2) :- pi x\ copy x x => copy (F x) (F2 x).
 4
 5%cbn X Y :- print "XXXXXXXXX" (cbn X Y), fail.
 6cbn (lam F) (lam F2) :- !, pi x\cbn x x => copy x x => cbn (F x) (F2 x). 
 7cbn (app (lam F) N) M :- !, subst F N B, cbn B M.
 8cbn (app M N) R :- cbn M (lam F), !, cbn (app (lam F) N) R.
 9cbn (app X Y) (app X2 Y2) :- cbn X X2, cbn Y Y2.
10
11%subst F N B :- print "XXXXXXXXX" (subst F N B), fail.
12subst F N B :- pi x\ copy x N => copy (F x) (B2 x), B = B2 x.
13
14main :-
15 ZERO = (lam s\ lam z\ z),
16 SUCC = (lam n\ lam s\ lam z\ app s (app (app n s) z)),
17 cbn (app SUCC ZERO) ONE,
18 PLUS = (lam n\ lam m\ lam s\ lam z\ app (app n s) (app (app m s) z)),
19 MULT = (lam n\ lam m\ lam s\ app n (app m s)),
20 cbn (app SUCC (app SUCC ZERO)) TWO,
21 cbn (app (app PLUS (app (app PLUS TWO) TWO)) TWO) SIX,
22 cbn (app (app MULT SIX) TWO) TWELVE,
23 EXP = (lam n\ lam m\ app n m),
24 cbn (app (app PLUS TWO) ONE) THREE,
25 cbn (app (app EXP TWO) THREE) NINE,
26 cbn (app (app MULT TWO) TWO) FOUR,
27 cbn (app (app PLUS THREE) TWO) FIVE,
28 cbn (app (app PLUS FOUR) TWO) SIX,
29 cbn (app (app EXP FIVE) FIVE) RES,
30 cbn (app (app EXP FIVE) FIVE) RES,
31 cbn (app (app EXP FIVE) FIVE) RES,
32 cbn (app (app EXP FIVE) FIVE) RES,
33 cbn (app (app EXP FIVE) FIVE) RES,
34 cbn (app (app EXP FIVE) FIVE) RES.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbn.elpi", line 7, column 0, character 285:
 Warning: constant subst has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbn.elpi", line 3, column 0, character 101:
 Warning: constant lam has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbn.elpi", line 2, column 0, character 49:
 Warning: constant copy has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbn.elpi", line 6, column 0, character 211:
 Warning: constant cbn has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbn.elpi", line 2, column 0, character 49:
 Warning:
 constant app has no declared type. Did you mean std.append std.appendR ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbn.elpi", line 14, column 0, character 563:
 Warning: NINE is linear: name it _NINE (discard) or NINE_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbn.elpi", line 14, column 0, character 563:
 Warning:
 TWELVE is linear: name it _TWELVE (discard) or TWELVE_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.106

Success:

Time: 0.351

Constraints:


State:

../../tests/sources/reduce_cbv.elpi :

 1copy (app M N) (app M2 N2) :- copy M M2, copy N N2.
 2copy (lam F) (lam F2) :- pi x\ copy x x => copy (F x) (F2 x).
 3
 4cbv (lam F) (lam F2) :- pi x\ cbv x x => copy x x => cbv (F x) (F2 x).
 5cbv (app M N) R2 :-
 6 cbv N N2,
 7 cbv M M2,
 8 beta M2 N2 R2.
 9
10beta (lam F) T R2 :- !,
11 (pi x\ copy x T => copy (F x) (R' x), R = R' x),
12 cbv R R2.
13beta H A (app H A).
14
15main :-
16 ZERO = (lam s\ lam z\ z),
17 SUCC = (lam n\ lam s\ lam z\ app s (app (app n s) z)),
18 cbv (app SUCC ZERO) ONE,
19 PLUS = (lam n\ lam m\ lam s\ lam z\ app (app n s) (app (app m s) z)),
20 MULT = (lam n\ lam m\ lam s\ app n (app m s)),
21 cbv (app SUCC (app SUCC ZERO)) TWO,
22 cbv (app (app PLUS (app (app PLUS TWO) TWO)) TWO) SIX,
23 cbv (app (app MULT SIX) TWO) TWELVE,
24 EXP = (lam n\ lam m\ app n m),
25 cbv (app (app PLUS TWO) ONE) THREE,
26 cbv (app (app EXP TWO) THREE) NINE,
27 cbv (app (app MULT TWO) TWO) FOUR,
28 cbv (app (app PLUS THREE) TWO) FIVE,
29 cbv (app (app PLUS FOUR) TWO) SIX,
30 cbv (app (app EXP FIVE) FIVE) RES,
31 cbv (app (app EXP FIVE) FIVE) RES,
32 cbv (app (app EXP FIVE) FIVE) RES,
33 cbv (app (app EXP FIVE) FIVE) RES,
34 cbv (app (app EXP FIVE) FIVE) RES,
35 cbv (app (app EXP FIVE) FIVE) RES.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbv.elpi", line 2, column 0, character 52:
 Warning: constant lam has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbv.elpi", line 1, column 0, character 0:
 Warning: constant copy has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbv.elpi", line 4, column 0, character 115:
 Warning: constant cbv has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbv.elpi", line 5, column 0, character 186:
 Warning: constant beta has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbv.elpi", line 1, column 0, character 0:
 Warning:
 constant app has no declared type. Did you mean std.append std.appendR ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbv.elpi", line 15, column 0, character 351:
 Warning: NINE is linear: name it _NINE (discard) or NINE_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/reduce_cbv.elpi", line 15, column 0, character 351:
 Warning:
 TWELVE is linear: name it _TWELVE (discard) or TWELVE_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.106

Success:

Time: 2.359

Constraints:


State:

../../tests/sources/restriction.elpi :

1% main should fail.
2
3main :- (x\ x) = (x\ X).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/restriction.elpi", line 3, column 0, character 21:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.077

../../tests/sources/restriction3.elpi :

 1type  if prop -> prop -> prop -> prop.
 2mode (if i i i).
 3if B T _ :- B, !, T.
 4if _ _ E :- E.
 5
 6type debug-print string -> A -> prop.
 7debug-print A B :- print A B.
 8
 9pred spy i:prop.
10spy P :- counter "run" NR, if (not(NR = 0)) (debug-print "run=" NR) true,
11         debug-print "----<<---- enter: " P,
12         P, !,
13         debug-print "---->>---- exit: " P.
14spy P :- debug-print "---->>---- fail: " P, fail.
15
16type lam (term -> term) -> term.
17
18foo A B :-
19  spy(A = lam i\ lam j\ X_ i j),
20  spy(B = lam i\ lam j\ Y_ i j),
21  spy(A = lam i\ lam j\ i),
22  spy(B = lam i\ lam j\ i).
23
24main :- pi x\ foo (A_ x) B_.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/restriction3.elpi", line 18, column 0, character 442:
 Warning: constant foo has no declared type.
----<<---- enter:  X0 c0 = lam c1 \ lam c2 \ X1^1 c1 c2
---->>---- exit:  lam c1 \ lam c2 \ X1^1 c1 c2 = lam c1 \ lam c2 \ X1^1 c1 c2
----<<---- enter:  X2 = lam c1 \ lam c2 \ X3^1 c1 c2
---->>---- exit:  lam c1 \ lam c2 \ X4 c1 c2 = lam c1 \ lam c2 \ X4 c1 c2
----<<---- enter:  lam c1 \ lam c2 \ X1^1 c1 c2 = lam c1 \ lam c2 \ c1
---->>---- exit:  lam c1 \ lam c2 \ c1 = lam c1 \ lam c2 \ c1
----<<---- enter:  lam c1 \ lam c2 \ X4 c1 c2 = lam c1 \ lam c2 \ c1
---->>---- exit:  lam c1 \ lam c2 \ c1 = lam c1 \ lam c2 \ c1

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.088

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/restriction4.elpi :

1main :-
2    pi x\ sigma Y Z\ pi y\
3      std.spy(X x = f (Y y) e\ (Z y e)).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/restriction4.elpi", line 1, column 0, character 0:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/restriction4.elpi", line 1, column 0, character 0:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
----<<---- enter:  X0 c0 = f (X1^1 c1) c2 \ X2^1 c1 c2
---->>---- exit:  f (X3 c0) c2 \ X4 c0 c2 = f (X3 c0) c2 \ X4 c0 c2

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.080

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/restriction5.elpi :

1main :-
2  pi x y z u w\
3    std.spy(X x y = X u w).

----<<---- enter:  X0 c0 c1 = X0 c3 c4
---->>---- exit:  X1 = X1

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.079

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/restriction6.elpi :

1main :-
2  pi x\ sigma Y\ pi y\ sigma Z\
3      std.spy(X x = f (Y y) l\e\ (Z e)).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/restriction6.elpi", line 1, column 0, character 0:
 Warning:
 constant f has no declared type. Did you mean std.map.private.find std.map.find std.fatal-error std.fatal-error-w-data std.fold std.fold2 std.fold-map std.forall std.forall-ok std.forall2 std.filter std.flatten std.flip std.findall loc.fields std.string.map.find std.int.map.find std.loc.map.find gc.full ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/restriction6.elpi", line 1, column 0, character 0:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
----<<---- enter:  X0 c0 = f (X1^1 c1) c2 \ c3 \ X2^2 c3
---->>---- exit:  f (X3 c0) c2 \ c3 \ X4^1 c3 = f (X3 c0) c2 \ c3 \ X4^1 c3

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.077

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/rev.elpi :

 1% X10:
 2%   yap                                     0.027s
 3%   elpi                                    3.771s
 4%   one level index hashtbl                 0.528s
 5%   two level inefficient index             0.681s
 6%   one level index hashtbl + automatic GC  0.899s
 7%   one lvl hashtbl + flat + automatic GC   0.763s
 8%   one lvl hashtbl + flat                  0.629s
 9
10
11% X13:
12%   yap                          0.083s
13%   elpi                        10.068s
14%   one level index hashtbl      3.90s
15%   two level inefficient index  4.48s
16
17% X14:
18%   ocamlopt                     0.014s
19%   ocamlc                       0.024s
20%   yap                          0.033s
21%   teyjus                       0.257s
22%   elpi                         4.72s (setting ulimit -s 81920)
23%                                newlazy  lazy   eager   with formula       with terms
24%   no index                     2.90s  3.85s  4.74s   4.49s              4.28s
25%   one level index hashtbl      2.51s  2.37s  2.35s   2.29s              2.28s
26%   two level inefficient index  1.78s  2.19s  3.00s   2.30s              2.34s
27%   one level hashtbl + auto GC  3.78s  3.97s  4.67s   3.39s              3.88s
28%   one lvl hash+flat+ auto GC   3.10s  3.22s  3.40s   3.38s              3.14s
29%   one lvl hashtbl + flat              2.42s  2.43s   2.64s              2.27s
30%   one lvl hash+ flat + man GC         2.99s  2.80s   2.83s              2.37s
31%   one lvl index map main       2.61s  2.44s  2.60s   2.40s              2.18s
32%I  one lvl hashtbl              0.72s  0.61s  -----   0.63s              0.57s
33%I  two lvl efficient index      0.36s  0.55s  0.62s
34%II two lvl inefficient index    0.70s
35%I  desperate two lvl effici     0.19s
36%I  desperate.ml                 0.11s  0.14s
37%I  desperate2.ml                0.11s
38%I  desperate3.ml                0.12s
39
40rev L RL  :- aux L xnil  RL .
41aux (xcons X XS)  ACC  R :- aux XS (xcons X ACC) R . 
42aux xnil  L  L .
43
44append (xcons X XS) L (xcons X L1)  :- append XS L L1 .
45append xnil L L .
46
47main :-
48    X1 =  (xcons x1 (xcons x2 (xcons x3 (xcons x4 (xcons x5 (xcons x6 (xcons x7 (xcons x8 (xcons x9 (xcons x10 xnil)))))))))),
49   append X1 X1 X2  ,
50   append X2 X2 X3  ,
51   append X3 X3 X4  ,
52   append X4 X4 X5  ,
53   append X5 X5 X6  ,
54   append X6 X6 X7  ,
55   append X7 X7 X8  ,
56   append X8 X8 X9  ,
57   append X9 X9 X10  ,
58   append X10 X10 X11  ,
59   append X11 X11 X12  ,
60   append X12 X12 X13  ,
61   append X13 X13 X14  ,
62   % append X14 X14 X15  ,
63   % append X15 X15 X16  ,
64   % append X16 X16 X17  ,
65   % append X17 X17 X18  ,
66   X = X14 ,
67   rev X  Y,   rev Y Z,  X = Z.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 40, column 0, character 1827:
 Warning: constant xnil has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 41, column 0, character 1857:
 Warning: constant xcons has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x9 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x8 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x7 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x6 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x5 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x4 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x3 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: constant x2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev.elpi", line 47, column 0, character 2004:
 Warning: [suppressing 17 warnings]

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.119
Fatal error: exception Stack overflow

../../tests/sources/rev14.elpi :

 1rev L RL  :- aux L xnil  RL.
 2aux (xcons X XS)  ACC  R :- aux XS (xcons X ACC) R.
 3aux xnil  L  L.
 4
 5append (xcons X XS) L (xcons X L1)  :- append XS L L1.
 6append xnil L L.
 7
 8main :-
 9    X1 =  (xcons x1 (xcons x2 (xcons x3 (xcons x4 (xcons x5 (xcons x6 (xcons x7 (xcons x8 (xcons x9 (xcons x10 xnil)))))))))),
10   append X1 X1 X2  ,
11   append X2 X2 X3  ,
12   append X3 X3 X4  ,
13   append X4 X4 X5  ,
14   append X5 X5 X6  ,
15   append X6 X6 X7  ,
16   append X7 X7 X8  ,
17   append X8 X8 X9  ,
18   append X9 X9 X10  ,
19   append X10 X10 X11  ,
20   append X11 X11 X12  ,
21   append X12 X12 X13  ,
22   append X13 X13 X14  ,
23   % append X14 X14 X15  ,
24   % append X15 X15 X16  ,
25   % append X16 X16 X17  ,
26   % append X17 X17 X18  ,
27   X = X14 ,
28   rev X  Y,   rev Y Z,  X = Z.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 1, column 0, character 0:
 Warning: constant xnil has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 2, column 0, character 29:
 Warning: constant xcons has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x9 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x8 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x7 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x6 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x5 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x4 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x3 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: constant x2 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/rev14.elpi", line 8, column 0, character 171:
 Warning: [suppressing 17 warnings]

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.133
Fatal error: exception Stack overflow

../../tests/sources/same_term.elpi :

1main :-
2  3 == 3,
3  not([X, _] == [X, Y]),
4  not(X == Y),
5  (x\ x) == (y\ y),
6  ID = (x\x),
7  (ID 3) == (ID 3),
8  pi x y\ same_var (X x) (X y), not(same_term (X x) (X y)).

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.084

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/self_assignment.elpi :

1% main should succeed
2
3q X X A.
4
5main :- (pi c\ q X A Y, q Y A X, q X Y A), X = d.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/self_assignment.elpi", line 3, column 0, character 23:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/self_assignment.elpi", line 5, column 0, character 33:
 Warning:
 constant d has no declared type. Did you mean std.debug-print std.drop std.drop-last std.do! std.do-ok! std.string.set.diff std.int.set.diff std.loc.set.diff ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/self_assignment.elpi", line 3, column 0, character 23:
 Warning: A is linear: name it _A (discard) or A_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.087

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/set.elpi :

 1
 2pred build i:int, i:int, i:std.set int, o:std.set int.
 3build N N X X :- !.
 4build N M X X1 :-
 5  N1 is N + 1,
 6  std.set.add N X XR,
 7  build N1 M XR X1.
 8
 9pred test i:int, i:int, i:(B -> A -> prop), i:A.
10test N N _ _ :- !.
11test N M F X :-
12  N1 is N + 1,
13  std.assert! (F N X) "not found",
14  test N1 M F X.
15
16pred test2 i:int, i:int, i:(B -> A -> A -> prop), i:A, o:A.
17test2 N N _ R R :- !.
18test2 N M F X R :-
19  N1 is N + 1,
20  F N X X1,
21  test2 N1 M F X1 R.
22
23macro @iters :- 4096.
24
25main :-
26  std.time (build 0 @iters {std.set.make cmp_term} T) Time0, !,
27  std.time (test 0 @iters std.set.mem T) Time1, !,
28  std.set.elements T L,
29  std.assert! ({std.length L} = @iters, L = [0|_]) "elements broken", !,
30  std.time (test2 0 @iters std.set.remove T E) Time2, !,
31  std.assert! (std.set.cardinal E 0) "not empty",
32  print Time0 "+" Time1 "+" Time2.

1.031358 + 0.051872 + 0.749295

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.082

Success:

Time: 1.924

Constraints:


State:

../../tests/sources/shorten.elpi :

 1namespace b {
 2
 3foo :- true.
 4baz :- fail.
 5
 6  namespace bar {
 7  
 8  baz :- foo.
 9
10  }
11
12
13shorten bar.{ baz }.
14
15}
16
17namespace a {
18
19  shorten b.{ foo }.
20  shorten b.bar.{ baz }.
21  
22  main :- foo, b.foo, baz, bar.baz, b.bar.baz.
23
24  bar.baz :- true.
25
26  shorten b.{ baz }.
27  
28  baz :- true.
29  bar.baz :- baz.
30
31}
32
33main :- a.main. 
34       

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten.elpi", line 4, column 0, character 16:
 Warning: constant b.foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten.elpi", line 5, column 0, character 29:
 Warning: constant b.baz has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten.elpi", line 9, column 3, character 67:
 Warning: constant b.bar.baz has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten.elpi", line 23, column 3, character 177:
 Warning: constant a.main has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten.elpi", line 23, column 3, character 177:
 Warning: constant a.bar.baz has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.115

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/shorten2.elpi :

1accumulate shorten_aux, shorten_aux2.
2
3foo :- true.
4
5main :-
6  foo, bar.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_aux2.elpi", line 1, column 0, character 0:
 Warning: constant foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_aux2.elpi", line 1, column 0, character 0:
 Warning: constant bar has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_aux.elpi", line 2, column 3, character 17:
 Warning: constant a.foo has no declared type.

Parsing time: 0.001

Compilation time: 0.001

Typechecking time: 0.109

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/shorten_aux.elpi :

1namespace a {
2  foo :- !, fail.
3}
4
5shorten a.{ foo }.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_aux.elpi", line 2, column 3, character 17:
 Warning: constant a.foo has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.077

../../tests/sources/shorten_aux2.elpi :

1bar :- foo.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_aux2.elpi", line 1, column 0, character 0:
 Warning: constant foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_aux2.elpi", line 1, column 0, character 0:
 Warning: constant bar has no declared type.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.080

../../tests/sources/shorten_builtin.elpi :

1shorten std.string.set.{ empty }.
2
3main :-
4  print {empty}.

{{  }}

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.077

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/shorten_trie.elpi :

1std.list.map _ _.
2std.string.concat1 _ _ _.
3std.string.escape _ _.
4
5shorten std.{list.map, string.{ concat1, escape }}.
6
7main :- list.map F [], concat1 "a" "b" AB, escape "x y" E.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_trie.elpi", line 3, column 0, character 44:
 Warning: constant std.string.escape has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_trie.elpi", line 2, column 0, character 18:
 Warning: constant std.string.concat1 has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_trie.elpi", line 1, column 0, character 0:
 Warning: constant std.list.map has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_trie.elpi", line 7, column 0, character 121:
 Warning: E is linear: name it _E (discard) or E_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_trie.elpi", line 7, column 0, character 121:
 Warning: AB is linear: name it _AB (discard) or AB_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/shorten_trie.elpi", line 7, column 0, character 121:
 Warning: F is linear: name it _F (discard) or F_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.093

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/spill_and.elpi :

 1kind term type.
 2type app term -> term -> term.
 3type lam (term -> term) -> term.
 4type t term.
 5
 6pred copy i:term, o:term.
 7copy (app A B) (app A1 B1) :- copy A A1, copy B B1.
 8copy (lam F) (lam F1) :- pi x\ copy (F x) (F1 x).
 9% we omit (copy x x) on purpose
10
11main :-
12  T = (lam x\ {copy x t => ((A x) = x, copy (app (A x) x))}),
13  print T,
14  T = (lam _\ app t t). 

lam c0 \ app t t

Parsing time: 0.000

Compilation time: 0.003

Typechecking time: 0.094

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/spill_impl.elpi :

 1kind term type.
 2type app term -> term -> term.
 3type lam (term -> term) -> term.
 4type t term.
 5
 6pred copy i:term, o:term.
 7copy (app A B) (app A1 B1) :- copy A A1, copy B B1.
 8copy (lam F) (lam F1) :- pi x\ copy (F x) (F1 x).
 9% we omit (copy x x) on purpose
10
11main :-
12  T = (lam x\ {copy x t => copy (app x x)}),
13  print T,
14  T = (lam _\ app t t). 

lam c0 \ app t t

Parsing time: 0.000

Compilation time: 0.004

Typechecking time: 0.088

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/spill_lam.elpi :

1pred pp i:int, o:string.
2main :- X = x\ print {pp x}.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/spill_lam.elpi", line 2, column 0, character 25:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.073

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/trace.elpi :

1p 1 1 :- 1 is 2 + 3.
2p 1 2 :- X = 1, Y = 2, X = Y.
3p 2 3.
4
5main :-
6  p 1 X ; p 2 Y.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trace.elpi", line 2, column 0, character 1:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trace.elpi", line 6, column 0, character 60:
 Warning: Y is linear: name it _Y (discard) or Y_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trace.elpi", line 6, column 0, character 60:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.082

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/trace2.elpi :

1main :-
2  print 1, (pi x\ sigma Y\ fail => (true, fail)).

1

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.077

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/trace_chr.elpi :

 1constraint even odd {
 2  rule \ (even X) (odd X) | (odd z) <=> true.
 3  rule \ (even X) (odd X) | (odd (s z)) <=> fail.
 4}
 5kind nat type.
 6type s nat -> nat.
 7type z nat.
 8
 9pred even i:nat.
10pred odd i:nat.
11even z.
12
13odd (s X) :- even X.
14even (s X) :- odd X.
15
16even (uvar as X) :- declare_constraint (even X) X.
17odd (uvar as X) :- declare_constraint (odd X) X.
18
19main :-
20  even Z,
21  declare_constraint true Z,
22  Z = s W,
23  not(even W).

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.080

Success:

Time: 0.000

Constraints:
 odd X0  /* suspended on X0 */

State:

../../tests/sources/trace_cut.elpi :

 1pred p.
 2p :- fail.
 3p :- !, fail.
 4p.
 5p :- print 1.
 6
 7pred q.
 8q.
 9q :- print 2.
10
11main :- p.
12main :- q, !, q => (q :- !) => q.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.085

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/trace_findall.elpi :

1p 1.
2p 2.
3p 3 :- p 2.
4
5main :-
6  std.findall (p _) L, print L.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trace_findall.elpi", line 1, column 0, character 0:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
[p 1, p 2, p 3]

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.076

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/trail.elpi :

 1% Query: p X Z.
 2% Expected outcome: X=ok, Z=ok.
 3
 4p X Z :- foo Y X, r Y Z.
 5foo Y X :- A = ok, q Y, X = A.
 6q a.
 7q b.
 8r b ok.
 9
10main :- p X Z, X = ok, Z = ok.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trail.elpi", line 4, column 0, character 49:
 Warning:
 constant r has no declared type. Did you mean std.set.private.remove-min-binding std.set.private.remove std.set.remove std.map.private.remove-min-binding std.map.private.remove std.map.remove std.rev rex.replace std.string.map.remove std.int.map.remove std.loc.map.remove std.string.set.remove std.int.set.remove std.loc.set.remove ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trail.elpi", line 5, column 0, character 74:
 Warning: constant q has no declared type. Did you mean gc.quick-stat ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trail.elpi", line 4, column 0, character 49:
 Warning:
 constant p has no declared type. Did you mean std.set.private.set std.set.private.empty std.set.private.node std.set.private.height std.set.private.create std.set.private.bal std.set.private.add std.set.private.mem std.set.private.remove-min-binding std.set.private.min-binding std.set.private.merge std.set.private.remove std.set.private.cardinal std.set.private.elements std.map.private.map std.map.private.empty std.map.private.node std.map.private.height std.map.private.create std.map.private.bal std.map.private.add std.map.private.find std.map.private.remove-min-binding std.map.private.min-binding std.map.private.merge std.map.private.remove std.map.private.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trail.elpi", line 4, column 0, character 49:
 Warning: constant foo has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trail.elpi", line 7, column 0, character 110:
 Warning:
 constant b has no declared type. Did you mean std.set.private.bal std.map.private.bal std.map.private.bindings std.map.bindings std.string.map.bindings std.int.map.bindings std.loc.map.bindings ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/trail.elpi", line 6, column 0, character 105:
 Warning:
 constant a has no declared type. Did you mean std.set.private.add std.set.add std.map.private.add std.map.add std.assert! std.assert-ok! std.append std.appendR std.any->string std.string.map.add std.int.map.add std.loc.map.add std.string.set.add std.int.set.add std.loc.set.add ?

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.102

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/typeabbrv.elpi :

 1typeabbrev xx bool.
 2
 3namespace foo {
 4
 5pred f i:xx.
 6f _.
 7
 8}
 9
10
11main :- foo.f tt.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.077

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/typeabbrv1.elpi :

1typeabbrev t1 int.
2
3pred f i:t1.
4f _.
5
6main :- f 3.

Parsing time: 0.000

Compilation time: 0.003

Typechecking time: 0.076

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/typeabbrv10.elpi :

1typeabbrev (bar A) (list A).
2typeabbrev (tmp A) (list A).
3typeabbrev (foo A) (tmp A).
4
5pred foo i:int, o:int.
6
7main :- std.map 3 foo _.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv10.elpi", line 7, column 0, character 111:
 Error: 3 has type int but is used with type (foo X24)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv10.elpi", line 7, column 0, character 111:
 Error: 3 has type int but is used with type type
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv10.elpi", line 7, column 0, character 111:
 Error: 3 has type int but is used with type (std.map.private.map X26 X25)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv10.elpi", line 7, column 0, character 111:
 Error: 3 has type int but is used with type (foo X27)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv10.elpi", line 7, column 0, character 111:
 Error: 3 has type int but is used with type (std.map.private.map X29 X28)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.076
Type error. To ignore it, pass -no-tc.

../../tests/sources/typeabbrv11.elpi :

1typeabbrev x int.
2
3pred f i:x.
4f "x".
5
6main.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv11.elpi", line 4, column 0, character 31:
 Error: x has type string but is used with type int

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.090
Type error. To ignore it, pass -no-tc.

../../tests/sources/typeabbrv12.elpi :

1typeabbrev y (list int).
2
3pred f i:y.
4f "x".
5
6main.

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv12.elpi", line 4, column 0, character 38:
 Error: x has type string but is used with type y

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.093
Type error. To ignore it, pass -no-tc.

../../tests/sources/typeabbrv2.elpi :

1typeabbrev t1 int.
2
3pred f i:t1.
4f _.
5
6typeabbrev t1 bool.
7
8main :- f 3.

Parsing time: 0.000
Fatal error: File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv2.elpi", line 6, column 0, character 39:duplicate type abbreviation for t1. Previous declaration: File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv2.elpi", line 1, column 0, character 0:

../../tests/sources/typeabbrv3.elpi :

1typeabbrev (t1 X Y) (pair Y X).
2
3pred f i:t1 bool int.
4f _.
5
6main :- f (pr 2 tt).

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.076

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/typeabbrv4.elpi :

1typeabbrev t1 int.
2
3pred f i:t1.
4f _.
5
6typeabbrev t1 int.
7
8main :- f 3.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.072

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/typeabbrv5.elpi :

1typeabbrev x y.
2typeabbrev y x.
3
4pred f i:x.
5f _.
6
7main :- f 0.

Parsing time: 0.000

Compilation time: 0.002
Fatal error: exception Elpi__Compiler.CompileError(_, "looping while unfolding type abbreviation for x")

../../tests/sources/typeabbrv6.elpi :

1typeabbrev x (option A).
2pred f i:x.
3f _.
4main :- f (some 3).

Parsing time: 0.000
Fatal error: File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/typeabbrv6.elpi", line 1, column 0, character 0:type abbreviation for x has unbound variables

../../tests/sources/typeabbrv7.elpi :

 1typeabbrev xx bool.
 2
 3namespace foo {
 4
 5pred f i:xx.
 6f _.
 7
 8}
 9
10
11main :- foo.f tt.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.072

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/typeabbrv8.elpi :

 1{ typeabbrev xx bool. }
 2
 3type g xx -> xx.
 4{
 5pred f i:xx.
 6f (g _).
 7
 8}
 9
10
11main :- f (g tt).

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.072

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/typeabbrv9.elpi :

 1typeabbrev t int.
 2
 3namespace xx {
 4    typeabbrev t int.
 5}
 6
 7pred f i:t, i:xx.t.
 8f 0 0.
 9
10main :- f 0 0.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.073

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/uminus.elpi :

1main :-
2  X is 3 - 2, Y is 3 + -2,
3  X =  1, Y = 1.

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.079

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/uvar_chr.elpi :

 1type app term -> term -> term.
 2type lam (term -> term) -> term.
 3
 4pred unsafe-cast o:A, o:B.
 5unsafe-cast X X.
 6
 7pred mk-app i:term, i:list term, o:term.
 8mk-app HD [] HD :- !.
 9mk-app (uvar as K) [A|Args] R :- !, unsafe-cast K K', mk-app (K' A) Args R.
10mk-app HD [X|XS] T :- mk-app (app HD X) XS T.
11
12pred copy i:term, o:term.
13
14copy (app A B) (app A1 B1) :- copy A A1, copy B B1.
15copy (lam F) (lam F1) :- pi x\ copy x x => copy (F x) (F1 x).
16copy (uvar F L as X) T :- var X, !, copy-list L L1, mk-app F L1 T.
17copy (uvar C L) (uvar C L1) :- copy-list L L1.
18
19copy-list [] [].
20copy-list [X|XS] [Y|YS] :- copy X Y, copy-list XS YS.
21
22pred meta-copy i:term, o:term.
23constraint meta-copy {
24  rule (meta-copy I O) | (copy I X) <=> (O = X).
25}
26
27main :- In = (lam x\ F x),
28  copy In T, print T,
29  declare_constraint (meta-copy In S) [], print S, not(var S).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/uvar_chr.elpi", line 17, column 0, character 438:
 Warning: constant copy-list has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/uvar_chr.elpi", line 28, column 0, character 731:
 Warning: F is linear: name it _F (discard) or F_ (fresh variable)
lam X0
lam c0 \ X0 c0

Parsing time: 0.000

Compilation time: 0.003

Typechecking time: 0.093

Success:

Time: 0.000

Constraints:
 meta-copy (lam c0 \ X0 c0) (lam c0 \ X0 c0)  /* suspended on  */

State:

../../tests/sources/var.elpi :

1main :-
2  var X0 _ [],
3  var X1,
4  var X2 _ _,
5  (pi x y\ (var (X3 x y) X3 [x,y])),
6  (pi x y\ (var (X9 x y) X9 (X10 x y))),
7  (pi x y\ sigma X5\ (var X5 X4 [x,y]),
8           print X0 "," X1 "," X2 "," X3 "," X4 "," X5).

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/var.elpi", line 1, column 0, character 0:
 Warning: X10 is linear: name it _X10 (discard) or X10_ (fresh variable)
X0 , X1 , X2 , X3 , X4 , X4 c0 c1

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.080

Success:

Time: 0.000

Constraints:


State:

../../tests/sources/variadic_declare_constraints.elpi :

1type foo tm -> (tm -> tm) -> prop.
2
3main :-
4  declare_constraint (foo X Y) X [Y, Z].

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/variadic_declare_constraints.elpi", line 3, column 0, character 36:
 Warning: Z is linear: name it _Z (discard) or Z_ (fresh variable)

Parsing time: 0.000

Compilation time: 0.002

Typechecking time: 0.082

Success:

Time: 0.000

Constraints:
 foo X0 X1  /* suspended on X0, X1, X2 */

State:

../../tests/sources/w.elpi :

  1filter [] _ [].
  2filter [X|XS] P [X|YS] :- P X, !, filter XS P YS.
  3filter [_|XS] P YS :- filter XS P YS.
  4
  5mem [X|_] X :- !.
  6mem [_|XS] X :- mem XS X.
  7
  8if G T _ :- G, !, T.
  9if _ _ E :- E.
 10
 11kind term type.
 12type app term -> term -> term.
 13type lam (term -> term) -> term.
 14type let term -> ty -> (term -> term) -> term.
 15
 16kind tye type.
 17% elpi:skip 2
 18infixr ==> 50.
 19infixl # 60.
 20type (==>) tye -> tye -> tye.
 21type (#) tye -> tye -> tye.
 22
 23kind ty type.
 24type all (tye -> ty) -> ty.
 25type mono tye -> ty.
 26
 27type one term.
 28type plus term.
 29type size term.
 30type empty term.
 31type comma term.
 32
 33type integer tye.
 34type list tye.
 35type pair tye.
 36
 37% constants
 38w one    (mono integer).
 39w plus   (mono (integer ==> integer ==> integer)).
 40w size   (all x\ mono (list # x ==> integer)).
 41w empty  (all x\ mono (list # x)).
 42w comma  (all x\ all y\ mono (x ==> y ==> (pair # x # y))).
 43
 44pred w i:term, o:ty.
 45
 46w (app F X) (mono R) :-
 47  w F (mono (A ==> R)),
 48  w X (mono A).
 49
 50w (lam F) (mono (A ==> R)) :-
 51  pi x\ w x (mono A) => w (F x) (mono R).
 52
 53w (let F FP B) (mono TC) :-
 54  w F (mono FT),
 55  declare_constraint (overbar (mono FT) FP) [],
 56  pi x\ w x FP => w (B x) (mono TC).
 57
 58w X (mono T) :- w X (all Poly), specialize (all Poly) T.
 59
 60w X TY :- print "Error: " X "cannot have type" TY.
 61
 62pred specialize i:ty, o:tye.
 63
 64specialize (all F) T :- specialize (F FRESH_) T.
 65specialize (mono X) X.
 66
 67pred overbar i:ty, o:ty.
 68
 69constraint w overbar {
 70
 71rule \ (G ?- overbar T T1)
 72     | (generalize G T POLYT) <=> (T1 = POLYT).
 73
 74rule \ (G ?- overbar T _) <=> (print "overbar" G "|-" T "failed", halt).
 75
 76generalize G (mono T) ALL :-
 77  free-ty (mono T) [] VT,
 78  free-gamma G [] VG,
 79  filter VT (x\ not(mem VG x)) Q,
 80  quantify Q T ALL.
 81
 82free-ty (mono X) L L1 :- free X L L1.
 83free-ty (all F) L L1 :- pi x\ free-ty (F x) L L1.
 84
 85free-gamma [] L L.
 86free-gamma [w _ T|X] L L2 :- free-ty T L L1, free-gamma X L1 L2.
 87
 88free (A # B) L L2 :- free A L L1, free B L1 L2.
 89free (A ==> B) L L2 :- free A L L1, free B L1 L2.
 90free (uvar X _) L L1 :- if (mem L X) (L1 = L) (L1 = [X|L]).
 91free X L L.
 92
 93copy-ty (mono X1) (mono X2) :- copy X1 X2.
 94copy-ty (all F1) (all F2) :- pi x\ copy x x => copy-ty (F1 x) (F2 x).
 95
 96copy (A ==> B) (A1 ==> B1) :- copy A A1, copy B B1.
 97copy (A # B) (A1 # B1) :- copy A A1, copy B B1.
 98copy X X.
 99
100quantify [] X (mono X1) :- copy X X1.
101quantify [X|XS] T (all x\ T2 x) :-
102  quantify XS T T1,
103  pi x\ copy (uvar X _) x => copy-ty T1 (T2 x).
104
105}
106
107main :-
108  print "Test 1",
109  P = let (lam x\x) T_ (id\ app (app plus (app id one))
110                                  (app size (app id empty))),
111  print "Typing" P,
112  w P TP,
113  print "OK" P "has type" TP,
114  print "",
115  print "Test 2",
116  X = lam (x\
117        let (lam y\ app (app comma x) y) Y_ (mk\
118          app (app comma (app mk one)) (app mk x))),
119  print "Typing" X,
120  w X XT,
121  print "OK" X "has type" XT,
122  print "",
123  print "Test 3",
124  Q = lam (id\ app (app plus (app id one))
125                                  (app size (app id empty))),
126  print "Typing" Q,
127  w Q TQ. % should print error

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 76, column 0, character 1561:
 Warning: constant quantify has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 5, column 0, character 105:
 Warning:
 constant mem has no declared type. Did you mean std.set.private.mem std.set.mem std.mem! std.mem std.string.map.mem std.int.map.mem std.loc.map.mem std.string.set.mem std.int.set.mem std.loc.set.mem ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 76, column 0, character 1561:
 Warning: constant generalize has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 76, column 0, character 1561:
 Warning: constant free-ty has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 76, column 0, character 1561:
 Warning: constant free-gamma has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 82, column 0, character 1693:
 Warning: constant free has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 1, column 0, character 0:
 Warning: constant filter has no declared type. Did you mean std.filter ?
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 93, column 0, character 2038:
 Warning: constant copy-ty has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 93, column 0, character 2038:
 Warning: constant copy has no declared type.
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 91, column 0, character 2025:
 Warning: X is linear: name it _X (discard) or X_ (fresh variable)
File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w.elpi", line 107, column 0, character 2408:
 Warning: TQ is linear: name it _TQ (discard) or TQ_ (fresh variable)
Test 1
Typing
 let (lam c0 \ c0) X0 c0 \
  app (app plus (app c0 one)) (app size (app c0 empty))
OK
 let (lam c0 \ c0) (all c0 \ mono (c0 ==> c0)) c0 \
  app (app plus (app c0 one)) (app size (app c0 empty)) has type mono integer

Test 2
Typing
 lam c0 \
  let (lam c1 \ app (app comma c0) c1) X1 c1 \
   app (app comma (app c1 one)) (app c1 c0)
OK
 lam c0 \
  let (lam c1 \ app (app comma c0) c1) (all c1 \ mono (c1 ==> pair # X2 # c1))
   c1 \ app (app comma (app c1 one)) (app c1 c0) has type
 mono (X2 ==> pair # (pair # X2 # integer) # (pair # X2 # X2))

Test 3
Typing lam c0 \ app (app plus (app c0 one)) (app size (app c0 empty))
Error:  c0 cannot have type all X3^1
Error:  c0 cannot have type mono (X4^1 ==> list # X5^1)

Parsing time: 0.001

Compilation time: 0.003

Typechecking time: 0.138

Success:

Time: 0.001

Constraints:


State:

../../tests/sources/w_legacy.elpi :

  1filter [] _ [].
  2filter [X|XS] P [X|YS] :- P X, !, filter XS P YS.
  3filter [_|XS] P YS :- filter XS P YS.
  4
  5mem [X|_] X :- !.
  6mem [_|XS] X :- mem XS X.
  7
  8if G T _ :- G, !, T.
  9if _ _ E :- E.
 10
 11kind term type.
 12type app term -> term -> term.
 13type lam (term -> term) -> term.
 14type let term -> ty -> (term -> term) -> term.
 15
 16kind tye type.
 17infixr ==> 50.
 18infixl # 60.
 19type (==>) tye -> tye -> tye.
 20type (#) tye -> tye -> tye.
 21
 22kind ty type.
 23type all (tye -> ty) -> ty.
 24type mono tye -> ty.
 25
 26type one term.
 27type plus term.
 28type size term.
 29type empty term.
 30type comma term.
 31
 32type integer tye.
 33type list tye.
 34type pair tye.
 35
 36% constants
 37w one    (mono integer).
 38w plus   (mono (integer ==> integer ==> integer)).
 39w size   (all x\ mono (list # x ==> integer)).
 40w empty  (all x\ mono (list # x)).
 41w comma  (all x\ all y\ mono (x ==> y ==> (pair # x # y))).
 42
 43pred w i:term, o:ty.
 44
 45w (app F X) (mono R) :-
 46  w F (mono (A ==> R)),
 47  w X (mono A).
 48
 49w (lam F) (mono (A ==> R)) :-
 50  pi x\ w x (mono A) => w (F x) (mono R).
 51
 52w (let F FP B) (mono TC) :-
 53  w F (mono FT),
 54  declare_constraint (overbar (mono FT) FP) [],
 55  pi x\ w x FP => w (B x) (mono TC).
 56
 57w X (mono T) :- w X (all Poly), specialize (all Poly) T.
 58
 59w X TY :- print "Error: " X "cannot have type" TY.
 60
 61pred specialize i:ty, o:tye.
 62
 63specialize (all F) T :- specialize (F FRESH_) T.
 64specialize (mono X) X.
 65
 66pred overbar i:ty, o:ty.
 67
 68constraint w overbar {
 69
 70rule \ (G ?- overbar T T1)
 71     | (generalize G T POLYT) <=> (T1 = POLYT).
 72
 73rule \ (G ?- overbar T _) <=> (print "overbar" G "|-" T "failed", halt).
 74
 75generalize G (mono T) ALL :-
 76  free-ty (mono T) [] VT,
 77  free-gamma G [] VG,
 78  filter VT (x\ not(mem VG x)) Q,
 79  quantify Q T ALL.
 80
 81free-ty (mono X) L L1 :- free X L L1.
 82free-ty (all F) L L1 :- pi x\ free-ty (F x) L L1.
 83
 84free-gamma [] L L.
 85free-gamma [w _ T|X] L L2 :- free-ty T L L1, free-gamma X L1 L2.
 86
 87free (A # B) L L2 :- free A L L1, free B L1 L2.
 88free (A ==> B) L L2 :- free A L L1, free B L1 L2.
 89free (uvar X _) L L1 :- if (mem L X) (L1 = L) (L1 = [X|L]).
 90free X L L.
 91
 92copy-ty (mono X1) (mono X2) :- copy X1 X2.
 93copy-ty (all F1) (all F2) :- pi x\ copy x x => copy-ty (F1 x) (F2 x).
 94
 95copy (A ==> B) (A1 ==> B1) :- copy A A1, copy B B1.
 96copy (A # B) (A1 # B1) :- copy A A1, copy B B1.
 97copy X X.
 98
 99quantify [] X (mono X1) :- copy X X1.
100quantify [X|XS] T (all x\ T2 x) :-
101  quantify XS T T1,
102  pi x\ copy (uvar X _) x => copy-ty T1 (T2 x).
103
104}
105
106main :-
107  print "Test 1",
108  P = let (lam x\x) T_ (id\ app (app plus (app id one))
109                                  (app size (app id empty))),
110  print "Typing" P,
111  w P TP,
112  print "OK" P "has type" TP,
113  print "",
114  print "Test 2",
115  X = lam (x\
116        let (lam y\ app (app comma x) y) Y_ (mk\
117          app (app comma (app mk one)) (app mk x))),
118  print "Typing" X,
119  w X XT,
120  print "OK" X "has type" XT,
121  print "",
122  print "Test 3",
123  Q = lam (id\ app (app plus (app id one))
124                                  (app size (app id empty))),
125  print "Typing" Q,
126  w Q TQ. % should print error

File "/home/jwintz/Development/elpi/docs/source/../../tests/sources/w_legacy.elpi", line 17, column 0, character 330:
Mixfix directives are not supported by this parser.

The parser is based on token families.
A family is identified by some starting characters, for example
a token '+-->' belongs to the family of '+'. There is no need
to declare it.

All the tokens of a family are parsed with the same precedence and
associativity, for example 'x +--> y *--> z' is parsed as
'x +--> (y *--> z)' since the family of '*' has higher precedence
than the family of '+'.

Here the table of tokens and token families.
Token families are represented by the start symbols followed by '..'.
Tokens of families marked with [*] cannot end with the starting symbol,
eg `foo` is not an infix, while `foo is.
The listing is ordered by increasing precedence.

fixity                     | tokens / token families
-------------------------- + -----------------------------------
Infix   not   associative  | :-  ?-
Infix   right associative  | ;
Infix   right associative  | ,  &
Infix   right associative  | ->
Infix   right associative  | =>
Infix   not   associative  | =  ==  =<  r<  i<  s<  r=<  i=<  s=<
                             <..  r>  i>  s>  r>=  i>=  s>=  >..
                             is
Infix   right associative  | ::
Infix   not   associative  | '.. [*]
Infix   left  associative  | ^..  r+  i+  s+  +..  -  r-  i-  s-
Infix   left  associative  | r*  i*  s*  *..  /  div  mod
Infix   right associative  | --..
Infix   not   associative  | `.. [*]
Infix   right associative  | ==..
Infix   right associative  | ||..
Infix   right associative  | &&..
Infix   left  associative  | #..
Prefix  not   associative  | r~  i~  ~..
Postfix not   associative  | ?..

If the token is a valid mixfix, and you want the file to stay compatible
with Teyjus, you can ask Elpi to skip the directive. Eg:

% elpi:skip 2  // skips the next two lines
infixr ==> 120.
infixr || 120.

As a debugging facility one can ask Elpi to print the AST in order to
verify how the text was parsed. Eg:

echo 'MyFormula = a || b ==> c && d' | elpi -parse-term

../../tests/sources/zebra.elpi:

Fatal error: exception Failure("File /home/jwintz/Development/elpi/docs/source/../../tests/sources/zebra.elp not found in: /home/jwintz/Development/elpi/_build/default/../lib/, /home/jwintz/Development/elpi/_build/default/../lib/ocaml, /home/jwintz/Development/elpi/_build/install/default/lib, /home/jwintz/Development/elpi/_build/default")