Skip to content

Commit

Permalink
Tangle simple vector marker contents.
Browse files Browse the repository at this point in the history
  • Loading branch information
Alex Plotnick committed Jul 8, 2013
1 parent 43a931e commit bbe89f5
Show file tree
Hide file tree
Showing 3 changed files with 15 additions and 11 deletions.
4 changes: 2 additions & 2 deletions clweb-tests.lisp
Expand Up @@ -330,8 +330,8 @@
(VALUES (QUOTED-FORM MARKER) (MARKER-VALUE MARKER)))
IDENTITY #'IDENTITY)
(DEFTEST READ-SIMPLE-VECTOR
(MARKER-VALUE (READ-FORM-FROM-STRING "#5(:a :b :c)"))
#(:A :B :C :C :C))
(MARKER-VALUE (READ-FORM-FROM-STRING "#5(:a :b :c #C(0 1))"))
#(:A :B :C #C(0 1) #C(0 1)))
(DEFTEST READ-BIT-VECTOR (MARKER-VALUE (READ-FORM-FROM-STRING "#6*101"))
#*101111)
(DEFTEST (READ-TIME-EVAL 1)
Expand Down
12 changes: 7 additions & 5 deletions clweb.clw
Expand Up @@ -1929,13 +1929,15 @@ abbreviation.
@l
(defclass simple-vector-marker (marker)
((length :initarg :length)
(elements :initarg :elements)
(element-type :initarg :element-type))
(elements :reader simple-vector-marker-elements :initarg :elements)
(element-type :reader simple-vector-marker-element-type ;
:initarg :element-type))
(:default-initargs :element-type t))
(defmethod marker-boundp ((marker simple-vector-marker)) t)
(defmethod marker-value ((marker simple-vector-marker))
(with-slots (elements element-type) marker
(let ((elements (tangle (simple-vector-marker-elements marker)))
(element-type (simple-vector-marker-element-type marker)))
(if (slot-boundp marker 'length)
(with-slots (length) marker
(let ((supplied-length (length elements)))
Expand Down Expand Up @@ -1968,8 +1970,8 @@ abbreviation.
@t@l
(deftest read-simple-vector
(marker-value (read-form-from-string "#5(:a :b :c)"))
#(:a :b :c :c :c))
(marker-value (read-form-from-string "#5(:a :b :c #C(0 1))"))
#(:a :b :c #C(0 1) #C(0 1)))
@ Sharpsign asterisk also creates a vector, but the token following the
asterisk must be composed entirely of the characters `0' and~`1', which
Expand Down
10 changes: 6 additions & 4 deletions clweb.lisp
Expand Up @@ -688,13 +688,15 @@ TANGLE-FILE.")
(SET-DISPATCH-MACRO-CHARACTER #\# #\' #'SHARPSIGN-QUOTE-READER
(READTABLE-FOR-MODE MODE)))
(DEFCLASS SIMPLE-VECTOR-MARKER (MARKER)
((LENGTH :INITARG :LENGTH) (ELEMENTS :INITARG :ELEMENTS)
(ELEMENT-TYPE :INITARG :ELEMENT-TYPE))
((LENGTH :INITARG :LENGTH)
(ELEMENTS :READER SIMPLE-VECTOR-MARKER-ELEMENTS :INITARG :ELEMENTS)
(ELEMENT-TYPE :READER SIMPLE-VECTOR-MARKER-ELEMENT-TYPE :INITARG
:ELEMENT-TYPE))
(:DEFAULT-INITARGS :ELEMENT-TYPE T))
(DEFMETHOD MARKER-BOUNDP ((MARKER SIMPLE-VECTOR-MARKER)) T)
(DEFMETHOD MARKER-VALUE ((MARKER SIMPLE-VECTOR-MARKER))
(WITH-SLOTS (ELEMENTS ELEMENT-TYPE)
MARKER
(LET ((ELEMENTS (TANGLE (SIMPLE-VECTOR-MARKER-ELEMENTS MARKER)))
(ELEMENT-TYPE (SIMPLE-VECTOR-MARKER-ELEMENT-TYPE MARKER)))
(IF (SLOT-BOUNDP MARKER 'LENGTH)
(WITH-SLOTS (LENGTH)
MARKER
Expand Down

0 comments on commit bbe89f5

Please sign in to comment.