# HG changeset patch # User Steve Losh # Date 1458993763 0 # Node ID 68ed4af714526719e3213074c243e8964400ce57 # Parent 765efa56a96592a690f9f9f94aa16249126327be Fix flet/labels indentation before I lose my mind diff -r 765efa56a965 -r 68ed4af71452 src/paip.lisp --- a/src/paip.lisp Fri Mar 25 18:52:21 2016 +0000 +++ b/src/paip.lisp Sat Mar 26 12:02:43 2016 +0000 @@ -102,53 +102,52 @@ (defun unify (x y &optional (bindings no-bindings)) "Unify the two terms and return bindings necessary to do so (or FAIL)." - (flet ((unify-variable - (variable target bindings) - (cond - ;; If we've already got a binding for this variable, we can try to - ;; unify its value with the target. - ((get-binding variable bindings) - (unify (lookup variable bindings) target bindings)) + (flet ((unify-variable (variable target bindings) + (cond + ;; If we've already got a binding for this variable, we can try to + ;; unify its value with the target. + ((get-binding variable bindings) + (unify (lookup variable bindings) target bindings)) - ;; If the target is ALSO a variable, and it has a binding, then we - ;; can unify this variable with the target's value. - ((and (variable-p target) (get-binding target bindings)) - (unify variable (lookup target bindings) bindings)) + ;; If the target is ALSO a variable, and it has a binding, then we + ;; can unify this variable with the target's value. + ((and (variable-p target) (get-binding target bindings)) + (unify variable (lookup target bindings) bindings)) - ;; If this variable occurs in the target (including in something - ;; in its bindings) and we're checking occurrence, bail. - ((and *check-occurs* (check-occurs variable target bindings)) - fail) + ;; If this variable occurs in the target (including in something + ;; in its bindings) and we're checking occurrence, bail. + ((and *check-occurs* (check-occurs variable target bindings)) + fail) - ;; Otherwise we can just bind this variable to the target. - (t (extend-bindings variable target bindings))))) + ;; Otherwise we can just bind this variable to the target. + (t (extend-bindings variable target bindings))))) (cond - ;; Pass failures through. - ((eq bindings fail) fail) + ;; Pass failures through. + ((eq bindings fail) fail) - ;; Trying to unify two identical objects (constants or variables) can just - ;; return the bindings as-is. - ;; - ;; ex: (unify :y :y) or (unify 'foo 'foo) - ((eql x y) bindings) + ;; Trying to unify two identical objects (constants or variables) can just + ;; return the bindings as-is. + ;; + ;; ex: (unify :y :y) or (unify 'foo 'foo) + ((eql x y) bindings) - ;; Unifying a variable with something. - ((variable-p x) (unify-variable x y bindings)) - ((variable-p y) (unify-variable y x bindings)) + ;; Unifying a variable with something. + ((variable-p x) (unify-variable x y bindings)) + ((variable-p y) (unify-variable y x bindings)) - ;; Unifying a non-variable with nil should fail, except for nil itself. - ;; But that was handled with (eql x y). - ((or (null x) (null y)) fail) + ;; Unifying a non-variable with nil should fail, except for nil itself. + ;; But that was handled with (eql x y). + ((or (null x) (null y)) fail) - ;; Unifying non-empty compound terms such as - ;; (likes :x cats) with (likes sally :y). - ((and (listp x) (listp y)) - (unify (rest x) (rest y) ; Unify the tails with the bindings gotten from... - (unify (first x) (first y) bindings))) ; unifying the heads. + ;; Unifying non-empty compound terms such as + ;; (likes :x cats) with (likes sally :y). + ((and (listp x) (listp y)) + (unify (rest x) (rest y) ; Unify the tails with the bindings gotten from... + (unify (first x) (first y) bindings))) ; unifying the heads. - ;; Otherwise we're looking at different constants, or a constant and a - ;; compound term, so just give up. - (t fail)))) + ;; Otherwise we're looking at different constants, or a constant and a + ;; compound term, so just give up. + (t fail)))) ;;;; Substitution diff -r 765efa56a965 -r 68ed4af71452 src/wam/compile.lisp --- a/src/wam/compile.lisp Fri Mar 25 18:52:21 2016 +0000 +++ b/src/wam/compile.lisp Sat Mar 26 12:02:43 2016 +0000 @@ -8,17 +8,14 @@ ;; X1 -> A ;; X2 -> q(X1, X3) ;; X3 -> B - (labels ((variable-p - (term) + (labels ((variable-p (term) (keywordp term)) - (parse-variable - (var registers) + (parse-variable (var registers) ;; If we've already seen this variable, just return its position, ;; otherwise allocate a register for it. (or (position var registers) (vector-push-extend var registers))) - (parse-structure - (structure registers) + (parse-structure (structure registers) (let* ((functor (first structure)) (arguments (rest structure)) (contents (list functor))) @@ -32,9 +29,9 @@ (parse arg registers)) arguments))))) (parse (term registers) - (if (variable-p term) - (parse-variable term registers) - (parse-structure term registers)))) + (if (variable-p term) + (parse-variable term registers) + (parse-structure term registers)))) (let ((registers (make-array 64 :fill-pointer 0 :adjustable t))) (parse term registers) (loop :for i :from 0 @@ -53,11 +50,9 @@ ;; into something like: ;; ;; X2 -> q(X1, X3), X0 -> p(X1, X2) - (labels ((variable-assignment-p - (ass) + (labels ((variable-assignment-p (ass) (keywordp (cdr ass))) - (assignment-less-p - (ass1 ass2) + (assignment-less-p (ass1 ass2) (cond ;; If 2 is a variable assignment, nothing can be less than it. ((variable-assignment-p ass2) nil) @@ -112,12 +107,10 @@ ;; (#'set-value 1) ;; (#'set-value 2) (let ((seen (list))) - (flet ((handle-structure - (register functor arity) + (flet ((handle-structure (register functor arity) (push register seen) (list #'put-structure functor arity register)) - (handle-register - (register) + (handle-register (register) (if (member register seen) (list #'set-value register) (progn diff -r 765efa56a965 -r 68ed4af71452 src/wam/dump.lisp --- a/src/wam/dump.lisp Fri Mar 25 18:52:21 2016 +0000 +++ b/src/wam/dump.lisp Sat Mar 26 12:02:43 2016 +0000 @@ -21,8 +21,7 @@ (format t " +------+-----+--------------+----------------------------+~%") (when (> from 0) (format t " | ⋮ | ⋮ | ⋮ | |~%")) - (flet ((print-cell - (i cell) + (flet ((print-cell (i cell) (let ((hi (= i highlight))) (format t "~A ~4@A | ~A | ~12@A | ~26A ~A~%" (if hi "==>" " |")