Merge pull request #67 from Bike/master

more type stuff

Code/Cleavir/AST-to-HIR/compile-array-related-asts.lisp

@@ -17,12 +17,13 @@
   (let* ((array-temp (make-temp))
 	 (index-temp (make-temp))
 	 (type (cleavir-ast:element-type ast))
-	 (unboxed (if (cleavir-ast:box-p ast)
-		      (list (make-temp))
-		      (results context)))
-	 (succ (if (cleavir-ast:box-p ast)
-		   (list (box-for-type type unboxed context))
-		   (successors context))))
+	 (unboxed (if (cleavir-ast:boxed-p ast)
+		      (results context)
+		      ;; need an additional boxing step.
+		      (list (make-temp))))
+	 (succ (if (cleavir-ast:boxed-p ast)
+		   (successors context)
+		   (list (box-for-type type unboxed context)))))
     (compile-ast
      (cleavir-ast:array-ast ast)
      (context
@@ -33,6 +34,7 @@
 		      (list (make-instance 'cleavir-ir:aref-instruction
 			      :element-type type
 			      :simple-p (cleavir-ast:simple-p ast)
+			      :boxed-p (cleavir-ast:boxed-p ast)
 			      :inputs (list array-temp index-temp)
 			      :outputs unboxed
 			      :successors succ))
@@ -58,33 +60,36 @@
 	 (aset (make-instance 'cleavir-ir:aset-instruction
 		 :element-type type
 		 :simple-p (cleavir-ast:simple-p ast)
+		 :boxed-p (cleavir-ast:boxed-p ast)
 		 :inputs (list array-temp index-temp element-temp)
 		 :outputs (results context)
 		 :successors (successors context))))
     (compile-ast
      (cleavir-ast:array-ast ast)
      (context
       (list array-temp)
-      (compile-ast
-       (cleavir-ast:index-ast ast)
-       (context
-	(list index-temp)
-	(compile-ast
-	 (cleavir-ast:element-ast ast)
-	 (if (cleavir-ast:unbox-p ast)
-	     ;; if we have to unbox the element first, compile
-	     ;; the element-ast in a context where the successor
-	     ;; is an unboxer and the output is a different temp.
-	     (let ((boxed-temp (make-temp)))
-	       (context
-		(list boxed-temp)
-		(list
-		 (unbox-for-type type boxed-temp
-				 element-temp aset))
-		(invocation context)))
-	     ;; otherwise it's simple.
-	     (context (list element-temp)
-		      (list aset)
-		      (invocation context))))
-	(invocation context)))
+      (list
+       (compile-ast
+	(cleavir-ast:index-ast ast)
+	(context
+	 (list index-temp)
+	 (list
+	  (compile-ast
+	   (cleavir-ast:element-ast ast)
+	   (if (cleavir-ast:boxed-p ast)
+	       ;; simple case: no unbox required
+	       (context (list element-temp)
+			(list aset)
+			(invocation context))
+	       ;; if we have to unbox the new value first, compile
+	       ;; the element-ast in a context where the successor
+	       ;; is an unboxer and the output is a different temp.
+	       (let ((boxed-temp (make-temp)))
+		 (context
+		  (list boxed-temp)
+		  (list
+		   (unbox-for-type type boxed-temp
+				   element-temp aset))
+		  (invocation context))))))
+	 (invocation context))))
       (invocation context)))))

Code/Cleavir/Abstract-syntax-tree/array-related-asts.lisp

@@ -9,22 +9,23 @@
 ;;; INDEX-AST is an AST that evaluates to a row-major index into
 ;;; the array that is the value of ARRAY-AST. ELEMENT-TYPE is the
 ;;; actual element-type of the array. SIMPLE-P is whether it's
-;;; actually simple. BOX-P is whether the value read should be
-;;; boxed in an additional instruction.
+;;; actually simple. BOXED-P is whether the values in the array
+;;; are boxed or not (if not, an additional BOX-INSTRUCTION will
+;;; be added at the output)
 
 (defclass aref-ast (ast one-value-ast-mixin)
   ((%array-ast :initarg :array-ast :reader array-ast)
    (%index-ast :initarg :index-ast :reader index-ast)
    (%element-type :initarg :element-type :reader element-type)
    (%simple-p :initarg :simple-p :reader simple-p)
-   (%box-p :initarg :box-p :reader box-p)))
+   (%boxed-p :initarg :boxed-p :reader boxed-p)))
 
 (cleavir-io:define-save-info aref-ast
   (:array-ast array-ast)
   (:index-ast index-ast)
   (:element-type element-type)
   (:simple-p simple-p)
-  (:box-p box-p))
+  (:boxed-p boxed-p))
 
 (defmethod children ((ast aref-ast))
   (list (array-ast ast) (index-ast ast)))
@@ -39,25 +40,25 @@
 ;;; to the element to be written, and that element must be of a type
 ;;; that is acceptable to store in the array, according to how the
 ;;; array is specialized. SIMPLE-P is whether the array is actually
-;;; simple and ELEMENT-TYPE is its actual element-type. UNBOX-P
-;;; indicates whether the object must be unboxed before being
-;;; written into the array.
+;;; simple and ELEMENT-TYPE is its actual element-type. BOXED-P
+;;; indicates whether the values in the array are boxed or not (if
+;;; not an additional UNBOX-INSTRUCTION will be added at the input)
 
 (defclass aset-ast (ast no-value-ast-mixin)
   ((%array-ast :initarg :array-ast :reader array-ast)
    (%index-ast :initarg :index-ast :reader index-ast)
    (%element-ast :initarg :element-ast :reader element-ast)
    (%element-type :initarg :element-type :reader element-type)
    (%simple-p :initarg :simple-p :reader simple-p)
-   (%unbox-p :initarg :unbox-p :reader unbox-p)))
+   (%boxed-p :initarg :boxed-p :reader boxed-p)))
 
 (cleavir-io:define-save-info aset-ast
   (:array-ast array-ast)
   (:index-ast index-ast)
   (:element-ast element-ast)
   (:element-type element-type)
   (:simple-p simple-p)
-  (:unbox-p unbox-p))
+  (:boxed-p boxed-p))
 
 (defmethod children ((ast aset-ast))
   (list (array-ast ast) (index-ast ast) (element-ast ast)))

Code/Cleavir/Abstract-syntax-tree/packages.lisp

@@ -111,7 +111,7 @@
    #:slot-write-ast #:make-slot-write-ast
    #:aref-ast #:aset-ast
    #:element-ast #:array-ast #:index-ast
-   #:element-type #:simple-p #:box-p #:unbox-p
+   #:element-type #:simple-p #:boxed-p
    #:child-ast
    #:scope-ast #:make-scope-ast
    #:map-ast-depth-first-preorder

Code/Cleavir/Generate-AST/convert-primop.lisp

@@ -466,19 +466,19 @@
 ;;; array and an index into it, as forms. The remainder of the
 ;;; arguments are not evaluated. The third is the actual element
 ;;; type of the array. The fourth is whether the array is actually
