--- a/examples/bench.lisp Sat Jul 09 21:51:02 2016 +0000
+++ b/examples/bench.lisp Sun Jul 10 14:21:18 2016 +0000
@@ -22,8 +22,8 @@
; (format t "PAIP (Compiled) --------------------~%")
; (time (paiprolog-test::dfs-exhaust))
- (format t "PAIP (Interpreted) -----------------~%")
- (time (bones.paip::depth-first-search :exhaust t))
+ ; (format t "PAIP (Interpreted) -----------------~%")
+ ; (time (bones.paip::depth-first-search :exhaust t))
(format t "WAM --------------------------------~%")
(time (bones.wam::depth-first-search :exhaust t)))
--- a/src/wam/bytecode.lisp Sat Jul 09 21:51:02 2016 +0000
+++ b/src/wam/bytecode.lisp Sun Jul 10 14:21:18 2016 +0000
@@ -14,27 +14,23 @@
(+opcode-noop+ 1)
(+opcode-get-structure+ 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-get-variable-local+ 3)
(+opcode-get-variable-stack+ 3)
(+opcode-get-value-local+ 3)
(+opcode-get-value-stack+ 3)
(+opcode-put-structure+ 3)
- (+opcode-set-variable-local+ 2)
- (+opcode-set-variable-stack+ 2)
- (+opcode-set-value-local+ 2)
- (+opcode-set-value-stack+ 2)
- (+opcode-set-void+ 2)
(+opcode-put-variable-local+ 3)
(+opcode-put-variable-stack+ 3)
(+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-call+ 2)
(+opcode-dynamic-call+ 1)
(+opcode-proceed+ 1)
@@ -47,7 +43,6 @@
(+opcode-cut+ 1)
(+opcode-get-constant+ 3)
- (+opcode-set-constant+ 2)
(+opcode-put-constant+ 3)
(+opcode-unify-constant+ 2)
@@ -59,28 +54,25 @@
(:returns string)
(eswitch (opcode)
(+opcode-noop+ "NOOP")
+
(+opcode-get-structure+ "GET-STRUCTURE")
- (+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-get-variable-local+ "GET-VARIABLE")
(+opcode-get-variable-stack+ "GET-VARIABLE")
(+opcode-get-value-local+ "GET-VALUE")
(+opcode-get-value-stack+ "GET-VALUE")
(+opcode-put-structure+ "PUT-STRUCTURE")
- (+opcode-set-variable-local+ "SET-VARIABLE")
- (+opcode-set-variable-stack+ "SET-VARIABLE")
- (+opcode-set-value-local+ "SET-VALUE")
- (+opcode-set-value-stack+ "SET-VALUE")
- (+opcode-set-void+ "SET-VOID")
(+opcode-put-variable-local+ "PUT-VARIABLE")
(+opcode-put-variable-stack+ "PUT-VARIABLE")
(+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-call+ "CALL")
(+opcode-dynamic-call+ "DYNAMIC-CALL")
(+opcode-proceed+ "PROCEED")
@@ -93,7 +85,6 @@
(+opcode-cut+ "CUT")
(+opcode-get-constant+ "GET-CONSTANT")
- (+opcode-set-constant+ "SET-CONSTANT")
(+opcode-put-constant+ "PUT-CONSTANT")
(+opcode-unify-constant+ "UNIFY-CONSTANT")
@@ -106,27 +97,23 @@
(+opcode-noop+ "NOOP")
(+opcode-get-structure+ "GETS")
- (+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-get-variable-local+ "GVAR")
(+opcode-get-variable-stack+ "GVAR")
(+opcode-get-value-local+ "GVLU")
(+opcode-get-value-stack+ "GVLU")
(+opcode-put-structure+ "PUTS")
- (+opcode-set-variable-local+ "SVAR")
- (+opcode-set-variable-stack+ "SVAR")
- (+opcode-set-value-local+ "SVLU")
- (+opcode-set-value-stack+ "SVLU")
- (+opcode-set-void+ "SVOI")
(+opcode-put-variable-local+ "PVAR")
(+opcode-put-variable-stack+ "PVAR")
(+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-call+ "CALL")
(+opcode-dynamic-call+ "DYCL")
(+opcode-proceed+ "PROC")
@@ -139,7 +126,6 @@
(+opcode-cut+ "CUTT")
(+opcode-get-constant+ "GCON")
- (+opcode-set-constant+ "SCON")
(+opcode-put-constant+ "PCON")
(+opcode-unify-constant+ "UCON")
--- a/src/wam/compiler.lisp Sat Jul 09 21:51:02 2016 +0000
+++ b/src/wam/compiler.lisp Sun Jul 10 14:21:18 2016 +0000
@@ -883,11 +883,11 @@
;;; into a list of instructions, each of which is a list:
;;;
;;; (:put-structure X2 q 2)
-;;; (:set-variable X1)
-;;; (:set-variable X3)
+;;; (:unify-variable X1)
+;;; (:unify-variable X3)
;;; (:put-structure X0 p 2)
-;;; (:set-value X1)
-;;; (:set-value X2)
+;;; (:unify-value X1)
+;;; (:unify-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.
@@ -995,24 +995,14 @@
(:program :get-list)
(:query :put-list)))
(:register (if first-seen
- (case mode
- (:program (case register-variant
- (:local :unify-variable-local)
- (:stack :unify-variable-stack)
- (:void :unify-void)))
- (:query (case register-variant
- (:local :set-variable-local)
- (:stack :set-variable-stack)
- (:void :set-void))))
- (case mode
- (:program (case register-variant
- (:local :unify-value-local)
- (:stack :unify-value-stack)
- (:void :unify-void)))
- (:query (case register-variant
- (:local :set-value-local)
- (:stack :set-value-stack)
- (:void :set-void)))))))))
+ (case register-variant
+ (:local :unify-variable-local)
+ (:stack :unify-variable-stack)
+ (:void :unify-void))
+ (case register-variant
+ (:local :unify-value-local)
+ (:stack :unify-value-stack)
+ (:void :unify-void)))))))
(defun precompile-tokens (wam head-tokens body-tokens)
@@ -1081,11 +1071,11 @@
(handle-register (register)
(if (register-anonymous-p register)
;; VOID 1
- (push-instruction (find-opcode :register nil mode register) 1)
+ (push-instruction (find-opcode :register nil nil register) 1)
;; OP reg
(let ((first-seen (push-if-new register seen :test #'register=)))
(push-instruction
- (find-opcode :register first-seen mode register)
+ (find-opcode :register first-seen nil register)
register))))
(handle-token (token)
(etypecase token
@@ -1264,24 +1254,24 @@
;; 2. put_structure c/0, Ai -> put_constant c, Ai
(circle-replace node `(:put-constant ,constant ,register)))
-(defun optimize-set-constant (node constant register)
+(defun optimize-unify-constant-query (node constant register)
;; 3. put_structure c/0, Xi *** WE ARE HERE
;; ...
- ;; set_value Xi -> set_constant c
+ ;; unify_value Xi -> unify_constant c
(loop
:with previous = (circle-prev node)
- ;; Search forward for the corresponding set-value instruction
+ ;; 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 :set-value-local)
+ :when (and (eql opcode :unify-value-local)
(register= register (first arguments)))
:do
- (circle-replace n `(:set-constant ,constant))
+ (circle-replace n `(:unify-constant ,constant))
(return previous)))
-(defun optimize-unify-constant (node constant register)
- ;; 4. unify_variable Xi -> unify_constant c
+(defun optimize-unify-constant-program (node constant register)
+ ;; 4. unify_variable Xi -> unify_constant c
;; ...
;; get_structure c/0, Xi *** WE ARE HERE
(loop
@@ -1311,14 +1301,14 @@
(setf node
(if (register-argument-p register)
(optimize-put-constant node functor register)
- (optimize-set-constant node functor register))))
+ (optimize-unify-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 node functor register))))))
+ (optimize-unify-constant-program node functor register))))))
instructions))
@@ -1360,28 +1350,22 @@
(defun render-opcode (opcode)
(ecase opcode
(:get-structure +opcode-get-structure+)
- (: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+)
(: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+)
- (:set-variable-local +opcode-set-variable-local+)
- (:set-variable-stack +opcode-set-variable-stack+)
- (:set-value-local +opcode-set-value-local+)
- (:set-value-stack +opcode-set-value-stack+)
- (:set-void +opcode-set-void+)
(: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+)
- (:set-constant +opcode-set-constant+)
(:get-list +opcode-get-list+)
(:put-list +opcode-put-list+)
(:unify-constant +opcode-unify-constant+)
--- a/src/wam/constants.lisp Sat Jul 09 21:51:02 2016 +0000
+++ b/src/wam/constants.lisp Sun Jul 10 14:21:18 2016 +0000
@@ -115,11 +115,6 @@
;; Program
+opcode-get-structure+
- +opcode-unify-variable-local+
- +opcode-unify-variable-stack+
- +opcode-unify-value-local+
- +opcode-unify-value-stack+
- +opcode-unify-void+
+opcode-get-variable-local+
+opcode-get-variable-stack+
+opcode-get-value-local+
@@ -127,16 +122,18 @@
;; Query
+opcode-put-structure+
- +opcode-set-variable-local+
- +opcode-set-variable-stack+
- +opcode-set-value-local+
- +opcode-set-value-stack+
- +opcode-set-void+
+opcode-put-variable-local+
+opcode-put-variable-stack+
+opcode-put-value-local+
+opcode-put-value-stack+
+ ;; Subterm
+ +opcode-unify-variable-local+
+ +opcode-unify-variable-stack+
+ +opcode-unify-value-local+
+ +opcode-unify-value-stack+
+ +opcode-unify-void+
+
;; Control
+opcode-call+
+opcode-dynamic-call+
@@ -151,7 +148,6 @@
;; Constants
+opcode-get-constant+
- +opcode-set-constant+
+opcode-put-constant+
+opcode-unify-constant+
--- a/src/wam/dump.lisp Sat Jul 09 21:51:02 2016 +0000
+++ b/src/wam/dump.lisp Sun Jul 10 14:21:18 2016 +0000
@@ -155,26 +155,6 @@
(pretty-arguments arguments)))
-(defmethod instruction-details ((opcode (eql +opcode-set-variable-local+)) arguments functor-list)
- (format nil "SVAR~A ; X~A <- new unbound REF"
- (pretty-arguments arguments)
- (first arguments)))
-
-(defmethod instruction-details ((opcode (eql +opcode-set-variable-stack+)) arguments functor-list)
- (format nil "SVAR~A ; Y~A <- new unbound REF"
- (pretty-arguments arguments)
- (first arguments)))
-
-(defmethod instruction-details ((opcode (eql +opcode-set-value-local+)) arguments functor-list)
- (format nil "SVLU~A ; new REF to X~A"
- (pretty-arguments arguments)
- (first arguments)))
-
-(defmethod instruction-details ((opcode (eql +opcode-set-value-stack+)) arguments functor-list)
- (format nil "SVLU~A ; new REF to Y~A"
- (pretty-arguments arguments)
- (first arguments)))
-
(defmethod instruction-details ((opcode (eql +opcode-get-structure+)) arguments functor-list)
(format nil "GETS~A ; X~A = ~A"
(pretty-arguments arguments)
@@ -252,11 +232,6 @@
(second arguments)
(pretty-functor (first arguments) functor-list)))
-(defmethod instruction-details ((opcode (eql +opcode-set-constant+)) arguments functor-list)
- (format nil "SCON~A ; SET CONSTANT ~A"
- (pretty-arguments 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"
(pretty-arguments arguments)
--- a/src/wam/vm.lisp Sat Jul 09 21:51:02 2016 +0000
+++ b/src/wam/vm.lisp Sun Jul 10 14:21:18 2016 +0000
@@ -340,28 +340,19 @@
(register register-index))
(setf (wam-local-register wam register)
(make-cell-structure
- (nth-value 1 (push-new-functor! wam functor)))))
+ (nth-value 1 (push-new-functor! wam functor)))
+
+ (wam-mode wam)
+ :write))
(define-instruction %put-list
((wam wam)
(register register-index))
(setf (wam-local-register wam register)
- (make-cell-list (wam-heap-pointer wam))))
-
-(define-instructions (%set-variable-local %set-variable-stack)
- ((wam wam)
- (register register-index))
- (setf (%wam-register% wam register)
- (push-unbound-reference! wam)))
+ (make-cell-list (wam-heap-pointer wam))
-(define-instructions (%set-value-local %set-value-stack)
- ((wam wam)
- (register register-index))
- (wam-heap-push! wam (%wam-register% wam register)))
-
-(define-instruction %set-void ((wam wam) (n arity))
- (repeat n
- (push-unbound-reference! wam)))
+ (wam-mode wam)
+ :write))
(define-instructions (%put-variable-local %put-variable-stack)
((wam wam)
@@ -369,14 +360,15 @@
(argument register-index))
(let ((new-reference (push-unbound-reference! wam)))
(setf (%wam-register% wam register) new-reference
- (wam-local-register wam argument) new-reference)))
+ (wam-local-register wam argument) new-reference
+ (wam-mode wam) :write)))
(define-instructions (%put-value-local %put-value-stack)
((wam wam)
(register register-index)
(argument register-index))
- (setf (wam-local-register wam argument)
- (%wam-register% wam register)))
+ (setf (wam-local-register wam argument) (%wam-register% wam register)
+ (wam-mode wam) :write))
;;;; Program Instructions
@@ -452,6 +444,21 @@
(t (backtrack! wam)))))
+(define-instructions (%get-variable-local %get-variable-stack)
+ ((wam wam)
+ (register register-index)
+ (argument register-index))
+ (setf (%wam-register% wam register)
+ (wam-local-register wam argument)))
+
+(define-instructions (%get-value-local %get-value-stack)
+ ((wam wam)
+ (register register-index)
+ (argument register-index))
+ (unify! wam register argument))
+
+
+;;;; Subterm Instructions
(define-instructions (%unify-variable-local %unify-variable-stack)
((wam wam)
(register register-index))
@@ -475,19 +482,6 @@
(:write (repeat n
(push-unbound-reference! wam)))))
-(define-instructions (%get-variable-local %get-variable-stack)
- ((wam wam)
- (register register-index)
- (argument register-index))
- (setf (%wam-register% wam register)
- (wam-local-register wam argument)))
-
-(define-instructions (%get-value-local %get-value-stack)
- ((wam wam)
- (register register-index)
- (argument register-index))
- (unify! wam register argument))
-
;;;; Control Instructions
(define-instruction %call ((wam wam) (functor functor-index)
@@ -652,19 +646,14 @@
(define-instruction %put-constant ((wam wam)
(constant functor-index)
(register register-index))
- (setf (wam-local-register wam register)
- (make-cell-constant constant)))
+ (setf (wam-local-register wam register) (make-cell-constant constant)
+ (wam-mode wam) :write))
(define-instruction %get-constant ((wam wam)
(constant functor-index)
(register register-index))
(%%match-constant wam constant register))
-(define-instruction %set-constant ((wam wam)
- (constant functor-index))
- (wam-heap-push! wam (make-cell-constant constant))
- (incf (wam-subterm wam)))
-
(define-instruction %unify-constant ((wam wam)
(constant functor-index))
(ecase (wam-mode wam)
@@ -754,30 +743,25 @@
(eswitch (opcode)
;; Query
(+opcode-put-structure+ (instruction %put-structure 2))
- (+opcode-set-variable-local+ (instruction %set-variable-local 1))
- (+opcode-set-variable-stack+ (instruction %set-variable-stack 1))
- (+opcode-set-value-local+ (instruction %set-value-local 1))
- (+opcode-set-value-stack+ (instruction %set-value-stack 1))
- (+opcode-set-void+ (instruction %set-void 1))
(+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))
+ ;; 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-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))
;; Constant
(+opcode-put-constant+ (instruction %put-constant 2))
(+opcode-get-constant+ (instruction %get-constant 2))
- (+opcode-set-constant+ (instruction %set-constant 1))
(+opcode-unify-constant+ (instruction %unify-constant 1))
;; List
(+opcode-put-list+ (instruction %put-list 1))