X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/52a79ab8b310a785f2c2f1a11069f3a5ad53810c..b3354e08ea601fe2420c15a9a16d1f6d5b98a897:/src/module-impl.lisp diff --git a/src/module-impl.lisp b/src/module-impl.lisp index 9e74b27..c15edda 100644 --- a/src/module-impl.lisp +++ b/src/module-impl.lisp @@ -144,11 +144,10 @@ ;;;-------------------------------------------------------------------------- ;;; Code fragments. -(export 'c-fragment) +(export '(c-fragment c-fragment-text)) (defclass c-fragment () - ((location :initarg :location :type file-location - :accessor c-fragment-location) - (text :initarg :text :type string :accessor c-fragment-text)) + ((location :initarg :location :type file-location :reader file-location) + (text :initarg :text :type string :reader c-fragment-text)) (:documentation "Represents a fragment of C code to be written to an output file. @@ -167,7 +166,8 @@ (line (file-location-line location)) (filename (file-location-filename location))) (cond (line - (format stream "~&#line ~D~@[ ~S~]~%" line filename) + (when (typep stream 'position-aware-stream) + (format stream "~&#line ~D~@[ ~S~]~%" line filename)) (funcall thunk) (when (typep stream 'position-aware-stream) (fresh-line stream) @@ -180,7 +180,7 @@ (defmethod print-object ((fragment c-fragment) stream) (let ((text (c-fragment-text fragment)) - (location (c-fragment-location fragment))) + (location (file-location fragment))) (if *print-escape* (print-unreadable-object (fragment stream :type t) (when location @@ -196,7 +196,8 @@ (defmethod make-load-form ((fragment c-fragment) &optional environment) (make-load-form-saving-slots fragment :environment environment)) -(export 'code-fragment-item) +(export '(code-fragment-item code-fragment code-fragment-reason + code-fragment-name code-fragment-constraints)) (defclass code-fragment-item () ((fragment :initarg :fragment :type c-fragment :reader code-fragment) (reason :initarg :reason :type keyword :reader code-fragment-reason) @@ -206,24 +207,6 @@ (:documentation "A plain fragment of C to be dropped in at top-level.")) -(defmacro define-fragment ((reason name) &body things) - (categorize (thing things) - ((constraints (listp thing)) - (frags (typep thing '(or string c-fragment)))) - (when (null frags) - (error "Missing code fragment")) - (when (cdr frags) - (error "Multiple code fragments")) - `(add-to-module - *module* - (make-instance 'code-fragment-item - :fragment ',(car frags) - :name ,name - :reason ,reason - :constraints (list ,@(mapcar (lambda (constraint) - (cons 'list constraint)) - constraints)))))) - ;;;-------------------------------------------------------------------------- ;;; File searching.