# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1462909324 0
# Node ID 12b69e64ece1ebe350d79206230d034d88033eab
# Parent  0a4b04d4dfa7fd754446cfe06f3273921f623c1d
Add constant cells (unused for now)

diff -r 0a4b04d4dfa7 -r 12b69e64ece1 src/wam/cells.lisp
--- a/src/wam/cells.lisp	Tue May 10 19:33:09 2016 +0000
+++ b/src/wam/cells.lisp	Tue May 10 19:42:04 2016 +0000
@@ -5,26 +5,25 @@
 ;;; low-order bits and their value in the higher-order bits:
 ;;;
 ;;;   value         type
-;;;   vvvvvvvvvvvvvvTT
+;;;   vvvvvvvvvvvvvTTT
 ;;;
 ;;; The contents of the value depend on the type of cell.
 ;;;
 ;;; NULL cells always have a value of zero.
 ;;;
-;;; STRUCTURE cell values are an index into the heap, describing where the
+;;; STRUCTURE cell values are an index into the store, describing where the
 ;;; structure starts.
 ;;;
-;;; REFERENCE cell values are an index into the heap, pointing at whatever the
-;;; value is bound to.  Unbound variables contain their own heap index as
+;;; REFERENCE cell values are an index into the store, pointing at whatever the
+;;; value is bound to.  Unbound variables contain their own store index as
 ;;; a value.
 ;;;
-;;; FUNCTOR cell values are again split into two chunks of bits:
+;;; FUNCTOR cell values are an index into the WAM's functor array where the
+;;; `(symbol . arity)` cons lives.
 ;;;
-;;;   index     arity
-;;;   iiiiiiiiiiAAAA
+;;; CONSTANT cells are the same as functor cells, except that they always refer
+;;; to functors with an arity of zero.
 ;;;
-;;; The index is the index into the WAM's functor table where this functor's
-;;; symbol lives.  Arity is the arity of the functor.
 
 
 (defun* cell-type ((cell cell))
@@ -42,7 +41,8 @@
     (+tag-null+ "NULL")
     (+tag-structure+ "STRUCTURE")
     (+tag-reference+ "REFERENCE")
-    (+tag-functor+ "FUNCTOR")))
+    (+tag-functor+ "FUNCTOR")
+    (+tag-constant+ "CONSTANT")))
 
 (defun* cell-type-short-name ((cell cell))
   (:returns string)
@@ -50,27 +50,15 @@
     (+tag-null+ "NUL")
     (+tag-structure+ "STR")
     (+tag-reference+ "REF")
-    (+tag-functor+ "FUN")))
-
-
-(defun* cell-functor-index ((cell cell))
-  (:returns functor-index)
-  (cell-value cell))
+    (+tag-functor+ "FUN")
+    (+tag-constant+ "CON")))
 
 
 (defun* cell-aesthetic ((cell cell))
   "Return a compact, human-friendly string representation of the cell."
-  (format nil "[~A~A]"
+  (format nil "[~A ~X]"
           (cell-type-short-name cell)
-          (eswitch ((cell-type cell))
-            (+tag-null+ "")
-            (+tag-structure+
-              (format nil " ~X" (cell-value cell)))
-            (+tag-functor+
-              (format nil " ~X"
-                      (cell-functor-index cell)))
-            (+tag-reference+
-              (format nil " ~X" (cell-value cell))))))
+          (cell-value cell)))
 
 
 (defun* cell-null-p ((cell cell))
@@ -89,6 +77,10 @@
   (:returns boolean)
   (= (cell-type cell) +tag-structure+))
 
+(defun* cell-constant-p ((cell cell))
+  (:returns boolean)
+  (= (cell-type cell) +tag-constant+))
+
 
 (defun* make-cell ((tag cell-tag) (value cell-value))
   (:returns cell)
@@ -112,4 +104,7 @@
   (:returns cell)
   (make-cell +tag-functor+ functor-index))
 
+(defun* make-cell-constant ((functor-index functor-index))
+  (:returns cell)
+  (make-cell +tag-constant+ functor-index))
 
diff -r 0a4b04d4dfa7 -r 12b69e64ece1 src/wam/dump.lisp
--- a/src/wam/dump.lisp	Tue May 10 19:33:09 2016 +0000
+++ b/src/wam/dump.lisp	Tue May 10 19:42:04 2016 +0000
@@ -22,7 +22,7 @@
         (format nil "structure pointer to ~4,'0X " (cell-value cell)))
       (+tag-functor+
         (destructuring-bind (functor . arity)
-            (wam-functor-lookup wam (cell-functor-index cell))
+            (wam-functor-lookup wam (cell-value cell))
           (format nil "~A/~D " functor arity)))
       (t ""))
     (registers-pointing-to wam addr)))
@@ -52,7 +52,7 @@
             (progn
               (print-cell i cell indent)
               (if (cell-functor-p cell)
-                (setf indent (wam-functor-arity wam (cell-functor-index cell)))
+                (setf indent (wam-functor-arity wam (cell-value cell)))
                 (when (not (zerop indent))
                   (decf indent))))))
     (when (< to (wam-heap-pointer wam))
diff -r 0a4b04d4dfa7 -r 12b69e64ece1 src/wam/vm.lisp
--- a/src/wam/vm.lisp	Tue May 10 19:33:09 2016 +0000
+++ b/src/wam/vm.lisp	Tue May 10 19:42:04 2016 +0000
@@ -50,7 +50,7 @@
   "Return whether `cell` is a functor cell containing `functor`."
   (ensure-boolean
     (and (cell-functor-p cell)
-         (= (cell-functor-index cell) functor))))
+         (= (cell-value cell) functor))))
 
 (defun* functors-match-p ((functor-cell-1 cell)
                           (functor-cell-2 cell))
@@ -504,7 +504,7 @@
                ((cell-structure-p cell) (recur (cell-value cell)))
                ((cell-functor-p cell)
                 (destructuring-bind (functor . arity)
-                    (wam-functor-lookup wam (cell-functor-index cell))
+                    (wam-functor-lookup wam (cell-value cell))
                   (if (zerop arity)
                     functor
                     (list* functor