micro_kanren 0.0.1 → 0.0.2
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/.travis.yml +0 -2
- data/README.md +20 -8
- data/lib/micro_kanren.rb +2 -0
- data/lib/micro_kanren/core.rb +41 -47
- data/lib/micro_kanren/lisp.rb +63 -15
- data/lib/micro_kanren/mini_kanren_wrappers.rb +63 -0
- data/lib/micro_kanren/var.rb +3 -0
- data/lib/micro_kanren/version.rb +1 -1
- data/spec/micro_kanren/core_spec.rb +104 -53
- data/spec/micro_kanren/lisp_spec.rb +77 -9
- data/spec/micro_kanren/mini_kanren_wrappers_spec.rb +17 -0
- data/spec/spec_helper.rb +3 -0
- data/spec/test_programs.rb +100 -0
- data/spec/test_support.rb +9 -0
- metadata +10 -2
checksums.yaml
CHANGED
@@ -1,7 +1,7 @@
|
|
1
1
|
---
|
2
2
|
SHA1:
|
3
|
-
metadata.gz:
|
4
|
-
data.tar.gz:
|
3
|
+
metadata.gz: 2a030efb3f7fd274fb7d90dc8d7b6f41c41afa28
|
4
|
+
data.tar.gz: 029ae9516a117f18ca88d6b864c9fadfbb7929e3
|
5
5
|
SHA512:
|
6
|
-
metadata.gz:
|
7
|
-
data.tar.gz:
|
6
|
+
metadata.gz: 09d106357a9d89c2015521c5b56561f84cf5dd070c0e95940c73a1832ba46d45c80a92db6d41c480f15fc08aed00b55bb27891aca4c3b2d96fa7956807f4be8a
|
7
|
+
data.tar.gz: b282d76b1435bff2969d2de701795c5c2da4ab6003422c362678e08bbf5acaaa090a783499468e7926fe4cea823b6d64e3921622558bd3a1d7fa5af466eb3d5e
|
data/.travis.yml
CHANGED
data/README.md
CHANGED
@@ -2,6 +2,13 @@
|
|
2
2
|
|
3
3
|
A port of microKanren, a minimalistic logic programming language, to Ruby.
|
4
4
|
|
5
|
+
## Description
|
6
|
+
|
7
|
+
This is a port of [microKanren](http://webyrd.net/scheme-2013/papers/HemannMuKanren2013.pdf)
|
8
|
+
to Ruby. It is an almost exact translation of
|
9
|
+
[the original implementation](https://github.com/jasonhemann/microKanren),
|
10
|
+
which was written for [Petite Chez Scheme](http://www.scheme.com/petitechezscheme.html).
|
11
|
+
|
5
12
|
## Installation
|
6
13
|
|
7
14
|
Add this line to your application's Gemfile:
|
@@ -18,16 +25,23 @@ Or install it yourself as:
|
|
18
25
|
|
19
26
|
## Usage
|
20
27
|
|
21
|
-
|
22
|
-
require 'micro_kanren'
|
23
|
-
include MicroKanren::Core
|
28
|
+
The following example demonstrates how MicroKanren can be used from the console:
|
24
29
|
|
25
|
-
|
30
|
+
```ruby
|
31
|
+
> require 'micro_kanren'
|
32
|
+
> include MicroKanren::Core
|
33
|
+
> include MicroKanren::MiniKanrenWrappers
|
26
34
|
|
27
|
-
|
35
|
+
> res = call_fresh(-> (q) { eq(q, 5) }).call(empty_state)
|
36
|
+
> puts lprint(res)
|
37
|
+
(((([0] . 5)) . 1))
|
28
38
|
```
|
29
39
|
|
30
|
-
See the
|
40
|
+
See the
|
41
|
+
[spec file](https://github.com/jsl/ruby_ukanren/blob/master/spec/micro_kanren/core_spec.rb)
|
42
|
+
for more examples. The spec file is almost an exact port of the [microKanren tests
|
43
|
+
written in Scheme](https://github.com/jasonhemann/microKanren/blob/master/microKanren-test.scm).
|
44
|
+
|
31
45
|
## Credits
|
32
46
|
|
33
47
|
The code in this gem is closely based on the following sources:
|
@@ -40,8 +54,6 @@ The code in this gem is closely based on the following sources:
|
|
40
54
|
[Scott Vokes' port of microKanren to Lua](https://github.com/silentbicycle/lua-ukanren).
|
41
55
|
It was great to have the Lua code as a second example of the implementation in
|
42
56
|
the paper, and it made my job especially easy since Lua is so similar to Ruby.
|
43
|
-
* Finally, I used the [microKanren examples in Scheme](https://github.com/jasonhemann/microKanren)
|
44
|
-
to see if this port worked as expected.
|
45
57
|
|
46
58
|
## Dependencies
|
47
59
|
|
data/lib/micro_kanren.rb
CHANGED
data/lib/micro_kanren/core.rb
CHANGED
@@ -2,23 +2,46 @@ module MicroKanren
|
|
2
2
|
module Core
|
3
3
|
include Lisp
|
4
4
|
|
5
|
-
def var(*c) ;
|
6
|
-
def var?(x) ; x.is_a?(
|
5
|
+
def var(*c) ; Var.new(c) ; end
|
6
|
+
def var?(x) ; x.is_a?(Var) ; end
|
7
7
|
|
8
|
-
|
8
|
+
# var=? in Scheme implementation.
|
9
|
+
def vars_eq?(x1, x2) ; x1[0] == x2[0] ; end
|
9
10
|
|
10
|
-
|
11
|
+
# Walk environment S and look up value of U, if present.
|
12
|
+
def walk(u, s)
|
13
|
+
if var?(u)
|
14
|
+
pr = assp(-> (v) { u == v }, s)
|
15
|
+
pr ? walk(cdr(pr), s) : u
|
16
|
+
|
17
|
+
else
|
18
|
+
u
|
19
|
+
end
|
20
|
+
end
|
11
21
|
|
12
22
|
def ext_s(x, v, s)
|
13
23
|
cons(cons(x, v), s)
|
14
24
|
end
|
15
25
|
|
26
|
+
# Constrain u to be equal to v.
|
27
|
+
# == in Scheme implementation, ≡ in uKanren papers.
|
28
|
+
def eq(u, v)
|
29
|
+
->(s_c) {
|
30
|
+
s = unify(u, v, car(s_c))
|
31
|
+
s ? unit(cons(s, cdr(s_c))) : mzero
|
32
|
+
}
|
33
|
+
end
|
34
|
+
|
35
|
+
def unit(s_c) ; cons(s_c, mzero) ; end
|
36
|
+
def mzero ; nil ; end
|
37
|
+
|
16
38
|
def unify(u, v, s)
|
17
39
|
u = walk(u, s)
|
18
40
|
v = walk(v, s)
|
19
41
|
|
20
42
|
if var?(u) && var?(v) && vars_eq?(u, v)
|
21
43
|
s
|
44
|
+
|
22
45
|
elsif var?(u)
|
23
46
|
ext_s(u, v, s)
|
24
47
|
|
@@ -26,34 +49,12 @@ module MicroKanren
|
|
26
49
|
ext_s(v, u, s)
|
27
50
|
|
28
51
|
elsif pair?(u) && pair?(v)
|
29
|
-
|
30
|
-
|
31
|
-
end
|
32
|
-
elsif u == v
|
33
|
-
s
|
34
|
-
end
|
35
|
-
end
|
36
|
-
|
37
|
-
def unit(s_c)
|
38
|
-
cons(s_c, mzero)
|
39
|
-
end
|
40
|
-
|
41
|
-
# Constrain u to be equal to v.
|
42
|
-
def eq(u, v)
|
43
|
-
->(s_c) {
|
44
|
-
s = unify(u, v, car(s_c))
|
45
|
-
s ? unit(cons(s, cdr(s_c))) : mzero
|
46
|
-
}
|
47
|
-
end
|
48
|
-
|
49
|
-
# Walk environment S and look up value of U, if present.
|
50
|
-
def walk(u, s)
|
51
|
-
if var?(u)
|
52
|
-
pr = assp(-> (v) { u == v }, s)
|
53
|
-
pr ? walk(cdr(pr), s) : u
|
52
|
+
s = unify(car(u), car(v), s)
|
53
|
+
s && unify(cdr(u), cdr(v), s)
|
54
54
|
|
55
55
|
else
|
56
|
-
|
56
|
+
# Object identity (equal?) seems closest to eqv? in Scheme.
|
57
|
+
u.equal?(v) && s
|
57
58
|
end
|
58
59
|
end
|
59
60
|
|
@@ -65,10 +66,18 @@ module MicroKanren
|
|
65
66
|
}
|
66
67
|
end
|
67
68
|
|
69
|
+
def disj(g1, g2)
|
70
|
+
-> (s_c) { mplus(g1.call(s_c), g2.call(s_c)) }
|
71
|
+
end
|
72
|
+
|
73
|
+
def conj(g1, g2)
|
74
|
+
-> (s_c) { bind(g1.call(s_c), g2) }
|
75
|
+
end
|
76
|
+
|
68
77
|
def mplus(d1, d2)
|
69
78
|
if d1.nil?
|
70
79
|
d2
|
71
|
-
elsif
|
80
|
+
elsif procedure?(d1)
|
72
81
|
-> { mplus(d2, d1.call) }
|
73
82
|
else
|
74
83
|
cons(car(d1), mplus(cdr(d1), d2))
|
@@ -78,27 +87,12 @@ module MicroKanren
|
|
78
87
|
def bind(d, g)
|
79
88
|
if d.nil?
|
80
89
|
mzero
|
81
|
-
elsif
|
90
|
+
elsif procedure?(d)
|
82
91
|
-> { bind(d.call, g) }
|
83
92
|
else
|
84
93
|
mplus(g.call(car(d)), bind(cdr(d), g))
|
85
94
|
end
|
86
95
|
end
|
87
96
|
|
88
|
-
def disj(g1, g2)
|
89
|
-
-> (s_c) {
|
90
|
-
mplus(g1.call(s_c), g2.call(s_c))
|
91
|
-
}
|
92
|
-
end
|
93
|
-
|
94
|
-
def conj(g1, g2)
|
95
|
-
-> (s_c) {
|
96
|
-
bind(g1.call(s_c), g2)
|
97
|
-
}
|
98
|
-
end
|
99
|
-
|
100
|
-
def empty_state
|
101
|
-
cons(mzero, 0)
|
102
|
-
end
|
103
97
|
end
|
104
98
|
end
|
data/lib/micro_kanren/lisp.rb
CHANGED
@@ -4,15 +4,30 @@ module MicroKanren
|
|
4
4
|
# Returns a Cons cell that is also marked as such for later identification.
|
5
5
|
def cons(x, y)
|
6
6
|
-> (m) { m.call(x, y) }.tap do |func|
|
7
|
-
func.instance_eval{ def
|
7
|
+
func.instance_eval{ def ccel? ; true ; end }
|
8
8
|
end
|
9
9
|
end
|
10
10
|
|
11
11
|
def car(z) ; z.call(-> (p, q) { p }) ; end
|
12
12
|
def cdr(z) ; z.call(-> (p, q) { q }) ; end
|
13
13
|
|
14
|
-
def
|
15
|
-
d.respond_to?(:
|
14
|
+
def cons?(d)
|
15
|
+
d.respond_to?(:ccel?) && d.ccel?
|
16
|
+
end
|
17
|
+
alias :pair? :cons?
|
18
|
+
|
19
|
+
def map(func, list)
|
20
|
+
cons(func.call(car(list)), map(func, cdr(list))) if list
|
21
|
+
end
|
22
|
+
|
23
|
+
def length(list)
|
24
|
+
list.nil? ? 0 : 1 + length(cdr(list))
|
25
|
+
end
|
26
|
+
|
27
|
+
# We implement scheme cons cells as Procs. This function returns a boolean
|
28
|
+
# identically to the Scheme procedure? function to avoid false positives.
|
29
|
+
def procedure?(elt)
|
30
|
+
elt.is_a?(Proc) && !cons?(elt)
|
16
31
|
end
|
17
32
|
|
18
33
|
# Search association list by predicate function.
|
@@ -22,24 +37,57 @@ module MicroKanren
|
|
22
37
|
# Additional reference for this function is scheme:
|
23
38
|
# Ref for assp: http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-4.html
|
24
39
|
def assp(func, alist)
|
25
|
-
if alist
|
26
|
-
|
40
|
+
if alist
|
41
|
+
first_pair = car(alist)
|
42
|
+
first_value = car(first_pair)
|
43
|
+
|
44
|
+
if func.call(first_value)
|
45
|
+
first_pair
|
46
|
+
else
|
47
|
+
assp(func, cdr(alist))
|
48
|
+
end
|
49
|
+
else
|
50
|
+
false
|
27
51
|
end
|
28
52
|
end
|
29
53
|
|
30
|
-
#
|
31
|
-
#
|
32
|
-
def
|
33
|
-
if
|
34
|
-
|
35
|
-
|
36
|
-
|
37
|
-
|
38
|
-
node
|
54
|
+
# Converts Lisp AST to a String. Algorithm is a recursive implementation of
|
55
|
+
# http://www.mat.uc.pt/~pedro/cientificos/funcional/lisp/gcl_22.html#SEC1238.
|
56
|
+
def lprint(node, cons_in_cdr = false)
|
57
|
+
if cons?(node)
|
58
|
+
str = cons_in_cdr ? '' : '('
|
59
|
+
str += lprint(car(node))
|
60
|
+
|
61
|
+
if cons?(cdr(node))
|
62
|
+
str += ' ' + lprint(cdr(node), true)
|
39
63
|
else
|
40
|
-
node.
|
64
|
+
str += ' . ' + lprint(cdr(node)) unless cdr(node).nil?
|
41
65
|
end
|
66
|
+
|
67
|
+
cons_in_cdr ? str : str << ')'
|
68
|
+
else
|
69
|
+
atom_string(node)
|
70
|
+
end
|
71
|
+
end
|
72
|
+
|
73
|
+
def lists_equal?(a, b)
|
74
|
+
if cons?(a) && cons?(b)
|
75
|
+
lists_equal?(car(a), car(b)) && lists_equal?(cdr(a), cdr(b))
|
76
|
+
else
|
77
|
+
a == b
|
42
78
|
end
|
43
79
|
end
|
80
|
+
|
81
|
+
private
|
82
|
+
|
83
|
+
def atom_string(node)
|
84
|
+
case node
|
85
|
+
when NilClass, Array, String
|
86
|
+
node.inspect
|
87
|
+
else
|
88
|
+
node.to_s
|
89
|
+
end
|
90
|
+
end
|
91
|
+
|
44
92
|
end
|
45
93
|
end
|
@@ -0,0 +1,63 @@
|
|
1
|
+
module MicroKanren
|
2
|
+
module MiniKanrenWrappers
|
3
|
+
include Lisp
|
4
|
+
|
5
|
+
def empty_state
|
6
|
+
cons(mzero, 0)
|
7
|
+
end
|
8
|
+
|
9
|
+
# Advances a stream until it matures. Per microKanren document 5.2, "From
|
10
|
+
# Streams to Lists."
|
11
|
+
def pull(stream)
|
12
|
+
stream.is_a?(Proc) && !cons?(stream) ? pull(stream.call) : stream
|
13
|
+
end
|
14
|
+
|
15
|
+
def take(n, stream)
|
16
|
+
if n > 0
|
17
|
+
if cur = pull(stream)
|
18
|
+
cons(car(cur), take(n - 1, cdr(cur)))
|
19
|
+
end
|
20
|
+
end
|
21
|
+
end
|
22
|
+
|
23
|
+
def take_all(stream)
|
24
|
+
if cur = pull(stream)
|
25
|
+
cons(car(cur), take_all(cdr(cur)))
|
26
|
+
end
|
27
|
+
end
|
28
|
+
|
29
|
+
def reify_1st(s_c)
|
30
|
+
v = walk_star((var 0), car(s_c))
|
31
|
+
walk_star(v, reify_s(v, nil))
|
32
|
+
end
|
33
|
+
|
34
|
+
def reify_s(v, s)
|
35
|
+
v = walk(v, s)
|
36
|
+
if var?(v)
|
37
|
+
n = reify_name(length(s))
|
38
|
+
cons(cons(v, n), s)
|
39
|
+
elsif pair?(v)
|
40
|
+
reify_s(cdr(v), reify_s(car(v), s))
|
41
|
+
else
|
42
|
+
s
|
43
|
+
end
|
44
|
+
end
|
45
|
+
|
46
|
+
def reify_name(n)
|
47
|
+
"_.#{n}".to_sym
|
48
|
+
end
|
49
|
+
|
50
|
+
def walk_star(v, s)
|
51
|
+
v = walk(v, s)
|
52
|
+
if var?(v)
|
53
|
+
v
|
54
|
+
elsif pair?(v)
|
55
|
+
cons(walk_star(car(v), s),
|
56
|
+
walk_star(cdr(v), s))
|
57
|
+
else
|
58
|
+
v
|
59
|
+
end
|
60
|
+
end
|
61
|
+
|
62
|
+
end
|
63
|
+
end
|
data/lib/micro_kanren/version.rb
CHANGED
@@ -1,61 +1,112 @@
|
|
1
1
|
require 'spec_helper'
|
2
2
|
|
3
3
|
describe MicroKanren::Core do
|
4
|
+
|
4
5
|
include MicroKanren::Core
|
6
|
+
include MicroKanren::MiniKanrenWrappers
|
7
|
+
include MicroKanren::Lisp
|
8
|
+
|
9
|
+
include MicroKanren::TestPrograms
|
10
|
+
include MicroKanren::TestSupport
|
11
|
+
|
12
|
+
# These tests follow the reference implementation in Scheme located at
|
13
|
+
# https://github.com/jasonhemann/microKanren/blob/master/microKanren-test.scm
|
14
|
+
|
15
|
+
it "second-set t1" do
|
16
|
+
res = car(call_fresh(-> (q) { eq(q, 5) }).call(empty_state))
|
17
|
+
lprint(res).must_equal '((([0] . 5)) . 1)'
|
18
|
+
end
|
19
|
+
|
20
|
+
it "second-set t2" do
|
21
|
+
res = call_fresh(-> (q) { eq(q, 5) }).call(empty_state)
|
22
|
+
cdr(res).must_be_nil
|
23
|
+
end
|
24
|
+
|
25
|
+
it "second-set t3" do
|
26
|
+
res = car(a_and_b.call(empty_state))
|
27
|
+
lprint(res).must_equal '((([1] . 5) ([0] . 7)) . 2)'
|
28
|
+
end
|
29
|
+
|
30
|
+
it "second set t3, take" do
|
31
|
+
res = take(1, (a_and_b.call(empty_state)))
|
32
|
+
lprint(res).must_equal '(((([1] . 5) ([0] . 7)) . 2))'
|
33
|
+
end
|
34
|
+
|
35
|
+
it "second set t4" do
|
36
|
+
res = car(cdr(a_and_b.call(empty_state)))
|
37
|
+
lprint(res).must_equal '((([1] . 6) ([0] . 7)) . 2)'
|
38
|
+
end
|
39
|
+
|
40
|
+
it "second set t5" do
|
41
|
+
cdr(cdr(a_and_b.call(empty_state))).must_be_nil
|
42
|
+
end
|
43
|
+
|
44
|
+
it "who cares" do
|
45
|
+
res = take(1, call_fresh(-> (q) { fives.call(q) }).call(empty_state))
|
46
|
+
lprint(res).must_equal '(((([0] . 5)) . 1))'
|
47
|
+
end
|
48
|
+
|
49
|
+
it "take 2 a_and_b stream" do
|
50
|
+
res = take(2, a_and_b.call(empty_state))
|
51
|
+
|
52
|
+
expected_ast_string =
|
53
|
+
"(((([1] . 5) ([0] . 7)) . 2) ((([1] . 6) ([0] . 7)) . 2))"
|
54
|
+
|
55
|
+
lprint(res).must_equal expected_ast_string
|
56
|
+
end
|
5
57
|
|
6
|
-
|
7
|
-
|
8
|
-
|
9
|
-
|
10
|
-
|
11
|
-
|
12
|
-
|
13
|
-
|
14
|
-
|
15
|
-
|
16
|
-
|
17
|
-
|
18
|
-
|
19
|
-
|
20
|
-
|
21
|
-
|
22
|
-
|
23
|
-
|
24
|
-
|
25
|
-
|
26
|
-
|
27
|
-
|
28
|
-
|
29
|
-
|
30
|
-
|
31
|
-
|
32
|
-
|
33
|
-
|
34
|
-
|
35
|
-
|
36
|
-
|
37
|
-
|
38
|
-
|
39
|
-
|
40
|
-
|
41
|
-
|
42
|
-
|
43
|
-
|
44
|
-
|
45
|
-
|
46
|
-
|
47
|
-
|
48
|
-
|
49
|
-
|
50
|
-
|
51
|
-
|
52
|
-
|
53
|
-
|
54
|
-
|
55
|
-
skip("Create proper assertion for this test")
|
56
|
-
l = -> (q) { fives.call(q) }
|
57
|
-
res = call_fresh(l).call(empty_state)
|
58
|
-
end
|
58
|
+
it "take_all a_and_b stream" do
|
59
|
+
res = take_all(a_and_b.call(empty_state))
|
60
|
+
|
61
|
+
expected_ast_string =
|
62
|
+
"(((([1] . 5) ([0] . 7)) . 2) ((([1] . 6) ([0] . 7)) . 2))"
|
63
|
+
|
64
|
+
lprint(res).must_equal expected_ast_string
|
65
|
+
end
|
66
|
+
|
67
|
+
it "ground appendo" do
|
68
|
+
res = car(ground_appendo.call(empty_state).call)
|
69
|
+
|
70
|
+
# Expected result in scheme:
|
71
|
+
# (((#(2) b) (#(1)) (#(0) . a)) . 3)
|
72
|
+
|
73
|
+
expected_ast_string =
|
74
|
+
'((([2] b) ([1]) ([0] . a)) . 3)'
|
75
|
+
|
76
|
+
lprint(res).must_equal expected_ast_string
|
77
|
+
end
|
78
|
+
|
79
|
+
it "ground appendo2" do
|
80
|
+
res = lprint(car(ground_appendo2.call(empty_state).call))
|
81
|
+
res.must_equal '((([2] b) ([1]) ([0] . a)) . 3)'
|
82
|
+
end
|
83
|
+
|
84
|
+
it "appendo" do
|
85
|
+
res = lprint(take(2, call_appendo.call(empty_state)))
|
86
|
+
res.must_equal '(((([0] [1] [2] [3]) ([2] . [3]) ([1])) . 4) ((([0] [1] [2] [3]) ([2] . [6]) ([5]) ([3] [4] . [6]) ([1] [4] . [5])) . 7))'
|
87
|
+
end
|
88
|
+
|
89
|
+
it "appendo2" do
|
90
|
+
res = lprint(take(2, call_appendo2.call(empty_state)))
|
91
|
+
res.must_equal '(((([0] [1] [2] [3]) ([2] . [3]) ([1])) . 4) ((([0] [1] [2] [3]) ([3] [4] . [6]) ([2] . [6]) ([5]) ([1] [4] . [5])) . 7))'
|
92
|
+
end
|
93
|
+
|
94
|
+
it "reify-1st across appendo" do
|
95
|
+
res = map(method(:reify_1st).to_proc, take(2, call_appendo.call(empty_state)))
|
96
|
+
|
97
|
+
# Expected result in scheme:
|
98
|
+
# ((() _.0 _.0) ((_.0) _.1 (_.0 . _.1)))
|
99
|
+
|
100
|
+
lprint(res).must_equal '((nil _.0 _.0) ((_.0) _.1 (_.0 . _.1)))'
|
101
|
+
end
|
102
|
+
|
103
|
+
it "reify-1st across appendo2" do
|
104
|
+
res = map(method(:reify_1st).to_proc, take(2, call_appendo2.call(empty_state)))
|
105
|
+
lprint(res).must_equal '((nil _.0 _.0) ((_.0) _.1 (_.0 . _.1)))'
|
106
|
+
end
|
59
107
|
|
108
|
+
it "#many non-ans" do
|
109
|
+
res = take(1, many_non_ans.call(empty_state))
|
110
|
+
lprint(res).must_equal '(((([0] . 3)) . 1))'
|
60
111
|
end
|
61
112
|
end
|
@@ -22,32 +22,100 @@ describe MicroKanren::Lisp do
|
|
22
22
|
end
|
23
23
|
end
|
24
24
|
|
25
|
+
describe "#length" do
|
26
|
+
it "returns 0 for an empty list" do
|
27
|
+
length(nil).must_equal 0
|
28
|
+
end
|
29
|
+
|
30
|
+
it "returns the list length for a non-empty list" do
|
31
|
+
length(cons(1, cons(2, nil))).must_equal 2
|
32
|
+
end
|
33
|
+
end
|
34
|
+
|
35
|
+
describe "#map" do
|
36
|
+
it "maps a function over a list" do
|
37
|
+
func = -> (str) { str.upcase }
|
38
|
+
lprint(map(func, cons("foo", cons("bar", nil)))).must_equal '("FOO" "BAR")'
|
39
|
+
end
|
40
|
+
end
|
41
|
+
|
25
42
|
describe "#assp" do
|
26
|
-
it "returns the first
|
27
|
-
|
28
|
-
|
43
|
+
it "returns the first pair for which the predicate function is true" do
|
44
|
+
al1 = cons(3, cons(:a, nil))
|
45
|
+
al2 = cons(1, cons(:b, nil))
|
46
|
+
al3 = cons(4, cons(:c, nil))
|
47
|
+
|
48
|
+
alist = cons(al1, cons(al2, cons(al3, nil)))
|
49
|
+
|
50
|
+
res = assp(->(i) { i.even? }, alist)
|
51
|
+
lists_equal?(res, cons(4, cons(:c, nil))).must_equal true
|
52
|
+
end
|
53
|
+
|
54
|
+
it "returns false if there is no matching element found" do
|
55
|
+
pair1 = cons(3, cons(:a, nil))
|
56
|
+
pair2 = cons(1, cons(:b, nil))
|
57
|
+
pair3 = cons(4, cons(:c, nil))
|
58
|
+
|
59
|
+
alist = cons(pair1, cons(pair2, cons(pair3, nil)))
|
60
|
+
|
61
|
+
res = assp(->(i) { i == 5 }, alist)
|
62
|
+
res.must_equal false
|
63
|
+
end
|
64
|
+
end
|
65
|
+
|
66
|
+
# http://download.plt-scheme.org/doc/html/reference/pairs.html#(def._((quote._~23~25kernel)._pair~3f))
|
67
|
+
describe "#pair?" do
|
68
|
+
it "is false for an integer" do
|
69
|
+
pair?(1).must_equal false
|
70
|
+
end
|
71
|
+
|
72
|
+
it "is true for a list with an int in the car and cdr" do
|
73
|
+
pair?(cons(1, 2)).must_equal true
|
74
|
+
end
|
75
|
+
|
76
|
+
it "is true for a proper list" do
|
77
|
+
pair?(cons(1, cons(2, nil))).must_equal true
|
78
|
+
end
|
79
|
+
|
80
|
+
it "is false for an empty list" do
|
81
|
+
pair?(nil).must_equal false
|
29
82
|
end
|
30
83
|
end
|
31
84
|
|
32
|
-
describe "#
|
85
|
+
describe "#lprint" do
|
86
|
+
it "prints an expression correctly" do
|
87
|
+
c = cons(1, cons(2, cons(cons(3, cons(4, nil)), cons(5, nil))))
|
88
|
+
lprint(c).must_equal "(1 2 (3 4) 5)"
|
89
|
+
end
|
90
|
+
|
33
91
|
it "prints a cons cell representation of a simple cell" do
|
34
|
-
|
92
|
+
lprint(cons('a', 'b')).must_equal '("a" . "b")'
|
35
93
|
end
|
36
94
|
|
37
95
|
it "represents Integers and Floats" do
|
38
|
-
|
96
|
+
lprint(cons(1, 2)).must_equal '(1 . 2)'
|
39
97
|
end
|
40
98
|
|
41
99
|
it "prints a nested expression" do
|
42
|
-
|
100
|
+
lprint(cons('a', cons('b', 'c'))).must_equal '("a" "b" . "c")'
|
43
101
|
end
|
44
102
|
|
45
103
|
it "represents Arrays (in scheme, vectors) correctly in printed form" do
|
46
|
-
|
104
|
+
lprint(cons('a', [])).must_equal '("a" . [])'
|
47
105
|
end
|
48
106
|
|
49
107
|
it "represents nil elements (in scheme, '())" do
|
50
|
-
|
108
|
+
lprint(cons('a', nil)).must_equal '("a")'
|
109
|
+
end
|
110
|
+
end
|
111
|
+
|
112
|
+
describe "#lists_equal?" do
|
113
|
+
it "is true if the lists are equal" do
|
114
|
+
lists_equal?(cons(1, cons(2, nil)), cons(1, cons(2, nil))).must_equal true
|
115
|
+
end
|
116
|
+
|
117
|
+
it "is false if the lists contain different objects" do
|
118
|
+
lists_equal?(cons(1, cons(2, nil)), cons(1, nil)).must_equal false
|
51
119
|
end
|
52
120
|
end
|
53
121
|
end
|
@@ -0,0 +1,17 @@
|
|
1
|
+
require 'spec_helper'
|
2
|
+
|
3
|
+
describe MicroKanren::MiniKanrenWrappers do
|
4
|
+
include MicroKanren::MiniKanrenWrappers
|
5
|
+
include MicroKanren::Lisp
|
6
|
+
|
7
|
+
describe "#pull" do
|
8
|
+
it "advances the stream until it matures" do
|
9
|
+
stream = -> { -> { 42 } }
|
10
|
+
pull(stream).must_equal 42
|
11
|
+
end
|
12
|
+
|
13
|
+
it "returns nil in the case of the empty stream" do
|
14
|
+
pull(nil).must_be_nil
|
15
|
+
end
|
16
|
+
end
|
17
|
+
end
|
data/spec/spec_helper.rb
CHANGED
@@ -0,0 +1,100 @@
|
|
1
|
+
module MicroKanren
|
2
|
+
module TestPrograms
|
3
|
+
def a_and_b
|
4
|
+
a = -> (a) { eq(a, 7) }
|
5
|
+
b = -> (b) { disj(eq(b, 5), eq(b, 6)) }
|
6
|
+
|
7
|
+
conj(call_fresh(a), call_fresh(b))
|
8
|
+
end
|
9
|
+
|
10
|
+
def fives
|
11
|
+
-> (x) {
|
12
|
+
disj(eq(x, 5), -> (a_c) { -> { fives(x).call(a_c) } })
|
13
|
+
}
|
14
|
+
end
|
15
|
+
|
16
|
+
def appendo
|
17
|
+
-> (l, s, out) {
|
18
|
+
disj(
|
19
|
+
conj(eq(nil, l), eq(s, out)),
|
20
|
+
call_fresh(-> (a) {
|
21
|
+
call_fresh(-> (d) {
|
22
|
+
conj(
|
23
|
+
eq(cons(a, d), l),
|
24
|
+
call_fresh(-> (res) {
|
25
|
+
conj(
|
26
|
+
eq(cons(a, res), out),
|
27
|
+
-> (s_c) {
|
28
|
+
-> {appendo.call(d, s, res).call(s_c)}})}))})}))}
|
29
|
+
end
|
30
|
+
|
31
|
+
def appendo2
|
32
|
+
-> (l, s, out) {
|
33
|
+
disj(
|
34
|
+
conj(eq(nil, l), eq(s, out)),
|
35
|
+
call_fresh(-> (a) {
|
36
|
+
call_fresh(-> (d) {
|
37
|
+
conj(
|
38
|
+
eq(cons(a, d), l),
|
39
|
+
call_fresh(-> (res) {
|
40
|
+
conj(
|
41
|
+
-> (s_c) {
|
42
|
+
-> { appendo2.call(d, s, res).call(s_c) }
|
43
|
+
},
|
44
|
+
eq(cons(a, res), out))}))})}))}
|
45
|
+
end
|
46
|
+
|
47
|
+
def call_appendo
|
48
|
+
call_fresh(-> (q) {
|
49
|
+
call_fresh(-> (l) {
|
50
|
+
call_fresh(-> (s) {
|
51
|
+
call_fresh(-> (out) {
|
52
|
+
conj(
|
53
|
+
appendo.call(l, s, out),
|
54
|
+
eq(cons(l, cons(s, cons(out, nil))), q))})})})})
|
55
|
+
end
|
56
|
+
|
57
|
+
def call_appendo2
|
58
|
+
call_fresh(-> (q) {
|
59
|
+
call_fresh(-> (l) {
|
60
|
+
call_fresh(-> (s) {
|
61
|
+
call_fresh(-> (out) {
|
62
|
+
conj(
|
63
|
+
appendo2.call(l, s, out),
|
64
|
+
eq(cons(l, cons(s, cons(out, nil))), q))})})})})
|
65
|
+
end
|
66
|
+
|
67
|
+
def ground_appendo
|
68
|
+
appendo.call(cons(:a, nil), cons(:b, nil), cons(:a, cons(:b, nil)))
|
69
|
+
end
|
70
|
+
|
71
|
+
def ground_appendo2
|
72
|
+
appendo2.call(cons(:a, nil), cons(:b, nil), cons(:a, cons(:b, nil)))
|
73
|
+
end
|
74
|
+
|
75
|
+
def relo
|
76
|
+
-> (x) {
|
77
|
+
call_fresh(-> (x1) {
|
78
|
+
call_fresh(-> (x2) {
|
79
|
+
conj(
|
80
|
+
eq(x, cons(x1, x2)),
|
81
|
+
disj(
|
82
|
+
eq(x1, x2),
|
83
|
+
-> (s_c) {
|
84
|
+
-> { relo.call(x).call(s_c) }
|
85
|
+
}
|
86
|
+
)
|
87
|
+
)
|
88
|
+
})
|
89
|
+
})
|
90
|
+
}
|
91
|
+
end
|
92
|
+
|
93
|
+
def many_non_ans
|
94
|
+
call_fresh(-> (x) {
|
95
|
+
disj(
|
96
|
+
relo.call(cons(5, 6)),
|
97
|
+
eq(x, 3))})
|
98
|
+
end
|
99
|
+
end
|
100
|
+
end
|
metadata
CHANGED
@@ -1,14 +1,14 @@
|
|
1
1
|
--- !ruby/object:Gem::Specification
|
2
2
|
name: micro_kanren
|
3
3
|
version: !ruby/object:Gem::Version
|
4
|
-
version: 0.0.
|
4
|
+
version: 0.0.2
|
5
5
|
platform: ruby
|
6
6
|
authors:
|
7
7
|
- Justin Leitgeb
|
8
8
|
autorequire:
|
9
9
|
bindir: bin
|
10
10
|
cert_chain: []
|
11
|
-
date: 2014-01-
|
11
|
+
date: 2014-01-29 00:00:00.000000000 Z
|
12
12
|
dependencies:
|
13
13
|
- !ruby/object:Gem::Dependency
|
14
14
|
name: bundler
|
@@ -68,11 +68,16 @@ files:
|
|
68
68
|
- lib/micro_kanren.rb
|
69
69
|
- lib/micro_kanren/core.rb
|
70
70
|
- lib/micro_kanren/lisp.rb
|
71
|
+
- lib/micro_kanren/mini_kanren_wrappers.rb
|
72
|
+
- lib/micro_kanren/var.rb
|
71
73
|
- lib/micro_kanren/version.rb
|
72
74
|
- micro_kanren.gemspec
|
73
75
|
- spec/micro_kanren/core_spec.rb
|
74
76
|
- spec/micro_kanren/lisp_spec.rb
|
77
|
+
- spec/micro_kanren/mini_kanren_wrappers_spec.rb
|
75
78
|
- spec/spec_helper.rb
|
79
|
+
- spec/test_programs.rb
|
80
|
+
- spec/test_support.rb
|
76
81
|
homepage: http://github.com/jsl/ruby_ukanren
|
77
82
|
licenses:
|
78
83
|
- MIT
|
@@ -100,4 +105,7 @@ summary: uKanren in Ruby
|
|
100
105
|
test_files:
|
101
106
|
- spec/micro_kanren/core_spec.rb
|
102
107
|
- spec/micro_kanren/lisp_spec.rb
|
108
|
+
- spec/micro_kanren/mini_kanren_wrappers_spec.rb
|
103
109
|
- spec/spec_helper.rb
|
110
|
+
- spec/test_programs.rb
|
111
|
+
- spec/test_support.rb
|