BSD 4_3_Tahoe development

[unix-history] / usr / src / ucb / lisp / lisplib / struct.l

diff --git a/usr/src/ucb/lisp/lisplib/struct.l b/usr/src/ucb/lisp/lisplib/struct.l
index 6de5eea..b5ddc14 100644 (file)
--- a/usr/src/ucb/lisp/lisplib/struct.l
+++ b/usr/src/ucb/lisp/lisplib/struct.l
@@ -1,7 +1,7 @@
 ;;; -*- Mode:Lisp; Package:SI; Lowercase:True; Base:8 -*-
 ;;;    ** (c) Copyright 1980 Massachusetts Institute of Technology **
 (setq rcs-struct-
 ;;; -*- Mode:Lisp; Package:SI; Lowercase:True; Base:8 -*-
 ;;;    ** (c) Copyright 1980 Massachusetts Institute of Technology **
 (setq rcs-struct-

-   "$Header: /usr/lib/lisp/struct.l,v 1.1 83/01/29 18:39:54 jkf Exp $")
+   "$Header: /usr/lib/lisp/RCS/struct.l,v 1.2 83/08/06 08:41:10 jkf Exp $")

 
 ;The master copy of this file is in MC:ALAN;NSTRUCT >
 ;The current Lisp machine copy is in AI:LISPM2;STRUCT >
 
 ;The master copy of this file is in MC:ALAN;NSTRUCT >
 ;The current Lisp machine copy is in AI:LISPM2;STRUCT >


@@ -519,11 +519,13 @@ it should be recompiled using the current version of defstruct"
          ((null type)
           (setq type
             (cond (named-p
          ((null type)
           (setq type
             (cond (named-p

-                   #+(or Franz PDP10) ':named-hunk
+                   #+PDP10 ':named-hunk
+                   #+Franz ':named-vector

                    #+Multics ':named-list
                    #+LispM ':named-array)
                   (t
                    #+Multics ':named-list
                    #+LispM ':named-array)
                   (t

-                   #+(or Franz PDP10) ':hunk
+                   #+PDP10 ':hunk
+                   #+Franz ':named-vector

                    #+Multics ':list
                    #+LispM ':array)))))
     (let ((type-description (or (get type 'defstruct-type-description)
                    #+Multics ':list
                    #+LispM ':array)))))
     (let ((type-description (or (get type 'defstruct-type-description)


@@ -1345,13 +1347,30 @@ it should be recompiled using the current version of defstruct"
     (cond #+PDP-10 ((= n 0) `(cxr 0 ,arg))
          (t `(cxr ,(1+ n) ,arg)))))
 
     (cond #+PDP-10 ((= n 0) `(cxr 0 ,arg))
          (t `(cxr ,(1+ n) ,arg)))))
 

-#+(or PDP10 NIL)
+#+(or Franz PDP10 NIL )

 (defstruct-define-type :vector
 (defstruct-define-type :vector

+   #+Franz
+   (:named :named-vector)
+   (:cons
+      (arg description etc) :list
+      description              ;ignored
+      etc                      ;ignored
+      `(vector ,@arg))
+   (:ref
+      (n description arg)
+      description              ;ignored
+      `(vref ,arg ,n)))
+
+#+Franz
+(defstruct-define-type :named-vector
+   :named

   (:cons
     (arg description etc) :list
     description                ;ignored
     etc                        ;ignored
   (:cons
     (arg description etc) :list
     description                ;ignored
     etc                        ;ignored

-    `(vector ,@arg))
+    `(let ((nv (vector ,@arg)))
+       (vsetprop nv ',(defstruct-description-name))
+       nv))

   (:ref
     (n description arg)
     description                ;ignored
   (:ref
     (n description arg)
     description                ;ignored