-;;; simple. The fifth is whether the value from aref should be
+;;; simple. The fifth is whether the value in the array is already
 ;;; boxed.
 
 (defmethod convert-special
     ((symbol (eql 'cleavir-primop:aref)) form env system)
-  (db origin (array-form index-form type simple-p box-p)
+  (db origin (array-form index-form type simple-p boxed-p)
       (rest form)
     (make-instance 'cleavir-ast:aref-ast
       :array-ast (convert array-form env system)
       :index-ast (convert index-form env system)
       :element-type type
       :simple-p simple-p
-      :box-p box-p
+      :boxed-p boxed-p
       :origin origin)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -487,8 +487,8 @@
 ;;;
 ;;; This primop takes six arguments. The first two are an array and
 ;;; an index into it. The third is the object to be written in. The
-;;; fourth and fifth are as above. The sixth is whether the object
-;;; has to be unboxed before being written into the array.
+;;; fourth and fifth are as above. The sixth is whether the objects
+;;; in the array are boxed.
 ;;;
 ;;; Forms using this primitive operation must occur in a context
 ;;; that does not require a value, such as in a PROGN other than as
@@ -497,15 +497,15 @@
 (defmethod convert-special
     ((symbol (eql 'cleavir-primop:aset)) form env system)
   (db origin (array-form index-form object-form
-			 type simple-p unbox-p)
+			 type simple-p boxed-p)
       (rest form)
     (make-instance 'cleavir-ast:aset-ast
       :array-ast (convert array-form env system)
       :index-ast (convert index-form env system)
       :element-ast (convert object-form env system)
       :element-type type
       :simple-p simple-p
-      :unbox-p unbox-p
+      :boxed-p boxed-p
       :origin origin)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Code/Cleavir/Intermediate-representation/HIR/array-related-instructions.lisp

@@ -8,12 +8,14 @@
 ;;; This instruction takes two inputs: an array and an index.
 ;;; The array must have the actual element-type of the instruction,
 ;;; and have actual simplicity corresponding to simple-p.
+;;; Boxed-p indicates whether elements in the array are boxed.
 ;;; The index is row-major.
 ;;; There is a single output, the read value.
 
 (defclass aref-instruction (instruction one-successor-mixin)
   ((%element-type :initarg :element-type :reader element-type)
-   (%simple-p :initarg :simple-p :reader simple-p)))
+   (%simple-p :initarg :simple-p :reader simple-p)
+   (%boxed-p :initarg :boxed-p :reader boxed-p)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -28,4 +30,5 @@
 (defclass aset-instruction
     (instruction one-successor-mixin side-effect-mixin)
   ((%element-type :initarg :element-type :reader element-type)
-   (%simple-p :initarg :simple-p :reader simple-p)))
+   (%simple-p :initarg :simple-p :reader simple-p)
+   (%boxed-p :initarg :boxed-p :reader boxed-p)))

Code/Cleavir/Intermediate-representation/packages.lisp

@@ -65,7 +65,7 @@
    #:phi-instruction #:make-phi-instruction
    #:use-instruction #:make-use-instruction
    #:aref-instruction #:aset-instruction
-   #:element-type #:simple-p
+   #:element-type #:simple-p #:boxed-p
    #:fixnum-add-instruction #:make-fixnum-add-instruction
    #:fixnum-sub-instruction #:make-fixnum-sub-instruction
    #:fixnum-less-instruction #:make-fixnum-less-instruction

Code/Cleavir/Type-inference/packages.lisp

@@ -5,7 +5,8 @@
   (:export #:approximate-type #:canonicalize-type
 	   #:top-p #:bottom-p
 	   #:binary-join #:binary-meet #:difference
-	   #:join #:meet)
+	   #:join #:meet
+	   #:descriptor-box #:descriptor-unbox)
   (:export #:approximate-values #:values-nth #:values-rest-p
 	   #:values-top-p #:values-bottom-p
 	   #:values-required #:values-required-count

Code/Cleavir/Type-inference/transfer.lisp

@@ -94,44 +94,76 @@
 		input-bag))))
 
 (defmethod one-successor-transfer
-    ((instruction cleavir-ir:short-float-unbox-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'unboxed-short-float input-bag)))
+    ((instruction cleavir-ir:aref-instruction) input-bag)
+  ;; TODO: update array
+  (let ((index (second (cleavir-ir:inputs instruction)))
+	(output (first (cleavir-ir:outputs instruction)))
+	(element-descriptor
+	  (approximate-type
+	   (cleavir-ir:element-type instruction))))
+    (update output
+	    (if (cleavir-ir:boxed-p instruction)
+		element-descriptor
+		(descriptor-unbox element-descriptor))
+	    (update index
+		    (binary-meet (find-type index input-bag)
+				 ;; could use array dimensions,
+				 ;; or a more proper thing with
+				 ;; ARRAY-TOTAL-SIZE
+				 (approximate-type 'fixnum))
+		    input-bag))))
 
 (defmethod one-successor-transfer
-    ((instruction cleavir-ir:short-float-box-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'short-float input-bag)))
+    ((instruction cleavir-ir:aset-instruction) input-bag)
+  ;; TODO: update array
+  (let ((index (second (cleavir-ir:inputs instruction)))
+	(object (third (cleavir-ir:inputs instruction)))
+	(element-descriptor
+	  (approximate-type
+	   (cleavir-ir:element-type instruction))))
+    (update object
+	    (binary-meet
+	     (find-type object input-bag)
+	     (if (cleavir-ir:boxed-p instruction)
+		 element-descriptor
+		 ;; if the array's elements are unboxed, the object
+		 ;; being written must be unboxed.
+		 (descriptor-unbox element-descriptor)))
+	    (update index
+		    (binary-meet (find-type index input-bag)
+				 ;; could use array dimensions,
+				 ;; or a more proper thing with
+				 ;; ARRAY-TOTAL-SIZE
+				 (approximate-type 'fixnum))
+		    input-bag))))
 
 (defmethod one-successor-transfer
-    ((instruction cleavir-ir:single-float-unbox-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'unboxed-single-float input-bag)))
+    ((instruction cleavir-ir:box-instruction) input-bag)
+  (let ((input (first (cleavir-ir:inputs instruction)))
+	(output (first (cleavir-ir:outputs instruction)))
+	(element-descriptor
+	  (approximate-type
+	   (cleavir-ir:element-type instruction))))
+    (update input
+	    (binary-meet (find-type input input-bag)
+			 (descriptor-unbox element-descriptor))
+	    (update output
+		    element-descriptor
+		    input-bag))))
 
 (defmethod one-successor-transfer
-    ((instruction cleavir-ir:single-float-box-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'single-float input-bag)))
-
-(defmethod one-successor-transfer
-    ((instruction cleavir-ir:double-float-unbox-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'unboxed-double-float input-bag)))
-
-(defmethod one-successor-transfer
-    ((instruction cleavir-ir:double-float-box-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'double-float input-bag)))
-
-(defmethod one-successor-transfer
-    ((instruction cleavir-ir:long-float-unbox-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'unboxed-long-float input-bag)))
-
-(defmethod one-successor-transfer
-    ((instruction cleavir-ir:long-float-box-instruction) input-bag)
-  (let ((output (first (cleavir-ir:outputs instruction))))
-    (update output 'long-float input-bag)))
+    ((instruction cleavir-ir:unbox-instruction) input-bag)
+  (let ((input (first (cleavir-ir:inputs instruction)))
+	(output (first (cleavir-ir:outputs instruction)))
+	(element-descriptor
+	  (approximate-type
+	   (cleavir-ir:element-type instruction))))
+    (update input
+	    (binary-meet (find-type input input-bag)
+			 element-descriptor)
+	    (update output
+		    (descriptor-unbox element-descriptor)
+		    input-bag))))
 
 (defmethod one-successor-transfer
     ((instruction cleavir-ir:the-values-instruction) input-bag)