# HG changeset patch # User Steve Losh # Date 1468160928 0 # Node ID 8cd3257c58e3c821211401965c8ef78c082d096c # Parent ba205f6b2875d04e69f4a26f1c31819d8548de8e Name the subterm-handling instructions something not completely stupid The `unify-*` instructions in the original WAM are used both in both program mode and query mode. In program mode, they are used to unify subterms of arguments with things. In query mode, they are used to write the subterms of the arguments into the head. You may have noticed the common word in both of these descriptions is "subterm" and not "unify". Let's use that word to name the instructions so it's less confusing. diff -r ba205f6b2875 -r 8cd3257c58e3 src/circle.lisp --- a/src/circle.lisp Sun Jul 10 14:21:18 2016 +0000 +++ b/src/circle.lisp Sun Jul 10 14:28:48 2016 +0000 @@ -28,8 +28,8 @@ ;;; 2. When we see a `:get-structure-* CONSTANT LOCALREG` instruction: ;;; A. Remove it in-place, so the next node will be processed on the next ;;; iteration (remember, we're iterating backwards). -;;; B. Search forward for the corresponding `:unify-variable` instruction and -;;; replace it in-place with the `:unify-constant` instruction. +;;; B. Search forward for the corresponding `:subterm-variable` instruction +;;; and replace it in-place with the `:subterm-constant` instruction. ;;; ;;; Of course you could do all this with immutable data structures, but it'll be ;;; pretty slow. And since one of the primary goals of this project is to be diff -r ba205f6b2875 -r 8cd3257c58e3 src/wam/bytecode.lisp --- a/src/wam/bytecode.lisp Sun Jul 10 14:21:18 2016 +0000 +++ b/src/wam/bytecode.lisp Sun Jul 10 14:28:48 2016 +0000 @@ -25,11 +25,11 @@ (+opcode-put-value-local+ 3) (+opcode-put-value-stack+ 3) - (+opcode-unify-variable-local+ 2) - (+opcode-unify-variable-stack+ 2) - (+opcode-unify-value-local+ 2) - (+opcode-unify-value-stack+ 2) - (+opcode-unify-void+ 2) + (+opcode-subterm-variable-local+ 2) + (+opcode-subterm-variable-stack+ 2) + (+opcode-subterm-value-local+ 2) + (+opcode-subterm-value-stack+ 2) + (+opcode-subterm-void+ 2) (+opcode-call+ 2) (+opcode-dynamic-call+ 1) @@ -44,7 +44,7 @@ (+opcode-get-constant+ 3) (+opcode-put-constant+ 3) - (+opcode-unify-constant+ 2) + (+opcode-subterm-constant+ 2) (+opcode-get-list+ 2) (+opcode-put-list+ 2))) @@ -67,11 +67,11 @@ (+opcode-put-value-local+ "PUT-VALUE") (+opcode-put-value-stack+ "PUT-VALUE") - (+opcode-unify-variable-local+ "UNIFY-VARIABLE") - (+opcode-unify-variable-stack+ "UNIFY-VARIABLE") - (+opcode-unify-value-local+ "UNIFY-VALUE") - (+opcode-unify-value-stack+ "UNIFY-VALUE") - (+opcode-unify-void+ "UNIFY-VOID") + (+opcode-subterm-variable-local+ "SUBTERM-VARIABLE") + (+opcode-subterm-variable-stack+ "SUBTERM-VARIABLE") + (+opcode-subterm-value-local+ "SUBTERM-VALUE") + (+opcode-subterm-value-stack+ "SUBTERM-VALUE") + (+opcode-subterm-void+ "SUBTERM-VOID") (+opcode-call+ "CALL") (+opcode-dynamic-call+ "DYNAMIC-CALL") @@ -86,7 +86,7 @@ (+opcode-get-constant+ "GET-CONSTANT") (+opcode-put-constant+ "PUT-CONSTANT") - (+opcode-unify-constant+ "UNIFY-CONSTANT") + (+opcode-subterm-constant+ "SUBTERM-CONSTANT") (+opcode-get-list+ "GET-LIST") (+opcode-put-list+ "PUT-LIST"))) @@ -108,11 +108,11 @@ (+opcode-put-value-local+ "PVLU") (+opcode-put-value-stack+ "PVLU") - (+opcode-unify-variable-local+ "UVAR") - (+opcode-unify-variable-stack+ "UVAR") - (+opcode-unify-value-local+ "UVLU") - (+opcode-unify-value-stack+ "UVLU") - (+opcode-unify-void+ "UVOI") + (+opcode-subterm-variable-local+ "SVAR") + (+opcode-subterm-variable-stack+ "SVAR") + (+opcode-subterm-value-local+ "SVLU") + (+opcode-subterm-value-stack+ "SVLU") + (+opcode-subterm-void+ "SVOI") (+opcode-call+ "CALL") (+opcode-dynamic-call+ "DYCL") @@ -127,7 +127,7 @@ (+opcode-get-constant+ "GCON") (+opcode-put-constant+ "PCON") - (+opcode-unify-constant+ "UCON") + (+opcode-subterm-constant+ "UCON") (+opcode-get-list+ "GLST") (+opcode-put-list+ "PLST"))) diff -r ba205f6b2875 -r 8cd3257c58e3 src/wam/compiler.lisp --- a/src/wam/compiler.lisp Sun Jul 10 14:21:18 2016 +0000 +++ b/src/wam/compiler.lisp Sun Jul 10 14:28:48 2016 +0000 @@ -883,11 +883,11 @@ ;;; into a list of instructions, each of which is a list: ;;; ;;; (:put-structure X2 q 2) -;;; (:unify-variable X1) -;;; (:unify-variable X3) +;;; (:subterm-variable X1) +;;; (:subterm-variable X3) ;;; (:put-structure X0 p 2) -;;; (:unify-value X1) -;;; (:unify-value X2) +;;; (:subterm-value X1) +;;; (:subterm-value X2) ;;; ;;; The opcodes are keywords and the register arguments remain register objects. ;;; They get converted down to the raw bytes in the final "rendering" step. @@ -996,13 +996,13 @@ (:query :put-list))) (:register (if first-seen (case register-variant - (:local :unify-variable-local) - (:stack :unify-variable-stack) - (:void :unify-void)) + (:local :subterm-variable-local) + (:stack :subterm-variable-stack) + (:void :subterm-void)) (case register-variant - (:local :unify-value-local) - (:stack :unify-value-stack) - (:void :unify-void))))))) + (:local :subterm-value-local) + (:stack :subterm-value-stack) + (:void :subterm-void))))))) (defun precompile-tokens (wam head-tokens body-tokens) @@ -1254,35 +1254,35 @@ ;; 2. put_structure c/0, Ai -> put_constant c, Ai (circle-replace node `(:put-constant ,constant ,register))) -(defun optimize-unify-constant-query (node constant register) +(defun optimize-subterm-constant-query (node constant register) ;; 3. put_structure c/0, Xi *** WE ARE HERE ;; ... - ;; unify_value Xi -> unify_constant c + ;; subterm_value Xi -> subterm_constant c (loop :with previous = (circle-prev node) ;; Search for the corresponding set-value instruction :for n = (circle-forward-remove node) :then (circle-forward n) :while n :for (opcode . arguments) = (circle-value n) - :when (and (eql opcode :unify-value-local) + :when (and (eql opcode :subterm-value-local) (register= register (first arguments))) :do - (circle-replace n `(:unify-constant ,constant)) + (circle-replace n `(:subterm-constant ,constant)) (return previous))) -(defun optimize-unify-constant-program (node constant register) - ;; 4. unify_variable Xi -> unify_constant c +(defun optimize-subterm-constant-program (node constant register) + ;; 4. subterm_variable Xi -> subterm_constant c ;; ... ;; get_structure c/0, Xi *** WE ARE HERE (loop - ;; Search backward for the corresponding unify-variable instruction + ;; Search backward for the corresponding subterm-variable instruction :for n = (circle-backward node) :then (circle-backward n) :while n :for (opcode . arguments) = (circle-value n) - :when (and (eql opcode :unify-variable-local) + :when (and (eql opcode :subterm-variable-local) (register= register (first arguments))) :do - (circle-replace n `(:unify-constant ,constant)) + (circle-replace n `(:subterm-constant ,constant)) (return (circle-backward-remove node)))) (defun optimize-constants (wam instructions) @@ -1301,14 +1301,14 @@ (setf node (if (register-argument-p register) (optimize-put-constant node functor register) - (optimize-unify-constant-query node functor register)))) + (optimize-subterm-constant-query node functor register)))) ((guard `(:get-structure ,functor ,register) (constant-p functor)) (setf node (if (register-argument-p register) (optimize-get-constant node functor register) - (optimize-unify-constant-program node functor register)))))) + (optimize-subterm-constant-program node functor register)))))) instructions)) @@ -1321,7 +1321,7 @@ :while node :for opcode = (car (circle-value node)) :when (or (eq opcode :set-void) - (eq opcode :unify-void)) + (eq opcode :subterm-void)) :do (loop :with beginning = (circle-backward node) @@ -1349,36 +1349,36 @@ (defun render-opcode (opcode) (ecase opcode - (:get-structure +opcode-get-structure+) - (:get-variable-local +opcode-get-variable-local+) - (:get-variable-stack +opcode-get-variable-stack+) - (:get-value-local +opcode-get-value-local+) - (:get-value-stack +opcode-get-value-stack+) - (:put-structure +opcode-put-structure+) - (:put-variable-local +opcode-put-variable-local+) - (:put-variable-stack +opcode-put-variable-stack+) - (:put-value-local +opcode-put-value-local+) - (:put-value-stack +opcode-put-value-stack+) - (:unify-variable-local +opcode-unify-variable-local+) - (:unify-variable-stack +opcode-unify-variable-stack+) - (:unify-value-local +opcode-unify-value-local+) - (:unify-value-stack +opcode-unify-value-stack+) - (:unify-void +opcode-unify-void+) - (:put-constant +opcode-put-constant+) - (:get-constant +opcode-get-constant+) - (:get-list +opcode-get-list+) - (:put-list +opcode-put-list+) - (:unify-constant +opcode-unify-constant+) - (:call +opcode-call+) - (:dynamic-call +opcode-dynamic-call+) - (:proceed +opcode-proceed+) - (:allocate +opcode-allocate+) - (:deallocate +opcode-deallocate+) - (:done +opcode-done+) - (:try +opcode-try+) - (:retry +opcode-retry+) - (:trust +opcode-trust+) - (:cut +opcode-cut+))) + (:get-structure +opcode-get-structure+) + (:get-variable-local +opcode-get-variable-local+) + (:get-variable-stack +opcode-get-variable-stack+) + (:get-value-local +opcode-get-value-local+) + (:get-value-stack +opcode-get-value-stack+) + (:put-structure +opcode-put-structure+) + (:put-variable-local +opcode-put-variable-local+) + (:put-variable-stack +opcode-put-variable-stack+) + (:put-value-local +opcode-put-value-local+) + (:put-value-stack +opcode-put-value-stack+) + (:subterm-variable-local +opcode-subterm-variable-local+) + (:subterm-variable-stack +opcode-subterm-variable-stack+) + (:subterm-value-local +opcode-subterm-value-local+) + (:subterm-value-stack +opcode-subterm-value-stack+) + (:subterm-void +opcode-subterm-void+) + (:put-constant +opcode-put-constant+) + (:get-constant +opcode-get-constant+) + (:get-list +opcode-get-list+) + (:put-list +opcode-put-list+) + (:subterm-constant +opcode-subterm-constant+) + (:call +opcode-call+) + (:dynamic-call +opcode-dynamic-call+) + (:proceed +opcode-proceed+) + (:allocate +opcode-allocate+) + (:deallocate +opcode-deallocate+) + (:done +opcode-done+) + (:try +opcode-try+) + (:retry +opcode-retry+) + (:trust +opcode-trust+) + (:cut +opcode-cut+))) (defun render-argument (argument) (etypecase argument diff -r ba205f6b2875 -r 8cd3257c58e3 src/wam/constants.lisp --- a/src/wam/constants.lisp Sun Jul 10 14:21:18 2016 +0000 +++ b/src/wam/constants.lisp Sun Jul 10 14:28:48 2016 +0000 @@ -128,11 +128,11 @@ +opcode-put-value-stack+ ;; Subterm - +opcode-unify-variable-local+ - +opcode-unify-variable-stack+ - +opcode-unify-value-local+ - +opcode-unify-value-stack+ - +opcode-unify-void+ + +opcode-subterm-variable-local+ + +opcode-subterm-variable-stack+ + +opcode-subterm-value-local+ + +opcode-subterm-value-stack+ + +opcode-subterm-void+ ;; Control +opcode-call+ @@ -149,7 +149,7 @@ ;; Constants +opcode-get-constant+ +opcode-put-constant+ - +opcode-unify-constant+ + +opcode-subterm-constant+ ;; Lists +opcode-get-list+ diff -r ba205f6b2875 -r 8cd3257c58e3 src/wam/dump.lisp --- a/src/wam/dump.lisp Sun Jul 10 14:21:18 2016 +0000 +++ b/src/wam/dump.lisp Sun Jul 10 14:28:48 2016 +0000 @@ -232,8 +232,8 @@ (second arguments) (pretty-functor (first arguments) functor-list))) -(defmethod instruction-details ((opcode (eql +opcode-unify-constant+)) arguments functor-list) - (format nil "UCON~A ; UNIFY CONSTANT ~A" +(defmethod instruction-details ((opcode (eql +opcode-subterm-constant+)) arguments functor-list) + (format nil "SCON~A ; SUBTERM CONSTANT ~A" (pretty-arguments arguments) (pretty-functor (first arguments) functor-list))) diff -r ba205f6b2875 -r 8cd3257c58e3 src/wam/vm.lisp --- a/src/wam/vm.lisp Sun Jul 10 14:21:18 2016 +0000 +++ b/src/wam/vm.lisp Sun Jul 10 14:28:48 2016 +0000 @@ -390,7 +390,7 @@ ;; ;; It seems a bit confusing that we don't push the rest of the structure ;; stuff on the heap after it too. But that's going to happen in the - ;; next few instructions (which will be unify-*'s, executed in write + ;; next few instructions (which will be subterm-*'s, executed in write ;; mode). ((cell-reference-p cell) (let ((structure-address (nth-value 1 (push-new-structure! wam))) @@ -459,7 +459,7 @@ ;;;; Subterm Instructions -(define-instructions (%unify-variable-local %unify-variable-stack) +(define-instructions (%subterm-variable-local %subterm-variable-stack) ((wam wam) (register register-index)) (setf (%wam-register% wam register) @@ -468,7 +468,7 @@ (:write (push-unbound-reference! wam)))) (incf (wam-subterm wam))) -(define-instructions (%unify-value-local %unify-value-stack) +(define-instructions (%subterm-value-local %subterm-value-stack) ((wam wam) (register register-index)) (ecase (wam-mode wam) @@ -476,7 +476,7 @@ (:write (wam-heap-push! wam (%wam-register% wam register)))) (incf (wam-subterm wam))) -(define-instruction %unify-void ((wam wam) (n arity)) +(define-instruction %subterm-void ((wam wam) (n arity)) (ecase (wam-mode wam) (:read (incf (wam-subterm wam) n)) (:write (repeat n @@ -654,7 +654,7 @@ (register register-index)) (%%match-constant wam constant register)) -(define-instruction %unify-constant ((wam wam) +(define-instruction %subterm-constant ((wam wam) (constant functor-index)) (ecase (wam-mode wam) (:read (%%match-constant wam constant (wam-subterm wam))) @@ -742,37 +742,37 @@ (break "About to execute instruction at ~4,'0X" pc)) (eswitch (opcode) ;; Query - (+opcode-put-structure+ (instruction %put-structure 2)) - (+opcode-put-variable-local+ (instruction %put-variable-local 2)) - (+opcode-put-variable-stack+ (instruction %put-variable-stack 2)) - (+opcode-put-value-local+ (instruction %put-value-local 2)) - (+opcode-put-value-stack+ (instruction %put-value-stack 2)) + (+opcode-put-structure+ (instruction %put-structure 2)) + (+opcode-put-variable-local+ (instruction %put-variable-local 2)) + (+opcode-put-variable-stack+ (instruction %put-variable-stack 2)) + (+opcode-put-value-local+ (instruction %put-value-local 2)) + (+opcode-put-value-stack+ (instruction %put-value-stack 2)) ;; Program - (+opcode-get-structure+ (instruction %get-structure 2)) - (+opcode-get-variable-local+ (instruction %get-variable-local 2)) - (+opcode-get-variable-stack+ (instruction %get-variable-stack 2)) - (+opcode-get-value-local+ (instruction %get-value-local 2)) - (+opcode-get-value-stack+ (instruction %get-value-stack 2)) + (+opcode-get-structure+ (instruction %get-structure 2)) + (+opcode-get-variable-local+ (instruction %get-variable-local 2)) + (+opcode-get-variable-stack+ (instruction %get-variable-stack 2)) + (+opcode-get-value-local+ (instruction %get-value-local 2)) + (+opcode-get-value-stack+ (instruction %get-value-stack 2)) ;; Subterm - (+opcode-unify-variable-local+ (instruction %unify-variable-local 1)) - (+opcode-unify-variable-stack+ (instruction %unify-variable-stack 1)) - (+opcode-unify-value-local+ (instruction %unify-value-local 1)) - (+opcode-unify-value-stack+ (instruction %unify-value-stack 1)) - (+opcode-unify-void+ (instruction %unify-void 1)) + (+opcode-subterm-variable-local+ (instruction %subterm-variable-local 1)) + (+opcode-subterm-variable-stack+ (instruction %subterm-variable-stack 1)) + (+opcode-subterm-value-local+ (instruction %subterm-value-local 1)) + (+opcode-subterm-value-stack+ (instruction %subterm-value-stack 1)) + (+opcode-subterm-void+ (instruction %subterm-void 1)) ;; Constant - (+opcode-put-constant+ (instruction %put-constant 2)) - (+opcode-get-constant+ (instruction %get-constant 2)) - (+opcode-unify-constant+ (instruction %unify-constant 1)) + (+opcode-put-constant+ (instruction %put-constant 2)) + (+opcode-get-constant+ (instruction %get-constant 2)) + (+opcode-subterm-constant+ (instruction %subterm-constant 1)) ;; List - (+opcode-put-list+ (instruction %put-list 1)) - (+opcode-get-list+ (instruction %get-list 1)) + (+opcode-put-list+ (instruction %put-list 1)) + (+opcode-get-list+ (instruction %get-list 1)) ;; Choice - (+opcode-try+ (instruction %try 1)) - (+opcode-retry+ (instruction %retry 1)) - (+opcode-trust+ (instruction %trust 0)) - (+opcode-cut+ (instruction %cut 0)) + (+opcode-try+ (instruction %try 1)) + (+opcode-retry+ (instruction %retry 1)) + (+opcode-trust+ (instruction %trust 0)) + (+opcode-cut+ (instruction %cut 0)) ;; Control - (+opcode-allocate+ (instruction %allocate 1)) + (+opcode-allocate+ (instruction %allocate 1)) ;; need to skip the PC increment for PROC/CALL/DEAL/DONE ;; TODO: this is still ugly (+opcode-deallocate+