Commit 3ea652c5 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Moved KEYWORDIZE to "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL"; Removed CONC-SYMBOL (use SCAT).

parent 1e5e714a
......@@ -39,6 +39,7 @@
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL"
(:use "COMMON-LISP")
(:export
"KEYWORDIZE"
"SCAT")
(:documentation
"
......@@ -75,4 +76,15 @@ License:
(intern (apply (function concatenate) 'string
(mapcar (function string) string-designators))))
(defun keywordize (string-designator)
"
RETURN: A new keyword with STRING-DESIGNATOR as name.
"
(intern (string string-designator)
(load-time-value (find-package "KEYWORD"))))
;;;; THE END ;;;;
......@@ -106,8 +106,6 @@
"DEFINE-WITH-STRUCTURE"
;; 9 - CONDITIONS
"HANDLING-ERRORS"
;; 10 - SYMBOLS
"KEYWORDIZE" "CONC-SYMBOL"
;; 12 - NUMBERS
"SIGN"
"DISTINCT-FLOAT-TYPES" "FLOAT-TYPECASE" "FLOAT-CTYPECASE" "FLOAT-ETYPECASE"
......@@ -1189,35 +1187,6 @@ DO: Execute the BODY with a handler for CONDITION and
(format *error-output* "~&~A:~%~A~%" (class-name (class-of err)) err)
(finish-output *error-output*))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 10 - SYMBOLS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun keywordize (string-designator)
"
RETURN: A new keyword with SYM as name.
"
(intern (string string-designator)
(load-time-value (find-package "KEYWORD"))))
(defun conc-symbol (&rest args)
"
DO: Concatenate the arguments and INTERN the resulting string.
NOTE: The last two arguments maybe :PACKAGE <a-package>
in which case the symbol is interned into the given package
instead of *PACKAGE*.
"
(let ((package *package*))
(when (and (<= 2 (length args))
(eq :package (car (last args 2))))
(setf package (car (last args))
args (butlast args 2)))
(intern (apply (function concatenate) 'string (mapcar (function string) args))
package)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 12 - NUMBERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......
......@@ -36,7 +36,7 @@
(setf *readtable* (copy-readtable nil)))
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.DATA-ENCODING.DATA-ENCODING"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY")
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL")
(:export "SIZE-OF-ENCTYPE" "ENCTYPE-INSTANCE" "ENCTYPE-WRITE" "ENCTYPE-READ"
"MAKE-ENCTYPE" "DEF-ENCRECORD" "DEF-ENCTYPE")
(:documentation
......@@ -929,12 +929,11 @@ set and retrieve the values of the fields.")
(values
(apply (function make-instance) (lisp-type self)
(mapcan (lambda (field)
(list (conc-symbol (field-name field) :package "KEYWORD")
(list (keywordize (field-name field))
(get-value (field-type field)
buffer (+ offset (field-offset field)))))
(fields self)))
(+ offset (size-of-enctype self)))) ;;get-value
(+ offset (size-of-enctype self))))
(defmethod set-value ((self record-enctype) buffer offset record)
(map nil (lambda (field)
......@@ -942,8 +941,7 @@ set and retrieve the values of the fields.")
buffer (+ offset (field-offset field))
(slot-value record (field-name field))))
(fields self))
(+ offset (size-of-enctype self))) ;;set-value
(+ offset (size-of-enctype self)))
;; ------------------------------------------------------------------------
......@@ -1259,9 +1257,9 @@ DO: Defines an enctype template for a record type,
`(,(first oof) ,(default-value enctype)
:type ,(to-lisp-type enctype))))
fields))
(defun ,(conc-symbol "READ-" name) (stream)
(defun ,(scat "READ-" name) (stream)
(enctype-read ',name (enctype-instance ',name) stream))
(defun ,(conc-symbol "WRITE-" name) (value stream)
(defun ,(scat "WRITE-" name) (value stream)
(enctype-write ',name (enctype-instance ',name) stream value))
',name)))
......
......@@ -37,6 +37,7 @@
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SEQUENCE"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
"COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER"
#|temporarily|# "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment