diff --git a/collects/schelog/dialects/dialects-supported.scm b/collects/schelog/dialects/dialects-supported.scm index 84974dd1b1..1e35bc5329 100644 --- a/collects/schelog/dialects/dialects-supported.scm +++ b/collects/schelog/dialects/dialects-supported.scm @@ -1,4 +1,6 @@ -;last change: 2003-06-01 +#lang racket + +#|;last change: 2003-06-01 bigloo gambit @@ -14,3 +16,4 @@ scsh stk sxm umbscheme +|# \ No newline at end of file diff --git a/collects/schelog/dialects/files-to-be-ported.scm b/collects/schelog/dialects/files-to-be-ported.scm index 3c2ffa5dab..0ea28bc9cb 100644 --- a/collects/schelog/dialects/files-to-be-ported.scm +++ b/collects/schelog/dialects/files-to-be-ported.scm @@ -1 +1,4 @@ -schelog.scm +#lang racket + +#|schelog.scm +|# diff --git a/collects/schelog/examples/bible.scm b/collects/schelog/examples/bible.rkt similarity index 99% rename from collects/schelog/examples/bible.scm rename to collects/schelog/examples/bible.rkt index c71163e0e8..7a055e10ea 100644 --- a/collects/schelog/examples/bible.scm +++ b/collects/schelog/examples/bible.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../schelog.scm" +(require "../schelog.rkt" schemeunit) ;The following is the "Biblical" database from "The Art of diff --git a/collects/schelog/examples/england.scm b/collects/schelog/examples/england.rkt similarity index 84% rename from collects/schelog/examples/england.scm rename to collects/schelog/examples/england.rkt index 658f7a8348..3a911d6400 100644 --- a/collects/schelog/examples/england.scm +++ b/collects/schelog/examples/england.rkt @@ -1,3 +1,8 @@ +#lang racket + +(require "../schelog.rkt" + schemeunit) + ;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 ;your ability to read the syntax. @@ -6,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)))) diff --git a/collects/schelog/examples/england2.scm b/collects/schelog/examples/england2.rkt similarity index 97% rename from collects/schelog/examples/england2.scm rename to collects/schelog/examples/england2.rkt index c3adf64846..aecc98f3aa 100644 --- a/collects/schelog/examples/england2.scm +++ b/collects/schelog/examples/england2.rkt @@ -1,3 +1,7 @@ +#lang racket + +(require "../schelog.rkt") + ;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 ;your ability to read the syntax. diff --git a/collects/schelog/examples/games.scm b/collects/schelog/examples/games.rkt similarity index 92% rename from collects/schelog/examples/games.scm rename to collects/schelog/examples/games.rkt index 8abdd0889a..9575a08595 100644 --- a/collects/schelog/examples/games.scm +++ b/collects/schelog/examples/games.rkt @@ -1,6 +1,8 @@ #lang scheme -(require "../schelog.scm" "./puzzle.scm") +(require "../schelog.rkt" + "./puzzle.rkt" + schemeunit) ;;This example is from Sterling & Shapiro, p. 214. ;; @@ -85,3 +87,6 @@ ;;ask (solve-puzzle %games) to get the solution, which is ;; ;;((michael is the australian) (richard plays tennis)) + +(check-equal? (solve-puzzle %games) + '((solution= ((michael is the australian) (richard plays tennis))))) diff --git a/collects/schelog/examples/holland.scm b/collects/schelog/examples/holland.rkt similarity index 94% rename from collects/schelog/examples/holland.scm rename to collects/schelog/examples/holland.rkt index 5a39e77eec..c7aa0b8be1 100644 --- a/collects/schelog/examples/holland.scm +++ b/collects/schelog/examples/holland.rkt @@ -1,3 +1,7 @@ +#lang racket + +(require "../schelog.rkt") + ;This is a very trivial program. In Prolog, it would be: ; ; city(amsterdam). diff --git a/collects/schelog/examples/houses.scm b/collects/schelog/examples/houses.rkt similarity index 87% rename from collects/schelog/examples/houses.scm rename to collects/schelog/examples/houses.rkt index 663216bf94..08e4601215 100644 --- a/collects/schelog/examples/houses.scm +++ b/collects/schelog/examples/houses.rkt @@ -1,3 +1,7 @@ +#lang racket + +(require "../schelog.rkt") + ;Exercise 14.1 (iv) from Sterling & Shapiro, p. 217-8 ;There are 5 houses, each of a different color and inhabited @@ -25,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) @@ -58,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 @@ -122,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) diff --git a/collects/schelog/examples/mapcol.scm b/collects/schelog/examples/mapcol.rkt similarity index 83% rename from collects/schelog/examples/mapcol.scm rename to collects/schelog/examples/mapcol.rkt index 5970cd6050..3c0de24d9c 100644 --- a/collects/schelog/examples/mapcol.scm +++ b/collects/schelog/examples/mapcol.rkt @@ -1,23 +1,29 @@ +#lang racket + +(require (except-in "../schelog.rkt" %member)) + ;map coloring, example from Sterling & Shapiro, p. 212 ;(%member x y) holds if x is in y +;; 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)))) @@ -29,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)) @@ -70,7 +76,7 @@ (region 'austria A (list I S G))))))) (define %colors - (%rel () + (%rel ! () (('(red yellow blue white))))) ;ask (%which (M) (%test-color 'test M)) or diff --git a/collects/schelog/examples/puzzle.scm b/collects/schelog/examples/puzzle.rkt similarity index 97% rename from collects/schelog/examples/puzzle.scm rename to collects/schelog/examples/puzzle.rkt index d58717e605..302fcd9594 100644 --- a/collects/schelog/examples/puzzle.scm +++ b/collects/schelog/examples/puzzle.rkt @@ -1,6 +1,6 @@ #lang scheme -(require "../schelog.scm") +(require "../schelog.rkt") (provide (all-defined-out)) diff --git a/collects/schelog/examples/toys.scm b/collects/schelog/examples/toys.rkt similarity index 82% rename from collects/schelog/examples/toys.scm rename to collects/schelog/examples/toys.rkt index 41f1af22f9..628a071dea 100644 --- a/collects/schelog/examples/toys.scm +++ b/collects/schelog/examples/toys.rkt @@ -1,17 +1,21 @@ +#lang racket + +(require (except-in "../schelog.rkt" %append)) + ;A list of trivial programs in Prolog, just so you can get used ;to schelog syntax. ;(%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)))) @@ -19,7 +23,7 @@ ;(%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)))) @@ -27,31 +31,31 @@ ;counting duplicates '(define %count - (%rel (x n y) + (%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) + (%rel ! (x y z yy) (('() '())) (((cons x y) z) (%reverse y yy) (%append yy (list x) z)))) @@ -59,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!) + (%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!))))) @@ -76,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!))))) diff --git a/collects/schelog/info.ss b/collects/schelog/info.ss new file mode 100644 index 0000000000..13a63c4835 --- /dev/null +++ b/collects/schelog/info.ss @@ -0,0 +1,2 @@ +#lang setup/infotab + diff --git a/collects/schelog/schelog.scm b/collects/schelog/schelog.rkt similarity index 100% rename from collects/schelog/schelog.scm rename to collects/schelog/schelog.rkt