├── .gitignore ├── AUTHORS ├── BUGS ├── LICENSE ├── Makefile ├── TODO ├── check.sh ├── docs ├── .gitignore ├── Makefile ├── TODO ├── bench.txt ├── never_equals.txt └── presentation.rst ├── mk-scheme ├── publish.sh ├── shell └── src ├── info └── hircus │ └── kanren │ ├── MKMath.scala │ ├── MiniKanren.scala │ ├── Prelude.scala │ ├── Subst.scala │ ├── examples │ ├── PalProd.scala │ └── SendMoreMoney.scala │ └── tests │ ├── BranchingSpecification.scala │ ├── MathSpecification.scala │ ├── RunSpecification.scala │ ├── SubstSpecification.scala │ └── UnifySpecification.scala └── shell.scala /.gitignore: -------------------------------------------------------------------------------- 1 | .classpath 2 | .manager 3 | .project 4 | .scala_dependencies 5 | api 6 | bin 7 | *.class 8 | *~ 9 | *.\#* 10 | *\#*\# 11 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | AUTHORS 2 | ======= 3 | 4 | Michel Alexandre Salim 5 | -------------------------------------------------------------------------------- /BUGS: -------------------------------------------------------------------------------- 1 | BUGS 2 | ==== 3 | 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions 5 | are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 2. Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in 11 | the documentation and/or other materials provided with the 12 | distribution. 13 | 3. The names of the authors may not be used to endorse or promote 14 | products derived from this software without specific, prior 15 | written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 20 | FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 21 | COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 22 | INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 23 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 24 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 25 | AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 27 | OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28 | SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | BASEDIR=info/hircus/kanren 2 | TITLE="Mini Kanren" 3 | 4 | all: bin bin/${BASEDIR}/examples 5 | 6 | bin: src/${BASEDIR}/*.scala src/${BASEDIR}/tests/*.scala 7 | $(shell [ -d bin ] && touch -m bin || mkdir -p bin) 8 | scalac -d bin src/${BASEDIR}/*.scala src/${BASEDIR}/tests/*.scala 9 | 10 | bin/${BASEDIR}/examples: bin src/${BASEDIR}/examples/*.scala 11 | scalac -d bin src/${BASEDIR}/examples/*.scala 12 | 13 | check: 14 | ./check.sh 15 | 16 | api: src/${BASEDIR}/*.scala src/${BASEDIR}/examples/*.scala 17 | $(shell [ -d api ] && touch -m api || mkdir -p api) 18 | scaladoc -doctitle ${TITLE} -windowtitle ${TITLE} -d api \ 19 | src/${BASEDIR}/*.scala src/${BASEDIR}/examples/*.scala 20 | 21 | clean: 22 | -rm -rf api bin 23 | 24 | publish: api 25 | make -C docs 26 | ./publish.sh 27 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | TODO 2 | ==== 3 | 4 | - Arithmetic operations 5 | -------------------------------------------------------------------------------- /check.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | cd bin 3 | for tst in info.hircus.kanren.tests.{Subst,Unify,Run,Branching,Math}Specification; do 4 | scala $tst 5 | done 6 | cd .. 7 | -------------------------------------------------------------------------------- /docs/.gitignore: -------------------------------------------------------------------------------- 1 | ui 2 | *.html 3 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | all: presentation.html handouts.html 2 | 3 | presentation.html: presentation.rst 4 | rst2s5 presentation.rst presentation.html 5 | 6 | handouts.html: presentation.rst 7 | rst2html presentation.rst handouts.html 8 | 9 | clean: 10 | -rm -rf presentation.html ui 11 | 12 | -------------------------------------------------------------------------------- /docs/TODO: -------------------------------------------------------------------------------- 1 | - Document the following Scala features: 2 | * converting to/from variadic arguments 3 | cf. Lisp/Scheme's (apply fn args) 4 | * differences from Java: generics syntax, casting 5 | * contrast with Python: 6 | - module => object 7 | - def => def 8 | - multiple inheritance => mixins 9 | * OCaml / Haskell 10 | - pattern-matching 11 | -Hindley-Milner type inferencer 12 | * can infer non-recursive return value 13 | * can infer type of local variables/values 14 | * can *not* infer type of fn args 15 | e.g. the lookup function, all Goal 16 | 17 | - richer libraries (JVM) 18 | 19 | * talk about REPL: can use to script Java code too! 20 | 21 | - Porting effort 22 | * Scheme implementation of streams as pairs with thunked cdrs => 23 | built-in Scala Stream 24 | * type-safety: instead of #f for empty stream, use Stream.empty 25 | (different from a stream containing a single empty list) 26 | 27 | * can use Scala's Option monad (Haskell's Maybe) but as it turns out 28 | it complicates the code too much 29 | 30 | * Scheme provides cond_e branching construct. The code looks so unwieldy 31 | in Scala, going with if_e instead 32 | 33 | def if_e(g0: Goal, g1: Goal, g2: Goal): Goal = ... 34 | 35 | note: not using call-by-name as goals are just functions anyway, cf. 36 | a general if 37 | 38 | * bind_e ==> in Scala, just a flatMap 39 | keeping as separate function because there are equivalents 40 | (bind_i, bind_a, etc.) that have to be coded by hand 41 | 42 | * map_inf ==> Stream.map 43 | * case_inf ==> just pattern matching on Streams 44 | 45 | * any_e ==> easy 46 | 47 | * all ==> interesting. talk about varargs 48 | 49 | * Testing 50 | Scala has several test framework, one of them, ScalaCheck (inspired by 51 | Haskell's QuickCheck) that can generate test cases 52 | 53 | -------------------------------------------------------------------------------- /docs/bench.txt: -------------------------------------------------------------------------------- 1 | =========================== 2 | With substitution-as-lists: 3 | =========================== 4 | 5 | scala> time(run(1,x)(palprod_o(x))) 6 | 100001 7 | 101101 8 | Elapsed: 114562 ms 9 | res0: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()))))))))))))))) 10 | 11 | scala> time(run(1,x)(palprod_o(x))) 12 | 100001 13 | 101101 14 | Elapsed: 111629 ms 15 | res1: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()))))))))))))))) 16 | 17 | scala> time(run(1,x)(palprod_o(x))) 18 | 100001 19 | 101101 20 | Elapsed: 109939 ms 21 | res2: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()))))))))))))))) 22 | 23 | ====================== 24 | With new substitution: 25 | ====================== 26 | 27 | scala> time(run(1,x)(palprod_o(x))) 28 | 100001 29 | 101101 30 | Elapsed: 47833 ms 31 | res0: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()))))))))))))))) 32 | 33 | scala> time(run(1,x)(palprod_o(x))) 34 | 100001 35 | 101101 36 | Elapsed: 44813 ms 37 | res1: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()))))))))))))))) 38 | 39 | scala> time(run(1,x)(palprod_o(x))) 40 | 100001 41 | 101101 42 | Elapsed: 44277 ms 43 | res2: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()))))))))))))))) 44 | 45 | ============================== 46 | With Clojure PersistentHashMap 47 | ============================== 48 | 49 | scala> ntimes(3, cljrun(1,x)(palprod_o(x))) 50 | 100001 51 | 101101 52 | 100001 53 | 101101 54 | 100001 55 | 101101 56 | Elapsed times: List(17955, 15586, 13482) 57 | Avg: 15674 58 | 59 | 60 | ================== 61 | Petite Chez Scheme 62 | ================== 63 | 64 | > (time (run 1 (q) (palprod2 q))) 65 | 100001 66 | 101101 67 | (time (run 1 ...)) 68 | 315 collections 69 | 37874 ms elapsed cpu time, including 166 ms collecting 70 | 39312 ms elapsed real time, including 167 ms collecting 71 | 1330081488 bytes allocated, including 1325753776 bytes reclaimed 72 | ((1 1 1 0 0 1 1 1 1 1 0 0 0 1)) 73 | > (time (run 1 (q) (palprod2 q))) 74 | 100001 75 | 101101 76 | (time (run 1 ...)) 77 | 316 collections 78 | 38074 ms elapsed cpu time, including 163 ms collecting 79 | 38853 ms elapsed real time, including 176 ms collecting 80 | 1330082640 bytes allocated, including 1331106472 bytes reclaimed 81 | ((1 1 1 0 0 1 1 1 1 1 0 0 0 1)) 82 | > (time (run 1 (q) (palprod2 q))) 83 | 100001 84 | 101101 85 | (time (run 1 ...)) 86 | 316 collections 87 | 37951 ms elapsed cpu time, including 148 ms collecting 88 | 39207 ms elapsed real time, including 160 ms collecting 89 | 1330082640 bytes allocated, including 1330638672 bytes reclaimed 90 | ((1 1 1 0 0 1 1 1 1 1 0 0 0 1)) 91 | > 92 | 93 | ======= 94 | Summary 95 | ======= 96 | 97 | We're now about 3x faster than Scheme Mk! Huzzah! 98 | -------------------------------------------------------------------------------- /docs/never_equals.txt: -------------------------------------------------------------------------------- 1 | Never Equals 2 | ============ 3 | 4 | This document describes the inequality constraint "never equals". 5 | 6 | To implement this, our idea of a substitution needs to be extended, so 7 | that instead of a single mapping, we have two mappings: 8 | - a mapping from logic vars to their bindings 9 | - another mapping from logic vars to things they must *not* equal 10 | 11 | Plan 12 | ---- 13 | 14 | As there is a cost to checking inequality constraints (both CPU and memory), 15 | it would be desirable to be able to turn off this feature. 16 | 17 | The first step is therefore to restructure the code as follows: 18 | - start a new Git branch for this work 19 | - make Substitution be a trait (cf. Haskell typeclasses) 20 | - lookup is now a method of the trait 21 | - write a simple implementation of this trait 22 | - verify that performance (on e.g. palprod) is not impacted 23 | - re-merge with master 24 | - now write a second trait that provides the neverEq construct 25 | - implement this trait 26 | 27 | Semantics 28 | --------- 29 | 30 | neverEq 31 | ~~~~~~~ 32 | 33 | First, walk the two inputs. then: 34 | 35 | - simplest case: neverEq(val1, val2) 36 | (val1 == val2) match { 37 | case true => fail 38 | case false => succeed 39 | } 40 | 41 | - next: neverEq(var1, val2) (also val1, var2) 42 | - extend the substitution's constraints with var1 =/= val2 43 | 44 | - next: neverEq(var1, var2) 45 | extend the constraints as such: 46 | - to the inequality constraints for var1, add var2 47 | - to that for var2, add var1 48 | 49 | mkEq 50 | ~~~~ 51 | 52 | Perform Eq as before, but check if the result breaks any of the existing 53 | constraints 54 | -------------------------------------------------------------------------------- /docs/presentation.rst: -------------------------------------------------------------------------------- 1 | Logical JVM: Implementing the Mini-Kanren logic system in Scala 2 | =============================================================== 3 | 4 | :Author: Michel Alexandre Salim 5 | 6 | .. image:: http://i.creativecommons.org/l/by-sa/3.0/us/88x31.png 7 | :height: 31px 8 | :width: 88px 9 | :alt: Creative Commons License 10 | :align: center 11 | 12 | Navigation 13 | ---------- 14 | 15 | * Use arrow keys, PgUp/PgDn, and mouse clicks to navigate 16 | * Press "**C**" for controls, and click the "|mode|" button to switch 17 | between presentation and handout/outline modes 18 | 19 | .. |mode| unicode:: U+00D8 .. capital o with stroke 20 | 21 | 22 | Abstract 23 | -------- 24 | 25 | .. class:: incremental 26 | 27 | Mini-Kanren is a simplified implementation of Kanren, a declarative 28 | logic system, embedded in a pure functional subset of Scheme. 29 | 30 | .. class:: incremental 31 | 32 | This presentation describes a port to Scala, written for the graduate 33 | programming language course at Indiana University. 34 | 35 | 36 | Outline 37 | ------- 38 | 39 | This presentation is in three sections: 40 | 41 | 1. `The Mini-Kanren logic system`_ 42 | 2. `An overview of Scala`_ 43 | 3. `The port`_ 44 | 45 | The Mini-Kanren logic system 46 | ---------------------------- 47 | 48 | To many ears, the term *logic programming* is virtually synonymous 49 | with Prolog (see [Colmerauer92]_ for a historical treatment). Outside 50 | the domain of Artificial Intelligence, computer science practicioners 51 | tend not to be exposed to the field -- in most cases, students are 52 | first exposed to procedural, then object-oriented, then functional 53 | languages\ [*]_. 54 | 55 | .. [Colmerauer92] *The birth of Prolog*, Colmerauer and Roussel, 1992 56 | .. [*] If they are (un)lucky, functional comes first 57 | 58 | 59 | Mini-Kanren: References 60 | ----------------------- 61 | 62 | The goal of *The Reasoned Schemer* is to help the functional 63 | programmer think logically and the logic programmer think 64 | functionally. -- [Friedman05]_ 65 | 66 | This presentation uses material sourced from the book, beta-tested by 67 | several classes of IU computer science students. 68 | 69 | .. [Friedman05] *The Reasoned Schemer*, by Daniel P. Friedman, William E. Byrd and Oleg Kiselyov 70 | 71 | Mini-Kanren: Substitution 72 | ------------------------- 73 | 74 | A *substitution* is a set of mappings from logical variables to values\ 75 | [#]_. It is immutable; extending a substitution with a new key-value 76 | mapping produces a new substitution, with the old substitution remaining 77 | unchanged\ [#]_. 78 | 79 | .. [#] including logical variables 80 | .. [#] Satisfied by Scheme association lists, or Clojure persistent maps 81 | 82 | Mini-Kanren: Goals 83 | ------------------ 84 | 85 | A *goal* is a function that, given a substitution, returns a stream of 86 | substitutions. There are two basic goals: 87 | 88 | .. class:: incremental 89 | 90 | - **succeed** (**#s**) returns a stream containing only the input substitution 91 | - **fail** (**#u**) returns an empty stream 92 | 93 | 94 | Mini-Kanren: Conditionals 95 | ------------------------- 96 | 97 | Four basic conditional constructs: 98 | 99 | .. class:: incremental 100 | 101 | - cond\ :sup:`e` -- each goal can succeed 102 | - cond\ :sup:`i` -- each goal can succeed, output is interleaved 103 | - cond\ :sup:`a` -- a single line, cf. soft-cut. only one goal can succeed 104 | - cond\ :sup:`u` -- uni-. like cond\ :sup:`a`, but the successful 105 | *question* only succeeds once 106 | 107 | .. class:: incremental 108 | 109 | We'll stick with cond\ :sup:`e` first, and discuss the others in a bit 110 | 111 | List predicate (Scheme) 112 | ----------------------- 113 | :: 114 | 115 | (def list? 116 | (λ (l) 117 | (cond 118 | ((null? l)) 119 | ((pair? l) 120 | (list? (cdr l))) 121 | (else #f)))) 122 | 123 | A list is either an empty list, or a pair whose tail is a list 124 | 125 | 126 | List predicate (Kanren) 127 | ----------------------- 128 | 129 | :: 130 | 131 | (def list° 132 | (λ (l) 133 | (conde 134 | ((null° l)) 135 | ((pair° l) 136 | (fresh (d) 137 | (cdr° l d) 138 | (list° d))) 139 | (else #u)))) 140 | 141 | List predicates 142 | --------------- 143 | 144 | Note the differences: 145 | 146 | - cond\ :sup:`e` instead of cond 147 | - cdr\ :sup:`o` instead of cdr 148 | - relations cannot be nested 149 | - non-boolean relations take an extra argument 150 | - relations return goals, not values 151 | 152 | Mini-Kanren: infinite goals 153 | --------------------------- 154 | 155 | :: 156 | 157 | (define any° 158 | (λ (g) 159 | (ife g #s 160 | (any° g)))) 161 | 162 | (define always° (any° #s)) 163 | (define never° (any° #u)) 164 | 165 | 166 | 167 | An overview of Scala 168 | -------------------- 169 | 170 | Scala is a concise, elegant, type-safe programming language that 171 | integrates object-oriented and functional features.\ [#]_ 172 | 173 | 174 | .. [#] http://www.scala-lang.org/ 175 | 176 | Scala: the name 177 | --------------- 178 | 179 | The name Scala stands for “scalable language.” The language is so 180 | named because it was designed to grow with the demands of its 181 | users. You can apply Scala to a wide range of programming tasks, 182 | from writing small scripts to building large systems.\ [#]_ 183 | 184 | .. [#] *Scala: A Scalable Language*, by Martin Odersky, Lex Spoon, and Bill Venners 185 | 186 | Scala: the authors 187 | ------------------ 188 | 189 | Scala is developed by the `LAMP group`_ at EPFL, led by Prof. Martin 190 | Odersky, who previously worked on `Pizza`_ and `Generic Java`_ 191 | 192 | .. _LAMP group: http://lamp.epfl.ch/ 193 | .. _Pizza: http://pizzacompiler.sourceforge.net/ 194 | .. _Generic Java: http://www.cis.unisa.edu.au/~pizza/gj/ 195 | 196 | Scala: Pros 197 | ----------- 198 | 199 | .. class:: incremental 200 | 201 | - runs on the JVM 202 | - interoperates well with Java 203 | - and thus with other JVM languages 204 | - provides functional programming constructs 205 | - pattern-matching 206 | - powerful type system 207 | 208 | 209 | Scala: Tail-Call Optimization 210 | ----------------------------- 211 | 212 | .. class:: incremental 213 | 214 | - function calls in tail position should not grow call stack 215 | - JVM does not have tailcall instruction 216 | - JVM functional languages work around this to differing extents 217 | 218 | Scala: TCO: self-recursion 219 | -------------------------- 220 | 221 | This is safe: 222 | 223 | :: 224 | 225 | def even_or_odd(check_even: Boolean, n: Int) = n match { 226 | case 0 => check_even 227 | case _ => even_or_odd(!check_even, n-1) 228 | } 229 | 230 | Scala: TCO: mutual recursion 231 | ---------------------------- 232 | 233 | This is not: 234 | 235 | :: 236 | 237 | def is_even(n: Int) = n match { 238 | case 0 => true 239 | case _ => is_odd(n-1) 240 | } 241 | 242 | def is_odd(n: Int) = n match { 243 | case 0 => false 244 | case _ => is_even(n-1) 245 | } 246 | 247 | .. class:: incremental 248 | 249 | - no mutual TCO (blame Sun) 250 | - No macros 251 | - call-by-name provides same power (but not conciseness) 252 | 253 | Scala: Objects 254 | -------------- 255 | 256 | Objects serve two purposes: 257 | 258 | .. class:: incremental 259 | 260 | - as a code container (cf. Python modules) 261 | - in Java, this will be a class with static fields 262 | - as singletons 263 | - an object is automatically instantiated exactly once 264 | 265 | .. class:: incremental 266 | 267 | Let's look at a concrete example 268 | 269 | Scala: Objects (cont.) 270 | ---------------------- 271 | 272 | :: 273 | 274 | package info.hircus.kanren 275 | object MiniKanren { 276 | import java.util.HashMap 277 | case class Var(name: Symbol, count: Int) 278 | private val m = new HashMap[Symbol, Int]() 279 | def make_var(name: Symbol) = { 280 | val count = m.get(name) 281 | m.put(name, count+1) 282 | Var(name, count) 283 | } /* more code */ 284 | } 285 | 286 | Scala: REPL 287 | ----------- 288 | 289 | Scala provides a read-evaluate-print-loop interpreter, familiar to 290 | users of functional and scripting languages 291 | 292 | :: 293 | 294 | scala> import info.hircus.kanren.MiniKanren._ 295 | import info.hircus.kanren.MiniKanren._ 296 | 297 | scala> val v = make_var('hello) 298 | v: info.hircus.kanren.MiniKanren.Var = Var('hello,0) 299 | 300 | scala> val w = make_var('hello) 301 | w: info.hircus.kanren.MiniKanren.Var = Var('hello,1) 302 | 303 | Scala: REPL (cont.) 304 | ------------------- 305 | 306 | REPL 307 | ~~~~ 308 | 309 | :: 310 | 311 | scala> val v = make_var('hello) 312 | v: info.hircus.kanren.MiniKanren.Var = Var('hello,2) 313 | 314 | scala> v = make_var('world) 315 | :7: error: reassignment to val 316 | v = make_var('world) 317 | 318 | .. class:: incremental 319 | 320 | Values cannot be reassigned -- use variables for that. 321 | 322 | Scala: Pattern matching 323 | ----------------------- 324 | 325 | Those familiar with either OCaml or Haskell will be right at home with Scala's pattern-matching construct. 326 | Unlike Haskell, there is no pattern matching on function definitions. 327 | 328 | .. class:: incremental 329 | 330 | Contrast an implementation of a list-summing function in the three languages: 331 | 332 | .. class:: incremental 333 | 334 | :: 335 | 336 | lsum :: (Num t) => [t] -> t -- this line is optional 337 | lsum [] = 0 338 | lsum (h:tl) = h + lsum tl 339 | 340 | 341 | Scala: Pattern matching 342 | ----------------------- 343 | 344 | .. class:: incremental 345 | 346 | :: 347 | 348 | # let rec sum list = match list with 349 | | [] -> 0 350 | | head::tail -> head + sum tail;; 351 | val sum : int list -> int = 352 | # 353 | 354 | .. class:: incremental 355 | 356 | :: 357 | 358 | scala> def sum(l: List[Int]): Int = l match { 359 | | case Nil => 0 360 | | case h::tl => h + sum(tl) 361 | | } 362 | sum: (List[Int])Int 363 | 364 | scala> 365 | 366 | 367 | Scala: scalacheck 368 | ----------------- 369 | 370 | *scalacheck*\ [#]_ is a tool for random testing of program properties, with 371 | automatic test case generation. It was initially a port of Haskell's 372 | *QuickCheck*\ [#]_ library. 373 | 374 | .. [#] http://code.google.com/p/scalacheck/ 375 | .. [#] http://hackage.haskell.org/package/QuickCheck-2.1.0.2 376 | 377 | Scala: scalacheck examples 378 | -------------------------- 379 | 380 | :: 381 | 382 | import org.scalacheck._ 383 | 384 | object StringSpecification extends Properties("String") { 385 | property("startsWith") = Prop.forAll((a: String, b: String) => 386 | (a+b).startsWith(a)) 387 | // Is this really always true? 388 | property("concat") = Prop.forAll((a: String, b: String) => 389 | (a+b).length > a.length && (a+b).length > b.length ) 390 | property("substring") = Prop.forAll((a: String, b: String) => 391 | (a+b).substring(a.length) == b ) 392 | } 393 | 394 | The port 395 | -------- 396 | 397 | The initial port was done over the course of several weeks; the 398 | current implementation is a rewrite\ [#]_. The initial implementation 399 | had a stack-overflow bug that was reëncountered during the rewrite, 400 | which I'll discuss in a bit. 401 | 402 | The new codebase is better tested, and utilizes more Scala features to 403 | make the syntax look natural. 404 | 405 | .. [#] original code is lost. moral story: backup (and share online...) 406 | 407 | Substitution 408 | ------------ 409 | 410 | Several choices for substitution: 411 | 412 | .. class:: incremental 413 | 414 | - List[(Var, Any)] --> equivalent to ((Var,Any),Subst) 415 | - linked triples: (Var, Any, Subst) 416 | - immutable maps 417 | 418 | Substitution (cont.) 419 | -------------------- 420 | 421 | Scheme Kanren uses *association lists*, i.e. a linked list of linked lists, 422 | but that could be partly because that's the only native recursive data structure 423 | in Scheme. 424 | 425 | .. class:: incremental 426 | 427 | - consider memory usage 428 | - in Scala, triples are more than twice faster 429 | - immutable maps ==> heap OOM 430 | 431 | 432 | Constraints 433 | ----------- 434 | 435 | Kanren does not natively understand numbers, so the most natural 436 | constraint is inequality. (This is proposed by Prof. Friedman and is 437 | not part of the official Kanren codebase, probably due to performance 438 | cost) 439 | 440 | This implementation led to the shift in the Scala port from an exact 441 | translation of Scheme's substitution to a more OOP implementation 442 | (cf. Haskell typeclass). 443 | 444 | Constraints (cont.) 445 | ------------------- 446 | 447 | .. class:: incremental 448 | 449 | - simple substitutions have no-op constraint methods 450 | - constraint substitutions delegate to the simple substitution methods when 451 | possible, and layer constraint checking on top 452 | 453 | Constraints: code 454 | ----------------- 455 | 456 | :: 457 | 458 | case class ConstraintSubstN(s: SimpleSubst, 459 | c: Constraints) extends Subst { 460 | def extend(v: Var, x: Any) = 461 | if (this.constraints(v) contains x) None 462 | else Some(ConstraintSubstN(SimpleSubst(v,x,s), c)) 463 | 464 | override def c_extend(v: Var, x: Any) = 465 | ConstraintSubstN(s, c_insert(v,x,c)) 466 | 467 | Constraints: code 468 | ----------------- 469 | 470 | :: 471 | 472 | def lookup(v: Var) = s.lookup(v) 473 | override def constraints(v: Var) = c_lookup(v, c) 474 | def length: Int = s.length 475 | } 476 | 477 | 478 | Monadic operator: mplus (Scheme) 479 | -------------------------------- 480 | 481 | :: 482 | 483 | (define mplus 484 | (lambda (a-inf f) 485 | (case-inf a-inf 486 | (f) 487 | ((a) (choice a f)) 488 | ((a f0) (choice a 489 | (lambdaf@ () (mplus (f0) f))))))) 490 | 491 | Monadic operator: mplus (Scala) 492 | ------------------------------- 493 | 494 | :: 495 | 496 | def mplus(a_inf: Stream[Subst], 497 | f: => Stream[Subst]): Stream[Subst] = 498 | a_inf append f 499 | 500 | .. class:: handout 501 | 502 | **mplus** is simply stream append. It is kept as a separate function because, 503 | as can be seen in the next slide, other variants do not have built-in Scala 504 | implementations. 505 | 506 | Monadic operator: mplus\ :sup:`i` (Scheme) 507 | ------------------------------------------ 508 | 509 | :: 510 | 511 | (define mplusi 512 | (lambda (a-inf f) 513 | (case-inf a-inf 514 | (f) 515 | ((a) (choice a f)) 516 | ((a f0) (choice a 517 | (lambdaf@ () (mplusi (f) f0))))))) 518 | 519 | **mplus**\ :sup:`i` *interleaves* two streams 520 | 521 | Monadic operator: mplus\ :sup:`i` (Scala) 522 | ----------------------------------------- 523 | 524 | :: 525 | 526 | def mplus_i(a_inf: Stream[Subst], 527 | f: => Stream[Subst]): Stream[Subst] = a_inf match { 528 | case Stream.empty => f 529 | case Stream.cons(a, f0) => f0 match { 530 | case Stream.empty => Stream.cons(a, f) 531 | case _ => Stream.cons(a, mplus_i(f, f0)) 532 | } 533 | } 534 | 535 | 536 | Monadic operator: bind (Scheme) 537 | ------------------------------- 538 | 539 | :: 540 | 541 | (define bind 542 | (lambda (a-inf g) 543 | (case-inf a-inf 544 | (mzero) 545 | ((a) (g a)) 546 | ((a f) (mplus (g a) 547 | (lambdaf@ () (bind (f) g))))))) 548 | 549 | Monadic operator: bind (Scala) 550 | ------------------------------ 551 | 552 | :: 553 | 554 | def bind(a_inf: Stream[Subst], g: Goal): Stream[Subst] = 555 | a_inf flatMap g 556 | 557 | .. class:: handout 558 | 559 | **bind** is flatMap: it first maps *g* over the stream, and then append the 560 | resulting streams together. 561 | 562 | Monadic operator: bind\ :sup:`i` (Scheme) 563 | ----------------------------------------- 564 | 565 | :: 566 | 567 | (define bindi 568 | (lambda (a-inf g) 569 | (case-inf a-inf 570 | (mzero) 571 | ((a) (g a)) 572 | ((a f) (mplusi (g a) 573 | (lambdaf@ () (bindi (f) g))))))) 574 | 575 | Monadic operator: bind\ :sup:`i` (Scala) 576 | ---------------------------------------- 577 | 578 | :: 579 | 580 | def bind_i(a_inf: Stream[Subst], g: Goal): Stream[Subst] = 581 | a_inf match { 582 | case Stream.empty => a_inf 583 | case Stream.cons(a, f) => f match { 584 | case Stream.empty => g(a) 585 | case _ => mplus_i(g(a), bind(f, g)) 586 | } 587 | } 588 | 589 | Syntax: equality 590 | ---------------- 591 | 592 | In Scheme, (≡ x y) is the goal that unifies *x* and *y*; (≢ x y) 593 | constrains them from being unifiable. The syntax looks natural in 594 | Scheme, as everything is infix. 595 | 596 | .. class:: incremental 597 | 598 | In Scala, however, the equivalent looks ugly: *mkEqual(x,y)*; 599 | *neverEqual(x,y)*. We can introduce infix operations by using implicit 600 | conversions 601 | 602 | Syntax: equality 603 | ---------------- 604 | 605 | :: 606 | 607 | class Unifiable(a: Any) { 608 | def ===(b: Any): Goal = mkEqual(a, b) 609 | def =/=(b: Any): Goal = neverEqual(a, b) 610 | } 611 | 612 | implicit def unifiable(a: Any) = new Unifiable(a) 613 | 614 | ≡ and ≢ are now methods of the class *Unifiable*, and because an 615 | implicit conversion function is in scope, attempting to call it on any 616 | value will autobox it to a Unifiable with the same value. 617 | 618 | Macros 619 | ------ 620 | 621 | Most macros in the original code can be completely replaced by 622 | functions, apart from the ones that introduce new names. 623 | 624 | Drawbacks -- the use of macros is equivalent to compiler inlining, in 625 | that the expansion is computed at compile time, rather than at 626 | runtime. There is a performance hit that has not been quantified yet; 627 | more later. 628 | 629 | On the other hand, macros are harder to compose -- not first-class values. 630 | 631 | Macros: run 632 | --------------------- 633 | 634 | :: 635 | 636 | > (run #f (q) (member° q '(a b c d e))) 637 | (a b c d e) 638 | > 639 | 640 | .. class:: handout 641 | 642 | - first arg is number of desired results (#f == all) 643 | - specifying the number of results is a Scheme-ism, in a language with 644 | more idiomatic support for lazy sequences, **run** can be composed with 645 | **take** 646 | 647 | Macros: run 648 | ----------- 649 | 650 | :: 651 | 652 | (define-syntax run 653 | (syntax-rules () 654 | ((_ n^ (x) g ...) 655 | (let ((n n^) (x (var x))) 656 | (if (or (not n) (> n 0)) 657 | (map-inf n 658 | (lambda (s) 659 | (reify (walk* x s))) 660 | ((all g ...) empty-s)) 661 | ()))))) 662 | 663 | Macros: Run 664 | ----------- 665 | 666 | :: 667 | 668 | def run(n: Int, v: Var)(g0: Goal, gs: Goal*) = { 669 | val g = gs.toList match { 670 | case Nil => g0 671 | case gls => all((g0::gls): _*) 672 | } 673 | val allres = g(empty_s) map {s: Subst => reify(walk_*(v, s)) } 674 | (if (n < 0) allres else (allres take n)) toList 675 | } 676 | 677 | .. class:: handout 678 | 679 | - not a macro: *v* must be already defined 680 | - We use the **map** method of a stream, which produces a lazy stream 681 | - It's not idiomatic outside Lisp to have functions that take either 682 | #f or some other type. Instead, a negative number is used to 683 | collect all results 684 | 685 | Macros: fresh 686 | ------------- 687 | 688 | :: 689 | 690 | (def list° 691 | (λ (l) 692 | (conde 693 | ((null° l)) 694 | ((pair° l) 695 | (fresh (d) 696 | (cdr° l d) 697 | (list° d)))))) 698 | 699 | .. class:: incremental 700 | 701 | This differs slightly from the first appearance of *list°*: the (else #u) line is removed, 702 | as cond\ :sup:`e` fails by default 703 | 704 | Macros: fresh 705 | ------------- 706 | 707 | :: 708 | 709 | def list_o(l: Any): Goal = { 710 | cond_e((null_o(l), succeed), 711 | (pair_o(l), { s: Subst => { 712 | val d = make_var('d) 713 | both(cdr_o(l, d), list_o(d))(s) } })) 714 | } 715 | 716 | .. class:: incremental 717 | 718 | - unlike a macro, *cond_e* is evaluated at runtime. 719 | - each line is required to have strictly 2 goals (thus **succeed** is inserted) 720 | - the **fresh** goal is replaced by a closure. Note *s* is passed to **both** 721 | 722 | Macros: project 723 | --------------- 724 | 725 | :: 726 | 727 | > (run 2 (x) 728 | (conde 729 | ((== x 7) (project (x) (begin (printf "~s~n" x) succeed))) 730 | ((== x 42) (project (x) (begin (printf "~s~n" x) fail))))) 731 | 7 732 | 42 733 | (7) 734 | > 735 | 736 | .. class:: handout 737 | 738 | - within the body of the projection, the logic variable *x* is 739 | replaced by its bound value 740 | - cond\ :sup:`e` successively bind *x* to 7 and 42 741 | - the second **project** expression fails after printing 42, thus 42 742 | is not in the result list 743 | 744 | 745 | Macros: project 746 | --------------- 747 | 748 | :: 749 | 750 | run(2, x)(cond_e((mkEqual(x,7), { s: Subst => { 751 | val x1 = walk_*(x, s) 752 | println(x1) 753 | succeed(s) }}), 754 | (mkEqual(x,42), { s: Subst => { 755 | val x1 = walk_*(x, s) 756 | println(x1) 757 | fail(s) }}))) 758 | 759 | 760 | 761 | Debugging 762 | --------- 763 | 764 | .. class:: incremental 765 | 766 | - property specification allows for easy declaration of test cases 767 | - can stress-test individual functions, and narrow down possible culprits 768 | - stack overflow bug found in a combination of elimination and having comments 769 | 770 | Debugging (cont.) 771 | ----------------- 772 | 773 | When computing with streams, eagerness is *bad* 774 | 775 | :: 776 | 777 | $ git diff 5bc7a839ae9db cc596e43b465c 778 | /** 779 | - * While we could use call-by-name here, 780 | - * since the goals are functions anyway, delaying evaluation is 781 | - * unnecessary 782 | ... 783 | - def if_e(g0: Goal, g1: Goal, g2: Goal): Goal = { 784 | + def if_e(testg: Goal, conseqg: Goal, altg: => Goal): Goal = { 785 | ... 786 | 787 | Common pitfalls 788 | --------------- 789 | 790 | - when translating a Scheme **fresh** or **project** goal, forgetting 791 | to apply the created goal to the input substitution 792 | - higher-order functions: functional parameter must be followed by *_* 793 | - Variadic functions: if arg array is converted internally to arg list, 794 | must convert back to arg array when recurring 795 | 796 | 797 | Benchmarks: Petite Chez Scheme 798 | ---------------------------------------- 799 | 800 | :: 801 | 802 | > (time (run 1 (q) (palprod2 q))) 803 | 100001 804 | 101101 805 | (time (run 1 ...)) 806 | 315 collections 807 | 37916 ms elapsed cpu time, including 156 ms collecting 808 | 38858 ms elapsed real time, including 161 ms collecting 809 | 1330081488 bytes allocated, including 1325728560 bytes reclaimed 810 | ((1 1 1 0 0 1 1 1 1 1 0 0 0 1)) 811 | 812 | 813 | Benchmarks: Scala (association list) 814 | ---------------------------------------------- 815 | 816 | :: 817 | 818 | scala> time(run(1,x)(palprod_o(x))) 819 | 100001 820 | 101101 821 | Elapsed: 114344 ms 822 | res2: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()... 823 | 824 | Benchmarks: Scala (case class) 825 | ---------------------------------------- 826 | 827 | :: 828 | 829 | scala> time(run(1,x)(palprod_o(x))) 830 | 100001 831 | 101101 832 | Elapsed: 44277 ms 833 | res2: Any = List((1,(1,(1,(0,(0,(1,(1,(1,(1,(1,(0,(0,(0,(1,List()... 834 | 835 | Conclusion 836 | ---------- 837 | 838 | TODO list 839 | --------- 840 | 841 | .. class:: incremental 842 | 843 | - parallelization: cf. pmap\ [#]_ 844 | - the problem is that we don't want to precompute too many answers, so 845 | unlike a list pmap, a stream pmap will have to precompute only a 846 | fixed number of elements 847 | - Prolog benchmarks from the full Kanren 848 | 849 | .. [#] Erlang implementation: http://lukego.livejournal.com/6753.html 850 | 851 | Clojure 852 | ------- 853 | 854 | .. class:: incremental 855 | 856 | - MK Scala already uses Clojure's implementation of persistent maps 857 | - Scala-native implementation scheduled to be available in version 2.8 858 | - Using Clojure will allow measurement of the performance hit entailed in 859 | using functions over macros 860 | 861 | The port: Downloads 862 | ------------------- 863 | 864 | The Scala port is available under the BSD license from GitHub\ [#]_. 865 | The latest Kanren source is available on Sourceforge\ [#]_. 866 | 867 | .. [#] http://github.com/hircus/minikanren-scala 868 | .. [#] http://kanren.sourceforge.net/ 869 | 870 | Q&A 871 | --- 872 | 873 | Your questions, suggestions, etc. are welcome! The project bug tracker is 874 | at the GitHub address. 875 | -------------------------------------------------------------------------------- /mk-scheme: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | pushd ${HOME}/checkouts/upstream/kanren/mini 3 | #petite mybook.ss 4 | petite palindrom-fixed.scm 5 | popd 6 | -------------------------------------------------------------------------------- /publish.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | if [ -z "$1" ]; then 3 | HOST=hircus@iceland.freeshell.org 4 | else 5 | HOST=$1 6 | fi 7 | 8 | if [ -z "$2" ]; then 9 | PUBDIR=html/kanren/ 10 | else 11 | PUBDIR=$2 12 | fi 13 | 14 | rsync -avz --delete -e ssh api docs/{handouts,presentation}.html docs/ui \ 15 | $HOST:$PUBDIR 16 | 17 | -------------------------------------------------------------------------------- /shell: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | scala -cp bin -i src/shell.scala 3 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/MKMath.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren 33 | 34 | /** 35 | * Mini Kanren math relations.
36 | * This will be merged with Prelude once all operations are implemented 37 | */ 38 | object MKMath { 39 | import info.hircus.kanren.MiniKanren._ 40 | import info.hircus.kanren.Prelude._ 41 | 42 | /** 43 | * (x XOR y) === r 44 | * 45 | * @param x a bit 46 | * @param y a bit 47 | * @param r a bit 48 | */ 49 | def bit_xor_o(x: Any, y: Any, r: Any): Goal = { 50 | if_e(both(mkEqual(0,x), mkEqual(0,y)), mkEqual(0,r), 51 | if_e(both(mkEqual(1,x), mkEqual(0,y)), mkEqual(1,r), 52 | if_e(both(mkEqual(0,x), mkEqual(1,y)), mkEqual(1,r), 53 | if_e(both(mkEqual(1,x), mkEqual(1,y)), mkEqual(0,r), 54 | fail)))) } 55 | 56 | /** 57 | * (x AND y) === r 58 | * 59 | * @param x a bit 60 | * @param y a bit 61 | * @param r a bit 62 | */ 63 | def bit_and_o(x: Any, y: Any, r: Any): Goal = { 64 | if_e(both(mkEqual(0,x), mkEqual(0,y)), mkEqual(0,r), 65 | if_e(both(mkEqual(1,x), mkEqual(0,y)), mkEqual(0,r), 66 | if_e(both(mkEqual(0,x), mkEqual(1,y)), mkEqual(0,r), 67 | if_e(both(mkEqual(1,x), mkEqual(1,y)), mkEqual(1,r), 68 | fail)))) } 69 | 70 | /** 71 | * Given the bits x, y, r, and c, satisfies x + y = r + 2*c 72 | * 73 | * @param x a bit 74 | * @param y a bit 75 | * @param r x+y % 2 76 | * @param c x+y >> 1 77 | */ 78 | def half_adder_o(x: Any, y: Any, r: Any, c: Any): Goal = { 79 | both(bit_xor_o(x,y,r), 80 | bit_and_o(x,y,c)) 81 | } 82 | 83 | /** 84 | * Given the bits b, x, y, r, and c,satisfies b + x + y == r + 2*c 85 | * 86 | * @param b previous carry 87 | * @param x a bit 88 | * @param y a bit 89 | * @param r b+x+y % 2 90 | * @param c b+x+y >> 1 91 | */ 92 | def full_adder_o(b: Any, x: Any, y: Any, r: Any, c: Any): Goal = { 93 | val w = make_var('w) 94 | val xy = make_var('xy) 95 | val wz = make_var('wz) 96 | 97 | all(half_adder_o(x,y,w,xy), 98 | half_adder_o(w,b,r,wz), 99 | bit_xor_o(xy,wz,c)) 100 | } 101 | 102 | /** 103 | * Build a Kanren number from an integer 104 | * 105 | * @param n an integer 106 | * @return a Kanren number 107 | */ 108 | def build_num(n: Int): Any = { 109 | if (n==0) Nil 110 | else ( (n%2), build_num(n >> 1) ) 111 | } 112 | 113 | /** 114 | * Read a Kanren number as an integer 115 | * 116 | * @param n a Kanren number 117 | * @return an integer 118 | */ 119 | def read_num(n: Any): Int = n match { 120 | case Nil => 0 121 | case (x, p) => x.asInstanceOf[Int] + (read_num(p) << 1) 122 | } 123 | 124 | /* "Predicates" */ 125 | /** 126 | * succeeds when n represents a positive number 127 | * 128 | * @param n a bitlist number 129 | */ 130 | def pos_o(n: Any): Goal = { 131 | val a = make_var('a) 132 | val d = make_var('d) 133 | 134 | mkEqual((a,d), n) 135 | } 136 | 137 | /** 138 | * succeeds when n represents a number > 1 139 | * 140 | * @param n a bitlist number 141 | */ 142 | def gt1_o(n: Any): Goal = { 143 | val a = make_var('a) 144 | val ad = make_var('ad) 145 | val dd = make_var('dd) 146 | 147 | mkEqual((a,(ad,dd)), n) 148 | } 149 | 150 | 151 | /** 152 | * Holds if a is a digit (i.e. 0 to 9) 153 | * 154 | * @param a a bitlist number 155 | */ 156 | def digit_o(a: Any): Goal = { 157 | cond_e((mkEqual(a, build_num(0)), succeed), 158 | (mkEqual(a, build_num(1)), succeed), 159 | (mkEqual(a, build_num(2)), succeed), 160 | (mkEqual(a, build_num(3)), succeed), 161 | (mkEqual(a, build_num(4)), succeed), 162 | (mkEqual(a, build_num(5)), succeed), 163 | (mkEqual(a, build_num(6)), succeed), 164 | (mkEqual(a, build_num(7)), succeed), 165 | (mkEqual(a, build_num(8)), succeed), 166 | (mkEqual(a, build_num(9)), succeed)) 167 | } 168 | 169 | /** 170 | * Holds if both n and m are zero 171 | * or if floor(log2(n)) == floor(log2(m)) 172 | * 173 | * @param n a bitlist number 174 | * @param m a bitlist number 175 | */ 176 | def eq_len_o(n: Any, m: Any): Goal = { 177 | if_e(mkEqual(Nil, n), mkEqual(Nil, m), 178 | eq_len_o_aux(n, m)) 179 | } 180 | 181 | private def eq_len_o_aux(n: Any, m: Any): Goal = { 182 | if_e(mkEqual((1,Nil), n), mkEqual((1,Nil), m), 183 | { s: Subst => { 184 | val x = make_var('x) 185 | val y = make_var('y) 186 | val any1 = make_var('any1) 187 | val any2 = make_var('any2) 188 | all(mkEqual((any1,x), n), pos_o(x), 189 | mkEqual((any2,y), m), pos_o(y), 190 | eq_len_o_aux(x,y))(s) 191 | } }) 192 | } 193 | 194 | def lt_len_o(n: Any, m: Any): Goal = { 195 | if_e(mkEqual(Nil,n), pos_o(m), 196 | if_e(mkEqual((1,Nil),n), gt1_o(m), 197 | { s: Subst => { 198 | val a = make_var('a) 199 | val x = make_var('x) 200 | val b = make_var('b) 201 | val y = make_var('y) 202 | 203 | all(mkEqual((a,x),n), pos_o(x), 204 | mkEqual((b,y),m), pos_o(y), 205 | lt_len_o(x,y))(s) 206 | } })) 207 | } 208 | 209 | /** 210 | * Holds if n < m 211 | * 212 | * @param n a bitlist number 213 | * @param m a bitlist number 214 | */ 215 | def lt_o(n: Any, m: Any): Goal = { 216 | cond_i((lt_len_o(n,m), succeed), 217 | (eq_len_o(n,m), 218 | { s: Subst => { 219 | val x = make_var('x) 220 | both(pos_o(x), add_o(n, x, m))(s) 221 | } })) 222 | } 223 | 224 | /* Math operations */ 225 | def gen_adder_o(d:Any, n: Any, m: Any, r: Any): Goal = { 226 | val a = make_var('a) 227 | val b = make_var('b) 228 | val c = make_var('c) 229 | val e = make_var('e) 230 | val x = make_var('x) 231 | val y = make_var('y) 232 | val z = make_var('z) 233 | 234 | all(mkEqual((a,x),n), 235 | mkEqual((b,y),m), pos_o(y), 236 | mkEqual((c,z),r), pos_o(z), 237 | all_i(full_adder_o(d,a,b,c,e), 238 | adder_o(e,x,y,z))) 239 | } 240 | 241 | def adder_o(d: Any, n: Any, m: Any, r: Any): Goal = { 242 | if_i(both(mkEqual(0,d), mkEqual(Nil,m)), mkEqual(n,r), 243 | if_i(all(mkEqual(0,d), mkEqual(Nil,n), mkEqual(m,r)), pos_o(m), 244 | if_i(both(mkEqual(1,d), mkEqual(Nil,m)), adder_o(0, n, (1,Nil), r), 245 | if_i(all(mkEqual(1,d), mkEqual(Nil,n), pos_o(m)), adder_o(0, (1,Nil), m, r), 246 | if_i(both(mkEqual((1,Nil),n), mkEqual((1,Nil),m)), 247 | { s: Subst => { 248 | val a = make_var('a) 249 | val c = make_var('c) 250 | both(mkEqual((a,(c,Nil)), r), 251 | full_adder_o(d,1,1,a,c))(s) 252 | } }, 253 | if_i(mkEqual((1,Nil),n), gen_adder_o(d,n,m,r), 254 | if_i(all(mkEqual((1,Nil),m), gt1_o(n), gt1_o(r)), 255 | adder_o(d, (1,Nil), n, r), 256 | if_i(gt1_o(n), gen_adder_o(d,n,m,r), 257 | fail)))))))) 258 | } 259 | 260 | /** 261 | * (n + m) === k 262 | * 263 | * @param n a Kanren number 264 | * @param m a Kanren number 265 | * @param k a Kanren number 266 | */ 267 | def add_o(n: Any, m: Any, k: Any): Goal = adder_o(0, n, m, k) 268 | 269 | /** 270 | * (n - m) === k 271 | * 272 | * @param n a Kanren number 273 | * @param m a Kanren number 274 | * @param k a Kanren number 275 | */ 276 | def sub_o(n: Any, m: Any, k: Any): Goal = adder_o(0, m, k, n) 277 | 278 | /* Multiplication */ 279 | 280 | /** 281 | * The multiplication relation 282 | * 283 | * @param n a bitlist number 284 | * @param m a bitlist number 285 | * @param p the product bitlist 286 | */ 287 | def mul_o(n: Any, m: Any, p: Any): Goal = { 288 | if_i(mkEqual(Nil,n), mkEqual(Nil, p), 289 | if_i(both(pos_o(n), mkEqual(Nil,m)), mkEqual(Nil,p), 290 | if_i(both(mkEqual((1,Nil),n), pos_o(m)), mkEqual(m,p), 291 | if_i(both(gt1_o(n), mkEqual((1,Nil),m)), mkEqual(n,p), 292 | if_i({ s: Subst => { 293 | val x = make_var('x) 294 | val z = make_var('z) 295 | all(mkEqual((0,x),n), pos_o(x), 296 | mkEqual((0,z),p), pos_o(z), 297 | gt1_o(m), 298 | mul_o(x,m,z))(s) }}, succeed, 299 | if_i({ s: Subst => { 300 | val x = make_var('x) 301 | val y = make_var('y) 302 | all(mkEqual((1,x),n), pos_o(x), 303 | mkEqual((0,y),m), pos_o(y), 304 | mul_o(m,n,p))(s) }}, succeed, 305 | if_i({ s: Subst => { 306 | val x = make_var('x) 307 | val y = make_var('y) 308 | all(mkEqual((1,x),n), pos_o(x), 309 | mkEqual((1,y),m), pos_o(y), 310 | odd_mul_o(x,n,m,p))(s) }}, succeed, 311 | fail))))))) 312 | } 313 | 314 | def odd_mul_o(x: Any, n: Any, m: Any, p: Any) = { 315 | val q = make_var('q) 316 | all(bound_mul_o(q,p,n,m), 317 | mul_o(x,m,q), 318 | add_o((0,q), m, p)) 319 | } 320 | 321 | def bound_mul_o(q: Any, p: Any, n: Any, m: Any): Goal = { 322 | if_e(null_o(q), pair_o(p), 323 | { s: Subst => { 324 | val x = make_var('x) 325 | val y = make_var('y) 326 | val z = make_var('z) 327 | all(cdr_o(q,x), 328 | cdr_o(p,y), 329 | if_i(both(null_o(n), cdr_o(m, z)), 330 | bound_mul_o(x,y,z,Nil), 331 | both(cdr_o(n,z), bound_mul_o(x,y,z,m))))(s) } } ) 332 | } 333 | 334 | } 335 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/MiniKanren.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren 33 | 34 | object MiniKanren { 35 | 36 | /* Type definitions */ 37 | import java.util.HashMap 38 | 39 | /** 40 | * A constraint is a list of pairs, each pair consisting of a logical variable and a list of 41 | * variables/values it is not allowed to unify with 42 | */ 43 | type Constraints = List[(Var, List[Any])] 44 | 45 | /** 46 | * This abstract class specifies the basic operations any substitution must satisfy. 47 | */ 48 | abstract class Subst { 49 | /** 50 | * Extend a substitution with a new mapping from v -> x. Might fail in some substitution implementations. 51 | */ 52 | def extend(v: Var, x: Any): Option[Subst] 53 | /** 54 | * Add a constraint for the specified variable 55 | */ 56 | def c_extend(v: Var, x: Any): Subst = this 57 | /** 58 | * Given a variable, look up its constraints 59 | */ 60 | def constraints(v: Var): List[Any] = Nil 61 | /** 62 | * Given a variable, look up its bound value 63 | */ 64 | def lookup(v: Var): Option[Any] 65 | /** 66 | * The length of a substitution, i.e. the number of var -> value mappings it contains 67 | */ 68 | def length: Int 69 | 70 | /** 71 | * Unifies two terms 72 | * This default implementation always succeeds; substitution classes with constraints 73 | * must override this, but may call this implementation once the unification is verified to be safe 74 | * 75 | * @param term1 Any value 76 | * @param term2 Any value 77 | * @return Some substitution 78 | */ 79 | def unify(term1: Any, term2: Any): Option[Subst] = { 80 | val t1 = walk(term1, this) 81 | val t2 = walk(term2, this) 82 | 83 | if (t1 == t2) return Some(this) 84 | else if (t1.isInstanceOf[Var]) 85 | return this.extend(t1.asInstanceOf[Var], t2) 86 | else if (t2.isInstanceOf[Var]) 87 | return this.extend(t2.asInstanceOf[Var], t1) 88 | else if (pairp(t1) && pairp(t2)) { 89 | val ls1 = t1.asInstanceOf[(Any,Any)] 90 | val ls2 = t2.asInstanceOf[(Any,Any)] 91 | 92 | this.unify(ls1._1, ls2._1) match { 93 | case None => return None 94 | case Some(s2: Subst) => 95 | return s2.unify(ls1._2, ls2._2) 96 | } 97 | } 98 | else if (t1 == t2) return Some(this) 99 | else return None 100 | } 101 | } 102 | 103 | import info.hircus.kanren.Substitution._ 104 | 105 | /** 106 | * A goal is a function that, given a substitution, produces a stream of substitution. 107 | * This stream is empty if the goal fails; otherwise, it may contain any number of 108 | * substitutions 109 | */ 110 | type Goal = (Subst) => Stream[Subst] 111 | val empty_s = EmptySubst 112 | val empty_cs = ConstraintSubst0(Nil) 113 | 114 | /** 115 | * A logic variable 116 | * It consists of two parts: a user-supplied name, and a count that is automatically incremented. 117 | * The count makes sure that each created variable is unique. 118 | */ 119 | case class Var(name: Symbol, count: Int) 120 | private val m = new HashMap[Symbol, Int]() 121 | /** 122 | * Creates a logic variable, with the requested name, and a count that is automatically incremented 123 | * 124 | * @param name The name of the variable 125 | * @return a logic variable 126 | */ 127 | def make_var(name: Symbol) = { 128 | val count = m.get(name) 129 | m.put(name, count+1) 130 | Var(name, count) 131 | } 132 | 133 | /* Monads */ 134 | 135 | /** 136 | * A goal that always succeeds, returning a stream containing only its input substitution 137 | */ 138 | def succeed: Goal = { s: Subst => 139 | Stream.cons(s, Stream.empty) 140 | } 141 | /** 142 | * A goal that always fails, returning an empty stream of substitution 143 | */ 144 | def fail: Goal = { s: Subst => Stream.empty } 145 | 146 | 147 | def pairp(x: Any): Boolean = 148 | x.isInstanceOf[(Any,Any)] 149 | 150 | /* 151 | * (define walk 152 | * (lambda (v s) 153 | * (cond 154 | * ((var? v) 155 | * (cond 156 | * ((assq v s) => 157 | * (lambda (a) 158 | * (let ((v^ (rhs a))) 159 | * (walk v^ s)))) 160 | * (else v))) 161 | * (else v)))) 162 | * 163 | * 164 | */ 165 | 166 | def walk(v: Any, s: Subst): Any = 167 | if (v.isInstanceOf[Var]) s.lookup(v.asInstanceOf[Var]) match { 168 | case Some(x) => walk(x, s) 169 | case None => v 170 | } else v 171 | 172 | /* 173 | * (define walk* 174 | * (lambda (v s) 175 | * (let ((v (walk v s))) 176 | * (cond 177 | * ((var? v) v) 178 | * ((pair? v) 179 | * (cons 180 | * (walk* (car v) s) 181 | * (walk* (cdr v) s))) 182 | * (else v))))) 183 | */ 184 | def walk_*(v: Any, s: Subst): Any = { 185 | val v1 = walk(v, s) 186 | if (v1.isInstanceOf[Var]) v1 187 | else if (pairp(v1)) { 188 | val ls = v1.asInstanceOf[(Any,Any)] 189 | (walk_*(ls._1, s), walk_*(ls._2, s)) 190 | } else v1 191 | } 192 | 193 | /* (define reify-s 194 | * (lambda (v s) 195 | * (let ((v (walk v s))) 196 | * (cond 197 | * ((var? v) (ext-s v (reify-name (size-s s)) s)) 198 | * ((pair? v) (reify-s (cdr v) (reify-s (car v) s))) 199 | * (else s))))) 200 | * 201 | * (define reify-name 202 | * (lambda (n) 203 | * (string->symbol 204 | * (string-append "_" "." (number->string n))))) 205 | */ 206 | 207 | def reify_name(n: Int) = 208 | Symbol("_." + n) 209 | 210 | def reify_s(v: Any, s: Subst): Subst= { 211 | val v1 = walk(v, s) 212 | if (v1.isInstanceOf[Var]) 213 | s.extend(v1.asInstanceOf[Var], reify_name(s.length)) match { 214 | case Some(s1) => s1 215 | /* never happens as reification does not use any constraints 216 | * but the compiler does not know that 217 | */ 218 | case _ => s 219 | } 220 | else if (pairp(v1)) { 221 | val ls = v1.asInstanceOf[(Any,Any)] 222 | reify_s(ls._2, reify_s(ls._1, s)) 223 | } else s 224 | } 225 | 226 | /* (define reify 227 | * (lambda (v) 228 | * (walk* v (reify-s v empty-s)))) 229 | */ 230 | def reify(v: Any) = walk_*(v, reify_s(v, empty_s)) 231 | 232 | /* Logic system */ 233 | 234 | /* (define bind 235 | * (lambda (a-inf g) 236 | * (case-inf a-inf 237 | * (mzero) 238 | * ((a) (g a)) 239 | * ((a f) (mplus (g a) 240 | * (lambdaf@ () (bind (f) g))))))) 241 | */ 242 | def bind(a_inf: Stream[Subst], g: Goal): Stream[Subst] = 243 | a_inf flatMap g 244 | 245 | def bind_i(a_inf: Stream[Subst], g: Goal): Stream[Subst] = 246 | a_inf match { 247 | case Stream.empty => a_inf 248 | case Stream.cons(a, f) => f match { 249 | case Stream.empty => g(a) 250 | case _ => mplus_i(g(a), bind(f, g)) 251 | } 252 | } 253 | 254 | /* (define mplus 255 | * (lambda (a-inf f) 256 | * (case-inf a-inf 257 | * (f) 258 | * ((a) (choice a f)) 259 | * ((a f0) (choice a 260 | * (lambdaf@ () (mplus (f0) f))))))) 261 | */ 262 | def mplus(a_inf: Stream[Subst], 263 | f: => Stream[Subst]): Stream[Subst] = 264 | a_inf append f 265 | 266 | /** 267 | * Like mplus, but interleaves the two input streams 268 | * Allows a goal to proceed even if the first subgoal is bottom 269 | * 270 | * @param a_inf a stream of substitutions 271 | * @param f a second stream of substitutions to append 272 | * @return an interleaved stream of substitutions 273 | */ 274 | def mplus_i(a_inf: Stream[Subst], 275 | f: => Stream[Subst]): Stream[Subst] = a_inf match { 276 | case Stream.empty => f 277 | case Stream.cons(a, f0) => f0 match { 278 | case Stream.empty => Stream.cons(a, f) 279 | case _ => Stream.cons(a, mplus_i(f, f0)) 280 | } 281 | 282 | } 283 | 284 | 285 | /* (define-syntax anye 286 | * (syntax-rules () 287 | * ((_ g1 g2) 288 | * (lambdag@ (s) 289 | * (mplus (g1 s) 290 | * (lambdaf@ () (g2 s))))))) 291 | */ 292 | def any_e(g1: Goal, g2: Goal): Goal = { s: Subst => 293 | mplus(g1(s), g2(s)) } 294 | 295 | /* (define-syntax all 296 | * (syntax-rules () 297 | * ((_) succeed) 298 | * ((_ g) (lambdag@ (s) (g s))) 299 | * ((_ g^ g ...) (lambdag@ (s) (bind (g^ s) (all g ...)))))) 300 | */ 301 | def all_aux(bindfn: (Stream[Subst], Goal) => Stream[Subst])(gs: Goal*): Goal = { 302 | gs.toList match { 303 | case Nil => succeed 304 | case g :: Nil => g 305 | case g :: gs2 => 306 | { s: Subst => bindfn(g(s), all(gs2: _*)) } 307 | } 308 | } 309 | 310 | def all = all_aux(bind) _ 311 | def all_i = all_aux(bind_i) _ 312 | 313 | 314 | /** 315 | * Faster than all, if only two goals are used 316 | */ 317 | def both(g0: Goal, g1: Goal): Goal = { s: Subst => 318 | g0(s) flatMap g1 } 319 | 320 | /* (define-syntax ife 321 | * (syntax-rules () 322 | * ((_ g0 g1 g2) 323 | * (lambdag@ (s) 324 | * (mplus ((all g0 g1) s) 325 | * (lambdaf@ () (g2 s))))))) 326 | */ 327 | 328 | /** 329 | * if_e produces a goal that, given a substitution, produces a stream of substitutions 330 | * starting with the result of running a combination of the first two goals on the substitution, 331 | * followed by running the alternate goal. 332 | * 333 | * @param testg The first, 'test' goal. Guards the consequent 334 | * @param conseqg The 'consequent' goal 335 | * @param altg The alternate goal. Call-by-name as otherwise, in a situation with many nested if_e 336 | * (e.g. using any_o), the stack overflows. 337 | */ 338 | def if_e(testg: Goal, conseqg: =>Goal, altg: =>Goal): Goal = { 339 | s: Subst => 340 | mplus(both(testg, conseqg)(s), 341 | altg(s)) 342 | } 343 | 344 | def if_i(testg: Goal, conseqg: =>Goal, altg: =>Goal): Goal = { 345 | s: Subst => 346 | mplus_i(both(testg, conseqg)(s), 347 | altg(s)) 348 | } 349 | 350 | def if_a(testg: Goal, conseqg: =>Goal, altg: =>Goal): Goal = { 351 | s: Subst => { 352 | val s_inf = testg(s) 353 | s_inf match { 354 | case Stream.empty => altg(s) 355 | case Stream.cons(s_1, s_inf_1) => s_inf_1 match { 356 | case Stream.empty => conseqg(s_1) 357 | case _ => bind(s_inf, conseqg) } } 358 | } } 359 | 360 | def if_u(testg: Goal, conseqg: =>Goal, altg: =>Goal): Goal = { 361 | s: Subst => { 362 | testg(s) match { 363 | case Stream.empty => altg(s) 364 | case Stream.cons(s_1, s_inf) => conseqg(s_1) } 365 | } } 366 | 367 | def cond_aux(ifer: (Goal, =>Goal, =>Goal) => Goal)(gs: (Goal,Goal)*): Goal = 368 | { gs.toList match { 369 | case Nil => fail 370 | case (g0, g1) :: gs2 => gs2 match { 371 | case Nil => both(g0, g1) 372 | case _ => ifer(g0, g1, 373 | cond_aux(ifer)(gs2: _*)) 374 | } } } 375 | 376 | def cond_e = cond_aux(if_e _) _ 377 | def cond_i = cond_aux(if_i _) _ 378 | def cond_a = cond_aux(if_a _) _ 379 | def cond_u = cond_aux(if_u _) _ 380 | 381 | class Unifiable(a: Any) { 382 | def ===(b: Any): Goal = mkEqual(a, b) 383 | def =/=(b: Any): Goal = neverEqual(a, b) 384 | } 385 | 386 | implicit def unifiable(a: Any) = new Unifiable(a) 387 | 388 | def mkEqual(t1: Any, t2: Any): Goal = { s: Subst => { 389 | s.unify(t1, t2) match { 390 | case Some(s2) => succeed(s2) 391 | case None => fail(s) // does not matter which substitution 392 | } 393 | } } 394 | 395 | def neverEqual(t1: Any, t2: Any): Goal = { s: Subst => { 396 | val v1 = walk(t1, s) 397 | val v2 = walk(t2, s) 398 | 399 | if (v1 == v2) fail(s) 400 | else { 401 | val s1 = if (v1.isInstanceOf[Var]) s.c_extend(v1.asInstanceOf[Var], v2) else s 402 | val s2 = if (v2.isInstanceOf[Var]) s1.c_extend(v2.asInstanceOf[Var], v1) else s1 403 | 404 | succeed(s2) 405 | } 406 | } } 407 | 408 | /* (define-syntax run 409 | * (syntax-rules () 410 | * ((_ n^ (x) g ...) 411 | * (let ((n n^) (x (var 'x))) 412 | * (if (or (not n) (> n 0)) 413 | * (map-inf n 414 | * (lambda (s) (reify (walk* x s))) 415 | * ((all g ...) empty-s)) 416 | * '()))))) 417 | */ 418 | 419 | /** 420 | * Runs the given goals and produce up to n results for the specified variable 421 | * 422 | * @param n max number of results. A negative number specifies that all available results should be returned 423 | * @param v the variable to be inspected 424 | * @param g0 a goal; multiple goals might be specified 425 | */ 426 | def run(n: Int, v: Var) = run_aux(n, v, empty_s) _ 427 | def crun(n: Int, v: Var) = run_aux(n, v, empty_cs) _ 428 | def maprun(n: Int, v: Var) = run_aux(n, v, empty_msubst) _ 429 | def cljrun(n: Int, v: Var) = run_aux(n, v, empty_cljsubst) _ 430 | 431 | private def run_aux(n: Int, v: Var, subst: Subst)(g0: Goal, gs: Goal*): List[Any] = { 432 | val g = gs.toList match { 433 | case Nil => g0 434 | case gls => all((g0::gls): _*) 435 | } 436 | val allres = g(subst) map {s: Subst => reify(walk_*(v, s)) } 437 | (if (n < 0) allres else (allres take n)) toList 438 | } 439 | } 440 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/Prelude.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren 33 | 34 | /*** 35 | * The standard library for Mini Kanren.
36 | * Currently contains all but mathematical operators, which are in 37 | * MKMath 38 | */ 39 | object Prelude { 40 | import info.hircus.kanren.MiniKanren._ 41 | 42 | /* Control operators */ 43 | def once(g: Goal): Goal = { 44 | if_u(g, succeed, 45 | fail) 46 | } 47 | 48 | /* Lists */ 49 | 50 | /** 51 | * Utility function to convert a Scala linked list to a 52 | * pair that is more digestible 53 | * 54 | * @param l a Scala list 55 | * @return a list made of nested pairs 56 | */ 57 | def list2pair(l: List[Any]): Any = l match { 58 | case Nil => Nil 59 | case h :: tl => (h, list2pair(tl)) 60 | } 61 | 62 | /** 63 | * Utility function to convert back from nested pairs to a Scala list 64 | * 65 | * @param p a list made of nested pairs, Nil-terminated 66 | * @return a Scala list 67 | * @todo might have to return an exception for improper lists 68 | */ 69 | def pair2list(p: Any): List[Any] = p match { 70 | case Nil => Nil 71 | case (h, tl) => h :: pair2list(tl) 72 | } 73 | 74 | 75 | /** 76 | * A relation unifying the head of the pair 'p' with 'a' 77 | * 78 | * @param p something pair-able 79 | * @param a anything 80 | */ 81 | def car_o(p: Any, a: Any): Goal = { 82 | val d = make_var('d) 83 | mkEqual( (a, d), p ) 84 | } 85 | 86 | /** 87 | * A relation unifying the tail of the pair 'p' with 'd' 88 | * 89 | * @param p something pair-able 90 | * @param d anything 91 | */ 92 | def cdr_o(p: Any, d: Any): Goal = { 93 | val a = make_var('a) 94 | mkEqual( (a, d), p ) 95 | } 96 | 97 | /** 98 | * A relation unifying p with a fresh pair of variables 99 | * 100 | * @param p something pair-able 101 | */ 102 | def pair_o(p: Any): Goal = { 103 | val a = make_var('a) 104 | val d = make_var('d) 105 | mkEqual( (a, d), p ) 106 | } 107 | 108 | /** 109 | * A relation that unifies 'x' with the empty list 110 | * 111 | * @param x something null-able 112 | */ 113 | def null_o(x: Any): Goal = { 114 | mkEqual( Nil, x ) 115 | } 116 | 117 | /** 118 | * A relation that unifies l with a Kanren list.
119 | * If l is fresh, this is actually a list generator 120 | * 121 | * @param l something list-able 122 | */ 123 | def list_o (l: Any): Goal = 124 | if_e(null_o(l), succeed, 125 | if_e(pair_o(l), { s: Subst => 126 | val d = make_var('d) 127 | all(cdr_o(l, d), 128 | list_o(d))(s) }, 129 | fail)) 130 | 131 | 132 | /** 133 | * A relation that holds if l3 is unifiable with the append of l1 and l2 134 | * 135 | * @param l1 a Kanren list 136 | * @param l2 a Kanren list 137 | * @param l3 a Kanren list 138 | */ 139 | def append_o(l1: Any, l2: Any, l3: Any): Goal = 140 | if_i(null_o(l1), l2 === l3, 141 | { s: Subst => { 142 | val x = make_var('x) 143 | val l11 = make_var('l11) 144 | val l31 = make_var('l31) 145 | 146 | all(l1 === (x, l11), 147 | l3 === (x, l31), 148 | append_o(l11, l2, l31))(s) } }) 149 | 150 | /** 151 | * A relation that unifies 'x' with an element from 'l'.
152 | * If x is fresh, collecting all results yield all the elements of l
153 | * If 'l' is fresh, generates all possible lists containing 'x'
154 | * Otherwise, the only possible result is if 'x' matches an element in 'l' 155 | * 156 | * @param x any 157 | * @param l something list-able 158 | */ 159 | def member_o(x: Any, l: Any): Goal = 160 | if_e(null_o(l), fail, 161 | if_e(car_o(l, x), succeed, 162 | {s: Subst => 163 | val d = make_var('d) 164 | all(cdr_o(l, d), 165 | member_o(x, d))(s) 166 | } )) 167 | 168 | /** 169 | * see page 77 of Reasoned Schemer 170 | * 171 | * @param g a Goal 172 | * @return a goal that succeeds if 'g' succeeds, and otherwise has 173 | * no value (bottom) 174 | */ 175 | def any_o(g: Goal): Goal = if_e(g, succeed, any_o(g)) 176 | 177 | /** 178 | * Bottom: this is a goal that never terminates if evaluated
179 | * see page 77 of Reasoned Schemer 180 | */ 181 | def never_o: Goal = any_o(fail) 182 | 183 | /** 184 | * Always: a goal that can succeed an infinite number of times
185 | * see page 77-78 of Reasoned Schemer 186 | */ 187 | def always_o: Goal = any_o(succeed) 188 | 189 | } 190 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/Subst.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren 33 | 34 | import info.hircus.kanren.MiniKanren._ 35 | 36 | object Substitution { 37 | 38 | /** 39 | * An empty simple substitution 40 | */ 41 | object EmptySubst extends Subst { 42 | /** 43 | * Extending an empty substitution always succeeds, producing a simple substitution 44 | * with one binding, v -> x 45 | * 46 | * @param v a logical variable 47 | * @param x a value to bind x to 48 | */ 49 | def extend(v: Var, x: Any) = Some(SimpleSubst(v,x,this)) 50 | /** 51 | * Looking up in an empty substitution always fails 52 | * 53 | * @param v a logical variable 54 | */ 55 | def lookup(v: Var) = None 56 | /** 57 | * The length of an empty substitution is zero 58 | */ 59 | def length: Int = 0 60 | } 61 | 62 | /** 63 | * A non-empty simple substitution 64 | */ 65 | case class SimpleSubst(v: Var, x: Any, s: Subst) extends Subst { 66 | /** 67 | * Extending a simple substitution always succeeds, producing a new substitution 68 | * linked with the current one 69 | * 70 | * @param v a logical variable 71 | * @param x a value to bind to x 72 | */ 73 | def extend(v: Var, x: Any) = Some(SimpleSubst(v,x,this)) 74 | /** 75 | * Looking up a variable succeeds immediately if it is at the head of the substitution. 76 | * Otherwise, the linked substitution is queried. 77 | * 78 | * @param v a logical variable 79 | */ 80 | def lookup(v: Var) = if (this.v == v) Some(x) else s.lookup(v) 81 | 82 | /** 83 | * The length of a non-empty substitution is one more than its linked substitution 84 | */ 85 | def length: Int = 1 + s.length 86 | } 87 | 88 | abstract class ConstraintSubst extends Subst { 89 | /** 90 | * In a constrained substitution, two walked terms are only unifiable if neither are listed in 91 | * the other's constraints 92 | */ 93 | override def unify(term1: Any, term2: Any): Option[Subst] = { 94 | val v1 = walk(term1, this) 95 | val v2 = walk(term2, this) 96 | 97 | if (v1.isInstanceOf[Var] && (this.constraints(v1.asInstanceOf[Var]) contains v2)) None 98 | else if (v2.isInstanceOf[Var] && (this.constraints(v2.asInstanceOf[Var]) contains v1)) None 99 | else super.unify(v1, v2) 100 | } 101 | } 102 | 103 | private def c_lookup(v: Var, c: Constraints): List[Any] = c match { 104 | case Nil => Nil 105 | case (w, cls) :: c2 => if (v==w) cls else c_lookup(v, c2) 106 | } 107 | 108 | private def c_insert(v: Var, x: Any, c: Constraints): Constraints = c match { 109 | case Nil => List((v, List(x))) 110 | case (w, cls) :: c2 => if (v==w) ((w, if (cls contains x) cls 111 | else x::cls) :: c2) 112 | else (w,cls) :: c_insert(v,x,c2) 113 | } 114 | 115 | 116 | case class ConstraintSubst0(c: Constraints) extends Subst { 117 | /** 118 | * extending a constraint substitution creates a new constraint substitution 119 | * with the extension done in the simple substitution part 120 | */ 121 | def extend(v: Var, x: Any) = 122 | if (this.constraints(v) contains x) None 123 | else Some(ConstraintSubstN(SimpleSubst(v,x,this), c)) 124 | 125 | override def c_extend(v: Var, x: Any) = ConstraintSubst0(c_insert(v,x,c)) 126 | 127 | /** 128 | * Looking up a variable in an empty constraint substitution always returns None 129 | * 130 | * @param v a logical variable 131 | * @return None 132 | */ 133 | def lookup(v: Var) = None 134 | override def constraints(v: Var) = c_lookup(v, c) 135 | /** 136 | * The length of an empty constraint substitution is zero 137 | */ 138 | def length: Int = 0 139 | } 140 | 141 | case class ConstraintSubstN(s: SimpleSubst, c: Constraints) extends Subst { 142 | /** 143 | * Constraint checking is performed here, since it is not needed with 144 | * simple substitutions. Doing it in unify would be less efficient 145 | */ 146 | def extend(v: Var, x: Any) = 147 | if (this.constraints(v) contains x) None 148 | else Some(ConstraintSubstN(SimpleSubst(v,x,s), c)) 149 | 150 | override def c_extend(v: Var, x: Any) = ConstraintSubstN(s, c_insert(v,x,c)) 151 | 152 | /** 153 | * Looking up a variable in a constraint substitution looks it up in the 154 | * simple substitution 155 | * 156 | * @param v a logical variable 157 | */ 158 | def lookup(v: Var) = s.lookup(v) 159 | override def constraints(v: Var) = c_lookup(v, c) 160 | /** 161 | * The length of a constraing substitution is the length of its simple substitution 162 | */ 163 | def length: Int = s.length 164 | } 165 | 166 | /** 167 | *

Uses an immutable map to store the substitution.
168 | * If the computation is lookup-heavy, this should be faster.

169 | * 170 | *

Not used by default as memory consumption is heavy -- palprod_o 171 | * causes heap OOM exception.

172 | */ 173 | case class MSubst(m: Map[Var, Any]) extends Subst { 174 | def extend(v: Var, x: Any) = Some(MSubst(m(v) = x)) 175 | def lookup(v: Var) = m.get(v) 176 | def length = m.size 177 | } 178 | 179 | val empty_msubst = MSubst(Map()) 180 | 181 | import clojure.lang.IPersistentMap 182 | import clojure.lang.PersistentHashMap 183 | 184 | /** 185 | * A substitution based on Clojure's PersistentHashMap 186 | * (earlier based on Odersky's colleague's work at EPFL!) 187 | * 188 | * Requires a modified Clojure, because right now the 189 | * MapEntry interface exposes a val() getter which clashes 190 | * with the Scala keyword 191 | */ 192 | case class CljSubst(m: IPersistentMap) extends Subst { 193 | def extend(v: Var, x: Any) = Some(CljSubst(m.assoc(v, x))) 194 | def lookup(v: Var) = { 195 | val res = m.entryAt(v) 196 | if (res != null) Some(res.`val`) 197 | else None 198 | } 199 | def length = m.count 200 | } 201 | 202 | val empty_cljsubst = CljSubst(PersistentHashMap.EMPTY) 203 | } 204 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/examples/PalProd.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren.examples 33 | 34 | /** 35 | *

Finds palindromic six-digit numbers that are the product of two 36 | * three-digit numbers.

37 | * 38 | *

This is a good stress test for the arithmetic implementation: 39 | * time(run(1,x)(palprod_o(x))) takes > 40s on a Core 2 Duo 2 GHz

40 | */ 41 | object PalProd { 42 | import info.hircus.kanren.MiniKanren._ 43 | import info.hircus.kanren.Prelude._ 44 | import info.hircus.kanren.MKMath._ 45 | 46 | private def add_len_o(a: Any, b: Any, c: Any): Goal = { 47 | val a1 = make_var('a1) 48 | val ar = make_var('ar) 49 | val c1 = make_var('c1) 50 | val cr = make_var('cr) 51 | 52 | if_e(mkEqual(a, Nil), eq_len_o(b, c), 53 | if_e(both(mkEqual(a, (a1,ar)), mkEqual(c, (c1,cr))), 54 | add_len_o(ar,b,cr), 55 | fail)) 56 | } 57 | 58 | /** 59 | * Palindrome products: 60 | * 61 | * Find all six-digit palindromic numbers that are the product of 62 | * two three-digit numbers. The answers are printed to the console. 63 | * 64 | * @param q a fresh logic variable. Ignore the result 65 | */ 66 | def palprod_o(q: Any): Goal = { 67 | val a = make_var('a) 68 | val a9091 = make_var('a9091) 69 | val b = make_var('b) 70 | val b910 = make_var('b910) 71 | val c = make_var('c) 72 | val c100 = make_var('c100) 73 | val t1 = make_var('t1) 74 | val sum = make_var('sum) 75 | val k = make_var('k) 76 | 77 | all(digit_o(a), 78 | pos_o(a), 79 | mul_o(a, build_num(9091), a9091), 80 | digit_o(b), 81 | mul_o(b, build_num(910), b910), 82 | add_o(a9091, b910, t1), 83 | digit_o(c), 84 | mul_o(c, build_num(100), c100), 85 | add_o(t1, c100, sum), 86 | { s: Subst => { 87 | val the_sum = walk_*(sum, s) 88 | if (!the_sum.isInstanceOf[Var]) println(11*read_num(the_sum)) 89 | succeed(s) 90 | }}, 91 | if_e(eq_len_o(k, build_num(8)), lt_o(build_num(9), k), 92 | if_e(eq_len_o(k, build_num(16)), succeed, 93 | if_e(eq_len_o(k, build_num(32)), succeed, 94 | if_e(eq_len_o(k, build_num(64)), lt_o(k, build_num(91)), 95 | fail)))), 96 | once({ s: Subst => { 97 | val the_sum = walk_*(sum, s) 98 | val xyz = make_var('xyz) 99 | all(lt_len_o(xyz, build_num(1024)), 100 | lt_len_o(build_num(32), xyz), 101 | if_e(add_len_o(k, xyz, sum), succeed, 102 | add_len_o(k, xyz, (0,sum))), 103 | mul_o(k, xyz, sum), 104 | lt_o(xyz, build_num(1000)), 105 | lt_o(build_num(99), xyz))(s) }}), 106 | mkEqual(q, sum)) 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/examples/SendMoreMoney.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren.examples 33 | 34 | /** 35 | * The send-more-money puzzle
36 | * from upstream's send-more-money.scm
37 | * 38 | *
 39 |  *   S E N D
 40 |  *   M O R E
 41 |  * ---------
 42 |  * M O N E Y
 43 |  *
44 | */ 45 | object SendMoreMoney { 46 | import info.hircus.kanren.MiniKanren._ 47 | import info.hircus.kanren.Prelude._ 48 | import info.hircus.kanren.MKMath._ 49 | 50 | private def common_prefix_o(l: Any, l1: Any, l2: Any): Goal = { 51 | if_i(null_o(l), succeed, 52 | { s: Subst => { 53 | val x = make_var('x) 54 | val ls = make_var('ls) 55 | val l1s = make_var('l1s) 56 | val l2s = make_var('l2s) 57 | 58 | all(l === (x, ls), 59 | l1 === (x, l1s), 60 | l2 === (x, l2s), 61 | common_prefix_o(ls, l1s, l2s))(s) } }) 62 | } 63 | 64 | def reme(x: Any, l: Any, lo: Any): Goal = { 65 | val l1 = make_var('l1) 66 | val l2 = make_var('l2) 67 | 68 | all_i(common_prefix_o(l1, l, lo), 69 | append_o(l1, (x,l2), l), 70 | append_o(l1, l2, lo)) 71 | } 72 | 73 | 74 | def solve_puzzle(q: Any): Goal = { 75 | val all_digits = list2pair(((0 to 10) toList) map build_num) 76 | val ten = build_num(10) 77 | 78 | def make_number(digits: Any, n: Any) = { 79 | def loop(digits: Any, acc: Any): Goal = { 80 | if_i(digits === Nil, n === acc, 81 | { s: Subst => { 82 | val d = make_var('d) 83 | val rest = make_var('rest) 84 | val acc1 = make_var('acc1) 85 | val acc2 = make_var('acc2) 86 | 87 | all_i(digits === (d, rest), 88 | mul_o(acc, ten, acc1), 89 | add_o(acc1, d, acc2), 90 | loop(rest, acc2))(s) } } ) 91 | } 92 | loop(digits, Nil) 93 | } 94 | 95 | def choose_digits(digits: Any, 96 | all_digits: Any, 97 | remained_digits: Any): Goal = { 98 | if_i(digits === Nil, all_digits === remained_digits, 99 | { s: Subst => { 100 | val d = make_var('d) 101 | val rest = make_var('rest) 102 | val set1 = make_var('set1) 103 | 104 | all_i(digits === (d, rest), 105 | reme(d, all_digits, set1), 106 | choose_digits(rest, set1, remained_digits))(s) } }) 107 | } 108 | 109 | /** 110 | * d1 + d2 + ci = do + 10*co 111 | * c1 and co can only be either 0 or 1 112 | */ 113 | def add_carry(ci: Any, d1: Any, d2: Any, d_o: Any, co: Any) = { 114 | val d11 = make_var('d11) 115 | val dr = make_var('dr) 116 | 117 | all(if_e(ci === Nil, succeed, 118 | ci === (1,Nil)), 119 | add_o(ci, d1, d11), 120 | add_o(d11, d2, dr), 121 | if_e(dr === d_o, co === Nil, 122 | if_e(add_o(d_o, ten, dr), co === (1,Nil), 123 | fail))) 124 | } 125 | 126 | val s = make_var('s) 127 | val e = make_var('e) 128 | val n = make_var('n) 129 | val d = make_var('d) 130 | val m = make_var('m) 131 | val o = make_var('o) 132 | val r = make_var('r) 133 | val y = make_var('y) 134 | val send = make_var('send) 135 | val more = make_var('more) 136 | val money = make_var('money) 137 | val c1 = make_var('c1) 138 | val c2 = make_var('c2) 139 | val c3 = make_var('c3) 140 | val rd1 = make_var('rd1) 141 | val rd2 = make_var('rd2) 142 | val rd3 = make_var('rd3) 143 | 144 | all_i(choose_digits((m,(s,(o,Nil))), all_digits, rd1), 145 | pos_o(s), 146 | pos_o(m), 147 | add_carry(c3, s,m,o,m), 148 | choose_digits((e,(n,Nil)), rd1, rd2), 149 | add_carry(c2, e,o,n,c3), 150 | choose_digits((r,(d,(y,Nil))), rd2, rd3), 151 | add_carry(Nil, d,e,y,c1), 152 | add_carry(c1, n,r,e,c2), 153 | // verify 154 | make_number((s,(e,(n,(d,Nil)))), send), 155 | make_number((m,(o,(r,(e,Nil)))), more), 156 | make_number((m,(o,(n,(e,(y,Nil))))), money), 157 | add_o(send, more, money), 158 | 159 | { s: Subst => { 160 | val the_send = walk_*(send, s) 161 | val the_more = walk_*(more, s) 162 | val the_money = walk_*(money, s) 163 | 164 | (q === (List(the_send, the_more, the_money) map read_num))(s) } } 165 | ) 166 | } 167 | } 168 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/tests/BranchingSpecification.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren.tests 33 | 34 | import org.scalacheck._ 35 | import info.hircus.kanren.MiniKanren._ 36 | import info.hircus.kanren.Prelude._ 37 | 38 | object BranchingSpecification extends Properties("Branching") { 39 | import Prop.forAll 40 | 41 | val v = make_var('v) 42 | val w = make_var('w) 43 | 44 | property("fail-then-never") = run(1, v)(all(fail, never_o)) == Nil 45 | 46 | property("always-first") = 47 | run(5, v)(all(always_o, true === v)) == ( 48 | (for { x <- 0 until 5 } yield true) toList ) 49 | 50 | property("always-second") = 51 | run(5, v)(all(true === v, always_o)) == ( 52 | (for { x <- 0 until 5 } yield true) toList ) 53 | 54 | 55 | property("cond_i #1") = 56 | run(5, v)(both(if_i(false === v, always_o, 57 | if_i(true === v, always_o, 58 | fail)), 59 | true === v)) == ( (for { x <- 0 until 5 } yield true) toList ) 60 | 61 | property("cond_i #2") = 62 | run(5, v)(both(all_i(if_e(false === v, succeed, 63 | true === v), 64 | always_o), 65 | true === v)) == ( 66 | (for { x <- 0 until 5 } yield true) toList ) 67 | 68 | } 69 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/tests/MathSpecification.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren.tests 33 | 34 | import org.scalacheck._ 35 | import info.hircus.kanren.MiniKanren._ 36 | import info.hircus.kanren.MKMath._ 37 | import info.hircus.kanren.Prelude._ 38 | 39 | object MathSpecification extends Properties("Math") { 40 | import Prop.forAll 41 | 42 | private val MIN_INT=0 43 | private val MAX_INT=1000000000 44 | 45 | private def pairGen(min: Int, max: Int) = for { 46 | n <- Gen.choose(min, max) 47 | m <- Gen.choose(min, max) 48 | } yield (n,m) 49 | 50 | private def tripleGen(min: Int, max: Int) = for { 51 | x <- Gen.choose(min, max) 52 | y <- Gen.choose(min, max) 53 | z <- Gen.choose(min, max) 54 | } yield (x,y,z) 55 | 56 | val b = make_var('b) 57 | val x = make_var('x) 58 | val y = make_var('y) 59 | val r = make_var('r) // remainder 60 | val c = make_var('c) // carry 61 | val s = make_var('s) // sum 62 | 63 | property("bit-xor-o 0") = run(-1, s)(both(bit_xor_o(x,y,0), (x,y) === s)) == List((0,0),(1,1)) 64 | property("bit-xor-o 1") = run(-1, s)(both(bit_xor_o(x,y,1), (x,y) === s)) == List((1,0),(0,1)) 65 | property("bit-and-o 0") = run(-1, s)(both(bit_and_o(x,y,0), (x,y) === s)) == List((0,0),(1,0),(0,1)) 66 | property("bit-and-o 1") = run(-1, s)(both(bit_and_o(x,y,1), (x,y) === s)) == List((1,1)) 67 | 68 | property("digit-o") = { 69 | ((run(-1, x)(digit_o(x))) map read_num _) == ((0 until 10) toList) 70 | } 71 | 72 | private def floor_log2(n: Double) = { 73 | Math.floor(Math.log(n) / Math.log(2)) 74 | } 75 | 76 | property("=lo") = forAll(Gen.choose(1, MAX_INT)) { n => { 77 | val bn = build_num(n) 78 | val m = n << 1 79 | val bm = build_num(m) 80 | (floor_log2(n) == floor_log2(m)) == (run(-1, x)(eq_len_o(bn, bm)) != Nil) 81 | 82 | } } 83 | 84 | property(" p match { 85 | case (n,m) => { 86 | val x = (Math.exp(n) toInt) 87 | val y = (Math.exp(m) toInt) 88 | (floor_log2(x) < floor_log2(y) == 89 | (run(-1, s)(lt_len_o(build_num(x), 90 | build_num(y))) != Nil) ) } 91 | } } 92 | 93 | property(" p match { 94 | case (n,m) => 95 | (n < m) == (run(-1, x)(lt_o(build_num(n), build_num(m))) != Nil) 96 | } } 97 | 98 | property("half-adder-o") = { 99 | ((run(-1, s)(both(half_adder_o(x,y,r,c), 100 | list2pair(List(x,y,r,c)) === s)) map pair2list _ ) 101 | == 102 | List(List(0,0,0,0), 103 | List(1,0,1,0), 104 | List(0,1,1,0), 105 | List(1,1,0,1)) ) } 106 | 107 | property("full-adder-o") = { 108 | ((run(-1, s)(both(full_adder_o(b,x,y,r,c), 109 | list2pair(List(b,x,y,r,c)) === s)) map pair2list _ ) 110 | == 111 | List(List(0,0,0,0,0), 112 | List(1,0,0,1,0), 113 | List(0,1,0,1,0), 114 | List(1,1,0,0,1), 115 | List(0,0,1,1,0), 116 | List(1,0,1,0,1), 117 | List(0,1,1,0,1), 118 | List(1,1,1,1,1)) ) } 119 | 120 | property("gen-adder-o") = 121 | ( (run(-1,s)(gen_adder_o(1, list2pair(List(0,1,1)), 122 | list2pair(List(1,1)), s))) map pair2list _) == List(List(0,1,0,1)) 123 | 124 | property("adder-o") = { 125 | val res = ((run(-1, s)(both(adder_o(0, x, y, list2pair(List(1,0,1))), 126 | (x,(y,Nil)) === s))) map pair2list _ ) 127 | ( (res map { l: List[Any] => l map pair2list _ } ) 128 | == 129 | List(List(List(1,0,1), Nil), 130 | List(Nil, List(1,0,1)), 131 | List(List(1), List(0,0,1)), 132 | List(List(0,0,1), List(1)), 133 | List(List(1,1), List(0,1)), 134 | List(List(0,1), List(1,1))) ) 135 | } 136 | 137 | property("build-read") = forAll(Gen.choose(MIN_INT, MAX_INT)) { n => 138 | read_num(build_num(n)) == n } 139 | 140 | property("add_o") = forAll(pairGen(MIN_INT, MAX_INT)) { p => 141 | run(-1, s)(add_o(build_num(p _1), 142 | build_num(p _2), 143 | s)) == List(build_num(p._1+p._2)) } 144 | 145 | property("sub_o") = forAll(pairGen(MIN_INT, MAX_INT)) { p => 146 | run(-1, s)(sub_o(build_num(p _1), 147 | build_num(p._1+p._2+1), 148 | s)) == Nil } 149 | 150 | property("mul_o prod") = forAll(pairGen(0,100)) { p => p match { 151 | case (x,y) => { 152 | val bx = build_num(x) 153 | val by = build_num(y) 154 | val bz = build_num(x*y) 155 | run(-1, s)(mul_o(bx, by, s)) == List(bz) 156 | } }} 157 | 158 | /* same behavior as Scheme MK */ 159 | property("mul_o zero") = { 160 | val ans = List(Nil, (Symbol("_.0"), Symbol("_.1"))) 161 | run(-1, s)(mul_o(s, Nil, Nil)) == ans && 162 | run(-1,s)(mul_o(Nil,s,Nil)) == List(Symbol("_.0")) 163 | } 164 | 165 | /* next two are very slow; must debug */ 166 | property("mul_o mul0") = forAll(pairGen(1,10)) { p => p match { 167 | case (x,y) => { 168 | val bx = build_num(x) 169 | val by = build_num(y) 170 | val bz = build_num(x*y) 171 | run(-1, s)(mul_o(s, by, bz)) == List(bx) 172 | } }} 173 | 174 | property("mul_o mul1") = forAll(pairGen(1,10)) { p => p match { 175 | case (x,y) => { 176 | val bx = build_num(x) 177 | val by = build_num(y) 178 | val bz = build_num(x*y) 179 | run(-1, s)(mul_o(bx, s, bz)) == List(by) 180 | } }} 181 | 182 | } 183 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/tests/RunSpecification.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren.tests 33 | 34 | import org.scalacheck._ 35 | import info.hircus.kanren.MiniKanren._ 36 | import info.hircus.kanren.Prelude._ 37 | 38 | object RunSpecification extends Properties("Run") { 39 | import Prop.forAll 40 | 41 | val v = make_var('v) 42 | val w = make_var('w) 43 | 44 | property("==") = forAll { n: Int => 45 | run(1, v)(v === n) == List(n) 46 | } 47 | 48 | property("==*") = forAll { n: Int => 49 | run(-1, v)(v === n) == List(n) 50 | } 51 | 52 | property("all0") = run(-1, v)(all()) == List(Symbol("_.0")) 53 | property("all1") = forAll { n: Int => run(-1, v)(all(v === n)) == List(n) } 54 | property("all*") = forAll { (m: Int, n: Int) => 55 | (m==n || 56 | run(-1, v)(all(v === n, w === m)) == List(n)) 57 | } 58 | 59 | property("all-any") = forAll { (m: Int, n: Int) => 60 | m==n || 61 | (run(-1, v)(all(v === n, any_e(v === m, v === n))) 62 | == List(n)) } 63 | 64 | property("ife") = forAll { (m: Int, n: Int) => 65 | run(-1, v)(if_e(v === m, succeed, 66 | v === n)) == List(m, n) } 67 | 68 | property("null") = forAll { n: Int => 69 | val x = make_var('x) 70 | if (n <= 0) true 71 | else run(n, x)(null_o(x)) == List(Nil) 72 | } 73 | 74 | property("car") = forAll { (m: Int, n: Int) => 75 | val x = make_var('x) 76 | run(-1, x)(car_o( (m, n), x )) == List(m) 77 | } 78 | 79 | property("cdr") = forAll { (m: Int, n: Int) => 80 | val x = make_var('x) 81 | run(-1, x)(cdr_o( (m, n), x )) == List(n) 82 | } 83 | 84 | property("listgen") = forAll { n: Int => 85 | val ls = make_var('ls) 86 | if (n <= 0 || n > 100) true 87 | else { 88 | val res = run(n, ls)(list_o(('a, ('b, ('c, ls))))) 89 | res.length == n 90 | } 91 | } 92 | 93 | property("member0") = run(-1, v)(member_o(v, Nil)) == Nil 94 | property("member1") = forAll { n: Int => 95 | run(-1, v)(member_o(v, (n,Nil))) == List(n) } 96 | property("member*") = forAll { (n: Int, ls: List[Int]) => 97 | run(-1, v)(member_o(v, list2pair(n::ls))) == n::ls } 98 | } 99 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/tests/SubstSpecification.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren.tests 33 | 34 | import org.scalacheck._ 35 | import info.hircus.kanren.MiniKanren._ 36 | 37 | object SubstSpecification extends Properties("Substitution") { 38 | import Prop.forAll 39 | 40 | /* Utility function */ 41 | def remove_right_dups[A](s: List[A]): List[A] = { 42 | if (s.isEmpty) s 43 | else s.head :: remove_right_dups(s.tail.remove({_ == s.head})) 44 | } 45 | 46 | property("freshvar") = forAll { (vstr: String) => 47 | val v = make_var(Symbol(vstr)) 48 | walk_*(v,reify_s(v, empty_s)) == Symbol("_.0") 49 | } 50 | 51 | /* for a list containing at least one variable, the reified substitution 52 | * contains as many bindings as there are unique variables 53 | */ 54 | property("freshvarls") = forAll { (n: Int, ls: List[Int]) => 55 | import info.hircus.kanren.Prelude._ 56 | 57 | val vars = (n::ls) map { n: Int => make_var(Symbol(n.toString)) } 58 | val pvars = list2pair(vars).asInstanceOf[(Any,Any)] 59 | 60 | val s = reify_s(pvars, empty_s) 61 | 62 | val unique_vars = remove_right_dups(vars) 63 | 64 | ( (s == reify_s(pvars._2, 65 | reify_s(pvars._1, empty_s))) && 66 | unique_vars.length == s.length && 67 | pair2list(walk_*(list2pair(unique_vars), s)) == 68 | ((0 until s.length) map { reify_name(_) } toList) ) 69 | } 70 | 71 | } 72 | -------------------------------------------------------------------------------- /src/info/hircus/kanren/tests/UnifySpecification.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Michel Alexandre Salim. All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in 12 | * the documentation and/or other materials provided with the 13 | * distribution. 14 | * 3. The names of the authors may not be used to endorse or promote 15 | * products derived from this software without specific, prior 16 | * written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 26 | * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 28 | * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29 | * SUCH DAMAGE. 30 | */ 31 | 32 | package info.hircus.kanren.tests 33 | 34 | import org.scalacheck._ 35 | import info.hircus.kanren.MiniKanren._ 36 | 37 | object UnifySpecification extends Properties("Unification") { 38 | import Prop.forAll 39 | 40 | val v = make_var('v) 41 | val w = make_var('w) 42 | 43 | /* Utility function */ 44 | def remove_right_dups[A](s: List[A]): List[A] = { 45 | if (s.isEmpty) s 46 | else s.head :: remove_right_dups(s.tail.remove({_ == s.head})) 47 | } 48 | 49 | property("bindonce") = forAll { n: Int => 50 | val v = make_var('v) 51 | (for { 52 | s <- empty_s.unify(v, n) 53 | res <- s.lookup(v) 54 | } yield res) match { 55 | case Some(x) => x == n 56 | case None => false 57 | } 58 | } 59 | 60 | property("bindtwice") = forAll { (vstr: String, m: Int, n: Int) => 61 | val v = make_var(Symbol(vstr)) 62 | (for { 63 | s1 <- empty_s.unify(v, m) 64 | s2 <- s1.unify(v, n) 65 | res <- s2.lookup(v) 66 | } yield res) match { 67 | case Some(_) => m==n 68 | case None => true 69 | } 70 | } 71 | 72 | property("pairs") = forAll { (m:Int, n: Int) => 73 | def pairGoal: Goal = 74 | (v, w) === (m, n) 75 | 76 | run(-1, v)(pairGoal) == List(m) && 77 | run(-1, w)(pairGoal) == List(n) } 78 | 79 | property("=/= #1") = forAll { n:Int => 80 | crun(-1, v)(v =/= n, v === n) == Nil } 81 | 82 | property("=/= #2") = forAll { n:Int => 83 | crun(-1, v)(v =/= n, w === n, v === w) == Nil } 84 | 85 | } 86 | 87 | -------------------------------------------------------------------------------- /src/shell.scala: -------------------------------------------------------------------------------- 1 | import info.hircus.kanren.MiniKanren._ 2 | import info.hircus.kanren.Prelude._ 3 | import info.hircus.kanren.MKMath._ 4 | import info.hircus.kanren.examples.PalProd._ 5 | import info.hircus.kanren.examples.SendMoreMoney._ 6 | 7 | var x = make_var('x) 8 | var y = make_var('y) 9 | var z = make_var('z) 10 | 11 | def time(block: => Any) = { 12 | val start = System currentTimeMillis () 13 | val res = block 14 | val stop = System currentTimeMillis () 15 | ((stop-start), res) 16 | } 17 | 18 | def ntimes(n: Int, block: => Any) = { 19 | // folding a list of Longs is cumbersome 20 | def adder(x:Long,y:Long) = x+y 21 | val zero : Long = 0 22 | 23 | // compute only once! 24 | val res = (for (i <- 0 until n) yield (time(block) _1)).toList 25 | println("Elapsed times: " + res) 26 | println("Avg: " + (res.foldLeft(zero)(adder) / n)) 27 | } 28 | --------------------------------------------------------------------------------