├── .gitignore ├── LICENSE ├── README.md ├── clause-and-effect ├── 01-party-pairs.php ├── 02-drinking-pairs.php ├── 03-affordable-journeys.php ├── 04-acyclic-directed-graph.php ├── 06-length-of-a-list.php ├── 07-inner-product.php ├── 08-maximum-of-a-list.php ├── 09-searching-a-cyclic-graph.php ├── 12-partial-maps.php ├── 13-removing-duplicates.php ├── 14-partial-maps-with-a-parameter.php ├── 15-multiple-disjoint-partial-maps.php ├── 18-sequential-maps-with-state.php ├── 22-ordered-search-trees.php ├── 23-frequency-distribution.php ├── 27-linearising.php ├── 28-linearising-efficiently.php └── 99-06-term-rewriting.php ├── composer.json ├── interpreter.php ├── oleg-numbers.php ├── peano.php ├── reasoned.php ├── test.php └── type-inferencer.php /.gitignore: -------------------------------------------------------------------------------- 1 | vendor 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014 Igor Wiedler 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is furnished 8 | to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # reasoned-php 2 | 3 | A [miniKanren](http://minikanren.org/) in PHP. 4 | 5 | ## Prologue 6 | 7 | What the hell is this? It's a tiny logic programming engine! 8 | 9 | What is logic programming, you ask? Logic programming is a largely underrated 10 | paradigm that radically changes the way you write, think about, and run, 11 | programs. 12 | 13 | Imagine your program as a bunch of relations. You can relate things to each 14 | other. Every time you would use an uni-directional assignment `=`, that 15 | assignment now becomes a bi-directional relation `==`. It goes both ways. The 16 | program forms a chain of relations from one or more inputs to one or more 17 | outputs. 18 | 19 | You can introduce logic variables that are unbound values (using `fresh`). 20 | These variables obey the constraints imposed on them through relations. This 21 | allows you to provide a fresh logic variable and see what it gets bound to. 22 | That's what you generally do to get an output from a logic program. 23 | 24 | Through the use of conjunction ("and") and disjunction ("or"), you can form 25 | logical relations. This allows you to encode different possible flows of 26 | execution. The higher-level method for this is `conde`, which is a disjunction 27 | of conjunctions. 28 | 29 | All of these logical relations form a tree. The execution of a program 30 | corresponds to a breadth-first search through the tree that unifies the 31 | provided arguments in accordance to the relations. This means that a program 32 | can discover more than one solution, or no solution at all. 33 | 34 | This radical way of thinking about and writing programs allows for something 35 | very amazing: **You can run your programs backwards.** 36 | 37 | What this means is that you can either give a program inputs and search for a 38 | corresponding output, but you can also provide outputs and ask for 39 | corresponding inputs. 40 | 41 | ## Examples 42 | 43 | ### eq 44 | 45 | var_dump(run_star(function ($q) { 46 | return eq($q, 'corn'); 47 | })); 48 | 49 | // => ['corn'] 50 | 51 | ### conde 52 | 53 | var_dump(run_star(function ($q) { 54 | return conde([ 55 | [eq($q, 'tea')], 56 | [eq($q, 'cup')], 57 | ]); 58 | })); 59 | 60 | // => ['tea', 'cup'] 61 | 62 | ### firsto 63 | 64 | var_dump(run_star(function ($q) { 65 | return firsto(['a', 'c', 'o', 'r', 'n'], $q); 66 | })); 67 | 68 | // => ['a'] 69 | 70 | ### resto 71 | 72 | var_dump(run_star(function ($q) { 73 | return resto(['a', 'c', 'o', 'r', 'n'], $q); 74 | })); 75 | 76 | // => [['c', 'o', 'r', 'n']] 77 | 78 | ### all 79 | 80 | var_dump(run_star(function ($q) { 81 | return all([ 82 | firsto(['a', 'l'], $q), 83 | firsto(['a', 'x'], $q), 84 | firsto(['a', 'z'], $q), 85 | ]); 86 | })); 87 | 88 | // => ['a'] 89 | 90 | ### fresh 91 | 92 | var_dump(run_star(function ($q) { 93 | return fresh(function ($x) use ($q) { 94 | return all([ 95 | eq(['d', 'a', $x, 'c'], $q), 96 | conso($x, ['a', $x, 'c'], $q), 97 | ]); 98 | }); 99 | })); 100 | 101 | // => ['d', 'a', 'd', 'c'] 102 | 103 | ### membero 104 | 105 | function membero($x, $l) { 106 | return conde([ 107 | [fresh(function ($d) use ($x, $l) { 108 | return conso($x, $d, $l); 109 | })], 110 | [fresh(function ($a, $d) use ($x, $l) { 111 | return all([ 112 | conso($a, $d, $l), 113 | membero($x, $d), 114 | ]); 115 | })], 116 | ]); 117 | } 118 | 119 | var_dump(run_star(function ($q) { 120 | return all([ 121 | membero($q, [1, 2, 3]), 122 | membero($q, [2, 3, 4]), 123 | ]); 124 | })); 125 | 126 | // => [2, 3] 127 | 128 | ### run 129 | 130 | var_dump(run(3, function ($q) { 131 | return membero('tofu', $q); 132 | })); 133 | 134 | // => [['tofu', '.', '_.0'] 135 | // ['_.0', 'tofu', '.', '_.1'] 136 | // ['_.0', '_.1', 'tofu', '.', '_.2']] 137 | 138 | ### appendo 139 | 140 | var_dump(run_star(function ($q) { 141 | return appendo([1, 2, 3], [4, 5, 6], $q); 142 | })); 143 | 144 | // => [[1, 2, 3, 4, 5, 6]] 145 | 146 | ### neq (disequality) 147 | 148 | var_dump(run_star(function ($q) { 149 | return all([ 150 | membero($q, [1, 2, 3]), 151 | neq($q, 2), 152 | ]); 153 | })); 154 | 155 | // => [1, 3] 156 | 157 | ### rembero 158 | 159 | function rembero($x, $l, $out) { 160 | return conde([ 161 | [eq([], $l), eq([], $out)], 162 | [fresh(function ($a, $d) use ($x, $l, $out) { 163 | return all([ 164 | eq(pair($a, $d), $l), 165 | eq($a, $x), 166 | eq($d, $out), 167 | ]); 168 | })], 169 | [fresh(function ($a, $d, $res) use ($x, $l, $out) { 170 | return all([ 171 | eq(pair($a, $d), $l), 172 | neq($a, $x), 173 | eq(pair($a, $res), $out), 174 | rembero($x, $d, $res), 175 | ]); 176 | })], 177 | ]); 178 | } 179 | 180 | var_dump(run_star(function ($q) { 181 | return rembero('b', ['a', 'b', 'c', 'b', 'd'], $q); 182 | })); 183 | 184 | // => [['a', 'c', 'b', 'd']] 185 | 186 | ## See also 187 | 188 | * [The Reasoned Schemer](http://mitpress.mit.edu/books/reasoned-schemer) 189 | * [miniKanren](http://minikanren.org/) 190 | * [miniKanren](https://scholarworks.iu.edu/dspace/bitstream/handle/2022/8777/Byrd_indiana_0093A_10344.pdf) (Byrd's Dissertation) 191 | * [microKanren](http://webyrd.net/scheme-2013/papers/HemannMuKanren2013.pdf) 192 | * [rKanren](http://webyrd.net/scheme-2013/papers/Swords2013.pdf) 193 | * [Clause and Effect](http://www.amazon.com/Clause-Effect-Programming-Working-Programmer/dp/3540629718) by William F. Clocksin 194 | -------------------------------------------------------------------------------- /clause-and-effect/01-party-pairs.php: -------------------------------------------------------------------------------- 1 | dance_pairo('percival', $q))); 35 | var_dump(run_star($q ==> dance_pairo('apollo', 'daphne'))); 36 | var_dump(run_star($q ==> dance_pairo('camilla', $q))); 37 | var_dump(run_star($q ==> dance_pairo($q, $q))); 38 | var_dump(run_star($q ==> 39 | fresh_all(($a, $b) ==> [ 40 | dance_pairo($a, $b), 41 | eq($q, [$a, $b]), 42 | ]))); 43 | 44 | // ok, now let's be a bit more inclusive 45 | // fuck the patriarchy 46 | 47 | function persono($person) { 48 | return conde([ 49 | [eq($person, 'bertram')], 50 | [eq($person, 'percival')], 51 | [eq($person, 'apollo')], 52 | [eq($person, 'fido')], 53 | [eq($person, 'lucinda')], 54 | [eq($person, 'camilla')], 55 | [eq($person, 'daphne')], 56 | ]); 57 | } 58 | 59 | function dance_pair_fixedo($a, $b) { 60 | return all([ 61 | persono($a), 62 | persono($b), 63 | neq($a, $b), 64 | ]); 65 | } 66 | 67 | var_dump(run_star($q ==> 68 | fresh_all(($a, $b) ==> [ 69 | dance_pair_fixedo($a, $b), 70 | eq($q, [$a, $b]), 71 | ]))); 72 | 73 | // that's better 74 | -------------------------------------------------------------------------------- /clause-and-effect/02-drinking-pairs.php: -------------------------------------------------------------------------------- 1 | drink_pairo($q, 'john', 'martini'))); 30 | var_dump(run_star($q ==> drink_pairo('mary', 'susan', 'gin'))); 31 | var_dump(run_star($q ==> drink_pairo('john', 'mary', 'gin'))); 32 | var_dump(run_star($q ==> drink_pairo('john', 'john', 'gin'))); 33 | var_dump(run_star($q ==> 34 | fresh_all(($a, $b) ==> [ 35 | drink_pairo($a, $b, 'gin'), 36 | eq($q, [$a, $b]), 37 | ]))); 38 | var_dump(run_star($q ==> drink_pairo('bertram', 'lucinda', 'vodka'))); 39 | var_dump(run_star($q ==> 40 | fresh_all(($a, $b, $drink) ==> [ 41 | drink_pairo($a, $b, $drink), 42 | eq($q, [$a, $b, $drink]), 43 | ]))); 44 | -------------------------------------------------------------------------------- /clause-and-effect/03-affordable-journeys.php: -------------------------------------------------------------------------------- 1 | 33 | all([ 34 | adjacento($a, $i), 35 | adjacento($i, $b), 36 | ])); 37 | } 38 | 39 | var_dump(run_star($q ==> affordableo('wiltshire', 'sussex'))); 40 | var_dump(run_star($q ==> affordableo('wiltshire', 'kent'))); 41 | var_dump(run_star($q ==> affordableo('hampshire', 'hampshire'))); 42 | var_dump(run_star($q ==> affordableo($q, 'kent'))); 43 | var_dump(run_star($q ==> affordableo('sussex', $q))); 44 | var_dump(run_star($q ==> 45 | fresh_all(($a, $b) ==> [ 46 | affordableo($a, $b), 47 | eq($q, [$a, $b]), 48 | ]))); 49 | -------------------------------------------------------------------------------- /clause-and-effect/04-acyclic-directed-graph.php: -------------------------------------------------------------------------------- 1 | [ 29 | grapho($a, $i), 30 | patho($i, $b), 31 | ])], 32 | ]); 33 | } 34 | 35 | var_dump(run_star($q ==> patho('f', 'f'))); 36 | var_dump(run_star($q ==> patho('a', 'c'))); 37 | var_dump(run_star($q ==> patho('g', 'e'))); 38 | var_dump(run_star($q ==> patho('g', $q))); 39 | var_dump(run_star($q ==> patho($q, 'h'))); 40 | -------------------------------------------------------------------------------- /clause-and-effect/06-length-of-a-list.php: -------------------------------------------------------------------------------- 1 | [ 14 | conso($a, $d, $l), 15 | lengtho($d, $d_len), 16 | pluso($d_len, build_num(1), $len), 17 | ])], 18 | ]); 19 | } 20 | 21 | // accumulator version 22 | 23 | function accumulateo($l, $acc, $out) { 24 | return conde([ 25 | [eq($l, []), eq($out, $acc)], 26 | [fresh_all(($a, $d, $acc1) ==> [ 27 | conso($a, $d, $l), 28 | pluso($acc, build_num(1), $acc1), 29 | accumulateo($d, $acc1, $out), 30 | ])], 31 | ]); 32 | } 33 | 34 | function length_acco($l, $len) { 35 | return accumulateo($l, build_num(0), $len); 36 | } 37 | 38 | var_dump(parse_nums(run_star($q ==> lengtho(['a', 'b', 'c'], $q)))); 39 | var_dump(parse_nums(run_star($q ==> length_acco(['a', 'b', 'c'], $q)))); 40 | var_dump(parse_nums(run_star($q ==> length_acco(['apple', 'pear'], $q)))); 41 | // var_dump(run(1, $q ==> length_acco($q, 3))); 42 | // var_dump(run(1, $q ==> lengtho($q, 0))); // stack overflow? @todo investigate 43 | var_dump(parse_nums(run_star($q ==> length_acco(['alpha'], build_num(2))))); 44 | -------------------------------------------------------------------------------- /clause-and-effect/07-inner-product.php: -------------------------------------------------------------------------------- 1 | [ 18 | conso($aa, $ad, $a), 19 | conso($ba, $bd, $b), 20 | timeso($aa, $ba, $prod), 21 | pluso($prod, $n, $n1), 22 | dotaux($ad, $bd, $n1, $z)])], 23 | ]); 24 | } 25 | 26 | var_dump(parse_nums(run(20, $q ==> 27 | fresh($n ==> 28 | inner([build_num(2), build_num(2), build_num(1)], [build_num(2), build_num(2), build_num(3)], $q))))); 29 | -------------------------------------------------------------------------------- /clause-and-effect/08-maximum-of-a-list.php: -------------------------------------------------------------------------------- 1 | [ 14 | conso($a, $d, $l), 15 | conde([ 16 | [lto($acc, $a), maxo($d, $a, $m)], 17 | [lteqo($a, $acc), maxo($d, $acc, $m)], 18 | ]), 19 | ])], 20 | ]); 21 | } 22 | 23 | var_dump(parse_nums(run(1, $q ==> 24 | fresh($n ==> 25 | maxo([build_num(1), build_num(2), build_num(14), build_num(7)], build_num(0), $q))))); 26 | -------------------------------------------------------------------------------- /clause-and-effect/09-searching-a-cyclic-graph.php: -------------------------------------------------------------------------------- 1 | [ 33 | grapho($a, $i), 34 | naive_patho($i, $b), 35 | ])], 36 | ]); 37 | } 38 | 39 | // diverges to infinite loop 40 | // var_dump(run_star($q ==> 41 | // fresh(($a, $b) ==> 42 | // naive_path($a, $b)))); 43 | 44 | function patho($a, $b, $t) { 45 | return conde([ 46 | [eq($a, $a)], 47 | [fresh_all(($z, $t2) ==> [ 48 | grapho($a, $b), 49 | legalo($z, $t), 50 | conso($z, $t, $t2), 51 | patho($z, $b, $t2)])], 52 | ]); 53 | } 54 | 55 | function legalo($z, $l) { 56 | return conde([ 57 | [eq($l, [])], 58 | [fresh_all(($a, $d) ==> [ 59 | conso($a, $d, $l), 60 | neq($z, $a), 61 | legalo($z, $d)])], 62 | ]); 63 | } 64 | 65 | var_dump(run_star($q ==> patho('g', 'c', []))); 66 | var_dump(run_star($q ==> patho('g', 'c', ['f']))); 67 | var_dump(run_star($q ==> patho('a', $q, ['f', 'd']))); 68 | -------------------------------------------------------------------------------- /clause-and-effect/12-partial-maps.php: -------------------------------------------------------------------------------- 1 | divideo($n, $m, $res, $mod)); 15 | } 16 | 17 | function eveno($n) { 18 | return moduloo($n, build_num(2), build_num(0)); 19 | } 20 | 21 | function oddo($n) { 22 | return moduloo($n, build_num(2), build_num(1)); 23 | } 24 | 25 | // "evenso" sounded a little odd 26 | function evens_of_listo($l, $out) { 27 | return conde([ 28 | [eq($l, []), eq($out, [])], 29 | [fresh_all(($a1, $d1, $a2, $d2) ==> [ 30 | conso($a1, $d1, $l), 31 | conso($a2, $d2, $out), 32 | conde([ 33 | [eveno($a1), eq($a1, $a2), evens_of_listo($d1, $d2)], 34 | [oddo($a1), evens_of_listo($d1, $out)], 35 | ]), 36 | ])], 37 | ]); 38 | } 39 | 40 | var_dump(run_star($q ==> 41 | evens_of_listo([], $q))); 42 | 43 | var_dump(run_star($q ==> 44 | evens_of_listo([build_num(0)], $q))); 45 | 46 | var_dump(run_star($q ==> 47 | evens_of_listo([build_num(1)], $q))); 48 | 49 | var_dump(run_star($q ==> 50 | evens_of_listo([build_num(2)], $q))); 51 | 52 | var_dump(run_star($q ==> 53 | evens_of_listo([build_num(0), build_num(1), build_num(2)], $q))); 54 | 55 | var_dump(run_star($q ==> 56 | evens_of_listo([build_num(0), build_num(1), build_num(2), build_num(3), build_num(4)], $q))); 57 | -------------------------------------------------------------------------------- /clause-and-effect/13-removing-duplicates.php: -------------------------------------------------------------------------------- 1 | [ 17 | conso($a, $d, $l1), 18 | membero($a, $d), 19 | setify($d, $l2)])], 20 | [fresh_all(($a, $d1, $d2) ==> [ 21 | conso($a, $d1, $l1), 22 | conso($a, $d2, $l2), 23 | setify($d1, $d2)])] 24 | ]); 25 | } 26 | 27 | function membero($x, $l) { 28 | return conde([ 29 | [firsto($l, $x)], 30 | [fresh_all($d ==> [ 31 | resto($l, $d), 32 | membero($x, $d)])], 33 | ]); 34 | } 35 | 36 | var_dump(run_star($q ==> setify(['a', 'a', 'b', 'c', 'b'], $q))); 37 | var_dump(run_star($q ==> setify(['a', 'a', 'b', 'c', 'b'], ['a', 'c', 'b']))); 38 | var_dump(run_star($q ==> setify(['a', 'a', 'b', 'c', 'b'], ['a', 'b', 'c']))); 39 | -------------------------------------------------------------------------------- /clause-and-effect/14-partial-maps-with-a-parameter.php: -------------------------------------------------------------------------------- 1 | [ 14 | conso($a, $d, $l), 15 | conso($a, $dm, $m), 16 | reduceo($d, $x, $dm)])], 17 | ]); 18 | } 19 | 20 | var_dump(run_star($q ==> reduceo(['a', 'b', 'c'], 'a', $q))); 21 | -------------------------------------------------------------------------------- /clause-and-effect/15-multiple-disjoint-partial-maps.php: -------------------------------------------------------------------------------- 1 | [ 23 | conso('sheep', $d, $l), 24 | conso('sheep', $d_sheep, $sheep), 25 | herdo($d, $d_sheep, $goats)])], 26 | [fresh_all(($d, $d_goats) ==> [ 27 | conso('goat', $d, $l), 28 | conso('goat', $d_goats, $goats), 29 | herdo($d, $sheep, $d_goats)])], 30 | ]); 31 | } 32 | 33 | var_dump(run_star($q ==> 34 | fresh_all(($sheep, $goats) ==> [ 35 | herdo(['sheep', 'goat', 'goat', 'sheep', 'goat'], $sheep, $goats), 36 | eq($q, [$sheep, $goats])]))); 37 | var_dump(run_star($q ==> 38 | fresh_all(($sheep, $goats) ==> [ 39 | herdo(['goat', 'sheep', 'stone', 'goat', 'tree'], $sheep, $goats), 40 | eq($q, [$sheep, $goats])]))); 41 | var_dump(run_star($q ==> herdo($q, ['sheep', 'sheep'], ['goat', 'goat']))); 42 | 43 | function herd_ignore_invalido($l, $sheep, $goats) { 44 | return conde([ 45 | [eq($l, []), eq($sheep, []), eq($goats, [])], 46 | [fresh_all(($d, $d_sheep) ==> [ 47 | conso('sheep', $d, $l), 48 | conso('sheep', $d_sheep, $sheep), 49 | herd_ignore_invalido($d, $d_sheep, $goats)])], 50 | [fresh_all(($d, $d_goats) ==> [ 51 | conso('goat', $d, $l), 52 | conso('goat', $d_goats, $goats), 53 | herd_ignore_invalido($d, $sheep, $d_goats)])], 54 | [fresh_all(($a, $d) ==> [ 55 | conso($a, $d, $l), 56 | neq($a, 'sheep'), 57 | neq($a, 'goat'), 58 | herd_ignore_invalido($d, $sheep, $goats)])], 59 | ]); 60 | } 61 | 62 | var_dump(run_star($q ==> 63 | fresh_all(($sheep, $goats) ==> [ 64 | herd_ignore_invalido(['goat', 'sheep', 'stone', 'goat', 'tree'], $sheep, $goats), 65 | eq($q, [$sheep, $goats])]))); 66 | 67 | function herd_separate_invalido($l, $sheep, $goats, $other) { 68 | return conde([ 69 | [eq($l, []), eq($sheep, []), eq($goats, []), eq($other, [])], 70 | [fresh_all(($d, $d_sheep) ==> [ 71 | conso('sheep', $d, $l), 72 | conso('sheep', $d_sheep, $sheep), 73 | herd_separate_invalido($d, $d_sheep, $goats, $other)])], 74 | [fresh_all(($d, $d_goats) ==> [ 75 | conso('goat', $d, $l), 76 | conso('goat', $d_goats, $goats), 77 | herd_separate_invalido($d, $sheep, $d_goats, $other)])], 78 | [fresh_all(($a, $d, $d_other) ==> [ 79 | conso($a, $d, $l), 80 | neq($a, 'sheep'), 81 | neq($a, 'goat'), 82 | conso($a, $d_other, $other), 83 | herd_separate_invalido($d, $sheep, $goats, $d_other)])], 84 | ]); 85 | } 86 | 87 | var_dump(run_star($q ==> 88 | fresh_all(($sheep, $goats, $other) ==> [ 89 | herd_separate_invalido(['goat', 'sheep', 'stone', 'goat', 'tree'], $sheep, $goats, $other), 90 | eq($q, [$sheep, $goats, $other])]))); 91 | 92 | function alternateo($l, $x, $y) { 93 | return conde([ 94 | [eq($l, []), eq($x, []), eq($y, [])], 95 | [fresh_all(($d1, $d2, $ax, $dx, $ay, $dy) ==> [ 96 | conso($ax, $d1, $l), 97 | conso($ay, $d2, $d1), 98 | conso($ax, $dx, $x), 99 | conso($ay, $dy, $y), 100 | alternateo($d2, $dx, $dy)])], 101 | ]); 102 | } 103 | 104 | var_dump(run_star($q ==> 105 | fresh_all(($x, $y) ==> [ 106 | alternateo([1, 2, 3, 4, 5, 6], $x, $y), 107 | eq($q, [$x, $y])]))); 108 | -------------------------------------------------------------------------------- /clause-and-effect/18-sequential-maps-with-state.php: -------------------------------------------------------------------------------- 1 | [ 16 | conso($a, $d, $l), 17 | eq($c, $a), 18 | pluso($n, build_num(1), $n1), 19 | runcodeo($d, $a, $n1, $x)])], 20 | [fresh_all(($a, $d, $z) ==> [ 21 | conso($a, $d, $l), 22 | conso(['*', $n, $c], $z, $x), 23 | neq($a, $c), 24 | runcodeo($d, $a, build_num(1), $z)])], 25 | ]); 26 | } 27 | 28 | var_dump(run_star($q ==> 29 | fresh_all(($c, $x) ==> [ 30 | runcodeo([1, 1, 2, 2, 2, 3], $c, build_num(0), $x), 31 | eq($q, [$c, $x])]))); 32 | 33 | var_dump(run_star($q ==> 34 | fresh_all(($c, $x) ==> [ 35 | runcodeo([12, 2, 2, 'w', 3, 3, 's', 's', 's'], $c, build_num(0), $x), 36 | eq($q, [$c, $x])]))); 37 | -------------------------------------------------------------------------------- /clause-and-effect/22-ordered-search-trees.php: -------------------------------------------------------------------------------- 1 | [ 35 | eq($tree, [$n, $l, $r]), 36 | eq($out, [$n, $l1, $r]), 37 | lto($item, $n), 38 | inserto($item, $l, $l1), 39 | ])], 40 | [fresh_all(($n, $l, $r, $r1) ==> [ 41 | eq($tree, [$n, $l, $r]), 42 | eq($out, [$n, $l, $r1]), 43 | lto($n, $item), 44 | inserto($item, $r, $r1), 45 | ])], 46 | [fresh_all(($l, $r) ==> [ 47 | eq($tree, [$item, $l, $r]), 48 | eq($out, [$item, $l, $r]), 49 | ])], 50 | ]); 51 | } 52 | 53 | echo json_encode(run_star($q ==> inserto(build_num(1), [], $q)))."\n"; 54 | echo json_encode(run_star($q ==> inserto(build_num(2), [build_num(1), [], []], $q)))."\n"; 55 | echo json_encode(run_star($q ==> inserto(build_num(1), [build_num(2), [], []], $q)))."\n"; 56 | echo json_encode(run_star($q ==> inserto(build_num(3), [build_num(2), [build_num(1), [], []], []], $q)))."\n"; 57 | echo json_encode(run_star($q ==> inserto(build_num(3), [build_num(2), [build_num(1), [], []], []], $q)))."\n"; 58 | echo json_encode(run_star($q ==> inserto(build_num(8), $tree, $q)))."\n"; 59 | -------------------------------------------------------------------------------- /clause-and-effect/23-frequency-distribution.php: -------------------------------------------------------------------------------- 1 | [ 14 | conso($n, $d, $l), 15 | updateo($n, $acc, $s2), 16 | frequencyo($d, $s2, $s), 17 | ])], 18 | ]); 19 | } 20 | 21 | function updateo($n, $in, $out) { 22 | return conde([ 23 | [eq($in, []), eq($out, [['*', build_num(1), $n]])], 24 | [fresh_all(($f, $s, $f1) ==> [ 25 | conso(['*', $f, $n], $s, $in), 26 | conso(['*', $f1, $n], $s, $out), 27 | pluso($f, build_num(1), $f1), 28 | ])], 29 | [fresh_all(($f, $s, $m) ==> [ 30 | conso(['*', $f, $m], $s, $in), 31 | eq($out, pairo(['*', build_num(1), $n], pairo(['*', $f, $m], $s))), 32 | lto($n, $m), 33 | // ! 34 | ])], 35 | [fresh_all(($f, $m, $s, $s1) ==> [ 36 | conso(['*', $f, $m], $s, $in), 37 | conso(['*', $f, $m], $s1, $out), 38 | neq($n, $m), 39 | updateo($n, $s, $s1), 40 | ])], 41 | ]); 42 | } 43 | 44 | echo json_encode(run_star($q ==> 45 | frequencyo([build_num(1)], 46 | [], 47 | $q)))."\n"; 48 | echo json_encode(run_star($q ==> 49 | frequencyo([build_num(1), build_num(2)], 50 | [], 51 | $q)))."\n"; 52 | echo json_encode(run_star($q ==> 53 | frequencyo([build_num(1), build_num(1)], 54 | [], 55 | $q)))."\n"; 56 | echo json_encode(run_star($q ==> 57 | frequencyo([build_num(3), build_num(3), build_num(2), build_num(2), build_num(1), build_num(1), build_num(2), build_num(2), build_num(3), build_num(3)], 58 | [], 59 | $q)))."\n"; 60 | -------------------------------------------------------------------------------- /clause-and-effect/27-linearising.php: -------------------------------------------------------------------------------- 1 | [ 15 | neq(pair($a, $d), $x), 16 | neq([], $x), 17 | ]); 18 | } 19 | 20 | function flatteno($l, $out) { 21 | return conde([ 22 | [eq($l, []), eq($out, [])], 23 | [fresh_all(($a, $d, $l1, $l2) ==> [ 24 | conso($a, $d, $l), 25 | flatteno($a, $l1), 26 | flatteno($d, $l2), 27 | appendo($l1, $l2, $out), 28 | ])], 29 | [not_listo($l), eq($out, [$l]), trace_lvars([$l, $out])], 30 | ]); 31 | } 32 | 33 | echo json_encode(run_star($q ==> 34 | flatteno([], $q)))."\n"; 35 | echo json_encode(run_star($q ==> 36 | flatteno([1], $q)))."\n"; 37 | echo json_encode(run_star($q ==> 38 | flatteno([1, 2, 3], $q)))."\n"; 39 | echo json_encode(run_star($q ==> 40 | flatteno([[[[[1, 2, 3], 4, 5], [6], [7, 8]]], 9], $q)))."\n"; 41 | -------------------------------------------------------------------------------- /clause-and-effect/28-linearising-efficiently.php: -------------------------------------------------------------------------------- 1 | [ 23 | neq(pair($a, $d), $x), 24 | neq([], $x), 25 | ]); 26 | } 27 | 28 | function flat_pairo($x, $y) { 29 | return conde([ 30 | [eq($x, []), fresh($l ==> eq($y, ['-', $l, $l]))], 31 | [fresh_all(($a, $d, $l1, $l2, $l3) ==> [ 32 | conso($a, $d, $x), 33 | eq($y, ['-', $l1, $l3]), 34 | flat_pairo($a, ['-', $l1, $l2]), 35 | flat_pairo($d, ['-', $l2, $l3]), 36 | ])], 37 | [not_listo($x), fresh($z ==> eq($y, ['-', pair($x, $z), $z]))], 38 | ]); 39 | } 40 | 41 | echo json_encode(run_star($q ==> 42 | flatteno([], $q)))."\n"; 43 | echo json_encode(run_star($q ==> 44 | flatteno([1], $q)))."\n"; 45 | echo json_encode(run_star($q ==> 46 | flatteno([1, 2, 3], $q)))."\n"; 47 | echo json_encode(run_star($q ==> 48 | flatteno([[[[[1, 2, 3], 4, 5], [6], [7, 8]]], 9], $q)))."\n"; 49 | -------------------------------------------------------------------------------- /clause-and-effect/99-06-term-rewriting.php: -------------------------------------------------------------------------------- 1 | 13 | eq(v($v), $x)); 14 | } 15 | 16 | // tagged atomic value 17 | function v($v) { 18 | return ['v', $v]; 19 | } 20 | 21 | // 6.1 symbolic differentiation 22 | 23 | function derivativo($expr, $x, $out) { 24 | return conde([ 25 | [eq($expr, $x), eq($out, v(1))], 26 | [neq($expr, $x), atomic($expr), eq($out, v(0))], 27 | [fresh_all(($a, $u) ==> [ 28 | eq(['-', $a], $expr), 29 | eq(['-', $u], $out), 30 | derivativo($a, $x, $u), 31 | ])], 32 | [fresh_all(($a, $b, $u, $v) ==> [ 33 | eq(['+', $a, $b], $expr), 34 | eq(['+', $u, $v], $out), 35 | derivativo($a, $x, $u), 36 | derivativo($b, $x, $v), 37 | ])], 38 | [fresh_all(($a, $b, $u, $v) ==> [ 39 | eq(['-', $a, $b], $expr), 40 | eq(['-', $u, $v], $out), 41 | derivativo($a, $x, $u), 42 | derivativo($b, $x, $v), 43 | ])], 44 | [fresh_all(($a, $b, $u, $v) ==> [ 45 | eq(['*', $a, $b], $expr), 46 | eq(['+', ['*', $b, $u], ['*', $a, $v]], $out), 47 | derivativo($a, $x, $u), 48 | derivativo($b, $x, $v), 49 | ])], 50 | ]); 51 | } 52 | 53 | // @todo 6.2 matrix products by symbolic algebra 54 | 55 | // 6.3 the simplifier 56 | 57 | function simplify_expro($expr, $out) { 58 | return conde([ 59 | [fresh_all(($a, $a1, $b, $b1) ==> [ 60 | eq(['+', $a, $b], $expr), 61 | simplify_expro($a, $a1), 62 | simplify_expro($b, $b1), 63 | op(['+', $a1, $b1], $out), 64 | ])], 65 | [fresh_all(($a, $a1, $b, $b1) ==> [ 66 | eq(['-', $a, $b], $expr), 67 | simplify_expro($a, $a1), 68 | simplify_expro($b, $b1), 69 | op(['-', $a1, $b1], $out), 70 | ])], 71 | [fresh_all(($a, $a1, $b, $b1) ==> [ 72 | eq(['*', $a, $b], $expr), 73 | simplify_expro($a, $a1), 74 | simplify_expro($b, $b1), 75 | op(['*', $a1, $b1], $out), 76 | ])], 77 | [fresh_all(($a, $b) ==> [ 78 | neq(['+', $a, $b], $expr), 79 | neq(['-', $a, $b], $expr), 80 | neq(['*', $a, $b], $expr), 81 | eq($expr, $out), 82 | ])], 83 | ]); 84 | } 85 | 86 | function op($expr, $out) { 87 | return conde([ 88 | // @todo could rewrite using oleg numbers 89 | // to perform actual addition 90 | // [fresh_all(($a, $b) ==> [ 91 | // eq(['+', $a, $b], $expr), 92 | // numbero($a), 93 | // numbero($b), 94 | // pluso($a, $b, $out), 95 | // ])], 96 | [fresh_all($a ==> [ 97 | eq(['+', v(0), $a], $expr), 98 | eq($a, $out), 99 | ])], 100 | [fresh_all($a ==> [ 101 | eq(['+', $a, v(0)], $expr), 102 | eq($a, $out), 103 | ])], 104 | [fresh_all($a ==> [ 105 | eq(['*', v(1), $a], $expr), 106 | eq($a, $out), 107 | ])], 108 | [fresh_all($a ==> [ 109 | eq(['*', v(0), $a], $expr), 110 | eq(v(0), $out), 111 | ])], 112 | [fresh_all($a ==> [ 113 | eq(['*', $a, v(1)], $expr), 114 | eq($a, $out), 115 | ])], 116 | [fresh_all($a ==> [ 117 | eq(['*', $a, v(0)], $expr), 118 | eq(v(0), $out), 119 | ])], 120 | [fresh_all($a ==> [ 121 | eq(['-', $a, v(0)], $expr), 122 | eq($a, $out), 123 | ])], 124 | [fresh_all($a ==> [ 125 | eq(['-', $a, $a], $expr), 126 | eq(v(0), $out), 127 | ])], 128 | [fresh_all($a ==> [ 129 | neq(['+', v(0), $a], $expr), 130 | neq(['+', $a, v(0)], $expr), 131 | neq(['*', v(1), $a], $expr), 132 | neq(['*', v(0), $a], $expr), 133 | neq(['*', $a, v(1)], $expr), 134 | neq(['*', $a, v(0)], $expr), 135 | neq(['-', $a, v(0)], $expr), 136 | neq(['-', $a, $a], $expr), 137 | eq($expr, $out), 138 | ])], 139 | ]); 140 | } 141 | 142 | // distribute negations using DeMorgan's Laws 143 | function distribute_nego($expr, $out) { 144 | return conde([ 145 | [fresh_all($a ==> [ 146 | eq(['-', ['-', $a]], $expr), 147 | distribute_nego($a, $out), 148 | ])], 149 | [fresh_all(($a, $b, $u, $v) ==> [ 150 | eq(['-', ['+', $a, $b]], $expr), 151 | eq(['+', $u, $v], $out), 152 | distribute_nego(['-', $a], $u), 153 | distribute_nego(['-', $b], $v), 154 | ])], 155 | [fresh_all(($a, $b, $u, $v) ==> [ 156 | eq(['-', ['*', $a, $b]], $expr), 157 | eq(['*', $u, $v], $out), 158 | distribute_nego(['-', $a], $u), 159 | distribute_nego($b, $v), 160 | ])], 161 | [fresh_all(($a, $b, $u, $v) ==> [ 162 | eq(['+', $a, $b], $expr), 163 | eq(['+', $u, $v], $out), 164 | distribute_nego($a, $u), 165 | distribute_nego($b, $v), 166 | ])], 167 | [fresh_all(($a, $b, $u, $v) ==> [ 168 | eq(['*', $a, $b], $expr), 169 | eq(['*', $u, $v], $out), 170 | distribute_nego($a, $u), 171 | distribute_nego($b, $v), 172 | ])], 173 | [fresh_all(($a, $b) ==> [ 174 | neq(['-', ['-', $a]], $expr), 175 | neq(['-', ['+', $a, $b]], $expr), 176 | neq(['-', ['*', $a, $b]], $expr), 177 | neq(['+', $a, $b], $expr), 178 | neq(['*', $a, $b], $expr), 179 | eq($expr, $out), 180 | ])], 181 | ]); 182 | } 183 | 184 | function simplifyo($expr, $out) { 185 | return fresh_all($a ==> [ 186 | distribute_nego($expr, $a), 187 | simplify_expro($a, $out), 188 | ]); 189 | } 190 | 191 | echo json_encode(run_star($q ==> 192 | derivativo(v(0), v('x'), $q)))."\n"; 193 | echo json_encode(run_star($q ==> 194 | derivativo(v('x'), v('x'), $q)))."\n"; 195 | echo json_encode(run_star($q ==> 196 | derivativo(['-', ['*', v('x'), v('x')], v(2)], v('x'), $q)))."\n"; 197 | 198 | // @todo figure out why it is spitting out so many answers, we only want the shortest 199 | echo json_encode(run_star($q ==> 200 | simplify_expro(['-', v(1), v(0)], $q)))."\n"; 201 | echo json_encode(run_star($q ==> 202 | simplifyo(['-', ['+', ['*', v('x'), v(1)], ['*', v('x'), v(1)]], v(0)], $q)))."\n"; 203 | -------------------------------------------------------------------------------- /composer.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "igorw/reasoned", 3 | "description": "A miniKanren in PHP.", 4 | "keywords": ["logic"], 5 | "license": "MIT", 6 | "authors": [ 7 | { 8 | "name": "Igor Wiedler", 9 | "email": "igor@wiedler.ch" 10 | } 11 | ], 12 | "require": { 13 | "php": ">=5.5.0" 14 | }, 15 | "autoload": { 16 | "files": ["reasoned.php"] 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /interpreter.php: -------------------------------------------------------------------------------- 1 | 64 | all([ 65 | half_addero($x, $y, $w, $xy), 66 | half_addero($w, $b, $r, $wz), 67 | bit_xoro($xy, $wz, $c), 68 | ]) 69 | ); 70 | } 71 | 72 | function build_num($n) { 73 | if ($n === 0) { 74 | return []; 75 | } 76 | if ($n > 0 && $n % 2 === 0) { 77 | return cons(0, build_num($n / 2)); 78 | } 79 | if ($n % 2 === 1) { 80 | return cons(1, build_num(($n - 1) / 2)); 81 | } 82 | } 83 | 84 | function poso($n) { 85 | return fresh(($a, $d) ==> 86 | eq(pair($a, $d), $n) 87 | ); 88 | } 89 | 90 | // >1o 91 | function gt1o($n) { 92 | return fresh(($a, $ad, $dd) ==> 93 | // (== `(,a ,ad . ,dd) n) 94 | eq(pair($a, pair($ad, $dd)), $n) 95 | ); 96 | } 97 | 98 | // d = carry in, n = operand1, m = operand2, r = result 99 | function addero($d, $n, $m, $r) { 100 | return fresh(() ==> 101 | conde([ 102 | [eq(0, $d), eq([], $m), eq($n, $r)], 103 | [eq(0, $d), eq([], $n), eq($m, $r), poso($m)], 104 | [eq(1, $d), eq([], $m), addero(0, $n, [1], $r)], 105 | [eq(1, $d), eq([], $n), poso($m), addero(0, [1], $m, $r)], 106 | [eq([1], $n), eq([1], $m), 107 | fresh_all(($a, $c) ==> [ 108 | eq([$a, $c], $r), 109 | full_addero($d, 1, 1, $a, $c) 110 | ])], 111 | [eq([1], $n), gen_addero($d, $n, $m, $r)], 112 | [eq([1], $m), gt1o($n), gt1o($r), addero($d, [1], $n, $r)], 113 | [gt1o($n), gen_addero($d, $n, $m, $r)], 114 | ]) 115 | ); 116 | } 117 | 118 | function gen_addero($d, $n, $m, $r) { 119 | return fresh_all(($a, $b, $c, $e, $x, $y, $z) ==> [ 120 | eq(pair($a, $x), $n), 121 | eq(pair($b, $y), $m), 122 | poso($y), 123 | eq(pair($c, $z), $r), 124 | poso($z), 125 | full_addero($d, $a, $b, $c, $e), 126 | addero($e, $x, $y, $z), 127 | ]); 128 | } 129 | 130 | function pluso($n, $m, $k) { 131 | return addero(0, $n, $m, $k); 132 | } 133 | 134 | function minuso($n, $m, $k) { 135 | return pluso($m, $k, $n); 136 | } 137 | 138 | function parse_num(array $n) { 139 | return (int) base_convert(implode('', array_reverse($n)), 2, 10); 140 | } 141 | 142 | function parse_nums($nums) { 143 | return array_map($n ==> parse_num($n), $nums); 144 | } 145 | 146 | // just a bit more (the reasoned schemer chapter 8) 147 | 148 | function timeso($n, $m, $p) { 149 | return conde([ 150 | [eq([], $n), eq([], $p)], 151 | [poso($n), eq([], $m), eq([], $p)], 152 | [eq([1], $n), poso($m), eq($m, $p)], 153 | [gt1o($n), eq([1], $m), eq($n, $p)], 154 | [fresh_all(($x, $z) ==> [ 155 | eq(pair(0, $x), $n), 156 | poso($x), 157 | eq(pair(0, $z), $p), 158 | poso($z), 159 | gt1o($m), 160 | timeso($x, $m, $z)])], 161 | [fresh_all(($x, $y) ==> [ 162 | eq(pair(1, $x), $n), 163 | poso($x), 164 | eq(pair(0, $y), $m), 165 | poso($y), 166 | timeso($m, $n, $p)])], 167 | [fresh_all(($x, $y) ==> [ 168 | eq(pair(1, $x), $n), 169 | poso($x), 170 | eq(pair(1, $y), $m), 171 | poso($y), 172 | odd_timeso($x, $n, $m, $p)])], 173 | ]); 174 | } 175 | 176 | function odd_timeso($x, $n, $m, $p) { 177 | return fresh_all($q ==> [ 178 | bound_timeso($q, $p, $n, $m), 179 | timeso($x, $m, $q), 180 | pluso(pair(0, $q), $m, $p), 181 | ]); 182 | } 183 | 184 | function bound_timeso($q, $p, $n, $m) { 185 | return conde([ 186 | [nullo($q), pairo($p)], 187 | [fresh_all(($x, $y, $z) ==> [ 188 | resto($q, $x), 189 | resto($p, $y), 190 | conde([ 191 | [nullo($n), 192 | resto($m, $z), 193 | bound_timeso($x, $y, $z, [])], 194 | [resto($n, $z), 195 | bound_timeso($x, $y, $z, $m)], 196 | ])])], 197 | ]); 198 | } 199 | 200 | function nullo($l) { 201 | return eq($l, []); 202 | } 203 | 204 | function pairo($l) { 205 | return fresh(($a, $d) ==> 206 | conso($a, $d, $l)); 207 | } 208 | 209 | // =lo 210 | function eq_lengtho($n, $m) { 211 | return conde([ 212 | [eq([], $n), eq([], $m)], 213 | [eq([1], $n), eq([1], $m)], 214 | [fresh_all(($a, $x, $b, $y) ==> [ 215 | eq(pair($a, $x), $n), 216 | poso($x), 217 | eq(pair($b, $y), $m), 218 | poso($y), 219 | eq_lengtho($x, $y)])], 220 | ]); 221 | } 222 | 223 | // [ 229 | eq(pair($a, $x), $n), 230 | poso($x), 231 | eq(pair($b, $y), $m), 232 | poso($y), 233 | lt_lengtho($x, $y)])], 234 | ]); 235 | } 236 | 237 | // <=lo 238 | function lteq_lengtho($n, $m) { 239 | return conde([ 240 | [eq_lengtho($n, $m)], 241 | [lt_lengtho($n, $m)], 242 | ]); 243 | } 244 | 245 | // [ 251 | poso($x), 252 | pluso($n, $x, $m)])], 253 | ]); 254 | } 255 | 256 | // <=o 257 | function lteqo($n, $m) { 258 | return conde([ 259 | [eq($n, $m)], 260 | [lto($n, $m)], 261 | ]); 262 | } 263 | 264 | // hold on! it's going to get subtle! 265 | // ffs, no kidding... 266 | 267 | function splito($n, $r, $l, $h) { 268 | return conde([ 269 | [eq([], $n), eq([], $h), eq([], $l)], 270 | [fresh_all(($b, $nhat) ==> [ 271 | eq(pair(0, pair($b, $nhat)), $n), 272 | eq([], $r), 273 | eq(pair($b, $nhat), $h), 274 | eq([], $l)])], 275 | [fresh_all($nhat ==> [ 276 | eq(pair(1, $nhat), $n), 277 | eq([], $r), 278 | eq($nhat, $h), 279 | eq([1], $l)])], 280 | [fresh_all(($b, $nhat, $a, $rhat) ==> [ 281 | eq(pair(0, pair($b, $nhat)), $n), 282 | eq(pair($a, $rhat), $r), 283 | eq([], $l), 284 | splito(pair($b, $nhat), $rhat, [], $h)])], 285 | [fresh_all(($nhat, $a, $rhat) ==> [ 286 | eq(pair(1, $nhat), $n), 287 | eq(pair($a, $rhat), $r), 288 | eq([1], $l), 289 | splito($nhat, $rhat, [], $h)])], 290 | [fresh_all(($b, $nhat, $a, $rhat, $lhat) ==> [ 291 | eq(pair($b, $nhat), $n), 292 | eq(pair($a, $rhat), $r), 293 | eq(pair($b, $lhat), $l), 294 | poso($lhat), 295 | splito($nhat, $rhat, $lhat, $h)])], 296 | ]); 297 | } 298 | 299 | // /o 300 | function divideo($n, $m, $q, $r) { 301 | return conde([ 302 | [eq($r, $n), eq([], $q), lto($n, $m)], 303 | [eq([1], $q), eq_lengtho($n, $m), pluso($r, $m, $n), lto($r, $m)], 304 | [lt_lengtho($m, $n), 305 | lto($r, $m), 306 | poso($q), 307 | fresh_all(($nh, $nl, $qh, $ql, $qlm, $qlmr, $rr, $rh) ==> [ 308 | splito($n, $r, $nl, $nh), 309 | splito($q, $r, $ql, $qh), 310 | conde([ 311 | [eq([], $nh), 312 | eq([], $qh), 313 | minuso($nl, $r, $qlm), 314 | timeso($ql, $m, $qlm)], 315 | [poso($nh), 316 | timeso($ql, $m, $qlm), 317 | pluso($qlm, $r, $qlmr), 318 | minuso($qlmr, $nl, $rr), 319 | splito($rr, $r, [], $rh), 320 | divideo($nh, $m, $qh, $rh)], 321 | ])])], 322 | ]); 323 | } 324 | 325 | // guess what logo does? 326 | // it builds a split-rail fence 327 | 328 | function logo($n, $b, $q, $r) { 329 | return conde([ 330 | [eq([1], $n), poso($b), eq([], $q), eq([], $r)], 331 | [eq([], $q), lto($n, $b), pluso($r, [1], $n)], 332 | [eq([1], $q), gt1o($b), eq_lengtho($n, $b), pluso($r, $b, $n)], 333 | [eq([1], $b), poso($q), pluso($r, [1], $n)], 334 | [eq([], $b), poso($q), eq($r, $n)], 335 | [eq([0, 1], $b), 336 | fresh_all(($a, $ad, $dd) ==> [ 337 | poso($dd), 338 | eq(pair($a, pair($ad, $dd)), $n), 339 | exp2o($n, [], $q), 340 | fresh($s ==> 341 | splito($n, $dd, $r, $s))])], 342 | [fresh_all(($a, $ad, $add, $ddd) ==> [ 343 | conde([ 344 | [eq([1, 1], $b)], 345 | [eq(pair($a, pair($ad, pair($add, $ddd))), $b)], 346 | ])]), 347 | lt_lengtho($b, $n), 348 | fresh_all(($bw1, $bw, $nw, $nw1, $ql1, $ql, $s) ==> [ 349 | exp2o($b, [], $bw1), 350 | pluso($bw1, [1], $bw), 351 | lt_lengtho($q, $n), 352 | fresh_all(($q1, $bwq1) ==> [ 353 | pluso($q, [1], $q1), 354 | timeso($bw, $q1, $bwq1), 355 | lto($nw1, $bwq1), 356 | exp2o($n, [], $nw1), 357 | pluso($nw1, [1], $nw), 358 | divideo($nw, $bw, $ql1, $s), 359 | pluso($ql, [1], $ql1), 360 | ]), 361 | conde([ 362 | [eq($q, $ql)], 363 | [lt_lengtho($ql, $q)], 364 | ]), 365 | fresh_all(($bql, $qh, $s, $qdh, $qd) ==> [ 366 | repeated_mulo($b, $ql, $bql), 367 | divideo($nw, $bw1, $qh, $s), 368 | pluso($ql, $qdh, $qh), 369 | pluso($ql, $qd, $q), 370 | conde([ 371 | [eq($qd, $qdh)], 372 | [lto($qd, $qdh)], 373 | ]), 374 | fresh_all(($bqd, $bq1, $bq) ==> [ 375 | repeated_mulo($b, $qd, $bqd), 376 | timeso($bql, $bqd, $bq), 377 | timeso($b, $bq, $bq1), 378 | pluso($bq, $r, $n), 379 | lto($n, $bq1)])])])], 380 | ]); 381 | } 382 | 383 | function exp2o($n, $b, $q) { 384 | return conde([ 385 | [eq([1], $n), eq([], $q)], 386 | [gt1o($n), eq([1], $q), 387 | fresh($s ==> 388 | splito($n, $b, $s, [1]))], 389 | [fresh_all(($q1, $b2) ==> [ 390 | eq(pair(0, $q1), $q), 391 | poso($q1), 392 | lt_lengtho($b, $n), 393 | appendo($b, pair(1, $b), $b2), 394 | exp2o($n, $b2, $q1)])], 395 | [fresh_all(($q1, $nh, $b2, $s) ==> [ 396 | eq(pair(1, $q1), $q), 397 | poso($q1), 398 | poso($nh), 399 | splito($n, $b, $s, $nh), 400 | appendo($b, pair(1, $b), $b2), 401 | exp2o($nh, $b2, $q1)])], 402 | ]); 403 | } 404 | 405 | function repeated_mulo($n, $q, $nq) { 406 | return conde([ 407 | [poso($n), eq([], $q), eq([1], $nq)], 408 | [eq([1], $q), eq($n, $nq)], 409 | [gt1o($q), 410 | fresh_all(($q1, $nq1) ==> [ 411 | pluso($q1, [1], $q), 412 | repeated_mulo($n, $q1, $nq1), 413 | timeso($nq1, $n, $nq)])], 414 | ]); 415 | } 416 | 417 | function expo($b, $q, $n) { 418 | return logo($n, $b, $q, []); 419 | } 420 | -------------------------------------------------------------------------------- /peano.php: -------------------------------------------------------------------------------- 1 | all([ 29 | eq($n, ['s', $m]), 30 | peanoo($m), 31 | ]))], 32 | ]); 33 | } 34 | 35 | function peano_pluso($a, $b, $out) { 36 | return all([ 37 | conde([ 38 | [eq($a, 'z'), eq($out, $b)], 39 | [fresh(($c, $d) ==> all([ 40 | eq($a, ['s', $c]), 41 | eq($out, ['s', $d]), 42 | peano_pluso($c, $b, $d), 43 | ]))], 44 | ]), 45 | peanoo($a), 46 | peanoo($b), 47 | peanoo($out), 48 | ]); 49 | } 50 | 51 | // var_dump(run(10, $q ==> peanoo($q))); 52 | // var_dump(run(1, $q ==> peano_pluso('z', 'z', $q))); 53 | // var_dump(run(1, $q ==> peano_pluso(['s', 'z'], ['s', 'z'], $q))); 54 | // var_dump(run(2, $q ==> peano_pluso(['s', 'z'], ['s', 'z'], $q))); 55 | // var_dump(run(10, $q ==> 56 | // fresh(($x, $y, $z) ==> 57 | // all([ 58 | // peano_pluso($x, $y, $z), 59 | // eq($q, [$x, $y, $z]), 60 | // ])))); 61 | // var_dump(run(3, $q ==> 62 | // fresh(($x, $y) ==> 63 | // all([ 64 | // peano_pluso($x, $y, ['s', ['s', ['s', 'z']]]), 65 | // eq($q, [$x, $y]), 66 | // ])))); 67 | -------------------------------------------------------------------------------- /reasoned.php: -------------------------------------------------------------------------------- 1 | name = $name; 11 | } 12 | function is_equal(Variable $var) { 13 | return $this->name === $var->name; 14 | } 15 | } 16 | 17 | function variable($name) { 18 | return new Variable($name); 19 | } 20 | 21 | function is_variable($x) { 22 | return $x instanceof Variable; 23 | } 24 | 25 | class Substitution { 26 | public $values; 27 | function __construct(array $values = []) { 28 | $this->values = $values; 29 | } 30 | function walk($u) { 31 | if (is_variable($u) && null !== $value = $this->find($u)) { 32 | return $this->walk($value); 33 | } 34 | return $u; 35 | } 36 | function find(Variable $var) { 37 | foreach ($this->values as list($x, $value)) { 38 | if ($var->is_equal($x)) { 39 | return $value; 40 | } 41 | } 42 | return null; 43 | } 44 | function extend(Variable $x, $value) { 45 | if (occurs_check($x, $value, $this)) { 46 | // @todo return unextended subst? throw exception? 47 | return null; 48 | } 49 | return new Substitution(array_merge( 50 | [[$x, $value]], 51 | $this->values 52 | )); 53 | } 54 | function length() { 55 | return count($this->values); 56 | } 57 | function reify($v) { 58 | $v = $this->walk($v); 59 | if (is_variable($v)) { 60 | $n = reify_name($this->length()); 61 | return $this->extend($v, $n); 62 | } 63 | if (is_unifiable_array($v)) { 64 | return $this->reify(first($v)) 65 | ->reify(rest($v)); 66 | } 67 | return $this; 68 | } 69 | function prefix(Substitution $s) { 70 | $prefix = []; 71 | $values = $this->values; 72 | while ($values != $s->values) { 73 | $prefix[] = first($values); 74 | $values = rest($values); 75 | } 76 | return new Substitution($prefix); 77 | } 78 | } 79 | 80 | // the road not taken: occurs-check 81 | 82 | function occurs_check($x, $v, Substitution $subst) { 83 | $v = $subst->walk($v); 84 | if (is_variable($v)) { 85 | return $v->is_equal($x); 86 | } 87 | if (is_unifiable_array($v)) { 88 | return occurs_check($x, first($v), $subst) || occurs_check($x, rest($v), $subst); 89 | } 90 | return false; 91 | } 92 | 93 | // disequality, from byrd's dissertation 94 | 95 | class ConstraintStore { 96 | public $constraints; 97 | function __construct(array $constraints = []) { 98 | $this->constraints = $constraints; 99 | } 100 | function first() { 101 | return first($this->constraints); 102 | } 103 | function extend(Substitution $constraint) { 104 | return new ConstraintStore(array_merge( 105 | [$constraint], 106 | $this->constraints 107 | )); 108 | } 109 | function verify(Substitution $subst) { 110 | $verified = []; 111 | foreach ($this->constraints as $c) { 112 | $subst2 = unify_star($c, $subst); 113 | if ($subst2) { 114 | if ($subst == $subst2) { 115 | return null; 116 | } 117 | $c = $subst2->prefix($subst); 118 | $verified[] = $c; 119 | } 120 | } 121 | return new ConstraintStore($verified); 122 | } 123 | // r = reified name substitution 124 | function purify(Substitution $r) { 125 | return new ConstraintStore(array_filter($this->constraints, function ($c) use ($r) { 126 | return !any_var($c->values, $r); 127 | })); 128 | } 129 | function to_array() { 130 | return array_map(function (Substitution $c) { 131 | return $c->values; 132 | }, $this->constraints); 133 | } 134 | } 135 | 136 | function any_var($v, Substitution $r) { 137 | if (is_variable($v)) { 138 | return is_variable($r->walk($v)); 139 | } 140 | if (is_unifiable_array($v)) { 141 | // @todo use foreach? 142 | return any_var(first($v), $r) || any_var(rest($v), $r); 143 | } 144 | return false; 145 | } 146 | 147 | function is_subsumed(Substitution $c, ConstraintStore $cs) { 148 | foreach ($cs->constraints as $constraint) { 149 | if (unify_star($constraint, $c) == $c) { 150 | return true; 151 | } 152 | } 153 | return false; 154 | } 155 | 156 | function remove_subsumed(ConstraintStore $cs, ConstraintStore $cs2) { 157 | if ([] === $cs->constraints) { 158 | return $cs2; 159 | } 160 | $cs_rest = new ConstraintStore(rest($cs->constraints)); 161 | if (is_subsumed($cs->first(), $cs2) || is_subsumed($cs->first(), $cs_rest)) { 162 | return remove_subsumed($cs_rest, $cs2); 163 | } 164 | return remove_subsumed($cs_rest, $cs2->extend($cs->first())); 165 | } 166 | 167 | class State { 168 | public $subst; 169 | public $count; 170 | public $cs; 171 | function __construct(Substitution $subst = null, $count = 0, ConstraintStore $cs = null) { 172 | $this->subst = $subst ?: new Substitution(); 173 | $this->count = $count; 174 | $this->cs = $cs ?: new ConstraintStore(); 175 | } 176 | function next() { 177 | return new State($this->subst, $this->count + 1, $this->cs); 178 | } 179 | function reify() { 180 | $v = walk_star(variable(0), $this->subst); 181 | $cs = walk_star($this->cs, $this->subst); 182 | 183 | $r = (new Substitution())->reify($v); 184 | $v = walk_star($v, $r); 185 | 186 | $cs = $cs->purify($r); 187 | $cs = remove_subsumed($cs, new ConstraintStore()); 188 | $cs = walk_star($cs, $r); 189 | 190 | $cs = $cs->to_array(); 191 | if ([] === $cs) { 192 | return $v; 193 | } 194 | return [$v, ':-', array_merge(['!='], $cs)]; 195 | } 196 | } 197 | 198 | function eq($u, $v) { 199 | return function (State $state) use ($u, $v) { 200 | $subst = unify($u, $v, $state->subst); 201 | if (!$subst) { 202 | return mzero(); 203 | } 204 | if ($state->subst == $subst) { 205 | return unit($state); 206 | } 207 | $cs = $state->cs->verify($subst); 208 | if ($cs) { 209 | return unit(new State($subst, $state->count, $cs)); 210 | } 211 | return mzero(); 212 | }; 213 | } 214 | 215 | function neq($u, $v) { 216 | return function (State $state) use ($u, $v) { 217 | $subst = unify($u, $v, $state->subst); 218 | if (!$subst) { 219 | return unit($state); 220 | } 221 | if ($state->subst == $subst) { 222 | return mzero(); 223 | } 224 | $c = $subst->prefix($state->subst); 225 | return unit(new State($state->subst, $state->count, $state->cs->extend($c))); 226 | }; 227 | } 228 | 229 | function fail() { 230 | return function (State $state) { 231 | return mzero(); 232 | }; 233 | } 234 | 235 | function succeed() { 236 | return function (State $state) { 237 | return unit($state); 238 | }; 239 | } 240 | 241 | function unit(State $state) { 242 | return new PairStream($state, mzero()); 243 | } 244 | 245 | function mzero() { 246 | return new EmptyStream(); 247 | } 248 | 249 | function is_unifiable_array($value) { 250 | if ($value instanceof Substitution) { 251 | $value = $value->values; 252 | } 253 | if ($value instanceof ConstraintStore) { 254 | $value = $value->constraints; 255 | } 256 | return is_pair($value) || is_array($value) && count($value) > 0; 257 | } 258 | 259 | class Pair { 260 | public $first; 261 | public $rest; 262 | function __construct($first, $rest) { 263 | $this->first = $first; 264 | $this->rest = $rest; 265 | } 266 | } 267 | 268 | function pair($first, $rest) { 269 | return new Pair($first, $rest); 270 | } 271 | 272 | function is_pair($x) { 273 | return $x instanceof Pair; 274 | } 275 | 276 | function unify($u, $v, Substitution $subst) { 277 | $u = $subst->walk($u); 278 | $v = $subst->walk($v); 279 | 280 | if (is_variable($u) && is_variable($v) && $u->is_equal($v)) { 281 | return $subst; 282 | } 283 | if (is_variable($u)) { 284 | return $subst->extend($u, $v); 285 | } 286 | if (is_variable($v)) { 287 | return $subst->extend($v, $u); 288 | } 289 | if (is_unifiable_array($u) && is_unifiable_array($v)) { 290 | $subst = unify(first($u), first($v), $subst); 291 | return $subst ? unify(rest($u), rest($v), $subst) : null; 292 | } 293 | if ($u === $v) { 294 | return $subst; 295 | } 296 | return null; 297 | } 298 | 299 | function unify_star(Substitution $ps, Substitution $subst) { 300 | foreach ($ps->values as list($u, $v)) { 301 | $subst = unify($u, $v, $subst); 302 | if (!$subst) { 303 | return null; // false instead of null? 304 | } 305 | } 306 | return $subst; 307 | } 308 | 309 | // $f takes a fresh variable and returns a goal 310 | function call_fresh(callable $f) { 311 | return function (State $state) use ($f) { 312 | $goal = $f(variable($state->count)); 313 | return $goal($state->next()); 314 | }; 315 | } 316 | 317 | // same as call_fresh, but without fresh var 318 | function delay(callable $f) { 319 | return function (State $state) use ($f) { 320 | $goal = $f(); 321 | return $goal($state->next()); 322 | }; 323 | } 324 | 325 | function disj(callable $goal1, callable $goal2) { 326 | return function (State $state) use ($goal1, $goal2) { 327 | return $goal1($state)->mplus($goal2($state)); 328 | }; 329 | } 330 | 331 | function conj(callable $goal1, callable $goal2) { 332 | return function (State $state) use ($goal1, $goal2) { 333 | return $goal1($state)->bind($goal2); 334 | }; 335 | } 336 | 337 | // @todo: do not rely on cons/first/rest for subst/cs during reification? 338 | function cons($value, $list) { 339 | if ($list instanceof Substitution) { 340 | return new Substitution(cons($value, $list->values)); 341 | } 342 | if ($list instanceof ConstraintStore) { 343 | return new ConstraintStore(cons($value, $list->constraints)); 344 | } 345 | array_unshift($list, $value); 346 | return $list; 347 | } 348 | 349 | function first($list) { 350 | if ($list instanceof Substitution) { 351 | return first($list->values); 352 | } 353 | if ($list instanceof ConstraintStore) { 354 | return first($list->constraints); 355 | } 356 | if (is_pair($list)) { 357 | return $list->first; 358 | } 359 | return array_shift($list); 360 | } 361 | 362 | function rest($list) { 363 | if ($list instanceof Substitution) { 364 | return new Substitution(rest($list->values)); 365 | } 366 | if ($list instanceof ConstraintStore) { 367 | return new ConstraintStore(rest($list->constraints)); 368 | } 369 | if (is_pair($list)) { 370 | return $list->rest; 371 | } 372 | array_shift($list); 373 | return $list; 374 | } 375 | 376 | interface Stream extends \IteratorAggregate { 377 | function mplus(Stream $stream2); 378 | function bind(callable $goal); 379 | } 380 | 381 | class EmptyStream implements Stream { 382 | function mplus(Stream $stream2) { 383 | return $stream2; 384 | } 385 | function bind(callable $goal) { 386 | return mzero(); 387 | } 388 | function getIterator() { 389 | return new \EmptyIterator(); 390 | } 391 | } 392 | 393 | class CallableStream implements Stream { 394 | public $f; 395 | function __construct(callable $f) { 396 | $this->f = $f; 397 | } 398 | function mplus(Stream $stream2) { 399 | return new CallableStream(function () use ($stream2) { 400 | return $stream2->mplus($this->resolve()); 401 | }); 402 | } 403 | function bind(callable $goal) { 404 | return new CallableStream(function () use ($goal) { 405 | return $this->resolve()->bind($goal); 406 | }); 407 | } 408 | function getIterator() { 409 | $next = $this; 410 | do { 411 | $next = $next->resolve(); 412 | } while ($next instanceof CallableStream); 413 | 414 | return $next->getIterator(); 415 | } 416 | function resolve() { 417 | return call_user_func($this->f); 418 | } 419 | } 420 | 421 | class PairStream implements Stream { 422 | public $first; 423 | public $rest; 424 | function __construct($first, Stream $rest) { 425 | $this->first = $first; 426 | $this->rest = $rest; 427 | } 428 | function mplus(Stream $stream2) { 429 | return new PairStream($this->first, $this->rest->mplus($stream2)); 430 | } 431 | function bind(callable $goal) { 432 | return $goal($this->first)->mplus($this->rest->bind($goal)); 433 | } 434 | function getIterator() { 435 | yield $this->first; 436 | foreach ($this->rest as $x) { 437 | yield $x; 438 | } 439 | } 440 | } 441 | 442 | // recovering miniKanren's control operators 443 | 444 | function zzz(callable $goal) { 445 | return function (State $state) use ($goal) { 446 | return new CallableStream(function () use ($goal, $state) { 447 | return $goal($state); 448 | }); 449 | }; 450 | } 451 | 452 | function conj_plus(array $goals) { 453 | if (count($goals) === 0) { 454 | throw new \InvalidArgumentException('Must supply at least one goal'); 455 | } 456 | if (count($goals) === 1) { 457 | return zzz(first($goals)); 458 | } 459 | return conj(zzz(first($goals)), conj_plus(rest($goals))); 460 | } 461 | 462 | function disj_plus(array $goals) { 463 | if (count($goals) === 0) { 464 | throw new \InvalidArgumentException('Must supply at least one goal'); 465 | } 466 | if (count($goals) === 1) { 467 | return zzz(first($goals)); 468 | } 469 | return disj(zzz(first($goals)), disj_plus(rest($goals))); 470 | } 471 | 472 | function conde(array $lines) { 473 | return disj_plus(array_map('igorw\reasoned\conj_plus', $lines)); 474 | } 475 | 476 | // based heavily on mudge/php-microkanren 477 | function fresh(callable $f) { 478 | $argCount = (new \ReflectionFunction($f))->getNumberOfParameters(); 479 | if ($argCount === 0) { 480 | return delay($f); 481 | } 482 | return call_fresh(function ($x) use ($f, $argCount) { 483 | return collect_args($f, $argCount, [$x]); 484 | }); 485 | } 486 | 487 | function collect_args(callable $f, $argCount, $args) { 488 | if (count($args) === $argCount) { 489 | return call_user_func_array($f, $args); 490 | } 491 | 492 | return call_fresh(function ($x) use ($f, $argCount, $args) { 493 | return collect_args($f, $argCount, array_merge($args, [$x])); 494 | }); 495 | } 496 | 497 | // from streams to lists 498 | // @todo use iter? 499 | 500 | function take($n, $stream) { 501 | foreach ($stream as $x) { 502 | if ($n-- === 0) { 503 | break; 504 | } 505 | yield $x; 506 | } 507 | } 508 | 509 | function map(callable $f, $stream) { 510 | foreach ($stream as $x) { 511 | yield $f($x); 512 | } 513 | } 514 | 515 | function to_array($stream) { 516 | $array = []; 517 | foreach ($stream as $x) { 518 | $array[] = $x; 519 | } 520 | return $array; 521 | } 522 | 523 | // recovering reification 524 | 525 | function reify($states) { 526 | return map(function (State $state) { return $state->reify(); }, $states); 527 | } 528 | 529 | function reify_name($n) { 530 | return "_.$n"; 531 | } 532 | 533 | function walk_star($v, Substitution $subst) { 534 | $v = $subst->walk($v); 535 | if (is_variable($v)) { 536 | return $v; 537 | } 538 | if (is_pair($v)) { 539 | $first = walk_star(first($v), $subst); 540 | $rest = walk_star(rest($v), $subst); 541 | if (is_array($rest)) { 542 | return cons($first, $rest); 543 | } 544 | return [$first, '.', $rest]; 545 | } 546 | if (is_unifiable_array($v)) { 547 | return cons(walk_star(first($v), $subst), walk_star(rest($v), $subst)); 548 | } 549 | return $v; 550 | } 551 | 552 | // recovering the scheme interface 553 | 554 | function call_goal(callable $goal) { 555 | return $goal(new State()); 556 | } 557 | 558 | function run($n, callable $goal) { 559 | return to_array(take($n, reify(call_goal(fresh($goal))))); 560 | } 561 | 562 | function run_star(callable $goal) { 563 | return to_array(reify(call_goal(fresh($goal)))); 564 | } 565 | 566 | function all(array $goals) { 567 | return conj_plus($goals); 568 | } 569 | 570 | // more convenience 571 | 572 | // fresh(), combined with all() 573 | function fresh_all(callable $f) { 574 | $argCount = (new \ReflectionFunction($f))->getNumberOfParameters(); 575 | if ($argCount === 0) { 576 | return delay(function () use ($f) { 577 | return all($f()); 578 | }); 579 | } 580 | return call_fresh(function ($x) use ($f, $argCount) { 581 | return collect_args( 582 | function (/** ... */) use ($f) { 583 | return all(call_user_func_array($f, func_get_args())); 584 | }, 585 | $argCount, 586 | [$x] 587 | ); 588 | }); 589 | } 590 | 591 | // unicode madness 592 | 593 | function ≡($u, $v) { 594 | return eq($u, $v); 595 | } 596 | 597 | function ≢($u, $v) { 598 | return neq($u, $v); 599 | } 600 | 601 | function ⋀(array $goals) { 602 | return conj_plus($goals); 603 | } 604 | 605 | function ⋁(array $goals) { 606 | return disj_plus($goals); 607 | } 608 | 609 | function run٭(callable $goal) { 610 | return run_star($goal); 611 | } 612 | 613 | function condᵉ(array $lines) { 614 | return conde($lines); 615 | } 616 | 617 | // user level plumbing 618 | 619 | function conso($a, $d, $l) { 620 | return eq(pair($a, $d), $l); 621 | } 622 | 623 | function firsto($l, $a) { 624 | return fresh(function ($d) use ($l, $a) { 625 | return conso($a, $d, $l); 626 | }); 627 | } 628 | 629 | function resto($l, $d) { 630 | return fresh(function ($a) use ($l, $d) { 631 | return conso($a, $d, $l); 632 | }); 633 | } 634 | 635 | function appendo($l, $s, $out) { 636 | return conde([ 637 | [eq($l, []), eq($s, $out)], 638 | [fresh(function ($a, $d, $res) use ($l, $s, $out) { 639 | return all([ 640 | conso($a, $d, $l), 641 | conso($a, $res, $out), 642 | appendo($d, $s, $res), 643 | ]); 644 | })], 645 | ]); 646 | } 647 | 648 | // user level unicode madness 649 | 650 | function consᵒ($a, $d, $l) { 651 | return conso($a, $d, $l); 652 | } 653 | 654 | function firstᵒ($l, $a) { 655 | return firsto($l, $a); 656 | } 657 | 658 | function restᵒ($l, $d) { 659 | return resto($l, $d); 660 | } 661 | 662 | function appendᵒ($l, $s, $out) { 663 | return appendo($l, $s, $out); 664 | } 665 | 666 | // debugging goals (inspired by core.logic) 667 | 668 | function log($msg) { 669 | return function (State $state) use ($msg) { 670 | echo "$msg\n"; 671 | return unit($state); 672 | }; 673 | } 674 | 675 | function trace_subst() { 676 | return function (State $state) { 677 | var_dump($state->subst); 678 | return unit($state); 679 | }; 680 | } 681 | 682 | function trace_lvars(array $vars) { 683 | return function (State $state) use ($vars) { 684 | foreach ($vars as $var) { 685 | $v = walk_star($var, $state->subst); 686 | $reified = walk_star($v, (new Substitution())->reify($v)); 687 | 688 | if (is_variable($var) && is_string($reified)) { 689 | echo "variable({$var->name}) = $reified\n"; 690 | } else if (is_variable($var)) { 691 | echo "variable({$var->name}) =\n"; 692 | var_dump($reified); 693 | } else { 694 | var_dump($reified); 695 | } 696 | } 697 | return unit($state); 698 | }; 699 | } 700 | 701 | // @todo unifying with null 702 | // @todo the fun never ends: anyo, nevero, alwayso 703 | // @todo reduce stack consumption (streams mostly) 704 | -------------------------------------------------------------------------------- /test.php: -------------------------------------------------------------------------------- 1 | condᵉ([ 148 | [≡($q, 'unicode')], 149 | [≡($q, 'madness')], 150 | ]) 151 | )); 152 | 153 | // pair reification 154 | 155 | assertSame([['tofu', '.', '_.0'], ['_.0', 'tofu', '.', '_.1'], ['_.0', '_.1', 'tofu', '.', '_.2']], run(3, function ($q) { 156 | return membero('tofu', $q); 157 | })); 158 | 159 | assertSame([[1, 2, 3, 4, 5, 6]], run_star(function ($q) { 160 | return appendo([1, 2, 3], [4, 5, 6], $q); 161 | })); 162 | 163 | // disequality 164 | 165 | assertSame(['_.0'], run_star(function ($q) { 166 | return neq(5, 6); 167 | })); 168 | 169 | assertSame([], run_star(function ($q) { 170 | return neq(5, 5); 171 | })); 172 | 173 | assertSame([1, 3], run_star(function ($q) { 174 | return all([ 175 | membero($q, [1, 2, 3]), 176 | neq($q, 2), 177 | ]); 178 | })); 179 | 180 | assertSame( 181 | [ 182 | [['_.0', '_.1'], ':-', ['!=', [['_.0', 5], ['_.1', 6]]]], 183 | ], 184 | run_star(function ($q) { 185 | return fresh(function ($x, $y) use ($q) { 186 | return all([ 187 | neq([5, 6], [$x, $y]), 188 | eq($q, [$x, $y]), 189 | ]); 190 | }); 191 | }) 192 | ); 193 | 194 | // rembero 195 | 196 | function rembero($x, $l, $out) { 197 | return conde([ 198 | [eq([], $l), eq([], $out)], 199 | [fresh(function ($a, $d) use ($x, $l, $out) { 200 | return all([ 201 | eq(pair($a, $d), $l), 202 | eq($a, $x), 203 | eq($d, $out), 204 | ]); 205 | })], 206 | [fresh(function ($a, $d, $res) use ($x, $l, $out) { 207 | return all([ 208 | eq(pair($a, $d), $l), 209 | neq($a, $x), 210 | eq(pair($a, $res), $out), 211 | rembero($x, $d, $res), 212 | ]); 213 | })], 214 | ]); 215 | } 216 | 217 | assertSame([['a', 'c', 'b', 'd']], run_star(function ($q) { 218 | return rembero('b', ['a', 'b', 'c', 'b', 'd'], $q); 219 | })); 220 | 221 | assertSame([], run_star(function ($q) { 222 | return rembero('b', ['b'], ['b']); 223 | })); 224 | 225 | assertSame( 226 | [ 227 | ['a', ['b', 'c']], 228 | ['b', ['a', 'c']], 229 | ['c', ['a', 'b']], 230 | [['_.0', ['a', 'b', 'c']], ':-', ['!=', [['_.0', 'a']], [['_.0', 'b']], [['_.0', 'c']]]], 231 | ], 232 | run_star(function ($q) { 233 | return fresh(function ($x, $out) use ($q) { 234 | return all([ 235 | rembero($x, ['a', 'b', 'c'], $out), 236 | eq([$x, $out], $q), 237 | ]); 238 | }); 239 | }) 240 | ); 241 | 242 | // occurs check 243 | 244 | assertSame([], run_star(function ($q) { 245 | return eq($q, [$q]); 246 | })); 247 | 248 | // neq order 249 | 250 | assertSame([], run_star(function ($q) { 251 | return fresh(function ($a, $b) use ($q) { 252 | return all([ 253 | eq($a, 'mary'), 254 | eq($b, 'mary'), 255 | neq($a, $b), 256 | eq($q, [$a, $b]), 257 | ]); 258 | }); 259 | })); 260 | 261 | assertSame([], run_star(function ($q) { 262 | return fresh(function ($a, $b) use ($q) { 263 | return all([ 264 | neq($a, $b), 265 | eq($a, 'mary'), 266 | eq($b, 'mary'), 267 | eq($q, [$a, $b]), 268 | ]); 269 | }); 270 | })); 271 | 272 | // oleg numbers 273 | 274 | assertSame([[0, 0], [1, 1]], run_star($s ==> 275 | fresh(($x, $y) ==> 276 | all([ 277 | bit_xoro($x, $y, 0), 278 | eq([$x, $y], $s), 279 | ])) 280 | )); 281 | 282 | assertSame([[1, 1]], run_star($s ==> 283 | fresh(($x, $y) ==> 284 | all([ 285 | bit_ando($x, $y, 1), 286 | eq([$x, $y], $s), 287 | ])) 288 | )); 289 | 290 | assertSame([0], run_star($r ==> 291 | half_addero(1, 1, $r, 1) 292 | )); 293 | 294 | assertSame([[0, 1]], run_star(($s) ==> 295 | fresh(($r, $c) ==> 296 | all([ 297 | full_addero(0, 1, 1, $r, $c), 298 | eq([$r, $c], $s), 299 | ])) 300 | )); 301 | 302 | assertSame([true], run_star(($q) ==> 303 | all([ 304 | poso([1]), 305 | eq(true, $q) 306 | ]) 307 | )); 308 | 309 | assertSame([], run_star(($q) ==> 310 | all([ 311 | poso([]), 312 | eq(true, $q) 313 | ]) 314 | )); 315 | 316 | assertSame([['_.0', '.', '_.1']], run_star(($r) ==> 317 | poso($r) 318 | )); 319 | 320 | // is 6 greater than one? 321 | assertSame([true], run_star($q ==> 322 | all([ 323 | gt1o([0, 1, 1]), 324 | eq(true, $q), 325 | ]) 326 | )); 327 | 328 | // 6 + 3 (+ 1 carry in) = 10 329 | assertSame([[0, 1, 0, 1]], run_star($s ==> 330 | gen_addero(1, [0, 1, 1], [1, 1], $s) 331 | )); 332 | 333 | // x + y = 5 334 | assertSame( 335 | [[[1, 0, 1], []], 336 | [[], [1, 0, 1]], 337 | [[1], [0, 0, 1]]], 338 | run(3, $s ==> 339 | fresh(($x, $y) ==> 340 | all([ 341 | addero(0, $x, $y, [1, 0, 1]), 342 | eq([$x, $y], $s), 343 | ]))) 344 | ); 345 | 346 | // x + y = 5, using pluso 347 | assertSame( 348 | [[[1, 0, 1], []], [[], [1, 0, 1]], [[1], [0, 0, 1]]], 349 | run(3, $s ==> 350 | fresh(($x, $y) ==> 351 | all([ 352 | pluso($x, $y, [1, 0, 1]), 353 | eq([$x, $y], $s), 354 | ]))) 355 | ); 356 | 357 | // 8 - 5 = 3 358 | assertSame([[1, 1]], run_star($q ==> 359 | minuso([0, 0, 0, 1], [1, 0, 1], $q) 360 | )); 361 | 362 | // 6 - 6 = 0 363 | assertSame([[]], run_star($q ==> 364 | minuso([0, 1, 1], [0, 1, 1], $q) 365 | )); 366 | 367 | // 6 - 8 => does not compute (negative numbers not supported) 368 | assertSame([], run_star($q ==> 369 | minuso([0, 1, 1], [0, 0, 0, 1], $q) 370 | )); 371 | 372 | assertSame([25], parse_nums(run_star($q ==> 373 | all([ 374 | pluso(build_num(15), build_num(10), $q), 375 | ]) 376 | ))); 377 | 378 | // just a bit more 379 | 380 | assertSame([[1, 0, 0, 1, 1, 1, 0, 1, 1]], run_star($q ==> 381 | timeso([1, 1, 1], [1, 1, 1, 1, 1, 1], $q) 382 | )); 383 | 384 | assertSame([['_.0', '_.1', ['_.2', 1]]], run_star($q ==> 385 | fresh_all(($w, $x, $y) ==> [ 386 | eq_lengtho(pair(1, pair($w, pair($x, $y))), [0, 1, 1, 0, 1]), 387 | eq([$w, $x, $y], $q), 388 | ]) 389 | )); 390 | 391 | assertSame([1], run_star($q ==> 392 | eq_lengtho([1], [$q]) 393 | )); 394 | 395 | assertSame([['_.0', 1]], run_star($q ==> 396 | eq_lengtho(pair(1, pair(0, pair(1, $q))), [0, 1, 1, 0, 1]) 397 | )); 398 | 399 | assertSame([[[], '_.0'], [[1], '_.0']], run(2, $q ==> 400 | fresh_all(($y, $z) ==> [ 401 | lt_lengtho(pair(1, $y), pair(0, pair(1, pair(1, pair(0, pair(1, $z)))))), 402 | eq([$y, $z], $q), 403 | ]) 404 | )); 405 | 406 | assertSame([[[], []], [[], ['_.0', '.', '_.1']], [[1], [1]]], run(3, $q ==> 407 | fresh_all(($n, $m) ==> [ 408 | lteq_lengtho($n, $m), 409 | eq([$n, $m], $q), 410 | ]) 411 | )); 412 | 413 | assertSame(['_.0'], run_star($q ==> 414 | lto([1, 0, 1], [1, 1, 1]) 415 | )); 416 | 417 | assertSame([], run_star($q ==> 418 | lto([1, 1, 1], [1, 0, 1]) 419 | )); 420 | 421 | assertSame([], run_star($q ==> 422 | lto([1, 0, 1], [1, 0, 1]) 423 | )); 424 | 425 | assertSame([[], [1], ['_.0', 1], [0, 0, 1]], run_star($q ==> 426 | lto($q, [1, 0, 1]) 427 | )); 428 | 429 | // TRS-8.52 430 | // it has no value, since 432 | // lto($q, $q) 433 | // )); 434 | 435 | assertSame([], run_star($q ==> 436 | fresh($r ==> 437 | divideo([1, 0, 1], $q, [1, 1, 1], $r)) 438 | )); 439 | 440 | assertSame([[0, 1, 1]], run_star($q ==> 441 | logo([0, 1, 1, 1], [0, 1], [1, 1], $q) 442 | )); 443 | 444 | // diverges with run3 445 | // @todo figure out why! 446 | assertSame( 447 | [ 448 | [[], ['_.0', '_.1', '.', '_.2'], [0, 0, 1, 0, 0, 0, 1]], 449 | [[1], ['_.0', '_.1', '.', '_.2'], [1, 1, 0, 0, 0, 0, 1]], 450 | ], 451 | run(2, $s ==> 452 | fresh_all(($b, $q, $r) ==> [ 453 | logo([0, 0, 1, 0, 0, 0, 1], $b, $q, $r), 454 | gt1o($q), 455 | eq([$b, $q, $r], $s), 456 | ]) 457 | ) 458 | ); 459 | 460 | // diverges 461 | // @todo figure out why! 462 | // assertSame([[0, 0, 1]], run(1, $q ==> 463 | // expo([1, 1], [1, 1], $q) 464 | // )); 465 | 466 | // diverges 467 | // @todo figure out why! 468 | // assertSame([[1, 1, 0, 0, 1, 1, 1, 1]], run(1, $q ==> 469 | // expo([1, 1], [1, 0, 1], $q) 470 | // )); 471 | 472 | // this appears to be caused by the combination of two things: 473 | // * reification transforms ConstraintStore pairs into [5, '.', $d] 474 | // before performing constraint verification, this means they 475 | // cannot be (dis)unified properly later on. 476 | // * ConstraintStore::purify() removes non-reified (unground?) 477 | // constraints, which leads to the $d being ignored. 478 | // 479 | // ... so this might actually be the intended behaviour 480 | // assertSame([], run(1, $q ==> 481 | // fresh($d ==> neq($q, pair(5, $d))), 482 | // )); 483 | 484 | // when eq() calls ConstraintStore::verify(), it does not match 485 | // the constraint unification for some reason. 486 | // @todo figure out why! 487 | // assertSame([], run(1, $q ==> 488 | // all([ 489 | // fresh($d ==> neq($q, pair(5, $d))), 490 | // eq($q, [5, 6, 7]), 491 | // ]) 492 | // )); 493 | -------------------------------------------------------------------------------- /type-inferencer.php: -------------------------------------------------------------------------------- 1 | 14 | condᵉ([ 15 | [≡($e, ['intc', $e1]), ≡($t, 'int')], 16 | [≡($e, ['+', $e1, $e2]), ≡($t, 'int'), 17 | Ͱᵒ($Γ, $e1, 'int'), 18 | Ͱᵒ($Γ, $e2, 'int')], 19 | [≡($e, ['var', $e1]), lookupᵒ($Γ, $e1, $t)], 20 | [≡($e, ['λ', [$e1], $e2]), 21 | ≡($t, ['→', $t1, $t2]), 22 | Ͱᵒ(pair(pair($e1, $t1), $Γ), $e2, $t2)], 23 | [≡($e, ['app', $e1, $e2]), 24 | Ͱᵒ($Γ, $e1, ['→', $t1, $t]), 25 | Ͱᵒ($Γ, $e2, $t1)], 26 | ]) 27 | ); 28 | } 29 | 30 | function lookupᵒ($Γ, $x, $t) { 31 | return fresh(($rest, $type, $y) ==> 32 | condᵉ([ 33 | [≡(pair(pair($x, $t), $rest), $Γ)], 34 | [≡(pair(pair($y, $type), $rest), $Γ), 35 | ≢($x, $y), 36 | lookupᵒ($rest, $x, $t)], 37 | ]) 38 | ); 39 | } 40 | 41 | var_dump(run(4, function ($q) { 42 | return fresh(($e, $t) ==> 43 | all([ 44 | ≡($q, [$e, ':', $t]), 45 | Ͱᵒ([], $e, $t), 46 | ]) 47 | ); 48 | })); 49 | --------------------------------------------------------------------------------