Skip to content
Snippets Groups Projects
Commit 394643fc authored by wlott's avatar wlott
Browse files

Changed to use make-structure to create structures directly instead of

structurifying vectors.
parent 79c92808
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.17 1990/11/18 17:00:48 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.18 1990/12/18 20:39:06 wlott Exp $
;;; ;;;
;;; Defstruct structure definition package (Mark II). ;;; Defstruct structure definition package (Mark II).
;;; Written by Skef Wholey and Rob MacLachlan. ;;; Written by Skef Wholey and Rob MacLachlan.
...@@ -15,18 +15,21 @@ ...@@ -15,18 +15,21 @@
(in-package 'c) (in-package 'c)
(export '(lisp::defstruct) "LISP") (export '(lisp::defstruct) "LISP")
(export '(structure-index make-structure structure-length
structure-ref structure-set))
;;;; Structure frobbing primitives. ;;;; Structure frobbing primitives.
;;; Note: STRUCTURIFY is defined in struct.lisp. It converts a simple-vector (defun make-structure (length)
;;; into a structure. It should go away when we have a real structure "Allocate a new structure with LENGTH data slots."
;;; allocation primitive. (declare (type index length))
(make-structure length))
(defun structure-length (x) (defun structure-length (structure)
"Return the number of slots used by the structure object X, including the "Given a structure, return its length."
type slot." (declare (type structure structure))
(declare (type structure x)) (structure-length structure))
(structure-length x))
(defun structure-ref (struct index) (defun structure-ref (struct index)
"Return the value from the INDEXth slot of STRUCT. 0 corresponds to the "Return the value from the INDEXth slot of STRUCT. 0 corresponds to the
...@@ -411,16 +414,14 @@ ...@@ -411,16 +414,14 @@
(error "Structure for copier ~S is not a ~S:~% ~S" (error "Structure for copier ~S is not a ~S:~% ~S"
(dd-copier info) (dd-name info) structure)) (dd-copier info) (dd-name info) structure))
(let ((len (dd-length info))) (let* ((len (dd-length info))
(declare (fixnum len)) (res (make-structure len)))
(do ((i 1 (1+ i)) (declare (type structure-index len))
(res (structurify (make-array len :element-type t)))) (dotimes (i len)
((= i len) (declare (type structure-index i))
(setf (structure-ref res 0) (dd-name info))
res)
(declare (fixnum i))
(setf (structure-ref res i) (setf (structure-ref res i)
(structure-ref structure i))))))) (structure-ref structure i)))
res))))
(when (dd-doc info) (when (dd-doc info)
(setf (documentation (dd-name info) 'type) (dd-doc info)))) (setf (documentation (dd-name info) 'type) (dd-doc info))))
...@@ -482,9 +483,16 @@ ...@@ -482,9 +483,16 @@
(list (list
`(list ,@initial-cruft ,@names)) `(list ,@initial-cruft ,@names))
(structure (structure
`(truly-the ,(dd-name defstruct) (let ((temp (gensym)))
(structurify `(let ((,temp (make-structure ,(dd-length defstruct))))
(vector ,@initial-cruft ,@names)))) (declare (type structure ,temp))
(setf (structure-ref ,temp 0) ',(dd-name defstruct))
,@(mapcar #'(lambda (slot)
`(setf (structure-ref ,temp
,(dsd-index slot))
,(dsd-name slot)))
slots)
(truly-the ,(dd-name defstruct) ,temp))))
(vector (vector
`(vector ,@initial-cruft ,@names)) `(vector ,@initial-cruft ,@names))
(t (t
...@@ -577,8 +585,16 @@ ...@@ -577,8 +585,16 @@
(list (list
`(list ,@initial-cruft ,@thing)) `(list ,@initial-cruft ,@thing))
(structure (structure
`(truly-the ,(dd-name defstruct) (let ((temp (gensym)))
(structurify (vector ,@initial-cruft ,@thing)))) `(let ((,temp (make-structure ,(dd-length defstruct))))
(declare (type structure ,temp))
(setf (structure-ref ,temp 0) ',(dd-name defstruct))
,@(mapcar #'(lambda (slot thing)
`(setf (structure-ref ,temp
,(dsd-index slot))
,thing))
slots thing)
`(truly-the ,(dd-name defstruct) ,temp))))
(vector (vector
`(vector ,@initial-cruft ,@thing)) `(vector ,@initial-cruft ,@thing))
(t (t
...@@ -650,7 +666,7 @@ ...@@ -650,7 +666,7 @@
(dd (info type defined-structure-info type))) (dd (info type defined-structure-info type)))
(cond (*print-pretty* (cond (*print-pretty*
(let ((index 0)) (let ((index 0))
(declare (type index index)) (declare (type structure-index index))
(xp:pprint-logical-block (stream (cons type (dd-slots dd)) (xp:pprint-logical-block (stream (cons type (dd-slots dd))
:prefix "#S(" :prefix "#S("
:suffix ")") :suffix ")")
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.20 1990/12/01 11:27:25 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.21 1990/12/18 20:40:33 wlott Exp $
;;; ;;;
;;; Loader for Spice Lisp. ;;; Loader for Spice Lisp.
;;; Written by Skef Wholey and Rob MacLachlan. ;;; Written by Skef Wholey and Rob MacLachlan.
...@@ -475,7 +475,7 @@ ...@@ -475,7 +475,7 @@
(clone-fop (fop-struct 48) (clone-fop (fop-struct 48)
(fop-small-struct 49) (fop-small-struct 49)
(let* ((size (clone-arg)) (let* ((size (clone-arg))
(res (c::structurify (make-array size)))) (res (c:make-structure size))))
(declare (type index size)) (declare (type index size))
(do ((n (1- size) (1- n))) (do ((n (1- size) (1- n)))
((minusp n)) ((minusp n))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment