45 lines
1.6 KiB
Scheme
45 lines
1.6 KiB
Scheme
(begin
|
|
(define-macro (first sequence) `(list-ref ,sequence 0))
|
|
(define-macro car first)
|
|
(define-macro (rest sequence) `(list-tail ,sequence 1))
|
|
(define-macro cdr rest)
|
|
(define-macro and
|
|
(lambda args
|
|
(if (null? args) #t
|
|
(if (= (length args) 1) (car args)
|
|
`(if ,(car args) (and ,@(cdr args)) #n)
|
|
))))
|
|
(define-macro or
|
|
(lambda args
|
|
(if (null? args) #f
|
|
(if (= (length args) 1) (car args)
|
|
(let ((g-first (gensym)))
|
|
`(let ((,g-first ,(car args)))
|
|
(if ,g-first ,g-first (or ,@(cdr args)))))
|
|
))))
|
|
(define (unify x y) (unify-match-all (dict) x y))
|
|
(define (unify-match-all subst x y)
|
|
(cond
|
|
((= x y) subst)
|
|
((= subst #n) #n)
|
|
((unify-var? x) (unify-match-var subst x y))
|
|
((unify-var? y) (unify-match-var subst y x))
|
|
((or (atom? x) (atom? y)) #n)
|
|
(#t (unify-match-all (unify-match-all subst (car x) (car y)) (cdr x) (cdr y)))))
|
|
(define (unify-match-var subst var val)
|
|
(cond
|
|
((= var val) subst)
|
|
((dict-has subst var) (unify-match-all subst (dict-get subst var) val))
|
|
((and (unify-var? val) (dict-has subst val)) (unify-match-all subst var (dict-get subst val)))
|
|
((unify-occurs-in? subst var val) #n)
|
|
(#t (dict-add subst var val))))
|
|
(define (unify-occurs-in? subst var x)
|
|
(cond
|
|
((= var x) #t)
|
|
((dict-has subst x) (unify-occurs-in? subst var (dict-get subst x)))
|
|
((and (list? x) (> (length x) 0)) (or (unify-occurs-in? subst var (car x)) (unify-occurs-in? subst var (cdr x))))
|
|
(#t #n)))
|
|
(define (unify-var? x) (list-has '(X Y Z) x))
|
|
(define (unify-var? x) (and (> (length x) 0) (= (car x) ":")))
|
|
)
|