68ed4af71452

Fix flet/labels indentation before I lose my mind
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 26 Mar 2016 12:02:43 +0000
parents 765efa56a965
children 859a6c1314d3
branches/tags (none)
files src/paip.lisp src/wam/compile.lisp src/wam/dump.lisp

Changes

--- 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
--- 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
--- 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 "==>" "  |")