Add wild? and non-wild? predicates.

This commit is contained in:
Tony Garnock-Jones 2012-03-11 13:07:21 -04:00
parent ee6731a9b5
commit 72c646821c
2 changed files with 18 additions and 4 deletions

View File

@ -29,6 +29,8 @@
;; Reexported from unify.rkt for convenience ;; Reexported from unify.rkt for convenience
wild wild
wild?
non-wild?
) )
(struct arrived (who) #:prefab) ;; someone arrived (struct arrived (who) #:prefab) ;; someone arrived

View File

@ -7,6 +7,8 @@
(provide (struct-out variable) (provide (struct-out variable)
(struct-out canonical-variable) (struct-out canonical-variable)
wild wild
wild?
non-wild?
variables-in variables-in
unify unify
unify/env unify/env
@ -45,6 +47,16 @@
(define (wild [base-name '_]) (define (wild [base-name '_])
(variable (gensym base-name))) (variable (gensym base-name)))
;; Any -> Boolean
;; True iff the argument is a variable or canonical-variable.
(define (wild? x)
(or (variable? x) (canonical-variable? x)))
;; Any -> Boolean
;; True iff the argument is neither a variable nor a canonical-variable.
(define (non-wild? x)
(not (wild? x)))
;; Any -> Set<Variable> ;; Any -> Set<Variable>
(define (variables-in x) (define (variables-in x)
(let walk ((x x) (acc (set))) (let walk ((x x) (acc (set)))
@ -134,7 +146,7 @@
(define env (make-hash)) ;; cheeky use of mutation (define env (make-hash)) ;; cheeky use of mutation
(let walk ((t t)) (let walk ((t t))
(cond (cond
[(or (upper-case-symbol? t) (variable? t) (canonical-variable? t)) [(or (upper-case-symbol? t) (wild? t))
(cond [(hash-ref env t #f)] (cond [(hash-ref env t #f)]
[else (define v (canonical-variable (hash-count env))) (hash-set! env t v) v])] [else (define v (canonical-variable (hash-count env))) (hash-set! env t v) v])]
[(pair? t) (cons (walk (car t)) (walk (cdr t)))] [(pair? t) (cons (walk (car t)) (walk (cdr t)))]
@ -178,7 +190,7 @@
(define env (make-hash)) ;; cheeky use of mutation (define env (make-hash)) ;; cheeky use of mutation
(let walk ((t t)) (let walk ((t t))
(cond (cond
[(or (variable? t) (canonical-variable? t)) [(wild? t)
(cond [(hash-ref env t #f)] (cond [(hash-ref env t #f)]
[else (define v ((if (canonical-variable? t) canon-handler var-handler) t env)) [else (define v ((if (canonical-variable? t) canon-handler var-handler) t env))
(hash-set! env t v) (hash-set! env t v)
@ -246,8 +258,8 @@
(define (specialization? a b) (define (specialization? a b)
(let walk ((a a) (b b)) (let walk ((a a) (b b))
(cond (cond
[(or (variable? b) (canonical-variable? b)) #t] [(wild? b) #t]
[(or (variable? a) (canonical-variable? a)) #f] [(wild? a) #f]
[(and (pair? a) (pair? b)) [(and (pair? a) (pair? b))
(and (walk (car a) (car b)) (walk (cdr a) (cdr b)))] (and (walk (car a) (car b)) (walk (cdr a) (cdr b)))]
[(and (vector? a) (vector? b) (= (vector-length a) (vector-length b))) [(and (vector? a) (vector? b) (= (vector-length a) (vector-length b)))