Merge branch 'master' of git.racket-lang.org:plt
This commit is contained in:
Matthew Flatt
commit
0acbb358ce
|
|
@ -7,7 +7,7 @@
|
|||
(define suffix (filename-extension pth))
|
||||
(and suffix
|
||||
(ormap (lambda (bs) (bytes=? suffix bs))
|
||||
(list #"ss" #"scm" #"scrbl"))))
|
||||
(list #"ss" #"scm" #"scrbl" #"rkt"))))
|
||||
|
||||
(define PROP:command-line "drdr:command-line")
|
||||
(define PROP:timeout "drdr:timeout")
|
||||
|
|
@ -65,5 +65,7 @@
|
|||
(delete-file tmp-file))))))
|
||||
(unless props:get-prop
|
||||
(error 'get-prop "Could not load props file for ~e" (current-rev)))
|
||||
(props:get-prop a-path prop def
|
||||
#:as-string? as-string?))
|
||||
; XXX get-prop is stupid and errors when a-path is invalid rather than returning def
|
||||
(with-handlers ([exn? (lambda (x) def)])
|
||||
(props:get-prop a-path prop def
|
||||
#:as-string? as-string?)))
|
||||
|
|
|
|||
|
|
@ -101,7 +101,13 @@
|
|||
(regexp-replace "^(....-..-..)T(..:..:..).*Z$" date "\\1 \\2"))
|
||||
(define (git-date->nice-date date)
|
||||
(regexp-replace "^(....-..-..) (..:..:..).*$" date "\\1 \\2"))
|
||||
|
||||
(define (log->url log)
|
||||
(define start-commit (git-push-start-commit log))
|
||||
(define end-commit (git-push-end-commit log))
|
||||
(if (string=? start-commit end-commit)
|
||||
(format "http://github.com/plt/racket/commit/~a" end-commit)
|
||||
(format "http://github.com/plt/racket/compare/~a...~a" start-commit end-commit)))
|
||||
|
||||
(define (format-commit-msg)
|
||||
(define pth (revision-commit-msg (current-rev)))
|
||||
(define (timestamp pth)
|
||||
|
|
@ -608,9 +614,7 @@
|
|||
(define log (read-cache (future-record-path rev)))
|
||||
(define-values (committer title)
|
||||
(log->committer+title log))
|
||||
(define url
|
||||
(format "http://github.com/plt/racket/commit/~a"
|
||||
(git-push-end-commit log)))
|
||||
(define url (log->url log))
|
||||
`(tr ([class "dir"]
|
||||
[title ,title])
|
||||
(td (a ([href ,url]) ,name))
|
||||
|
|
|
|||
|
|
@ -135,9 +135,12 @@
|
|||
[to string?])]
|
||||
[get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)])
|
||||
|
||||
(define (git-push-start-commit gp)
|
||||
(git-commit-hash (last (git-push-commits gp))))
|
||||
(define (git-push-end-commit gp)
|
||||
(git-commit-hash (first (git-push-commits gp))))
|
||||
(provide/contract
|
||||
[git-push-start-commit (git-push? . -> . string?)]
|
||||
[git-push-end-commit (git-push? . -> . string?)])
|
||||
|
||||
(define scm-commit-author
|
||||
|
|
|
|||
|
|
@ -1,85 +0,0 @@
|
|||
Installing Schelog
|
||||
|
||||
|
||||
*** JBC, 2010-04-22: I conjecture that (as a collection
|
||||
within the PLT tree) installation directions are now
|
||||
superfluous. The below is preserved for posterity.
|
||||
|
||||
|
||||
|
||||
|
||||
-
|
||||
|
||||
First, obtain the Schelog distribution. This is
|
||||
available at
|
||||
|
||||
http://www.ccs.neu.edu/~dorai/schelog/schelog.html
|
||||
|
||||
Gunzipping and untarring this file produces a directory
|
||||
called "schelog". This directory contains, among other
|
||||
subsidiary files:
|
||||
|
||||
the Schelog code file "schelog.scm";
|
||||
|
||||
the file INSTALL, which you are now reading.
|
||||
|
||||
-
|
||||
|
||||
The file schelog.scm in the distribution loads in
|
||||
MzScheme (and some other Scheme dialects) without
|
||||
configuration. If it does not load in your
|
||||
dialect, you can configure Schelog for it using
|
||||
the scmxlate package, which is available at
|
||||
http://www.ccs.neu.edu/~dorai/scmxlate/scmxlate.html
|
||||
|
||||
Start your Scheme in the schelog directory, and load
|
||||
the file scmxlate/scmxlate.scm , using the correct
|
||||
relative or full pathname. You will be asked what your
|
||||
Scheme dialect is. Answer appropriately. The
|
||||
following symbols are used by the porting
|
||||
mechanism to identify the corresponding Scheme
|
||||
dialects: bigloo (Bigloo); gambit (Gambit); guile
|
||||
(Guile); mitscheme (MIT Scheme); mzscheme (MzScheme);
|
||||
petite (Petite Chez Scheme); pscheme (Pocket Scheme);
|
||||
scm (SCM); stk (STk).
|
||||
|
||||
scmxlate will generate a file called
|
||||
"my-schelog.scm", which you may rename to
|
||||
"schelog.scm".
|
||||
|
||||
Load schelog.scm into your Scheme in order to use
|
||||
Schelog.
|
||||
|
||||
The distribution comes with an "examples" subdirectory
|
||||
containing some sample Schelog programs. In order to
|
||||
try an example file, load it into your Scheme after
|
||||
ensuring that "schelog.scm" has already been loaded.
|
||||
Follow the instructions in the example file.
|
||||
|
||||
-
|
||||
|
||||
The file "schelog.tex" contains a tutorial on Schelog. Run it
|
||||
through (plain) TeX to obtain viewable/printable
|
||||
documentation. (You will need to run TeX twice to resolve
|
||||
cross references.)
|
||||
|
||||
You can get a browsable version of the document by
|
||||
calling
|
||||
|
||||
tex2page schelog.tex
|
||||
|
||||
This browsable version is also available for Web
|
||||
viewing at
|
||||
|
||||
http://www.ccs.neu.edu/~dorai/schelog/schelog.html
|
||||
|
||||
tex2page is available at
|
||||
|
||||
http://www.ccs.neu.edu/~dorai/tex2page/tex2page-doc.html
|
||||
|
||||
-
|
||||
|
||||
Concise bug reports, questions, and suggestions
|
||||
may be emailed to
|
||||
|
||||
ds26 at gte dot com
|
||||
|
|
@ -1,55 +0,0 @@
|
|||
README
|
||||
Schelog
|
||||
Dorai Sitaram
|
||||
ds26@gte.com
|
||||
|
||||
|
||||
*** JBC 2010-04-22: this package has been TAMPERED WITH in an unscrupulous and
|
||||
undisciplined way by John Clements 2010-04-22 in order to see how difficult it
|
||||
would be to get it to compile in PLT 4.2.5. The answer is "not hard", but it's
|
||||
certainly not portable any more, and crucially the two macros that cause
|
||||
capture of the ! symbol now require uses of the macro to supply the bang, thus
|
||||
making them non-capturing.
|
||||
|
||||
TODO:
|
||||
- pull some part of the docs across from their tex format
|
||||
- figure out what to do with the makefile (delete it?)
|
||||
- turn more of the implicit test cases into explicit test cases
|
||||
- clean up this README file
|
||||
- figure out whether there are copyright issues
|
||||
|
||||
|
||||
...
|
||||
|
||||
Schelog is for you if you are interested in any or all
|
||||
of the following: Scheme, Prolog, logic, logic
|
||||
programming, AI, and expert systems.
|
||||
|
||||
Schelog is an embedding of logic programming a la
|
||||
Prolog in Scheme. "Embedding" means you don't lose
|
||||
Scheme: You can use Prolog-style and conventional
|
||||
Scheme code fragments alongside each other. Schelog
|
||||
contains the full repertoire of Prolog features,
|
||||
including meta-logical and second-order ("set")
|
||||
predicates, leaving out only those features that could
|
||||
be more easily and more efficiently done with Scheme
|
||||
subexpressions. The Schelog distribution includes
|
||||
examples and comprehensive documentation.
|
||||
|
||||
Schelog has been tested successfully on the following
|
||||
Scheme dialects:
|
||||
|
||||
Bigloo, Gambit, Guile, MIT Scheme, MzScheme, Petite
|
||||
Chez Scheme, Pocket Scheme, SCM, and STk.
|
||||
|
||||
...
|
||||
|
||||
The Schelog distribution is available at the URL:
|
||||
|
||||
http://www.cs.rice.edu/CS/PLT/packages/schelog/
|
||||
|
||||
Unpacking (using gunzip and tar xf) the Schelog distribution
|
||||
produces a directory called "schelog". In it is a file
|
||||
called INSTALL which contains detailed installation
|
||||
instructions. Read INSTALL now.
|
||||
|
||||
|
|
@ -1,2 +1,4 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(define scribblings
|
||||
'(("schelog.scrbl" (multi-page) (tool))))
|
||||
|
|
|
|||
3
collects/schelog/main.rkt
Normal file
3
collects/schelog/main.rkt
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
#lang racket
|
||||
(require "schelog.rkt")
|
||||
(provide (all-from-out "schelog.rkt"))
|
||||
|
|
@ -1,48 +0,0 @@
|
|||
# JBC, 2010-04-22:
|
||||
# this makefile could probably be usefully rendered in scheme... but
|
||||
# I'm not going to try.
|
||||
|
||||
|
||||
TRIGGER_FILES = history manifest makefile version.tex \
|
||||
schelog.scm schelog.tex
|
||||
|
||||
default:
|
||||
@echo Please read the file INSTALL.
|
||||
|
||||
%.html: %.tex
|
||||
tex2page $(@:%.html=%)
|
||||
while grep -i "rerun: tex2page" $(@:%.html=%.hlog); do \
|
||||
tex2page $(@:%.html=%); \
|
||||
done
|
||||
|
||||
schelog.pdf: schelog.tex
|
||||
pdftex $^
|
||||
|
||||
schelog.tar:
|
||||
echo tar cf schelog.tar schelog/manifest > .tarscript
|
||||
for f in `grep "^[^;]" manifest`; do \
|
||||
echo tar uf schelog.tar schelog/$$f >> .tarscript; \
|
||||
done
|
||||
chmod +x .tarscript
|
||||
cd ..; schelog/.tarscript
|
||||
mv ../schelog.tar .
|
||||
|
||||
schelog.tar.bz2: $(TRIGGER_FILES)
|
||||
make schelog.tar
|
||||
bzip2 -f schelog.tar
|
||||
|
||||
schelog.tar.gz: $(TRIGGER_FILES)
|
||||
make schelog.tar
|
||||
gzip -f schelog.tar
|
||||
|
||||
html: schelog.html
|
||||
|
||||
pdf: schelog.pdf
|
||||
|
||||
dist: schelog.tar.bz2
|
||||
|
||||
webdist: schelog.tar.gz html
|
||||
|
||||
clean:
|
||||
@rm -f *~ *.bak
|
||||
cd dialects; rm -f *~ *.bak
|
||||
|
|
@ -1,20 +0,0 @@
|
|||
COPYING
|
||||
README
|
||||
manifest
|
||||
makefile
|
||||
schelog-version.tex
|
||||
INSTALL
|
||||
history
|
||||
schelog.tex
|
||||
schelog.scm
|
||||
schelog.bib
|
||||
dialects/*.scm
|
||||
examples/bible.scm
|
||||
examples/england.scm
|
||||
examples/england2.scm
|
||||
examples/games.scm
|
||||
examples/holland.scm
|
||||
examples/houses.scm
|
||||
examples/mapcol.scm
|
||||
examples/puzzle.scm
|
||||
examples/toys.scm
|
||||
|
|
@ -1 +0,0 @@
|
|||
2003-06-01% last change
|
||||
|
|
@ -1,95 +0,0 @@
|
|||
|
||||
@book{sicp,
|
||||
author = "Harold Abelson and Gerald Jay {Sussman with Julie Sussman}",
|
||||
title = "\urlp{Structure and Interpretation of
|
||||
Computer Programs (``SICP'')}{http://mitpress.mit.edu/sicp/full-text/book/book.html}",
|
||||
edition = "2nd",
|
||||
publisher = "MIT Press",
|
||||
year = 1996,
|
||||
}
|
||||
|
||||
@book{aop,
|
||||
author = "Leon Sterling and Ehud Shapiro",
|
||||
title = "\urlh{http://mitpress.mit.edu/book-home.tcl?isbn=0262193388}{The Art
|
||||
of Prolog}",
|
||||
publisher = "MIT Press",
|
||||
year = 1994,
|
||||
edition = "2nd",
|
||||
}
|
||||
|
||||
@book{tls,
|
||||
author = "Daniel P Friedman and Matthias Felleisen",
|
||||
title = "\urlh{http://www.ccs.neu.edu/~matthias/BTLS}{The Little Schemer}",
|
||||
publisher = "MIT Press",
|
||||
year = 1996,
|
||||
edition = "4th",
|
||||
}
|
||||
|
||||
@book{tss,
|
||||
author = "Daniel P Friedman and Matthias Felleisen",
|
||||
title = "\urlh{http://www.ccs.neu.edu/~matthias/BTSS}{The Seasoned Schemer}",
|
||||
publisher = "MIT Press",
|
||||
year = 1996,
|
||||
}
|
||||
|
||||
@book{eopl,
|
||||
author = "Daniel P Friedman and Mitchell Wand and Christopher T Haynes",
|
||||
title = "\urlh{http://mitpress.mit.edu/book-home.tcl?isbn=0262061457}{Essentials
|
||||
of Programming Languages}",
|
||||
publisher = "MIT Press, McGraw-Hill",
|
||||
year = 1992,
|
||||
}
|
||||
|
||||
@book{bratko,
|
||||
author = "Ivan Bratko",
|
||||
title = "Prolog Programming for Artificial Intelligence",
|
||||
publisher = "Addison-Wesley",
|
||||
year = 1986,
|
||||
}
|
||||
|
||||
@book{campbell,
|
||||
editor = "J A Campbell",
|
||||
title = "Implementations of Prolog",
|
||||
publisher = "Ellis Horwood",
|
||||
year = 1984,
|
||||
}
|
||||
|
||||
@book{ok:prolog,
|
||||
author = "Richard A O'Keefe",
|
||||
title = "\urlh{http://mitpress.mit.edu/book-home.tcl?isbn=0262150395}{The
|
||||
Craft of Prolog}",
|
||||
publisher = "MIT Press",
|
||||
year = 1990,
|
||||
}
|
||||
|
||||
@inproceedings{logick,
|
||||
author = "Christopher T Haynes",
|
||||
title = "{Logic continuations}",
|
||||
booktitle = "{J Logic Program}",
|
||||
year = 1987,
|
||||
note = "vol 4",
|
||||
pages = "157--176",
|
||||
}
|
||||
|
||||
@misc{r5rs,
|
||||
author = "Richard Kelsey and William Clinger and
|
||||
Jonathan {Rees (eds)}",
|
||||
title = "\urlp{Revised\^{}5
|
||||
Report on the Algorithmic Language Scheme
|
||||
(``R5RS'')}{http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs.html}",
|
||||
year = 1998,
|
||||
}
|
||||
|
||||
@misc{t-y-scheme,
|
||||
author = "Dorai Sitaram",
|
||||
title = "\urlp{Teach Yourself Scheme
|
||||
in Fixnum Days}{http://www.ccs.neu.edu/~dorai/t-y-scheme/t-y-scheme.html}",
|
||||
}
|
||||
|
||||
@techreport{mf:prolog,
|
||||
author = "Matthias Felleisen",
|
||||
title = "{Transliterating Prolog into Scheme}",
|
||||
institution = "{Indiana U Comp Sci Dept}",
|
||||
year = 1985,
|
||||
number = 182,
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
1460
collects/schelog/schelog.scrbl
Normal file
1460
collects/schelog/schelog.scrbl
Normal file
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require "../schelog.rkt"
|
||||
(require schelog
|
||||
schemeunit)
|
||||
|
||||
;The following is the "Biblical" database from "The Art of
|
||||
|
|
@ -9,7 +9,7 @@
|
|||
;(%father X Y) :- X is the father of Y.
|
||||
|
||||
(define %father
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('terach 'abraham)) (('terach 'nachor)) (('terach 'haran))
|
||||
(('abraham 'isaac)) (('haran 'lot)) (('haran 'milcah))
|
||||
(('haran 'yiscah))))
|
||||
|
|
@ -17,14 +17,14 @@
|
|||
;(%mother X Y) :- X is the mother of Y.
|
||||
|
||||
(define %mother
|
||||
(%rel ! () (('sarah 'isaac))))
|
||||
(%rel () (('sarah 'isaac))))
|
||||
|
||||
(define %male
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('terach)) (('abraham)) (('isaac)) (('lot)) (('haran)) (('nachor))))
|
||||
|
||||
(define %female
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('sarah)) (('milcah)) (('yiscah))))
|
||||
|
||||
;AoP, ch. 17. Finding all the children of a particular
|
||||
|
|
@ -36,13 +36,13 @@
|
|||
(define %children-1
|
||||
|
||||
(letrec ((children-aux
|
||||
(%rel ! (x a cc c)
|
||||
(%rel (x a cc c)
|
||||
((x a cc)
|
||||
(%father x c) (%not (%member c a)) !
|
||||
(children-aux x (cons c a) cc))
|
||||
((x cc cc)))))
|
||||
|
||||
(%rel ! (x cc)
|
||||
(%rel (x cc)
|
||||
((x cc) (children-aux x '() cc)))))
|
||||
|
||||
(define terachs-kids-test
|
||||
|
|
@ -53,7 +53,7 @@
|
|||
(%children-1 'terach cc))))
|
||||
|
||||
(check-equal? (terachs-kids-test)
|
||||
`((cc (haran nachor abraham))))
|
||||
`((cc . (haran nachor abraham))))
|
||||
|
||||
(define dad-kids-test
|
||||
;find a father and all his children. Returns
|
||||
|
|
@ -65,7 +65,7 @@
|
|||
(%children-1 f cc))))
|
||||
|
||||
(check-equal? (dad-kids-test)
|
||||
`((f terach) (cc (haran nachor abraham))))
|
||||
`((f . terach) (cc . (haran nachor abraham))))
|
||||
|
||||
(define terachs-kids-test-2
|
||||
;find all the kids of Terach, using %set-of.
|
||||
|
|
@ -75,11 +75,14 @@
|
|||
(%which (kk)
|
||||
(%set-of k (%father 'terach k) kk)))))
|
||||
|
||||
(check-equal? (terachs-kids-test-2)
|
||||
`((kk . (abraham nachor haran))))
|
||||
|
||||
;This is a better definition of the %children predicate.
|
||||
;Uses set predicate %bag-of
|
||||
|
||||
(define %children
|
||||
(%rel ! (x kids c)
|
||||
(%rel (x kids c)
|
||||
((kids) (%set-of c (%father x c) kids))))
|
||||
|
||||
(define dad-kids-test-2
|
||||
|
|
@ -93,6 +96,9 @@
|
|||
(%father dad x))
|
||||
kids)))))
|
||||
|
||||
(check-equal? (dad-kids-test-2)
|
||||
`((dad . terach) (kids . (abraham nachor haran))))
|
||||
|
||||
(define dad-kids-test-3
|
||||
;looks like dad-kids-test-2, but dad is now
|
||||
;existentially quantified. returns a set of
|
||||
|
|
@ -103,6 +109,9 @@
|
|||
(%set-of x (%father dad x)
|
||||
kids)))))
|
||||
|
||||
(check-equal? (dad-kids-test-3)
|
||||
`((dad . _) (kids . (abraham nachor haran isaac lot milcah yiscah))))
|
||||
|
||||
(define dad-kids-test-4
|
||||
;find the set of dad-kids.
|
||||
;since dad is existentially quantified,
|
||||
|
|
@ -115,6 +124,9 @@
|
|||
(%set-of x (%father dad x) kids)
|
||||
dad-kids)))))
|
||||
|
||||
(check-equal? (dad-kids-test-4)
|
||||
`((dad-kids . ((_ (abraham nachor haran isaac lot milcah yiscah))))))
|
||||
|
||||
(define dad-kids-test-5
|
||||
;the correct solution. dad is
|
||||
;identified as a free var.
|
||||
|
|
@ -128,3 +140,6 @@
|
|||
(%father dad x))
|
||||
kids)
|
||||
dad-kids)))))
|
||||
|
||||
(check-equal? (dad-kids-test-5)
|
||||
`((dad-kids . ((terach (abraham nachor haran)) (abraham (isaac)) (haran (lot milcah yiscah))))))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require "../schelog.rkt"
|
||||
(require schelog
|
||||
schemeunit)
|
||||
|
||||
;The following is a simple database about a certain family in England.
|
||||
|
|
@ -11,47 +11,47 @@
|
|||
;The file england2.scm uses a Scheme-like syntax.
|
||||
|
||||
(define %male
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('philip)) (('charles)) (('andrew)) (('edward))
|
||||
(('mark)) (('william)) (('harry)) (('peter))))
|
||||
|
||||
(define %female
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('elizabeth)) (('anne)) (('diana)) (('sarah)) (('zara))))
|
||||
|
||||
(define %husband-of
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('philip 'elizabeth)) (('charles 'diana))
|
||||
(('mark 'anne)) (('andrew 'sarah))))
|
||||
|
||||
(define %wife-of
|
||||
(%rel ! (w h)
|
||||
(%rel (w h)
|
||||
((w h) (%husband-of h w))))
|
||||
|
||||
(define %married-to
|
||||
(%rel ! (x y)
|
||||
(%rel (x y)
|
||||
((x y) (%husband-of x y))
|
||||
((x y) (%wife-of x y))))
|
||||
|
||||
(define %father-of
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('philip 'charles)) (('philip 'anne)) (('philip 'andrew))
|
||||
(('philip 'edward)) (('charles 'william)) (('charles 'harry))
|
||||
(('mark 'peter)) (('mark 'zara))))
|
||||
|
||||
(define %mother-of
|
||||
(%rel ! (m c f)
|
||||
(%rel (m c f)
|
||||
((m c) (%wife-of m f) (%father-of f c))))
|
||||
|
||||
(define %child-of
|
||||
(%rel ! (c p)
|
||||
(%rel (c p)
|
||||
((c p) (%father-of p c))
|
||||
((c p) (%mother-of p c))))
|
||||
|
||||
(define %parent-of
|
||||
(%rel ! (p c)
|
||||
(%rel (p c)
|
||||
((p c) (%child-of c p))))
|
||||
|
||||
(define %brother-of
|
||||
(%rel ! (b x f)
|
||||
(%rel (b x f)
|
||||
((b x) (%male b) (%father-of f b) (%father-of f x) (%/= b x))))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require "../schelog.rkt")
|
||||
(require schelog)
|
||||
|
||||
;The following is a simple database about a certain family in England.
|
||||
;Should be a piece of cake, but given here so that you can hone
|
||||
26
collects/tests/schelog/fac.rkt
Normal file
26
collects/tests/schelog/fac.rkt
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
#lang racket
|
||||
(require schelog tests/eli-tester)
|
||||
|
||||
(define %factorial
|
||||
(%rel (x y x1 y1)
|
||||
[(0 1) !]
|
||||
[(x y) (%< x 0) ! %fail]
|
||||
[(x y) (%is x1 (- x 1))
|
||||
(%factorial x1 y1)
|
||||
(%is y (* y1 x))]))
|
||||
|
||||
(test
|
||||
(%which ()
|
||||
(%factorial 0 1))
|
||||
=> empty
|
||||
(%more)
|
||||
=> #f
|
||||
|
||||
(%which ()
|
||||
(%factorial -1 1))
|
||||
=> #f
|
||||
(%which (x)
|
||||
(%factorial 3 x))
|
||||
=> `((x . 6))
|
||||
(%more)
|
||||
=> #f)
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme
|
||||
#lang racket
|
||||
|
||||
(require "../schelog.rkt"
|
||||
(require schelog
|
||||
"./puzzle.rkt"
|
||||
schemeunit)
|
||||
|
||||
|
|
@ -20,7 +20,7 @@
|
|||
(list 'person name country sport)))
|
||||
|
||||
(define %games
|
||||
(%rel ! (clues queries solution the-men
|
||||
(%rel (clues queries solution the-men
|
||||
n1 n2 n3 c1 c2 c3 s1 s2 s3)
|
||||
((clues queries solution)
|
||||
(%= the-men
|
||||
|
|
@ -29,7 +29,7 @@
|
|||
(%games-queries the-men queries solution))))
|
||||
|
||||
(define %games-clues
|
||||
(%rel ! (the-men clue1-man1 clue1-man2 clue2-man1 clue2-man2 clue3-man)
|
||||
(%rel (the-men clue1-man1 clue1-man2 clue2-man1 clue2-man2 clue3-man)
|
||||
((the-men
|
||||
(list
|
||||
(%did-better clue1-man1 clue1-man2 the-men)
|
||||
|
|
@ -46,7 +46,7 @@
|
|||
(%sport clue3-man 'cricket))))))
|
||||
|
||||
(define %games-queries
|
||||
(%rel ! (the-men man1 man2 aussies-name dicks-sport)
|
||||
(%rel (the-men man1 man2 aussies-name dicks-sport)
|
||||
((the-men
|
||||
(list
|
||||
(%member man1 the-men)
|
||||
|
|
@ -61,25 +61,25 @@
|
|||
(list 'richard 'plays dicks-sport))))))
|
||||
|
||||
(define %did-better
|
||||
(%rel ! (a b c)
|
||||
(%rel (a b c)
|
||||
((a b (list a b c)))
|
||||
((a c (list a b c)))
|
||||
((b c (list a b c)))))
|
||||
|
||||
(define %name
|
||||
(%rel ! (name country sport)
|
||||
(%rel (name country sport)
|
||||
(((person name country sport) name))))
|
||||
|
||||
(define %country
|
||||
(%rel ! (name country sport)
|
||||
(%rel (name country sport)
|
||||
(((person name country sport) country))))
|
||||
|
||||
(define %sport
|
||||
(%rel ! (name country sport)
|
||||
(%rel (name country sport)
|
||||
(((person name country sport) sport))))
|
||||
|
||||
(define %first
|
||||
(%rel ! (car cdr)
|
||||
(%rel (car cdr)
|
||||
(((cons car cdr) car))))
|
||||
|
||||
;;With the above as the database, and also loading the file
|
||||
|
|
@ -89,4 +89,4 @@
|
|||
;;((michael is the australian) (richard plays tennis))
|
||||
|
||||
(check-equal? (solve-puzzle %games)
|
||||
'((solution= ((michael is the australian) (richard plays tennis)))))
|
||||
'((solution= . ((michael is the australian) (richard plays tennis)))))
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket
|
||||
|
||||
(require "../schelog.rkt")
|
||||
(require schelog
|
||||
tests/eli-tester)
|
||||
|
||||
;This is a very trivial program. In Prolog, it would be:
|
||||
;
|
||||
|
|
@ -12,29 +13,34 @@
|
|||
(define %city
|
||||
(lambda (x)
|
||||
(%or (%= x 'amsterdam)
|
||||
(%= x 'brussels))))
|
||||
(%= x 'brussels))))
|
||||
|
||||
(define %country
|
||||
(lambda (x)
|
||||
(%or (%= x 'holland)
|
||||
(%= x 'belgium))))
|
||||
(%= x 'belgium))))
|
||||
|
||||
;For a more Prolog-style syntax, you can rewrite the same thing,
|
||||
;using the `%rel' macro, as the following:
|
||||
|
||||
'(define %city
|
||||
(define %city*
|
||||
(%rel ()
|
||||
(('amsterdam))
|
||||
(('brussels))))
|
||||
(('amsterdam))
|
||||
(('brussels))))
|
||||
|
||||
'(define %country
|
||||
(define %country*
|
||||
(%rel ()
|
||||
(('holland))
|
||||
(('belgium))))
|
||||
(('holland))
|
||||
(('belgium))))
|
||||
|
||||
;Typical easy queries:
|
||||
;
|
||||
; (%which (x) (%city x)) succeeds twice
|
||||
; (%which (x) (%country x)) succeeds twice
|
||||
; (%which () (%city 'amsterdam)) succeeds
|
||||
; (%which () (%country 'amsterdam)) fails
|
||||
(test
|
||||
(%which (x) (%city x))
|
||||
(%more)
|
||||
(%more) => #f
|
||||
(%which (x) (%country x))
|
||||
(%more)
|
||||
(%more) => #f
|
||||
(%which () (%city 'amsterdam))
|
||||
(%more) => #f
|
||||
(%which () (%country 'amsterdam)) => #f)
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require "../schelog.rkt")
|
||||
(require schelog)
|
||||
|
||||
;Exercise 14.1 (iv) from Sterling & Shapiro, p. 217-8
|
||||
|
||||
|
|
@ -29,25 +29,25 @@
|
|||
(lambda (hue nation pet drink cigarette)
|
||||
(list 'house hue nation pet drink cigarette)))
|
||||
|
||||
(define %hue (%rel ! (h) (((house h (_) (_) (_) (_)) h))))
|
||||
(define %nation (%rel ! (n) (((house (_) n (_) (_) (_)) n))))
|
||||
(define %pet (%rel ! (p) (((house (_) (_) p (_) (_)) p))))
|
||||
(define %drink (%rel ! (d) (((house (_) (_) (_) d (_)) d))))
|
||||
(define %cigarette (%rel ! (c) (((house (_) (_) (_) (_) c) c))))
|
||||
(define %hue (%rel (h) (((house h (_) (_) (_) (_)) h))))
|
||||
(define %nation (%rel (n) (((house (_) n (_) (_) (_)) n))))
|
||||
(define %pet (%rel (p) (((house (_) (_) p (_) (_)) p))))
|
||||
(define %drink (%rel (d) (((house (_) (_) (_) d (_)) d))))
|
||||
(define %cigarette (%rel (c) (((house (_) (_) (_) (_) c) c))))
|
||||
|
||||
(define %adjacent
|
||||
(%rel ! (a b)
|
||||
(%rel (a b)
|
||||
((a b (list a b (_) (_) (_))))
|
||||
((a b (list (_) a b (_) (_))))
|
||||
((a b (list (_) (_) a b (_))))
|
||||
((a b (list (_) (_) (_) a b)))))
|
||||
|
||||
(define %middle
|
||||
(%rel ! (a)
|
||||
(%rel (a)
|
||||
((a (list (_) (_) a (_) (_))))))
|
||||
|
||||
(define %houses
|
||||
(%rel ! (row-of-houses clues queries solution
|
||||
(%rel (row-of-houses clues queries solution
|
||||
h1 h2 h3 h4 h5 n1 n2 n3 n4 n5 p1 p2 p3 p4 p5
|
||||
d1 d2 d3 d4 d5 c1 c2 c3 c4 c5)
|
||||
((clues queries solution)
|
||||
|
|
@ -62,7 +62,7 @@
|
|||
(%houses-queries row-of-houses queries solution))))
|
||||
|
||||
(define %houses-clues
|
||||
(%rel ! (row-of-houses abode1 abode2 abode3 abode4 abode5 abode6 abode7
|
||||
(%rel (row-of-houses abode1 abode2 abode3 abode4 abode5 abode6 abode7
|
||||
abode8 abode9 abode10 abode11 abode12 abode13 abode14 abode15)
|
||||
((row-of-houses
|
||||
(list
|
||||
|
|
@ -126,7 +126,7 @@
|
|||
(%hue abode15 'blue))))))
|
||||
|
||||
(define %houses-queries
|
||||
(%rel ! (row-of-houses abode1 abode2 zebra-owner water-drinker)
|
||||
(%rel (row-of-houses abode1 abode2 zebra-owner water-drinker)
|
||||
((row-of-houses
|
||||
(list
|
||||
(%member abode1 row-of-houses)
|
||||
|
|
@ -140,13 +140,9 @@
|
|||
(list (list zebra-owner 'owns 'the 'zebra)
|
||||
(list water-drinker 'drinks 'water))))))
|
||||
|
||||
;Load puzzle.scm and type (solve-puzzle %houses)
|
||||
|
||||
;Note: This program, as written, requires
|
||||
;the occurs check. Make sure the global
|
||||
;*schelog-use-occurs-check?* is set to #t before
|
||||
;calling solve-puzzle. If not, you will get into
|
||||
;an infinite loop.
|
||||
|
||||
;Note 2: Perhaps there is a way to rewrite the
|
||||
;Note: Perhaps there is a way to rewrite the
|
||||
;program so that it doesn't rely on the occurs check.
|
||||
|
||||
(require "puzzle.rkt" tests/eli-tester)
|
||||
(use-occurs-check? #t)
|
||||
(test (solve-puzzle %houses))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require (except-in "../schelog.rkt" %member))
|
||||
(require (except-in schelog %member))
|
||||
|
||||
;map coloring, example from Sterling & Shapiro, p. 212
|
||||
|
||||
|
|
@ -9,21 +9,21 @@
|
|||
;; is this different from the %member provided by schelog? fencing that one out.
|
||||
|
||||
(define %member
|
||||
(%rel ! (X Xs Y Ys)
|
||||
(%rel (X Xs Y Ys)
|
||||
((X (cons X Xs)))
|
||||
((X (cons Y Ys)) (%member X Ys))))
|
||||
|
||||
;(%members x y) holds if x is a subset of y
|
||||
|
||||
(define %members
|
||||
(%rel ! (X Xs Ys)
|
||||
(%rel (X Xs Ys)
|
||||
(((cons X Xs) Ys) (%member X Ys) (%members Xs Ys))
|
||||
(('() Ys))))
|
||||
|
||||
;(%select x y z) holds if z is y with one less occurrence of x
|
||||
|
||||
(define %select
|
||||
(%rel ! (X Xs Y Ys Zs)
|
||||
(%rel (X Xs Y Ys Zs)
|
||||
((X (cons X Xs) Xs))
|
||||
((X (cons Y Ys) (cons Y Zs))
|
||||
(%select X Ys Zs))))
|
||||
|
|
@ -35,26 +35,26 @@
|
|||
(list 'region name color neighbors)))
|
||||
|
||||
(define %color-map
|
||||
(%rel ! (Region Regions Colors)
|
||||
(%rel (Region Regions Colors)
|
||||
(((cons Region Regions) Colors)
|
||||
(%color-region Region Colors) (%color-map Regions Colors))
|
||||
(('() Colors))))
|
||||
|
||||
(define %color-region
|
||||
(%rel ! (Name Color Neighbors Colors Colors1)
|
||||
(%rel (Name Color Neighbors Colors Colors1)
|
||||
(((region Name Color Neighbors) Colors)
|
||||
(%select Color Colors Colors1)
|
||||
(%members Neighbors Colors1))))
|
||||
|
||||
(define %test-color
|
||||
(%rel ! (Name Map Colors)
|
||||
(%rel (Name Map Colors)
|
||||
((Name Map)
|
||||
(%map Name Map)
|
||||
(%colors Colors)
|
||||
(%color-map Map Colors))))
|
||||
|
||||
(define %map
|
||||
(%rel ! (A B C D E F G H I L P S)
|
||||
(%rel (A B C D E F G H I L P S)
|
||||
(('test (list
|
||||
(region 'a A (list B C D))
|
||||
(region 'b B (list A C E))
|
||||
|
|
@ -76,10 +76,9 @@
|
|||
(region 'austria A (list I S G)))))))
|
||||
|
||||
(define %colors
|
||||
(%rel ! ()
|
||||
(%rel ()
|
||||
(('(red yellow blue white)))))
|
||||
|
||||
;ask (%which (M) (%test-color 'test M)) or
|
||||
;ask (%which (M) (%test-color 'western-europe M)) for the
|
||||
;respective (non-unique) colorings.
|
||||
|
||||
(require tests/eli-tester)
|
||||
(test (%which (M) (%test-color 'test M))
|
||||
(%which (M) (%test-color 'western-europe M)))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme
|
||||
#lang racket
|
||||
|
||||
(require "../schelog.rkt")
|
||||
(require schelog)
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -19,13 +19,13 @@
|
|||
; solve([]).
|
||||
|
||||
(define %solve-puzzle
|
||||
(%rel ! (clues queries solution)
|
||||
(%rel (clues queries solution)
|
||||
((clues queries solution)
|
||||
(%solve clues)
|
||||
(%solve queries))))
|
||||
|
||||
(define %solve
|
||||
(%rel ! (clue clues)
|
||||
(%rel (clue clues)
|
||||
(((cons clue clues))
|
||||
clue
|
||||
(%solve clues))
|
||||
9
collects/tests/schelog/run-all.rkt
Normal file
9
collects/tests/schelog/run-all.rkt
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#lang racket
|
||||
(require racket/runtime-path tests/eli-tester)
|
||||
(define-runtime-path here ".")
|
||||
(define this-file (build-path "run-all.rkt"))
|
||||
|
||||
(test
|
||||
(for ([p (in-list (directory-list here))]
|
||||
#:when (not (equal? this-file p)))
|
||||
(dynamic-require (build-path here p) #f)))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require (except-in "../schelog.rkt" %append))
|
||||
(require (except-in schelog %append))
|
||||
|
||||
;A list of trivial programs in Prolog, just so you can get used
|
||||
;to schelog syntax.
|
||||
|
|
@ -8,14 +8,14 @@
|
|||
;(%length l n) holds if length(l) = n
|
||||
|
||||
(define %length
|
||||
(%rel ! (h t n m)
|
||||
(%rel (h t n m)
|
||||
(('() 0))
|
||||
(((cons h t) n) (%length t m) (%is n (+ m 1)))))
|
||||
|
||||
;(%delete x y z) holds if z is y with all x's removed
|
||||
|
||||
(define %delete
|
||||
(%rel ! (x y z w)
|
||||
(%rel (x y z w)
|
||||
((x '() '()))
|
||||
((x (cons x w) y) (%delete x w y))
|
||||
((x (cons z w) (cons z y)) (%not (%= x z)) (%delete x w y))))
|
||||
|
|
@ -23,39 +23,39 @@
|
|||
;(%remdup x y) holds if y is x without duplicates
|
||||
|
||||
(define %remdup
|
||||
(%rel ! (x y z w)
|
||||
(%rel (x y z w)
|
||||
(('() '()))
|
||||
(((cons x y) (cons x z)) (%delete x y w) (%remdup w z))))
|
||||
|
||||
;(%count x n) holds if n is the number of elements in x without
|
||||
;counting duplicates
|
||||
|
||||
'(define %count
|
||||
(%rel ! (x n y)
|
||||
(define %count*
|
||||
(%rel (x n y)
|
||||
((x n) (%remdup x y) (%length y n))))
|
||||
|
||||
;same thing
|
||||
|
||||
(define %count
|
||||
(letrec ((countaux
|
||||
(%rel ! (m n m+1 x y z)
|
||||
(%rel (m n m+1 x y z)
|
||||
(('() m m))
|
||||
(((cons x y) m n)
|
||||
(%delete x y z) (%is m+1 (+ m 1)) (countaux z m+1 n)))))
|
||||
(%rel ! (x n)
|
||||
(%rel (x n)
|
||||
((x n) (countaux x 0 n)))))
|
||||
|
||||
;(%append x y z) holds if z is the concatenation of x and y
|
||||
|
||||
(define %append
|
||||
(%rel ! (x y z w)
|
||||
(%rel (x y z w)
|
||||
(('() x x))
|
||||
(((cons x y) z (cons x w)) (%append y z w))))
|
||||
|
||||
;(%reverse x y) holds if the y is the reversal of x
|
||||
|
||||
'(define %reverse
|
||||
(%rel ! (x y z yy)
|
||||
(define %reverse*
|
||||
(%rel (x y z yy)
|
||||
(('() '()))
|
||||
(((cons x y) z) (%reverse y yy) (%append yy (list x) z))))
|
||||
|
||||
|
|
@ -63,16 +63,16 @@
|
|||
|
||||
(define %reverse
|
||||
(letrec ((revaux
|
||||
(%rel ! (x y z w)
|
||||
(%rel (x y z w)
|
||||
(('() y y))
|
||||
(((cons x y) z w) (revaux y (cons x z) w)))))
|
||||
(%rel ! (x y)
|
||||
(%rel (x y)
|
||||
((x y) (revaux x '() y)))))
|
||||
|
||||
;(%fact n m) holds if m = n!
|
||||
|
||||
'(define %fact
|
||||
(%rel ! (n n! n-1 n-1!)
|
||||
(define %fact*
|
||||
(%rel (n n! n-1 n-1!)
|
||||
((0 1))
|
||||
((n n!) (%is n-1 (- n 1)) (%fact n-1 n-1!) (%is n! (* n n-1!)))))
|
||||
|
||||
|
|
@ -80,9 +80,9 @@
|
|||
|
||||
(define %fact
|
||||
(letrec ((factaux
|
||||
(%rel ! (n! m x m-1 xx)
|
||||
(%rel (n! m x m-1 xx)
|
||||
((0 n! n!))
|
||||
((m x n!) (%is m-1 (- m 1)) (%is xx (* x m))
|
||||
(factaux m-1 xx n!)))))
|
||||
(%rel ! (n n!)
|
||||
(%rel (n n!)
|
||||
((n n!) (factaux n 1 n!)))))
|
||||
306
collects/tests/schelog/unit.rkt
Normal file
306
collects/tests/schelog/unit.rkt
Normal file
|
|
@ -0,0 +1,306 @@
|
|||
#lang racket
|
||||
(require schelog
|
||||
tests/eli-tester)
|
||||
|
||||
(test
|
||||
(logic-var? (_))
|
||||
|
||||
(%which () (%/= 1 1)) => #f
|
||||
(%which () (%/= 1 2)) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which (x) (%/== x x)) => #f
|
||||
(%which (x y) (%/== x y)) => `((x . _) (y . _))
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%/== 1 1)) => #f
|
||||
(%which () (%/== 1 2)) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%< 1 2)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%< 1 1)) => #f
|
||||
(%which () (%< 2 1)) => #f
|
||||
(%which () (%< 'a 2)) => #f
|
||||
(%which () (%< 1 'b)) => #f
|
||||
(%which () (%< 'a 'b)) => #f
|
||||
|
||||
(%which () (%<= 1 2)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%<= 1 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%<= 2 1)) => #f
|
||||
(%which () (%<= 'a 2)) => #f
|
||||
(%which () (%<= 1 'b)) => #f
|
||||
(%which () (%<= 'a 'b)) => #f
|
||||
|
||||
(%which () (%= 1 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%= 'a 'a)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%= (cons 1 2) (cons 1 2))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%= (vector 1 2) (vector 1 2))) => empty
|
||||
(%more) => #f
|
||||
(%which (x) (%= x 1)) => `((x . 1))
|
||||
(%more) => #f
|
||||
(%which (x) (%= (cons x 2) (cons 1 2))) => `((x . 1))
|
||||
(%more) => #f
|
||||
(%which (x) (%= (vector x 2) (vector 1 2))) => `((x . 1))
|
||||
(%more) => #f
|
||||
(%which (x) (%and (%= x 1) (%= x 2))) => #f
|
||||
(%which () (%= 1 2)) => #f
|
||||
|
||||
(%which () (%=/= 1 1)) => #f
|
||||
(%which () (%=/= 'a 'a)) => #f
|
||||
(%which () (%=/= 1 2)) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%=:= 1 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%=:= 'a 'a)) => #f
|
||||
(%which () (%=:= 1 2)) => #f
|
||||
|
||||
(%which () (%== 1 1)) => empty
|
||||
(%more) => #f
|
||||
(%which (x) (%== x x)) => `((x . _))
|
||||
(%more) => #f
|
||||
(%which (x) (%== (cons 1 x) (cons 1 x))) => `((x . _))
|
||||
(%more) => #f
|
||||
; XXX This answer seems wrong
|
||||
(%which (x) (%and (%= x 1) (%== x 1))) => `((x . 1))
|
||||
(%more) => #f
|
||||
; XXX This answer seems wrong
|
||||
(%which (x y) (%and (%= x 1) (%= y 1) (%== x y))) => `((x . 1) (y . 1))
|
||||
(%more) => #f
|
||||
(%which (x y) (%== x y)) => #f
|
||||
(%which (x y) (%== (cons 1 x) (cons y 2))) => #f
|
||||
|
||||
(%which () (%> 2 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%> 1 1)) => #f
|
||||
(%which () (%> 1 2)) => #f
|
||||
(%which () (%> 'a 2)) => #f
|
||||
(%which () (%> 1 'b)) => #f
|
||||
(%which () (%> 'a 'b)) => #f
|
||||
|
||||
(%which () (%>= 2 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%>= 1 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%>= 1 2)) => #f
|
||||
(%which () (%>= 'a 2)) => #f
|
||||
(%which () (%>= 1 'b)) => #f
|
||||
(%which () (%>= 'a 'b)) => #f
|
||||
|
||||
(%which () (%and %true %true)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%and %fail %true)) => #f
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%append empty empty empty)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%append (list 1) empty (list 1))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%append empty (list 2) (list 2))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%append (list 1) (list 2) (list 1 2))) => empty
|
||||
(%more) => #f
|
||||
|
||||
(let ([rel %empty-rel])
|
||||
(test (%which (y) (rel 'x y)) => #f
|
||||
(%assert! rel () [('x 1)])
|
||||
(%which (y) (rel 'x y)) => `([y . 1])
|
||||
(%more) => #f
|
||||
(%assert-after! rel () [('x 2)])
|
||||
(%which (y) (rel 'x y)) => `([y . 2])
|
||||
(%more) => `([y . 1])
|
||||
(%more) => #f
|
||||
(%assert! rel () [('x 3)])
|
||||
(%which (y) (rel 'x y)) => `([y . 2])
|
||||
(%more) => `([y . 1])
|
||||
(%more) => `([y . 3])
|
||||
(%more) => #f))
|
||||
|
||||
(%which (y) (%let (x) (%bag-of x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 1 2)])
|
||||
(%more) => #f
|
||||
; XXX I don't know a program that would get these outputs
|
||||
;(%which (y) (%let (x) (%bag-of x XXX y))) => `([y . ()])
|
||||
(%more) => #f
|
||||
(%which (y) (%let (x) (%bag-of-1 x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 1 2)])
|
||||
(%more) => #f
|
||||
; XXX I don't know a program that would get these outputs
|
||||
;(%which (y) (%let (x) (%bag-of-1 x XXX y))) => #f
|
||||
|
||||
(%which () (%compound (cons 1 1))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%compound (vector 1 1))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%let (x) (%and (%= x (cons 1 1)) (%compound x)))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%compound 1)) => #f
|
||||
(%which () (%compound "1")) => #f
|
||||
(%which () (%compound '1)) => #f
|
||||
(%which () (%compound empty)) => #f
|
||||
|
||||
(%which () (%constant (cons 1 1))) => #f
|
||||
(%which () (%constant (vector 1 1))) => #f
|
||||
(%which () (%let (x) (%and (%= x 1) (%constant x)))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%constant 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%constant "1")) => empty
|
||||
(%more) => #f
|
||||
(%which () (%constant '1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%constant empty)) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which (x) (%let (y) (%and (%copy x y) (%= y 1)))) => `([x . _])
|
||||
(%more) => #f
|
||||
|
||||
! =error> "syntactically"
|
||||
|
||||
(%which () (%cut-delimiter %true)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%cut-delimiter !)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%cut-delimiter %fail)) => #f
|
||||
(%which () (%or %true %true)) => empty
|
||||
(%more) => empty
|
||||
(%more) => #f
|
||||
(%which () (%cut-delimiter (%or (%and ! %true) %true))) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%empty-rel 1 1)) => #f
|
||||
|
||||
(%which () %fail) => #f
|
||||
|
||||
; %free-vars example from documentation
|
||||
(local [(define %knows
|
||||
(%rel ()
|
||||
[('Odysseus 'TeX)]
|
||||
[('Odysseus 'Scheme)]
|
||||
[('Odysseus 'Prolog)]
|
||||
[('Odysseus 'Penelope)]
|
||||
[('Penelope 'TeX)]
|
||||
[('Penelope 'Prolog)]
|
||||
[('Penelope 'Odysseus)]
|
||||
[('Telemachus 'TeX)]
|
||||
[('Telemachus 'calculus)]))]
|
||||
(test (%which (someone things-known)
|
||||
(%let (x)
|
||||
(%set-of x (%knows someone x)
|
||||
things-known)))
|
||||
=>
|
||||
`((someone . _) (things-known TeX Scheme Prolog Penelope Odysseus calculus))
|
||||
(%more) => #f
|
||||
(%which (someone things-known)
|
||||
(%let (x)
|
||||
(%bag-of x
|
||||
(%free-vars (someone)
|
||||
(%knows someone x))
|
||||
things-known)))
|
||||
=>
|
||||
`((someone . Odysseus) (things-known TeX Scheme Prolog Penelope))
|
||||
(%more) =>
|
||||
`((someone . Penelope) (things-known TeX Prolog Odysseus))
|
||||
(%more) =>
|
||||
`((someone . Telemachus) (things-known TeX calculus))
|
||||
(%more) =>
|
||||
#f))
|
||||
|
||||
(%which (x) (%let (y) (%and (%freeze x y) (%nonvar y)))) => `([x . _])
|
||||
|
||||
(%which () (%if-then-else %true %true %true)) => empty
|
||||
(%more) => #f
|
||||
(%which () (%if-then-else %true %fail %true)) => #f
|
||||
(%which () (%if-then-else %fail %true %true)) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which (x) (%is x (* 6 7))) => `([x . 42])
|
||||
(%more) => #f
|
||||
(%which (x) (%let (y) (%and (%= y 7) (%is x (* 6 y))))) => `([x . 42])
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%let (x) (%= x x))) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which (x) (%let (y z) (%and (%freeze x y) (%melt y z) (%= z 1)))) => `([x . 1])
|
||||
(%more) => #f
|
||||
|
||||
(%which (x) (%let (y z) (%and (%freeze x y) (%melt-new y z) (%= z 1)))) => `([x . _])
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%member 3 (list 1 2 3))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%member 3 (list 1 2 3 3))) => empty
|
||||
(%more) => empty
|
||||
(%more) => #f
|
||||
(%which () (%member 3 (list 1 2))) => #f
|
||||
|
||||
(%which () (%let (x) (%nonvar x))) => #f
|
||||
(%which () (%let (x) (%nonvar (cons 1 x)))) => #f
|
||||
(%which () (%let (x) (%nonvar (vector x)))) => #f
|
||||
(%which () (%let (x) (%nonvar 1))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%let (x) (%and (%= x 1) (%nonvar x)))) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%not %true)) => #f
|
||||
(%which () (%not %fail)) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%or %true %true)) => empty
|
||||
(%more) => empty
|
||||
(%more) => #f
|
||||
(%which () (%or %true %fail %true)) => empty
|
||||
(%more) => empty
|
||||
(%more) => #f
|
||||
|
||||
(let ([rel (%rel () [(1)] [(2) %fail])])
|
||||
(test (%which () (rel 1)) => empty
|
||||
(%more) => #f
|
||||
(%which () (rel 2)) => #f))
|
||||
(let ([rel (%rel () [(1) !] [(1) (%repeat)])])
|
||||
(test (%which () (rel 1)) => empty
|
||||
(%more) => #f))
|
||||
|
||||
(local [(define (many-%more n)
|
||||
(if (zero? n)
|
||||
empty
|
||||
(and (%more)
|
||||
(many-%more (sub1 n)))))]
|
||||
(test (%which () (%repeat)) => empty
|
||||
(many-%more (random 50)) => empty))
|
||||
|
||||
(parameterize ([use-occurs-check? #f])
|
||||
(%which () (%let (x) (%= x (cons 1 x)))))
|
||||
=> empty
|
||||
(parameterize ([use-occurs-check? #t])
|
||||
(%which () (%let (x) (%= x (cons 1 x)))))
|
||||
=> #f
|
||||
|
||||
(%which (y) (%let (x) (%set-of x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 2)])
|
||||
(%more) => #f
|
||||
; XXX I don't know a program that would get these outputs
|
||||
;(%which (y) (%let (x) (%set-of x XXX y))) => `([y . ()])
|
||||
(%more) => #f
|
||||
(%which (y) (%let (x) (%set-of-1 x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 2)])
|
||||
(%more) => #f
|
||||
; XXX I don't know a program that would get these outputs
|
||||
;(%which (y) (%let (x) (%set-of-1 x XXX y))) => #f
|
||||
|
||||
(%which () %true) => empty
|
||||
(%more) => #f
|
||||
|
||||
(%which () (%let (x) (%var x))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%let (x) (%var (cons 1 x)))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%let (x) (%var (vector x)))) => empty
|
||||
(%more) => #f
|
||||
(%which () (%let (x) (%var 1))) => #f
|
||||
(%which () (%let (x) (%and (%= x 1) (%var x)))) => #f
|
||||
|
||||
)
|
||||
Loading…
Reference in New Issue
Block a user