# HG changeset patch # User Steve Losh # Date 1459032808 0 # Node ID e38bc4395d659e0484d9e98300cc6bfa2223abf7 # Parent 7447809d31ad017af38dc5fcdff920beca0f5a94 Blur the lambdas, and fix the instruction argument order diff -r 7447809d31ad -r e38bc4395d65 src/wam/compile.lisp --- a/src/wam/compile.lisp Sat Mar 26 20:40:23 2016 +0000 +++ b/src/wam/compile.lisp Sat Mar 26 22:53:28 2016 +0000 @@ -36,8 +36,8 @@ ;; once we're finished. The children should handle extending ;; the registers as needed. (nconc contents - (mapcar #'(lambda (arg) - (parse arg registers)) + (mapcar (lambda (arg) + (parse arg registers)) arguments))))) (parse (term registers) (cond @@ -90,14 +90,14 @@ Each entry will be a cons of `(a . b)` if register `a` depends on `b`. " - (mapcan #'(lambda (assignment) - (if (variable-assignment-p assignment) - () ; Variable assignments don't depend on anything else - (destructuring-bind (target . (functor . reqs)) - assignment - (declare (ignore functor)) - (loop :for req :in reqs - :collect (cons req target))))) + (mapcan (lambda (assignment) + (if (variable-assignment-p assignment) + () ; Variable assignments don't depend on anything else + (destructuring-bind (target . (functor . reqs)) + assignment + (declare (ignore functor)) + (loop :for req :in reqs + :collect (cons req target))))) registers)) (defun swap-cons (c) @@ -145,15 +145,15 @@ (defun tokenize-assignments (assignments) "Tokenize a flattened set of register assignments into a stream." - (mapcan #'(lambda (ass) - (destructuring-bind (register . (functor . arguments)) ass - ;; Take a single assignment like: - ;; X1 = f(a, b, c) (1 . (f a b c)) - ;; - ;; And turn it into a stream of tokens: - ;; (X1 = f/3), a, b, c (1 f 3) a b c - (cons (list register functor (length arguments)) - arguments))) + (mapcan (lambda (ass) + (destructuring-bind (register . (functor . arguments)) ass + ;; Take a single assignment like: + ;; X1 = f(a, b, c) (1 . (f a b c)) + ;; + ;; And turn it into a stream of tokens: + ;; (X1 = f/3), a, b, c (1 f 3) a b c + (cons (list register functor (length arguments)) + arguments))) assignments)) @@ -194,14 +194,14 @@ (defun generate-query-actions (tokens) (generate-actions tokens #'%put-structure - #'%set-value - #'%set-variable)) + #'%set-variable + #'%set-value)) (defun generate-program-actions (tokens) (generate-actions tokens #'%get-structure - #'%unify-value - #'%unify-variable)) + #'%unify-variable + #'%unify-value)) ;;;; UI @@ -224,8 +224,8 @@ (defun run (wam instructions) "Execute the machine instructions on the given WAM." - (mapc #'(lambda (action) - (apply (car action) wam (cdr action))) + (mapc (lambda (action) + (apply (car action) wam (cdr action))) instructions) (values)) diff -r 7447809d31ad -r e38bc4395d65 src/wam/topological-sort.lisp --- a/src/wam/topological-sort.lisp Sat Mar 26 20:40:23 2016 +0000 +++ b/src/wam/topological-sort.lisp Sat Mar 26 22:53:28 2016 +0000 @@ -32,8 +32,8 @@ (funcall key-test val (cdr constraint)))) (recur (remaining-constraints remaining-elements result) (let ((minimal-element - (find-if #'(lambda (el) - (minimal-p el remaining-constraints)) + (find-if (lambda (el) + (minimal-p el remaining-constraints)) remaining-elements))) (if (null minimal-element) (if (null remaining-elements) diff -r 7447809d31ad -r e38bc4395d65 test/paip.lisp --- a/test/paip.lisp Sat Mar 26 20:40:23 2016 +0000 +++ b/test/paip.lisp Sat Mar 26 22:53:28 2016 +0000 @@ -19,10 +19,10 @@ (defmacro with-db (rules &rest body) `(progn - (clear-db) - ,@(mapcar #'(lambda (rule) `(rule ,@rule)) - rules) - ,@body)) + (clear-db) + ,@(mapcar (lambda (rule) `(rule ,@rule)) + rules) + ,@body)) (defmacro proves (query)