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