suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixing racklog tests broken by bf95ee105

Browse Source
This commit is contained in:
Jay McCarthy 2012-06-01 17:32:41 -06:00
parent 7d506713dd
commit 3348ea1ae2
1 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/racklog/lang/compiler.rkt
View File

@ -22,7 +22,8 @@
(set->list
(for/seteq ([s (in-list p)]
#:when (assertion? s))
(clause-predicate (assertion-clause s)))))])
(coerce-sym
(clause-predicate (assertion-clause s))))))])
(quasisyntax
(#%module-begin
(require racklog
@ -31,8 +32,16 @@
...
#,@(map compile-statement p)))))
(define coerce-sym
(match-lambda
[(predicate-sym _ s)
s]
[(? symbol? s)
s]))
(define pred-cache (make-hasheq))
(define (pred->stx p)
(define (pred->stx maybe-p)
(define p (coerce-sym maybe-p))
(hash-ref! pred-cache p
(λ ()
(datum->syntax #f p))))
@ -67,7 +76,7 @@
[(literal _ _ ts)
(for/seteq ([t (in-list ts)]
#:when (variable? t))
(variable-sym t))]))
(coerce-sym (variable-sym t)))]))
(define clause-variables
(match-lambda
@ -108,7 +117,7 @@
(define compile-term
(match-lambda
[(variable srcloc sym)
(datum->syntax #f sym srcloc)]
(datum->syntax #f (coerce-sym sym) srcloc)]
[(constant srcloc (? string? str))
(datum->syntax #f str srcloc)]
[(constant srcloc (? symbol? sym))