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


parent 1e5e714a
......@@ -39,6 +39,7 @@
(:use "COMMON-LISP")
......@@ -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 @@
;; 10 - SYMBOLS
;; 12 - NUMBERS
......@@ -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))
;; 12 - NUMBERS
......@@ -36,7 +36,7 @@
(setf *readtable* (copy-readtable nil)))
......@@ -929,12 +929,11 @@ set and retrieve the values of the fields.")
(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))))
(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))
......@@ -37,6 +37,7 @@
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