-
-
Save anentropic/976121f288e7f0a2e91e8de082f44096 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang racket | |
(require datalog) | |
(define (make-echo-hash) | |
(impersonate-hash | |
(make-hash) | |
; ref-proc | |
(lambda (hash key) | |
(printf "<ref> ~a\n" key) | |
(values | |
key | |
(lambda (hash key val) (printf "<ref-found> ~a: ~a\n" key val)))) | |
(lambda (hash key val) | |
(printf "<set> ~s: ~a\n" key val) | |
(values key val)) | |
; remove-proc | |
(lambda (hash key) | |
(printf "<remove> ~a\n" key) | |
key) | |
; key-proc | |
(lambda (hash key) | |
(printf "<key> ~a\n" key) | |
key) | |
; clear-proc | |
(lambda (hash) | |
(printf "<clear>\n") | |
(hash-clear! hash)) | |
; equal-key-proc | |
(lambda (hash key) | |
(printf "<equal-key> ~a\n" key) | |
key))) | |
(define family (make-echo-hash)) | |
(datalog family | |
(! (male bill)) | |
(! (male buster)) | |
(! (male mike)) | |
(! (male paul)) | |
(! (male simon)) | |
(! (male sam)) | |
(! (female dee)) | |
(! (female kath)) | |
(! (female caroline)) | |
(! (female sophy)) | |
(! (parent bill caroline)) | |
(! (parent dee caroline)) | |
(! (parent buster mike)) | |
(! (parent kath mike)) | |
(! (parent mike paul)) | |
(! (parent caroline paul)) | |
(! (parent mike simon)) | |
(! (parent caroline simon)) | |
(! (parent simon sam)) | |
(! (parent sophy sam)) | |
(! (spouse simon sophy)) | |
(! (spouse bill dee)) | |
(! (spouse buster kath)) | |
(! (:- (father X Y) | |
(parent X Y) | |
(male X))) | |
(! (:- (mother X Y) | |
(parent X Y) | |
(female X))) | |
(! (:- (grandparent X Z) | |
(parent Y Z) | |
(parent X Y))) | |
(! (:- (grandfather X Y) | |
(grandparent X Y) | |
(male X))) | |
(! (:- (grandmother X Y) | |
(grandparent X Y) | |
(female X))) | |
(! (:- (child X Y) | |
(parent Y X))) | |
(! (:- (son X Y) | |
(child X Y) | |
(male X))) | |
(! (:- (daughter X Y) | |
(child X Y) | |
(female X))) | |
(! (:- (sibling X Y) | |
(parent Z X) | |
(parent Z Y) | |
(!= X Y))) | |
(! (:- (brother X Y) | |
(sibling X Y) | |
(male X))) | |
(! (:- (sister X Y) | |
(sibling X Y) | |
(female X))) | |
(! (:- (married X Y) | |
(spouse X Y))) | |
(! (:- (married X Y) | |
(spouse Y X))) | |
(! (:- (husband X Y) | |
(married X Y) | |
(male X))) | |
(! (:- (wife X Y) | |
(married X Y) | |
(female X))) | |
(! (:- (ommer X Y) | |
(parent Z Y) | |
(sibling X Z))); 'blood' | |
(! (:- (ommer X Y) | |
(parent Z Y) | |
(sibling S Z) | |
(married S X))); 'by marriage' | |
(! (:- (uncle X Y) | |
(ommer X Y) | |
(male X))) | |
(! (:- (aunt X Y) | |
(ommer X Y) | |
(female X))) | |
(! (:- (nibling X Y) | |
(ommer Y X))) | |
(! (:- (nephew X Y) | |
(nibling X Y) | |
(male X))) | |
(! (:- (niece X Y) | |
(nibling X Y) | |
(female X))) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
The code above loads and runs fine (the current impersonator is stupid, I just wanted to see it working before implementing something different). I have been running it in DrRacket 7.7 3m.
The error comes when I make a 'query' against the theory in the repl panel: