Added 'cons' array operator

This commit is contained in:
waldemar%netscape.com 2001-12-20 01:07:22 +00:00
parent cb85e2ed2c
commit 490270b28f
2 changed files with 25 additions and 0 deletions

View File

@ -3236,6 +3236,19 @@
(list 'expr-annotation:special-form special-form vector-annotated-expr low-annotated-expr nil)))))))
; (cons <value-expr> <vector-expr>)
; Returns a vector consisting of <value-expr> followed by all values in <vector-expr>.
(defun scan-cons (world type-env special-form value-expr vector-expr)
(multiple-value-bind (vector-code vector-type vector-annotated-expr) (scan-vector-value world type-env vector-expr)
(multiple-value-bind (value-code value-annotated-expr) (scan-typed-value world type-env value-expr (vector-element-type vector-type))
(values
(if (eq vector-type (world-string-type world))
`(concatenate 'string (list ,value-code) ,vector-code)
(list 'cons value-code vector-code))
vector-type
(list 'expr-annotation:special-form special-form value-annotated-expr vector-annotated-expr)))))
; (append <vector-expr> <vector-expr>)
; Returns a vector contatenating the two given vectors, which must have the same element type.
(defun scan-append (world type-env special-form vector1-expr vector2-expr)
@ -4665,6 +4678,7 @@
(vector-of scan-vector-of depict-vector-expr)
(nth scan-nth depict-nth)
(subseq scan-subseq depict-subseq)
(cons scan-cons depict-cons)
(append scan-append depict-append)
(set-nth scan-set-nth depict-set-nth)

View File

@ -652,6 +652,17 @@
(depict markup-stream "]"))))
; (cons <value-expr> <vector-expr>)
(defun depict-cons (markup-stream world level value-annotated-expr vector-annotated-expr)
(depict-expr-parentheses (markup-stream level %term%)
(depict-logical-block (markup-stream 0)
(depict markup-stream :vector-begin)
(depict-expression markup-stream world value-annotated-expr %expr%)
(depict markup-stream :vector-end " " :vector-append)
(depict-break markup-stream 1)
(depict-expression markup-stream world vector-annotated-expr %term%))))
; (append <vector-expr> <vector-expr>)
(defun depict-append (markup-stream world level vector1-annotated-expr vector2-annotated-expr)
(depict-expr-parentheses (markup-stream level %term%)