├── README.md ├── cg.scm ├── cg2.scm ├── cgl.scm ├── dcg-interp.scm ├── dcg-macro.scm ├── dcg-manual.scm ├── dcg.scm ├── dcg2.scm ├── dcg3.scm ├── lf.scm ├── lf2.scm ├── lf3.scm ├── lf4.scm ├── lf5.scm ├── lf6.scm ├── lf7.scm └── mk-meta.scm /README.md: -------------------------------------------------------------------------------- 1 | Prolog and Natural-Language Analysis 2 | == 3 | 4 | * http://www.mtome.com/Publications/PNLA/prolog-digital.pdf 5 | * http://www.mtome.com/Publications/PNLA/PNLA-code/index.html 6 | 7 | Progress: 8 | 9 | | Book | Repo | Status | 10 | | -----|-------- |--------------:| 11 | | DCG in prolog notation, 3.9, pg 54 | `dcg-manual.scm` | done | 12 | | DCG example, 3.10, pg 56 | `dcg.scm` | done | 13 | | DCG parse tree, 3.11, pg 58 | `dcg2.scm` | done | 14 | | Embedding miniKanren Calls in DCGs, 3.12, pg 60 | `dcg3.scm` | done| 15 | | Encoding the Semantic System, pg 74 | `lf.scm` | done | 16 | | Quantified Noun Phrases, exercise 4.2 pg 77 | `lf2.scm` | done | 17 | | Quantified Noun Phrases, program 4.2 pg 79 | `lf3.scm` | done | 18 | | Quantifier Scope, program 4.3 pg 83 | `lf4.scm` | done | 19 | | Auxiliary Verbs, Yes-No Questions, pg 89 | `lf5.scm` | done | 20 | | Filler-Gap Dependencies, Relative Clauses, program 4.4 pg 92 | `lf6.scm` | done | 21 | | WH-questions, Semantics of Filler-Gap Depdencies, program 4.5 pg 95 | `lf7.scm` | done | 22 | | Categorical Grammars, problem 4.10 pg 103 | `cg.scm` `cg2.scm` | done | 23 | | CG with Logical Form, problem 4.11, pg 105 | `cgl.scm` | done | 24 | | miniKanren in miniKanren, 6.1. pg 126 | `mk-meta.scm` | done | 25 | | DCG interpreter, 6.4, pg 133 | `dcg-interp.scm` | done | 26 | -------------------------------------------------------------------------------- /cg.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | 5 | ;; Problem 4.10 6 | (define (lexo in cat) 7 | (conde ((== 'bertrand in) (== 'np cat)) 8 | ((== 'terry in) (== 'np cat)) 9 | ((== 'principia in) (== 'np cat)) 10 | ((== 'halts in) (== '(\ s np) cat)) 11 | ((== 'wrote in) (== '(/ (\ s np) np) cat)) 12 | ((== 'met in) (== '(/ (\ s np) np) cat)))) 13 | 14 | (define (combine a b r) 15 | (conde ((== a `(/ ,r ,b))) 16 | ((== b `(\ ,r ,a))))) 17 | 18 | (--> (lex ty) 19 | (fresh (in) 20 | (conde (`(,in) (escape (lexo in ty)))))) 21 | 22 | (--> (parse ty) 23 | (fresh (a b) 24 | (conde ((lex ty)) 25 | ((escape (combine a b ty)) 26 | (parse a) 27 | (parse b))))) 28 | 29 | (runi (lambda (q) (parse 's q '()))) 30 | -------------------------------------------------------------------------------- /cg2.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | ;; Problem 4.10 5 | (define (lexo in cat) 6 | (conde ((== 'bertrand in) (== 'np cat)) 7 | ((== 'terry in) (== 'np cat)) 8 | ((== 'principia in) (== 'np cat)) 9 | ((== 'halts in) (== '(\ s np) cat)) 10 | ((== 'wrote in) (== '(/ (\ s np) np) cat)) 11 | ((== 'met in) (== '(/ (\ s np) np) cat)))) 12 | 13 | (define (combine a b r) 14 | (conde ((== a `(/ ,r ,b))) 15 | ((== b `(\ ,r ,a))))) 16 | 17 | (--> (lex in ty) 18 | (conde (`(,in) (escape (lexo in ty))))) 19 | 20 | ;; with parse tree 21 | (--> (parse ty tree) 22 | (fresh (tok a b l r) 23 | (conde ((== tree `(,tok : ,ty)) 24 | (lex tok ty)) 25 | ((escape (combine a b ty)) 26 | (== tree `(,l ,r : ,ty)) 27 | (parse a l) 28 | (parse b r))))) 29 | 30 | (runi (lambda (q) 31 | (fresh (q1 q2) 32 | (== q (list q1 q2)) 33 | (parse 's q1 q2 '())))) 34 | -------------------------------------------------------------------------------- /cgl.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren examples lists) 3 | (minikanren dcg)) 4 | 5 | (define (lexo in cat sem) 6 | (fresh (x y c) 7 | (membero (list in cat sem) 8 | `((bertrand np bertrand) 9 | (terry np terry) 10 | (marcel np marcel) 11 | (principia np principia) 12 | (completeness np completeness) 13 | (halts (\ s np) (lambda (,x) 14 | (halts ,x))) 15 | (wrote (/ (\ s np) np) 16 | (lambda (,x) 17 | (lambda (,y) 18 | (wrote ,y ,x)))) 19 | (met (/ (\ s np) np) 20 | (lambda (,x) 21 | (lambda (,y) 22 | (met ,y ,x)))) 23 | (conjectured (/ (\ s np) np) 24 | (lambda (,x) 25 | (lambda (,y) 26 | (conjectured ,y ,x)))) 27 | (proved (/ (\ s np) np) 28 | (lambda (,x) 29 | (lambda (,y) 30 | (proved ,y ,x)))) 31 | (and (/ (\ ,c ,c) ,c) 32 | (lambda (,x) 33 | (lambda (,y) 34 | (and ,y ,x)))))))) 35 | 36 | (define (combine a b r) 37 | (conde ((== a `(/ ,r ,b))) 38 | ((== b `(\ ,r ,a))))) 39 | 40 | (define (combine-sem a sa b sb r sr) 41 | (fresh (sr-l sr-r) 42 | (conde 43 | ;; basic 44 | ((== a `(/ ,r ,b)) 45 | (== sa `(lambda (,sb) ,sr))) 46 | ((== b `(\ ,r ,a)) 47 | (== sb `(lambda (,sa) ,sr))) 48 | ;; and 49 | ((== a `(/ ,r ,b)) 50 | (== sa `(and (lambda (,sb) ,sr-l) 51 | (lambda (,sb) ,sr-r))) 52 | (== sr `(and ,sr-l ,sr-r))) 53 | ((== b `(\ ,r ,a)) 54 | (== sb `(and (lambda (,sa) ,sr-l) 55 | (lambda (,sa) ,sr-r))) 56 | (== sr `(and ,sr-l ,sr-r)))))) 57 | 58 | (--> (lex in ty sem) 59 | (conde (`(,in) (escape (lexo in ty sem))))) 60 | 61 | (--> (parse ty tree sem) 62 | (fresh (tok a b l r ls rs) 63 | (conde ((== tree `(,tok : ,ty)) 64 | (lex tok ty sem)) 65 | ((escape (combine a b ty)) 66 | (== tree `(,l ,r : ,ty)) 67 | (parse a l ls) 68 | (parse b r rs) 69 | (escape (combine-sem a ls b rs ty sem)))))) 70 | 71 | (define (test q) 72 | (fresh (text tree sem) 73 | (== q (list text tree sem)) 74 | (parse 's tree sem text '()) 75 | (membero 'and text))) 76 | 77 | ;; browse through results 78 | ;; (runi test) 79 | ;; (((bertrand wrote bertrand and bertrand) ((bertrand : np) ((wrote : (/ (\ s np) np)) ((bertrand : np) ((and : (/ (\ np np) np)) (bertrand : np) : (\ np np)) : np) : (\ s np)) : s) (wrote bertrand (and bertrand bertrand))) where) 80 | ;; (another? y/n) 81 | ;; (((bertrand wrote bertrand and terry) ((bertrand : np) ((wrote : (/ (\ s np) np)) ((bertrand : np) ((and : (/ (\ np np) np)) (terry : np) : (\ np np)) : np) : (\ s np)) : s) (wrote bertrand (and bertrand terry))) where) 82 | ;; (another? y/n) 83 | ;; (((bertrand wrote bertrand and marcel) ((bertrand : np) ((wrote : (/ (\ s np) np)) ((bertrand : np) ((and : (/ (\ np np) np)) (marcel : np) : (\ np np)) : np) : (\ s np)) : s) (wrote bertrand (and bertrand marcel))) where) 84 | ;; (another? y/n) 85 | ;; (((bertrand wrote bertrand and principia) ((bertrand : np) ((wrote : (/ (\ s np) np)) ((bertrand : np) ((and : (/ (\ np np) np)) (principia : np) : (\ np np)) : np) : (\ s np)) : s) (wrote bertrand (and bertrand principia))) where) 86 | ;; (another? y/n) 87 | ;; (((bertrand wrote bertrand and completeness) ((bertrand : np) ((wrote : (/ (\ s np) np)) ((bertrand : np) ((and : (/ (\ np np) np)) (completeness : np) : (\ np np)) : np) : (\ s np)) : s) (wrote bertrand (and bertrand completeness))) where) 88 | ;; (another? y/n) 89 | ;; (((bertrand wrote terry and bertrand) ((bertrand : np) ((wrote : (/ (\ s np) np)) ((terry : np) ((and : (/ (\ np np) np)) (bertrand : np) : (\ np np)) : np) : (\ s np)) : s) (wrote bertrand (and terry bertrand))) where) 90 | ;; (another? y/n) 91 | ;; (((bertrand met bertrand and bertrand) ((bertrand : np) ((met : (/ (\ s np) np)) ((bertrand : np) ((and : (/ (\ np np) np)) (bertrand : np) : (\ np np)) : np) : (\ s np)) : s) (met bertrand (and bertrand bertrand))) where) 92 | ;; (another? y/n) 93 | ;; (((terry wrote bertrand and bertrand) ((terry : np) ((wrote : (/ (\ s np) np)) ((bertrand : np) ((and : (/ (\ np np) np)) (bertrand : np) : (\ np np)) : np) : (\ s np)) : s) (wrote terry (and bertrand bertrand))) where) 94 | 95 | (define (test-text t q) 96 | (fresh (tree) 97 | (parse 's tree q t '()))) 98 | 99 | ;; scheme@(guile-user)> (run^ 1 (lambda (q) (test-text '(marcel conjectured and proved completeness) q))) 100 | ;; $2 = (((and (proved marcel completeness) (conjectured marcel completeness)) where)) 101 | -------------------------------------------------------------------------------- /dcg-interp.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (membero x l) 3 | (fresh (head tail) 4 | (== l `(,head . ,tail)) 5 | (conde 6 | ((== x head)) 7 | ((membero x tail))))) 8 | 9 | (define (connects w w-r r) 10 | (== w-r (cons w r))) 11 | 12 | (define (parse-body e p0 p defs) 13 | (fresh (body1 body2 p1) 14 | (== e `(,body1 . ,body2)) 15 | (conde 16 | ((== body2 '()) 17 | (parse-inner body1 p0 p defs)) 18 | ((=/= body2 '()) 19 | (parse-inner body1 p0 p1 defs) 20 | (parse-body body2 p1 p defs))))) 21 | 22 | (define (parse-list e p0 p defs) 23 | (conde 24 | ((== e `()) (== p0 p)) 25 | ((fresh (word rest p1) 26 | (== e `(,word . ,rest)) 27 | (connects word p0 p1) 28 | (parse-list rest p1 p defs))))) 29 | 30 | (define (parse-inner e p0 p defs) 31 | (conde 32 | ((fresh (body) 33 | (membero `(--> ,e . ,body) defs) 34 | (parse-body body p0 p defs))) 35 | ((fresh (e1) 36 | (== e `(quote ,e1)) 37 | (parse-list e1 p0 p defs))))) 38 | 39 | (define (parse e p0 p defs) 40 | (conde 41 | ((fresh (es) 42 | (== e `(begin . ,es)) 43 | (parse-body es p0 p defs))) 44 | ((parse-inner e p0 p defs)))) 45 | 46 | (define my-lang 47 | `((--> (noun) '(cat)) 48 | (--> (noun) '(bat)) 49 | (--> (verb) '(eats)) 50 | (--> (det) '(the)) 51 | (--> (det) '(a)) 52 | 53 | (--> (s) (det) (noun) (verb) (det) (noun)) 54 | (--> (s!) (s) '(!)))) 55 | 56 | ;; (parse '(s!) x '() my-lang) 57 | 58 | (define prog3-10 59 | '((--> (s) (np) (vp)) 60 | (--> (np) (det) (n) (optrel)) 61 | (--> (np) (pn)) 62 | (--> (vp) (tv) (np)) 63 | (--> (vp) (iv)) 64 | (--> (optrel) '()) 65 | (--> (optrel) '(that) (vp)) 66 | (--> (pn) '(terry)) 67 | (--> (pn) '(shrdlu)) 68 | (--> (iv) '(halts)) 69 | (--> (det) '(a)) 70 | (--> (n) '(program)) 71 | (--> (tv) '(writes)))) 72 | 73 | ;; (parse '(s) x '() prog3-10) 74 | -------------------------------------------------------------------------------- /dcg-macro.scm: -------------------------------------------------------------------------------- 1 | (define appendo 2 | (lambda (l s out) 3 | (conde 4 | ((== '() l) (== s out)) 5 | ((fresh (a d res) 6 | (== `(,a . ,d) l) 7 | (== `(,a . ,res) out) 8 | (appendo d s res)))))) 9 | 10 | (define-syntax term 11 | (syntax-rules (quote == escape quasiquote) 12 | ((_ (quote t) in out) (appendo (quote t) out in)) 13 | ((_ (quasiquote t) in out) (appendo (quasiquote t) out in)) 14 | ((_ (== x y) in out) (fresh () (== x y) (== out in))) 15 | ((_ (escape g ...) in out) (fresh () (== out in) g ...)) 16 | ((_ (t ...) in out) (t ... in out)))) 17 | 18 | (define-syntax conj 19 | (syntax-rules () 20 | ((_ (f) in out) (term f in out)) 21 | ((_ (f r ...) in out) 22 | (fresh (mid) 23 | (term f in mid) 24 | (conj (r ...) mid out))))) 25 | 26 | (define-syntax --> 27 | (syntax-rules (fresh conde) 28 | 29 | ;; fresh is optional 30 | ((_ (name args ...) 31 | (conde (g ...) ...)) 32 | (--> (name args ...) 33 | (fresh () 34 | (conde (g ...) ...)))) 35 | 36 | ((_ (name args ...) 37 | (fresh (vars ...) 38 | (conde (g ...) ...))) 39 | (define (name args ... in out) 40 | (fresh (vars ...) 41 | (conde ((conj (g ...) in out)) ...)))))) 42 | -------------------------------------------------------------------------------- /dcg-manual.scm: -------------------------------------------------------------------------------- 1 | (define appendo 2 | (lambda (l s out) 3 | (conde 4 | ((== '() l) (== s out)) 5 | ((fresh (a d res) 6 | (== `(,a . ,d) l) 7 | (== `(,a . ,res) out) 8 | (appendo d s res)))))) 9 | 10 | ;(--> (s) ((np) (vp)) 11 | (define (s in out) 12 | (fresh (mid1) 13 | (conde 14 | ((np in mid1) 15 | (vp mid1 out))))) 16 | 17 | ;(--> (np) ((det) (n) (optrel)) 18 | ; ((np) (pn))) 19 | (define (np in out) 20 | (fresh (mid1 mid2) 21 | (conde 22 | ((det in mid1) 23 | (n mid1 mid2) 24 | (optrel mid2 out)) 25 | ((np in mid1) 26 | (pn mid1 out))))) 27 | 28 | ;(--> (vp) ((tv) (np)) 29 | ; ((iv))) 30 | (define (vp in out) 31 | (fresh (mid1) 32 | (conde 33 | ((tv in mid1) 34 | (np mid1 out)) 35 | ((iv in out))))) 36 | 37 | ;(--> (optrel) ('()) 38 | ; ('(that) (vp))) 39 | (define (optrel in out) 40 | (fresh (mid1) 41 | (conde 42 | ((== in out)) 43 | ((appendo '(that) mid1 in) 44 | (vp mid1 out))))) 45 | 46 | ;(--> (pn) ('(terry)) 47 | ; ('(shrdlu))) 48 | (define (pn in out) 49 | (conde 50 | ((appendo '(terry) out in)) 51 | ((appendo '(shrdlu) out in)))) 52 | 53 | ;(--> (iv) ('(halts))) 54 | (define (iv in out) 55 | (conde 56 | ((appendo '(halts) out in)))) 57 | 58 | ;(--> (det) ('(a))) 59 | (define (det in out) 60 | (conde 61 | ((appendo '(a) out in)))) 62 | 63 | ;(--> (n) ('(program))) 64 | (define (n in out) 65 | (conde 66 | ((appendo '(program) out in)))) 67 | 68 | ;(--> (tv) ('(writes))))) 69 | (define (tv in out) 70 | (conde 71 | ((appendo '(writes) out in)))) 72 | 73 | -------------------------------------------------------------------------------- /dcg.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language)) 2 | 3 | (define appendo 4 | (lambda (l s out) 5 | (conde 6 | ((== '() l) (== s out)) 7 | ((fresh (a d res) 8 | (== `(,a . ,d) l) 9 | (== `(,a . ,res) out) 10 | (appendo d s res)))))) 11 | 12 | (define-syntax term 13 | (syntax-rules (quote) 14 | ((_ in out (quote t)) (appendo (quote t) out in)) 15 | ((_ in out (t ...)) (t ... in out)))) 16 | 17 | (define-syntax conj 18 | (syntax-rules () 19 | ((_ in out (f)) (term in out f)) 20 | ((_ in out (f r ...)) 21 | (fresh (mid) 22 | (term in mid f) 23 | (conj mid out (r ...)))))) 24 | 25 | (define-syntax --> 26 | (syntax-rules () 27 | ((_ (name args ...) (g ...) ...) 28 | (define (name in out args ...) 29 | (conde ((conj in out (g ...))) ...))))) 30 | 31 | (--> (s) ((np) (vp))) 32 | (--> (np) ((det) (n) (optrel)) 33 | ((np) (pn))) 34 | (--> (vp) ((tv) (np)) 35 | ((iv))) 36 | (--> (optrel) ('()) 37 | ('(that) (vp))) 38 | (--> (pn) ('(terry)) 39 | ('(shrdlu))) 40 | (--> (iv) ('(halts))) 41 | (--> (det) ('(a))) 42 | (--> (n) ('(program))) 43 | (--> (tv) ('(writes))) 44 | 45 | (runi (lambda (q) 46 | (fresh (in out) 47 | (== q (list in out)) 48 | (s in out)))) 49 | -------------------------------------------------------------------------------- /dcg2.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language)) 2 | 3 | (define appendo 4 | (lambda (l s out) 5 | (conde 6 | ((== '() l) (== s out)) 7 | ((fresh (a d res) 8 | (== `(,a . ,d) l) 9 | (== `(,a . ,res) out) 10 | (appendo d s res)))))) 11 | 12 | 13 | (define-syntax term 14 | (syntax-rules (quote ==) 15 | ((_ (quote t) in out) (appendo (quote t) out in)) 16 | ((_ (== x y) in out) (fresh () (== x y) (== out in))) 17 | ((_ (t ...) in out) (t ... in out)))) 18 | 19 | (define-syntax conj 20 | (syntax-rules () 21 | ((_ (f) in out) (term f in out)) 22 | ((_ (f r ...) in out) 23 | (fresh (mid) 24 | (term f in mid) 25 | (conj (r ...) mid out))))) 26 | 27 | (define-syntax --> 28 | (syntax-rules (fresh conde) 29 | 30 | ;; fresh is optional 31 | ((_ (name args ...) 32 | (conde (g ...) ...)) 33 | (--> (name args ...) 34 | (fresh () 35 | (conde (g ...) ...)))) 36 | 37 | ((_ (name args ...) 38 | (fresh (vars ...) 39 | (conde (g ...) ...))) 40 | (define (name args ... in out) 41 | (fresh (vars ...) 42 | (conde ((conj (g ...) in out)) ...)))))) 43 | 44 | 45 | ;s(s(NP,VP)) --> np(NP), vp(VP). 46 | (--> (s x) 47 | (fresh (np- vp-) 48 | (conde ((== x `(s ,np- ,vp-)) (np np-) (vp vp-))))) 49 | 50 | 51 | ;np(np(Det,N,Rel)) --> det(Det), n(N), optrel(Rel). 52 | ;np(np(PN)) --> pn(PN). 53 | (--> (np x) 54 | (fresh (det- n- rel- np- pn-) 55 | (conde 56 | ((== x `(np ,det- ,n- ,rel-)) 57 | (det det-) (n n-) (optrel rel-)) 58 | ((== x `(np ,pn-)) (pn pn-))))) 59 | 60 | ;vp(vp(TV,NP)) --> tv(TV), np(NP). 61 | ;vp(vp(IV)) --> iv(IV). 62 | (--> (vp x) 63 | (fresh (tv- np- iv-) 64 | (conde ((== x `(vp ,tv- ,np-)) (tv tv-) (np np-)) 65 | ((== x `(vp ,iv-)) (iv iv-))))) 66 | 67 | ;optrel(rel(epsilon)) --> []. 68 | ;optrel(rel(that,VP)) --> [that], vp(VP). 69 | (--> (optrel x) 70 | (fresh (vp-) 71 | (conde 72 | ((== x `(rel epsilon)) '()) 73 | ((== x `(rel that ,vp-)) '(that) (vp vp-))))) 74 | 75 | ;pn(pn(terry)) --> [terry]. 76 | ;pn(pn(shrdlu)) --> [shrdlu]. 77 | (--> (pn x) 78 | (conde 79 | ((== x `(pn terry)) '(terry)) 80 | ((== x `(pn shrdlu)) '(shrdlu)))) 81 | 82 | 83 | ;iv(iv(halts)) --> [halts]. 84 | (--> (iv x) 85 | (conde ((== x `(iv halts)) '(halts)))) 86 | 87 | ;det(det(a)) --> [a]. 88 | (--> (det x) 89 | (conde ((== x `(det a)) '(a)))) 90 | 91 | ;n(n(program)) --> [program]. 92 | (--> (n x) 93 | (conde ((== x `(n program)) '(program)))) 94 | 95 | ;tv(tv(writes)) --> [writes]. 96 | (--> (tv x) 97 | (conde ((== x `(tv writes)) '(writes)))) 98 | 99 | (--> (test x) 100 | (conde ((pn x)))) 101 | 102 | (runi (lambda (m) 103 | (fresh (x q) 104 | (== m `(,x - ,q)) 105 | (s q '(terry writes a program that halts) '())))) 106 | 107 | 108 | (runi (lambda (m) 109 | (fresh (x q) 110 | (== m `(,x - ,q)) 111 | (np q '(a program) '())))) 112 | -------------------------------------------------------------------------------- /dcg3.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language)) 2 | 3 | (define appendo 4 | (lambda (l s out) 5 | (conde 6 | ((== '() l) (== s out)) 7 | ((fresh (a d res) 8 | (== `(,a . ,d) l) 9 | (== `(,a . ,res) out) 10 | (appendo d s res)))))) 11 | 12 | 13 | (define-syntax term 14 | (syntax-rules (quote == escape quasiquote) 15 | ((_ (quote t) in out) (appendo (quote t) out in)) 16 | ((_ (quasiquote t) in out) (appendo (quasiquote t) out in)) 17 | ((_ (== x y) in out) (fresh () (== x y) (== out in))) 18 | ((_ (escape g ...) in out) (fresh () (== out in) g ...)) 19 | ((_ (t ...) in out) (t ... in out)))) 20 | 21 | (define-syntax conj 22 | (syntax-rules () 23 | ((_ (f) in out) (term f in out)) 24 | ((_ (f r ...) in out) 25 | (fresh (mid) 26 | (term f in mid) 27 | (conj (r ...) mid out))))) 28 | 29 | (define-syntax --> 30 | (syntax-rules (fresh conde) 31 | 32 | ;; fresh is optional 33 | ((_ (name args ...) 34 | (conde (g ...) ...)) 35 | (--> (name args ...) 36 | (fresh () 37 | (conde (g ...) ...)))) 38 | 39 | ((_ (name args ...) 40 | (fresh (vars ...) 41 | (conde (g ...) ...))) 42 | (define (name args ... in out) 43 | (fresh (vars ...) 44 | (conde ((conj (g ...) in out)) ...)))))) 45 | 46 | ;; s --> np, vp. 47 | (--> (s) (conde ((np) (vp)))) 48 | 49 | ;; np --> det, n, optrel. 50 | ;; np --> pn. 51 | (--> (np) (conde ((det) (n) (optrel)) 52 | ((pn)))) 53 | 54 | ;; vp --> tv, np. 55 | ;; vp --> iv. 56 | (--> (vp) (conde ((tv) (np)) 57 | ((iv)))) 58 | 59 | ;; optrel --> []. 60 | ;; optrel --> [that], vp. 61 | (--> (optrel) (conde ('()) 62 | ('(that) (vp)))) 63 | 64 | ;; det --> [Det], {det(Det)}. 65 | (--> (det) 66 | (fresh (det-) 67 | (conde (`(,det-) (escape (deto det-)))))) 68 | 69 | ;; det(a). det(every). 70 | ;; det(some). det(the). 71 | (define (deto s) 72 | (conde ((== s 'a)) ((== s 'every)) 73 | ((== s 'some)) ((== s 'the)))) 74 | 75 | ;; n --> [N], {n(N)}. 76 | (--> (n) (fresh (n-) (conde (`(,n-) (escape (no n-)))))) 77 | 78 | ;; n(author). n(book). 79 | ;; n(professor). n(program). 80 | ;; n(programmer). n(student). 81 | (define (no s) 82 | (conde ((== s 'author)) ((== s 'book)) 83 | ((== s 'professor)) ((== s 'program)) 84 | ((== s 'programmer)) ((== s 'student)))) 85 | 86 | 87 | ;; pn --> [PN], {pn(PN)}. 88 | (--> (pn) (fresh (pn-) (conde (`(,pn-) (escape (pno pn-)))))) 89 | 90 | ;; pn(begriffsschrift). pn(bertrand). 91 | ;; pn(bill). pn(gottlob). 92 | ;; pn(lunar). pn(principia). 93 | ;; pn(shrdlu). pn(terry). 94 | (define (pno s) 95 | (conde ((== s 'begriffsschrift)) ((== s 'bertrand)) 96 | ((== s 'bill)) ((== s 'gottlob)) 97 | ((== s 'lunar)) ((== s 'principia)) 98 | ((== s 'shrdlu)) ((== s 'terry)))) 99 | 100 | 101 | ;; tv --> [TV], {tv(TV)}. 102 | (--> (tv) 103 | (fresh (tv-) 104 | (conde (`(,tv-) (escape (tvo tv-)))))) 105 | 106 | ;; tv(concerns). tv(met). 107 | ;; tv(ran). tv(wrote). 108 | (define (tvo s) 109 | (conde ((== s 'concerns)) ((== s 'met)) 110 | ((== s 'ran)) ((== s 'wrote)))) 111 | 112 | ;; iv --> [IV], {iv(IV)}. 113 | (--> (iv) 114 | (fresh (iv-) 115 | (conde (`(,iv-) (escape (ivo iv-)))))) 116 | 117 | (define (ivo s) (fresh () (== s 'halted))) 118 | 119 | (runi (lambda (q) (s q '()))) 120 | -------------------------------------------------------------------------------- /lf.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | ;;Program 4.1 5 | ;; reduce(ArgˆExpr, Arg, Expr). 6 | (define (reduceo ae a e) (== ae `(lambda (,a) ,e))) 7 | 8 | ;; ?- reduce(Xˆhalts(X), shrdlu, LF). 9 | ;; (runi (lambda (lf) (fresh (x) (reduceo `(lambda (,x) (halts ,x)) 'shrdlu lf)))) 10 | 11 | 12 | ;;s(S) --> np(NP), vp(VP), {reduce(VP,NP,S)}. 13 | (--> (s s-) 14 | (fresh (np- vp-) 15 | (conde ;; ((np np-) (vp vp-) (escape (reduceo vp- np- s-))) 16 | ;; partially executed 17 | ;; np(NP), vp(VP^S). 18 | ((np np-) (vp `(lambda (,np-) ,s-)))))) 19 | 20 | 21 | ;; vp(VP) --> tv(TV), np(NP), {reduce(TV, NP, VP)}. 22 | ;; vp(VP) --> iv(VP). 23 | (--> (vp vp-) 24 | (fresh (tv- np-) 25 | (conde ;;((tv tv-) (np np-) (escape (reduceo tv- np- vp-))) 26 | ;; partially executed 27 | ;; tv(NPˆVP), np(NP). 28 | ((tv `(lambda (,np-) ,vp-)) (np np-)) 29 | ((iv vp-))))) 30 | 31 | ;; tv(XˆYˆwrote(Y,X)) --> [wrote]. 32 | (--> (tv exp) 33 | (fresh (x y) 34 | (conde ((== exp `(lambda (,x) (lambda (,y) (wrote ,y ,x)))) 35 | '(wrote))))) 36 | 37 | ;; iv(Xˆhalts(X)) --> [halts]. 38 | (--> (iv exp) 39 | (fresh (x) 40 | (conde ((== exp `(lambda (,x) (halts ,x))) 41 | '(halts))))) 42 | 43 | ;; np(shrdlu) --> [shrdlu]. 44 | ;; np(terry) --> [terry]. 45 | (--> (np x) 46 | (conde ((== x 'shrdlu) 47 | '(shrdlu)) 48 | ((== x 'terry) 49 | '(terry)))) 50 | 51 | 52 | ;; ?- s(LF, [shrdlu, halts], []). 53 | ;; LF = halts(shrdlu) yes 54 | (runi (lambda (lf) (s lf '(shrdlu halts) '()))) 55 | 56 | ;; ?- s(LF, [terry, wrote, shrdlu], []). 57 | ;; LF = wrote(terry, shrdlu) yes 58 | (runi (lambda (lf) (s lf '(terry wrote shrdlu) '()))) 59 | -------------------------------------------------------------------------------- /lf2.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | ;;Program 4.1 5 | ;; reduce(ArgˆExpr, Arg, Expr). 6 | (define (reduceo ae a e) (== ae `(lambda (,a) ,e))) 7 | 8 | 9 | ;; s(S) --> np(VPˆS), vp(VP). 10 | (--> (s s-) 11 | (fresh (np- vp-) 12 | (conde ((np `(lambda (,vp-) ,s-)) (vp vp-))))) 13 | 14 | 15 | (--> (n n-) 16 | (fresh (x-) 17 | (conde ('(program) 18 | ;; Xˆprogram(X) 19 | (== lf- `(lambda (,x-) (program ,x-))))))) 20 | 21 | ;; λp.λq.(∀x)p(x) ⇒ q(x) 22 | ;; `(lambda (,p) `(lambda (,q) (all ,x (=> (,p ,x) (,q ,x))))) 23 | ;; partially executed 24 | ;; det( (X^P)^(X^Q)^all(X,(P => Q)) ) --> [every]. 25 | (--> (det a) 26 | (fresh (x p q x^p x^q) 27 | (conde ((== x^p `(lambda (,x) ,p)) 28 | (== x^q `(lambda (,x) ,q)) 29 | (== a `(lambda (,x^p) 30 | (lambda (,x^q) 31 | (all ,x (=> ,p ,q))))) 32 | '(every))))) 33 | 34 | 35 | ;; vp(VP) --> tv(TV), np(NP), {reduce(TV, NP, VP)}. 36 | ;; vp(VP) --> iv(VP). 37 | (--> (vp vp-) 38 | (fresh (tv- np-) 39 | (conde ;;((tv tv-) (np np-) (escape (reduceo tv- np- vp-))) 40 | ;; partially executed 41 | ;; tv(NPˆVP), np(NP). 42 | ((tv `(lambda (,np-) ,vp-)) (np np-)) 43 | ((iv vp-))))) 44 | 45 | 46 | ;; iv(LF) --> [IV], {iv(IV, LF)}. 47 | ;; iv( halts, Xˆhalts(X) ). 48 | (--> (iv lf-) 49 | (fresh (x-) 50 | (conde ('(halts) (== lf- `(lambda (,x-) (halts ,x-))))))) 51 | 52 | (--> (tv lf-) 53 | (fresh (x-) 54 | (conde ('(wrote) (== lf- `(lambda (,x-) (wrote ,x-))))))) 55 | 56 | 57 | ;; np(NP) --> det(NˆNP), n(N). 58 | (--> (np np-) 59 | (fresh (n-) 60 | (conde ((det `(lambda (,n-) ,np-)) (n n-))))) 61 | 62 | (runi (lambda (lf) (s lf '(every program halts) '()))) 63 | -------------------------------------------------------------------------------- /lf3.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | (define (reduceo ae a e) (== ae `(lambda (,a) ,e))) 5 | ;; Program 4.2 6 | 7 | ;; s(S) --> np(VPˆS), vp(VP). 8 | (--> (s s-) 9 | (fresh (np- vp-) 10 | (conde ((np `(lambda (,vp-) ,s-)) (vp vp-))))) 11 | 12 | ;; np(NP) --> det(N2ˆNP), n(N1), optrel(N1ˆN2). 13 | ;; np((EˆS)ˆS) --> pn(E). 14 | (--> (np np-) 15 | (fresh (n1- n2- e- s-) 16 | (conde ((det `(lambda (,n2-) ,np-)) 17 | (n n1-) 18 | (optrel `(lambda (,n1-) ,n2-))) 19 | ((== np- `(lambda ((lambda (,e-) ,s-)) ,s-)) 20 | (pn e-))))) 21 | 22 | 23 | ;; vp(XˆS) --> tv(XˆIV), np(IVˆS). 24 | ;; vp(IV) --> iv(IV). 25 | (--> (vp lf-) 26 | (fresh (x- s- iv-) 27 | (conde ((== lf- `(lambda (,x-) ,s-)) 28 | (tv `(lambda (,x-) ,iv-)) 29 | (np `(lambda (,iv-) ,s-))) 30 | ((iv lf-))))) 31 | 32 | ;; optrel((XˆS1)ˆ(Xˆ(S1 & S2))) --> [that], vp(XˆS2). 33 | ;; optrel(NˆN) --> []. 34 | (--> (optrel lf-) 35 | (fresh (x x^s1 s1 s2) 36 | (conde ((== x^s1 `(lambda (,x) ,s1)) 37 | (== lf- `(lambda (,x^s1) (lambda (,x) (& ,s1 ,s2)))) 38 | '(that) 39 | (vp `(lambda (,x) ,s2))) 40 | ('() 41 | (== lf- `(lambda (,x) ,x)))))) 42 | 43 | 44 | ;; det(LF) --> [D], {det(D, LF)}. 45 | ;; det( every, (XˆS1)ˆ(XˆS2)ˆall(X,(S1=>S2)) ). 46 | ;; det( a, (XˆS1)ˆ(XˆS2)ˆexists(X,S1&S2) ). 47 | (--> (det lf-) 48 | (fresh (d-) 49 | (conde (`(,d-) (escape (deto d- lf-)))))) 50 | 51 | (define (deto d lf) 52 | (fresh (dq x q p x^p x^q) 53 | (conde ((== d 'every) 54 | (== dq `(all ,x (=> ,p ,q)))) 55 | ((== d 'a) 56 | (== dq `(exists ,x (& ,p ,q))))) 57 | (== x^p `(lambda (,x) ,p)) 58 | (== x^q `(lambda (,x) ,q)) 59 | (== lf `(lambda (,x^p) (lambda (,x^q) ,dq))))) 60 | 61 | 62 | ;; n(LF) --> [N], {n(N, LF)}. 63 | ;; n( program, Xˆprogram(X) ). 64 | ;; n( student, Xˆstudent(X) ). 65 | (--> (n lf-) (fresh (n-) (conde (`(,n-) (escape (no n- lf-)))))) 66 | 67 | (define (no n lf) 68 | (fresh (x) 69 | (conde ((== n 'program)) 70 | ((== n 'student))) 71 | (== lf `(lambda (,x) (,n ,x))))) 72 | 73 | ;; pn(E) --> [PN], {pn(PN, E)}. 74 | ;; pn( terry, terry ). 75 | ;; pn( shrdlu, shrdlu ). 76 | (--> (pn e-) 77 | (fresh (pn-) 78 | (conde (`(,pn-) (escape (pno pn- e-)))))) 79 | 80 | (define (pno pn- e-) 81 | (conde ((== pn- 'terry) (== e- 'terry)) 82 | ((== pn- 'shrdlu) (== e- 'shrdlu)))) 83 | 84 | ;; tv(LF) --> [TV], {tv(TV, LF)}. 85 | ;; tv( wrote, XˆYˆwrote(X,Y) ). 86 | (--> (tv lf-) 87 | (fresh (tv- x y) 88 | (conde (`(,tv-) 89 | (== tv- 'wrote) 90 | (== lf- `(lambda (,x) 91 | (lambda (,y) 92 | (wrote ,x ,y)))))))) 93 | 94 | ;; iv(LF) --> [IV], {iv(IV, LF)}. 95 | ;; iv( halts, Xˆhalts(X) ). 96 | (--> (iv lf-) 97 | (fresh (x-) 98 | (conde ('(halts) (== lf- `(lambda (,x-) (halts ,x-))))))) 99 | 100 | 101 | (runi (lambda (lf) (fresh (x) (s lf `(terry wrote shrdlu) '())))) 102 | 103 | (runi (lambda (lf) (s lf `(every program halts) '()))) 104 | 105 | (runi (lambda (lf) (s lf `(every student wrote a program) '()))) 106 | -------------------------------------------------------------------------------- /lf4.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | (define (reduceo ae a e) (== ae `(lambda (,a) ,e))) 5 | ;; Program 4.3 6 | 7 | ;; s(S) --> np(VPˆS), vp(VP). 8 | (--> (s t-) 9 | (fresh (np- vp- s-) 10 | (conde ((np `(lambda (,vp-) ,s-)) (vp vp-) 11 | (escape (pullo/2 s- t-)) 12 | )))) 13 | 14 | ;; np(NP) --> det(N2ˆNP), n(N1), optrel(N1ˆN2). 15 | ;; np((EˆS)ˆS) --> pn(E). 16 | (--> (np np-) 17 | (fresh (n1- n2- e- s-) 18 | (conde ((det `(lambda (,n2-) ,np-)) 19 | (n n1-) 20 | (optrel `(lambda (,n1-) ,n2-))) 21 | ((== np- `(lambda ((lambda (,e-) ,s-)) ,s-)) 22 | (pn e-))))) 23 | 24 | 25 | ;; vp(XˆS) --> tv(XˆIV), np(IVˆS). 26 | ;; vp(IV) --> iv(IV). 27 | (--> (vp lf-) 28 | (fresh (x- s- iv-) 29 | (conde ((== lf- `(lambda (,x-) ,s-)) 30 | (tv `(lambda (,x-) ,iv-)) 31 | (np `(lambda (,iv-) ,s-))) 32 | ((iv lf-))))) 33 | 34 | ;; optrel((XˆS1)ˆ(Xˆ(S1 & S2))) --> [that], vp(XˆS2). 35 | ;; optrel(NˆN) --> []. 36 | (--> (optrel lf-) 37 | (fresh (x x^s1 s1 s2) 38 | (conde ((== x^s1 `(lambda (,x) ,s1)) 39 | (== lf- `(lambda (,x^s1) (lambda (,x) (& ,s1 ,s2)))) 40 | '(that) 41 | (vp `(lambda (,x) ,s2))) 42 | ('() 43 | (== lf- `(lambda (,x) ,x)))))) 44 | 45 | 46 | ;; det(LF) --> [D], {det(D, LF)}. 47 | ;; det( every, (XˆS1)ˆ(XˆS2)ˆq(PˆQˆall(X,P=>Q),S1,S2) ). 48 | ;; det( a, (XˆS1)ˆ(XˆS2)ˆq(PˆQˆexists(X,P&Q),S1,S2) ). 49 | (--> (det lf-) 50 | (fresh (d-) 51 | (conde (`(,d-) (escape (deto d- lf-)))))) 52 | 53 | (define (deto d lf) 54 | (fresh (dq x s1 s2 x^s1 x^s2 p q) 55 | (== x^s1 `(lambda (,x) ,s1)) 56 | (== x^s2 `(lambda (,x) ,s2)) 57 | (== lf `(lambda (,x^s1) (lambda (,x^s2) ,dq))) 58 | (conde ((== d 'every) 59 | (== dq `(q (lambda (,p) (lambda (,q) (all ,x (=> ,p ,q)))) ,s1 ,s2))) 60 | ((== d 'a) 61 | (== dq `(q (lambda (,p) (lambda (,q) (exists ,x (& ,p ,q)))) ,s1 ,s2)))))) 62 | 63 | ;; n(LF) --> [N], {n(N, LF)}. 64 | ;; n( book, Xˆ(‘book(X)) ). 65 | ;; n( professor, Xˆ(‘professor(X)) ). 66 | ;; n( program, Xˆ(‘program(X)) ). 67 | ;; n( student, Xˆ(‘student(X)) ). 68 | (--> (n lf-) (fresh (n-) (conde (`(,n-) (escape (no n- lf-)))))) 69 | 70 | (define (no n lf) 71 | (fresh (x) 72 | (conde ((== n 'program)) 73 | ((== n 'student)) 74 | ((== n 'book)) 75 | ((== n 'professor))) 76 | (== lf `(lambda (,x) (unscoped (,n ,x)))))) 77 | 78 | ;; pn(E) --> [PN], {pn(PN, E)}. 79 | ;; pn( terry, terry ). 80 | ;; pn( shrdlu, shrdlu ). 81 | (--> (pn e-) 82 | (fresh (pn-) 83 | (conde (`(,pn-) (escape (pno pn- e-)))))) 84 | 85 | (define (pno pn- e-) 86 | (conde ((== pn- 'terry) (== e- 'terry)) 87 | ((== pn- 'shrdlu) (== e- 'shrdlu)))) 88 | 89 | ;; tv(LF) --> [TV], {tv(TV, LF)}. 90 | ;; tv( ran, XˆYˆ(‘ran(X,Y)) ). 91 | ;; tv( wrote, XˆYˆ(‘wrote(X,Y)) ). 92 | (--> (tv lf-) 93 | (fresh (tv-) 94 | (conde (`(,tv-) (escape (tvo tv- lf-)))))) 95 | 96 | (define (tvo tv- lf-) 97 | (fresh (x y lf1-) 98 | (== lf- `(lambda (,x) (lambda (,y) (unscoped ,lf1-)))) 99 | (conde 100 | ((== tv- 'wrote) (== lf1- `(wrote ,x ,y))) 101 | ((== tv- 'ran) (== lf1- `(ran ,x ,y)))))) 102 | 103 | ;; iv(LF) --> [IV], {iv(IV, LF)}. 104 | ;; iv( halts, Xˆhalts(X) ). 105 | (--> (iv lf-) 106 | (fresh (x-) 107 | (conde ('(halts) (== lf- `(lambda (,x-) (unscoped (halts ,x-)))))))) 108 | 109 | ;; pull(‘Predication, Predication, []). 110 | ;; pull(QuantTree1 & QuantTree2, Formula1 & Formula2, Store) :- 111 | ;; pull(QuantTree1, Matrix1, Store1), 112 | ;; pull(QuantTree2, Matrix2, Store2), 113 | ;; conc(Pass1, Apply1, Store1), 114 | ;; conc(Pass2, Apply2, Store2), 115 | ;; apply_quants(Apply1, Matrix1, Formula1), 116 | ;; apply_quants(Apply2, Matrix2, Formula2), 117 | ;; shuffle(Pass1, Pass2, Store). 118 | 119 | ;; pull(q(Quantifier, RangeTree, ScopeTree), Matrix, Store) :- 120 | ;; pull(RangeTree, RangeMatrix, RangeStore), 121 | ;; pull(ScopeTree, Matrix, ScopeStore), 122 | ;; conc(RangePass, RangeApply, RangeStore), 123 | ;; apply_quants(RangeApply, RangeMatrix, Range), 124 | ;; reduce(Quantifier, Range, StoreElement), 125 | ;; conc(RangePass, [StoreElement], Pass), 126 | 127 | (define (pullo qt matrix store) 128 | (conde 129 | ((== qt `(unscoped ,matrix)) (== store '())) 130 | ((fresh (qt1 qt2 f1 f2 store1 store2 131 | pass1 pass2 apply1 apply2 matrix1 matrix2) 132 | (== `(& ,qt1 ,qt2) qt) 133 | (== `(& ,f1 ,f2) matrix) 134 | (pullo qt1 matrix1 store1) 135 | (pullo qt2 matrix2 store2) 136 | (appendo pass1 apply1 store1) 137 | (appendo pass2 apply2 store2) 138 | (apply-quantso apply1 matrix1 f1) 139 | (apply-quantso apply2 matrix2 f2) 140 | (shuffleo pass1 pass2 store))) 141 | ((fresh (quantifier range-tree scope-tree range range-store range-matrix scope-store 142 | range-pass range-apply store-element pass) 143 | (== qt `(q ,quantifier ,range-tree ,scope-tree)) 144 | (pullo range-tree range-matrix range-store) 145 | (pullo scope-tree matrix scope-store) 146 | (appendo range-pass range-apply range-store) 147 | (apply-quantso range-apply range-matrix range) 148 | (reduceo quantifier range store-element) 149 | (appendo range-pass `(,store-element) pass) 150 | (shuffleo pass scope-store store))))) 151 | 152 | ;; apply_quants([], Formula, Formula). 153 | ;; apply_quants([StoreElement|Elements], Matrix, Formula) :- 154 | ;; apply_quants(Elements, Matrix, SubFormula), 155 | ;; reduce(StoreElement, SubFormula, Formula). 156 | (define (apply-quantso store matrix formula) 157 | (conde 158 | ((== store '()) (== matrix formula)) 159 | ((fresh (store-element elements subformula) 160 | (== store `(,store-element . ,elements)) 161 | (apply-quantso elements matrix subformula) 162 | (reduceo store-element subformula formula))))) 163 | 164 | (define (pullo/2 quant-tree formula) 165 | (fresh (matrix store) 166 | (pullo quant-tree matrix store) 167 | (apply-quantso store matrix formula))) 168 | 169 | ;; - s(LF, [every,professor,that,wrote,a,book,ran,a,program], []). 170 | (runi (lambda (lf) (fresh (x) (s lf `(every professor that wrote a book ran a program) '())))) 171 | 172 | ;; without pull 173 | ;; --- 174 | ;; (q (lambda (_.0) (lambda (_.1) (all _.2 (=> _.0 _.1)))) 175 | ;; (& (unscoped (professor _.2)) 176 | ;; (q (lambda (_.3) (lambda (_.4) (exists _.5 (& _.3 _.4)))) 177 | ;; (unscoped (book _.5)) 178 | ;; (unscoped (wrote _.2 _.5)))) 179 | ;; (q (lambda (_.6) (lambda (_.7) (exists _.8 (& _.6 _.7)))) 180 | ;; (unscoped (program _.8)) 181 | ;; (unscoped (ran _.2 _.8)))) 182 | ;; --- 183 | ;; 184 | ;; ((exists _.0 (& (program _.0) 185 | ;; (all _.1 (=> (& (professor _.1) 186 | ;; (exists _.2 (& (book _.2) 187 | ;; (wrote _.1 _.2)))) 188 | ;; (ran _.1 _.0))))) where) 189 | ;; (another? y/n) 190 | ;; y 191 | ;; ((all _.0 (=> (& (professor _.0) 192 | ;; (exists _.1 (& (book _.1) (wrote _.0 _.1)))) 193 | ;; (exists _.2 (& (program _.2) (ran _.0 _.2))))) where) 194 | ;; (another? y/n) 195 | ;; y 196 | ;; ((exists _.0 (& (program _.0) 197 | ;; (all _.1 (=> (exists _.2 (& (book _.2) (& (professor _.1) (wrote _.1 _.2)))) 198 | ;; (ran _.1 _.0))))) where) 199 | ;; (another? y/n) 200 | ;; y 201 | ;; ((exists _.0 (& (program _.0) 202 | ;; (exists _.1 (& (book _.1) (all _.2 (=> (& (professor _.2) (wrote _.2 _.1)) (ran _.2 _.0))))))) where) 203 | ;; (another? y/n) 204 | ;; y 205 | ;; ((all _.0 (=> (exists _.1 (& (book _.1) (& (professor _.0) (wrote _.0 _.1)))) 206 | ;; (exists _.2 (& (program _.2) (ran _.0 _.2))))) where) 207 | ;; (another? y/n) 208 | ;; y 209 | ;; ((exists _.0 (& (book _.0) 210 | ;; (exists _.1 (& (program _.1) 211 | ;; (all _.2 (=> (& (professor _.2) (wrote _.2 _.0)) 212 | ;; (ran _.2 _.1))))))) where) 213 | ;; (another? y/n) 214 | ;; y 215 | ;; ((exists _.0 (& (book _.0) 216 | ;; (all _.1 (=> (& (professor _.1) (wrote _.1 _.0)) 217 | ;; (exists _.2 (& (program _.2) (ran _.1 _.2))))))) where) 218 | ;; (another? y/n) 219 | ;; y 220 | ;; thats-all! 221 | -------------------------------------------------------------------------------- /lf5.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | (define (shuffleo l r s) 5 | (conde ((== r '()) (== l s)) 6 | ((fresh (l1 lrest e rrest srest) 7 | (== r `(,e . ,rrest)) 8 | (appendo l1 lrest l) 9 | (shuffleo lrest rrest srest) 10 | (appendo l1 `(,e . ,srest) s))))) 11 | 12 | (--> (iv form-) 13 | (fresh (iv-) 14 | (conde (`(,iv-) (escape (ivo iv- form-)))))) 15 | 16 | (define (ivo iv- form-) 17 | (conde ((== iv- 'halts) (== form- 'finite)) 18 | ((== iv- 'halt) (== form- 'nonfinite)) 19 | ((== iv- 'halting) (== form- 'present_participle)) 20 | ((== iv- 'halted) (== form- 'past_participle)))) 21 | 22 | (--> (aux form-) 23 | (fresh (aux-) 24 | (conde (`(,aux-) (escape (auxo aux- form-)))))) 25 | 26 | (define (auxo aux- form-) 27 | (conde ((== aux- 'could) (== form- `(/ finite nonfinite))) 28 | ((== aux- 'have) (== form- `(/ nonfinite past_participle))) 29 | ((== aux- 'has) (== form- `(/ finite past_participle))) 30 | ((== aux- 'been) (== form- `(/ past_participle present_participle))) 31 | ((== aux- 'be) (== form- `(/ nonfinite present_participle))))) 32 | 33 | (--> (vp form-) 34 | (fresh (require-) 35 | (conde ((iv form-)) 36 | ((tv form-) (np)) 37 | ((aux `(/ ,form- ,require-)) (vp require-))))) 38 | 39 | (--> (s) (conde ((np) (vp 'finite)))) 40 | 41 | (--> (np) 42 | (conde ('(bretrand)) 43 | ('(bob)))) 44 | 45 | (--> (tv form-) 46 | (fresh (tv-) 47 | (conde (`(,tv-) (escape (tvo tv- form-)))))) 48 | 49 | (define (tvo tv- form-) 50 | (conde ((== tv- 'killed) (== form- 'past_participle)))) 51 | 52 | 53 | ;sinv --> aux(finite/Required), np, vp(Required). 54 | (--> (sinv) 55 | (fresh (required) 56 | (conde ((aux `(/ finite ,required)) (np) (vp required))))) 57 | 58 | (--> (q) 59 | (conde ((sinv) '(?)))) 60 | 61 | 62 | (runi (lambda (x) (s x '()))) 63 | 64 | (runi (lambda (x) (q x '()))) 65 | -------------------------------------------------------------------------------- /lf6.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | ;; s --> s(nogap). 5 | ;; s(Gap) --> np(nogap), vp(Gap). 6 | (--> (s gap) (conde ((np 'nogap) (vp gap)))) 7 | 8 | 9 | ;; np(nogap) --> det, n, optrel. 10 | ;; np(nogap) --> pn. 11 | ;; np(gap(np)) --> []. 12 | (--> (np gap) 13 | (fresh (t) 14 | (conde ((== gap 'nogap) (det t) (n t) (optrel)) 15 | ((== gap 'nogap) (pn)) 16 | ((== gap '(gap np)) '())))) 17 | 18 | ;; vp(Gap) --> tv, np(Gap). 19 | ;; vp(nogap) --> iv. 20 | (--> (vp gap) 21 | (conde ((tv) (np gap)) 22 | ((iv)))) 23 | 24 | ;;optrel --> []. 25 | ;;optrel --> relpron, vp(nogap). 26 | ;;optrel --> relpron, s(gap(np)). 27 | (--> (optrel) 28 | (conde ('()) 29 | ((relpron) (vp 'nogap)) 30 | ((relpron) (s '(gap np))))) 31 | 32 | ;; det --> [Det], {det(Det)}. 33 | (--> (det t) 34 | (fresh (det-) 35 | (conde (`(,det-) (escape (deto det- t)))))) 36 | 37 | ;; det(a). det(every). 38 | ;; det(some). det(the). 39 | 40 | (define (deto s t) 41 | (conde ((== s 'a) (== t 'consonant)) 42 | ((== s 'an) (== t 'vowel)) 43 | ((== s 'every)) 44 | ((== s 'some)) 45 | ((== s 'the)))) 46 | 47 | ;; n --> [N], {n(N)}. 48 | (--> (n t) (fresh (n-) (conde (`(,n-) (escape (no n- t)))))) 49 | 50 | ;; n(author). n(book). 51 | ;; n(professor). n(program). 52 | ;; n(programmer). n(student). 53 | (define (no s t) 54 | (conde ((== s 'author) (== t 'vowel)) 55 | ((== s 'book) (== t 'consonant)) 56 | ((== s 'professor) (== t 'consonant)) 57 | ((== s 'program) (== t 'consonant)) 58 | ((== s 'programmer) (== t 'consonant)) 59 | ((== s 'student) (== t 'consonant)))) 60 | 61 | 62 | ;; pn --> [PN], {pn(PN)}. 63 | (--> (pn) (fresh (pn-) (conde (`(,pn-) (escape (pno pn-)))))) 64 | 65 | ;; pn(begriffsschrift). pn(bertrand). 66 | ;; pn(bill). pn(gottlob). 67 | ;; pn(lunar). pn(principia). 68 | ;; pn(shrdlu). pn(terry). 69 | (define (pno s) 70 | (conde ((== s 'begriffsschrift)) ((== s 'bertrand)) 71 | ((== s 'bill)) ((== s 'gottlob)) 72 | ((== s 'lunar)) ((== s 'principia)) 73 | ((== s 'shrdlu)) ((== s 'terry)))) 74 | 75 | 76 | ;; tv --> [TV], {tv(TV)}. 77 | (--> (tv) 78 | (fresh (tv-) 79 | (conde (`(,tv-) (escape (tvo tv-)))))) 80 | 81 | ;; tv(concerns). tv(met). 82 | ;; tv(ran). tv(wrote). 83 | (define (tvo s) 84 | (conde ((== s 'concerns)) ((== s 'met)) 85 | ((== s 'ran)) ((== s 'wrote)))) 86 | 87 | ;; iv --> [IV], {iv(IV)}. 88 | (--> (iv) 89 | (fresh (iv-) 90 | (conde (`(,iv-) (escape (ivo iv-)))))) 91 | 92 | (define (ivo s) (fresh () (== s 'halted))) 93 | 94 | ;relpron --> [RelPron], {relpron(Relpron)}. 95 | (--> (relpron) 96 | (fresh (x) 97 | (conde (`(,x) (escape (relprono x)))))) 98 | 99 | (define (relprono x) 100 | (conde ((== x 'that)) 101 | ((== x 'who)) 102 | ((== x 'whom)))) 103 | 104 | (runi (lambda (q) (s '(gap np) q '()))) 105 | (runi (lambda (q) (s 'nogap q '()))) 106 | 107 | -------------------------------------------------------------------------------- /lf7.scm: -------------------------------------------------------------------------------- 1 | (use-modules (minikanren language) 2 | (minikanren dcg)) 3 | 4 | ;; Program 4.5 5 | 6 | ;; q(VP) --> whpron, vp(VP, nogap). 7 | ;; q(XˆS) --> whpron, sinv(S, gap(np, X)). 8 | ;; q(yesˆS) --> sinv(S, nogap). 9 | (--> (q vp-) 10 | (fresh (x s-) 11 | (conde 12 | ('whpron (vp vp- 'nogap)) 13 | ('whpron (sinv s- `(gap np ,x))) 14 | ((sinv s 'nogap))))) 15 | 16 | 17 | ;; s(S) --> s(S, nogap). 18 | ;; s(S, Gap) --> np(VPˆS, nogap), vp(VP, Gap). 19 | (--> (s s- gap) 20 | (fresh (vp-) 21 | (conde ((s s- 'nogap)) 22 | ((np `(lambda (,vp-) ,s-) 'nogap) 23 | (vp vp- gap))))) 24 | 25 | ;; sinv(S, GapInfo) --> 26 | ;; aux, np(VPˆS, nogap), vp(VP, GapInfo). 27 | (--> (sinv s- gapinfo-) 28 | (fresh (vp-) 29 | (conde ('aux 30 | (np `(lambda (,vp-) ,s-) 'nogap) 31 | (vp vp- gapinfo-))))) 32 | 33 | ;; np(NP, nogap) --> det(N2ˆNP), n(N1), optrel(N1ˆN2). 34 | ;; np((EˆS)ˆS, nogap) --> pn(E). 35 | ;; np((XˆS)ˆS, gap(np, X)) --> []. 36 | (--> (np np- gap) 37 | (fresh (e x n1 n2 np- s- t) 38 | (conde ((== gap 'nogap) 39 | (det `(lambda (,n2) ,np-)) 40 | (n n1 t) 41 | (optrel `(lambda (,n1) ,n2))) 42 | ((== gap 'nogap) 43 | (== np- `(lambda ((lambda (,e) ,s-)) ,s-)) 44 | (pn e)) 45 | ((== gap `(gap np ,x)) 46 | (== np- `(lambda ((lambda (,x) ,s-)) ,s-)) 47 | '())))) 48 | 49 | ;; vp(XˆS, Gap) --> tv(XˆVP), np(VPˆS, Gap). 50 | ;; vp(VP, nogap) --> iv(VP). 51 | (--> (vp vp- gap) 52 | (fresh (x s-) 53 | (conde ((== vp- `(lambda (,x) ,s-)) 54 | (tv `(lambda (,x) ,vp-)) 55 | (np `(lambda (,vp-) ,s-) gap)) 56 | ((== gap 'nogap) 57 | (iv vp-))))) 58 | 59 | 60 | ;; optrel(NˆN) --> []. 61 | ;; optrel((XˆS1)ˆ(Xˆ(S1&S2))) --> 62 | ;; relpron, vp(XˆS2, nogap). 63 | ;; optrel((XˆS1)ˆ(Xˆ(S1&S2))) --> 64 | ;; relpron, s(S2, gap(np, X)). 65 | (--> (optrel optrel-) 66 | (fresh (n- x- s1 s2) 67 | (conde ((== optrel- `(lambda (,n-) ,n-)) 68 | '()) 69 | ((== optrel- `(lambda ((lambda (,x-) ,s1)) (lambda (,x-) (& ,s1 ,s2)))) 70 | (relpron) 71 | (vp `(lambda (,x-) ,s2) 'nogap)) 72 | ((== optrel- `(lambda ((lambda (,x-) ,s1)) (lambda (,x-) (& ,s1 ,s2)))) 73 | (relpron) 74 | (s s2 `(gap np x-)))))) 75 | 76 | ;; det(LF) --> [D], {det(D, LF)}. 77 | ;; det( every, (XˆS1)ˆ(XˆS2)ˆall(X,(S1=>S2)) ). 78 | ;; det( a, (XˆS1)ˆ(XˆS2)ˆexists(X,S1&S2) ). 79 | (--> (det t) 80 | (fresh (det-) 81 | (conde (`(,det-) (escape (deto det- t)))))) 82 | 83 | 84 | (define (deto s t) 85 | (conde ((== s 'a) (== t 'consonant)) 86 | ((== s 'an) (== t 'vowel)) 87 | ((== s 'every)) 88 | ((== s 'some)) 89 | ((== s 'the)))) 90 | 91 | ;; n(LF) --> [N], {n(N, LF)}. 92 | ;; n( program, Xˆprogram(X) ). 93 | ;; n( student, Xˆstudent(X) ). 94 | (--> (n lf- t) 95 | (fresh (n-) 96 | (conde (`(,n-) (escape (no n- lf- t)))))) 97 | 98 | (define (no n- lf- t) 99 | (fresh (x) 100 | (conde ((== n- 'program) (== t 'consonant) 101 | (== lf- `(lambda (,x) (program ,x)))) 102 | ((== n- 'student) (== t 'consonant) 103 | (== lf- `(lambda (,x) (student ,x))))))) 104 | 105 | ;; pn(E) --> [PN], {pn(PN, E)}. 106 | ;; pn( terry, terry ). 107 | ;; pn( shrdlu, shrdlu ). 108 | (--> (pn e) (fresh (pn-) (conde (`(,pn-) (escape (pno pn- e)))))) 109 | 110 | (define (pno s e) 111 | (conde ((== s 'shrdlu) (== e 'shrdlu)) 112 | ((== s 'terry) (== e 'terry)))) 113 | 114 | 115 | ;; tv(LF) --> [TV], {tv(TV, LF)}. 116 | ;; tv( wrote, XˆYˆwrote(X,Y) ). 117 | (--> (tv lf-) 118 | (fresh (tv-) 119 | (conde (`(,tv-) (escape (tvo tv- lf-)))))) 120 | 121 | (define (tvo s lf-) 122 | (fresh (x y) 123 | (conde ((== s 'wrote) 124 | (== lf- `(lambda (,x) (lambda (,y) (wrote ,x ,y)))))))) 125 | 126 | ;; iv(LF) --> [IV], {iv(IV, LF)}. 127 | ;; iv( halts, Xˆhalts(X) ). 128 | (--> (iv lf-) 129 | (fresh (iv-) 130 | (conde (`(,iv-) (escape (ivo iv- lf-)))))) 131 | 132 | (define (ivo s lf-) 133 | (fresh (x) 134 | (== s 'halted) 135 | (== lf- `(lambda (,x) (halts ,x))))) 136 | 137 | ;; relpron --> [RelPron], {relpron(Relpron)}. 138 | ;; relpron(that). relpron(who). 139 | ;; relpron(whom). 140 | (--> (relpron) 141 | (fresh (x) 142 | (conde (`(,x) (escape (relprono x)))))) 143 | 144 | (define (relprono x) 145 | (conde ((== x 'that)) 146 | ((== x 'who)) 147 | ((== x 'whom)))) 148 | 149 | (runi (lambda (q) (fresh (a) (s a '(gap np) q '())))) 150 | -------------------------------------------------------------------------------- /mk-meta.scm: -------------------------------------------------------------------------------- 1 | (define (membero x l) 2 | (fresh (head tail) 3 | (== l `(,head . ,tail)) 4 | (conde 5 | ((== x head)) 6 | ((membero x tail))))) 7 | 8 | (define (mko t) 9 | (conde 10 | ((== t `(true))) 11 | ((fresh (x) (== t `(== ,x ,x)))) 12 | ((fresh (clause clauses) 13 | (== t `(conde . ,clauses)) 14 | (membero clause clauses) 15 | (mkos clause))) 16 | ((fresh (pred args clause) 17 | (== t `(,pred . ,args)) 18 | (=/= pred 'conde) 19 | (=/= pred 'true) 20 | (=/= pred '==) 21 | (clauseo pred args clause) 22 | (mko clause))))) 23 | 24 | (define (mkos ts) 25 | (conde 26 | ((== ts '())) 27 | ((fresh (u us) 28 | (== ts `(,u . ,us)) 29 | (mko u) 30 | (mkos us))))) 31 | 32 | (define (clauseo p args clause) 33 | (conde 34 | ((== p 'membero) 35 | (fresh (x head tail) 36 | (== args `(,x (,head . ,tail))) 37 | (== clause `(conde ((== ,x ,head)) 38 | ((membero ,x ,tail)))))))) 39 | 40 | 41 | 42 | (mko '(true)) 43 | 44 | (mko '(false)) 45 | 46 | (mko '(== a b)) 47 | 48 | (mko '(== 1 1)) 49 | 50 | (mko '(conde ((== 1 2)) 51 | ((== 1 1) (== 2 3)))) 52 | 53 | (mko '(membero x (a x b x y))) 54 | 55 | (mko `(membero ,x (a x b x y))) 56 | --------------------------------------------------------------------------------