syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Leave Racket's objects opaque to unification.

This commit is contained in:
Tony Garnock-Jones 2012-05-09 13:44:11 -04:00
parent 8f10b2ad4d
commit 7395f9b1fa
1 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
unify.rkt
View File

@ -2,6 +2,7 @@
(require racket/set)
(require racket/match)
(require (only-in racket/class object?))
(require "struct-map.rkt")
(provide (struct-out variable)
@ -57,6 +58,13 @@
(define (non-wild? x)
(not (wild? x)))
;; Any -> Boolean
;; Racket objects are structures, so we reject them explicitly for
;; now, leaving them opaque to unification.
(define (non-object-struct? x)
(and (struct? x)
(not (object? x))))
;; Any -> Set<Variable>
(define (variables-in x)
(let walk ((x x) (acc (set)))
@ -64,7 +72,7 @@
[(variable? x) (set-add acc x)]
[(pair? x) (walk (car x) (walk (cdr x) acc))]
[(vector? x) (foldl walk acc (vector->list x))]
[(struct? x) (walk (struct->vector x #f) acc)]
[(non-object-struct? x) (walk (struct->vector x #f) acc)]
[else acc])))
;; Variable Any -> Boolean
@ -74,7 +82,7 @@
[(eq? var x) #t]
[(pair? x) (or (walk (car x)) (walk (cdr x)))]
[(vector? x) (ormap walk (vector->list x))]
[(struct? x) (walk (struct->vector x #f))]
[(non-object-struct? x) (walk (struct->vector x #f))]
[else #f])))
;; Variable Any Subst -> Subst
@ -115,7 +123,7 @@
(walk (car a) (car b) (walk (cdr a) (cdr b) env))]
[(and (vector? a) (vector? b) (= (vector-length a) (vector-length b)))
(for/fold ([env env]) ([ea a] [eb b]) (walk ea eb env))]
[(and (struct? a) (struct? b))
[(and (non-object-struct? a) (non-object-struct? b))
(walk (struct->vector a #f) (struct->vector b #f) env)]
[else (and (equal? a b) env)])))))
@ -138,7 +146,7 @@
(define-values (val env1) (walk (vector-ref x i) env))
(vector-set! result i val)
env1))]
[(struct? x) (struct-map/accumulator walk env x)]
[(non-object-struct? x) (struct-map/accumulator walk env x)]
[else (values x env)])))
;; Any -> Any
@ -151,7 +159,7 @@
[else (define v (canonical-variable (hash-count env))) (hash-set! env t v) v])]
[(pair? t) (cons (walk (car t)) (walk (cdr t)))]
[(vector? t) (list->vector (map walk (vector->list t)))]
[(struct? t) (struct-map walk t)]
[(non-object-struct? t) (struct-map walk t)]
[else t])))
;; Any -> Boolean
@ -197,7 +205,7 @@
v])]
[(pair? t) (cons (walk (car t)) (walk (cdr t)))]
[(vector? t) (list->vector (map walk (vector->list t)))]
[(struct? t) (struct-map walk t)]
[(non-object-struct? t) (struct-map walk t)]
[else t])))
;; Any -> Any
@ -251,7 +259,7 @@
(cond
[(pair? x) (cons (walk (car x)) (walk (cdr x)))]
[(vector? x) (list->vector (map walk (vector->list x)))]
[(struct? x) (struct-map walk x)]
[(non-object-struct? x) (struct-map walk x)]
[else x])))
;; True iff a is a specialization (or instance) of b.
@ -264,7 +272,7 @@
(and (walk (car a) (car b)) (walk (cdr a) (cdr b)))]
[(and (vector? a) (vector? b) (= (vector-length a) (vector-length b)))
(for/and ([aa a] [bb b]) (walk aa bb))]
[(and (struct? a) (struct? b))
[(and (non-object-struct? a) (non-object-struct? b))
(walk (struct->vector a #f) (struct->vector b #f))]
[else (equal? a b)])))