fixed and finalized m4 defn

src/m4/m4-builtin.lisp

@@ -55,6 +55,8 @@
                                      (declare (ignore ,macro-name))
                                      (cond ((eql :definition ,internal-call)
                                             (concatenate 'string "<" ,name ">"))
+                                           ((eql :expansion ,internal-call)
+                                            "")
                                            ((and ,arguments-only (not ,internal-call) (null ,macro-args)) ; most macros are only recognized with parameters
                                             ,name)
                                            ((< (length ,macro-args) ,minimum-arguments)
@@ -74,7 +76,7 @@
   (let ((fun (if (macro-token-p expansion)
                  (macro-token-m4macro expansion)
                #'(lambda (macro-name internal-call &rest macro-args)
-                   (if (eql :definition internal-call)
+                   (if (find internal-call '(:definition :expansion))
                        expansion
                      (macro-return
                       (cl-ppcre:regex-replace-all "\\$(\\d+|#|\\*|@)" expansion
@@ -110,15 +112,23 @@
           args)))
 
 (defm4macro "defn" (&rest args) ()
-  (error 'macro-defn-invocation-condition
-         :macros (mapcar #'(lambda (name)
-                             (if (m4-macro name)
-                                 (make-macro-token (m4-macro name)
-                                                   (if (gethash name *m4-lib*)
-                                                       ""
-                                                     name))
-                               ""))
-                         args)))
+  (cond ((= 0 (length args))
+         "")
+        ((and (= 1 (length args))
+              (m4-macro (car args) t)) ; builtin macro
+         (error 'macro-defn-invocation-condition
+                :macro (make-macro-token (m4-macro (car args) t) (car args))))
+        (t (macro-return
+            (apply #'concatenate 'string            
+                   (mapcar #'(lambda (name)
+                               (let ((macro (m4-macro name)))
+                                 (if macro
+                                     (if (m4-macro name t)
+                                         (prog1 ""
+                                           (m4-warn (format nil "cannot concatenate builtin `~a'" name)))
+                                       (m4-quote-string (funcall macro name :expansion)))
+                                   "")))
+                           args))))))
 
 (defm4macro "pushdef" (name &optional (expansion "")) (:minimum-arguments 1)
   (prog1 ""

src/m4/m4-lexer.lisp

@@ -147,7 +147,7 @@
 
 (defgeneric m4-push-macro (m4-input-stream macro)
   (:method ((stream m4-input-stream) macro)
-    (setf (m4-macro-stack stream) macro)))
+    (push macro (m4-macro-stack stream))))
 
 (defgeneric m4-pop-macro (m4-input-stream)
   (:method ((stream m4-input-stream))

src/m4/m4-parser.lisp

@@ -160,11 +160,11 @@
        (macro-dnl-invocation-condition ()
          (parse-m4-dnl lexer))
        (macro-defn-invocation-condition (condition)
-         (m4-push-macro lexer (macro-defn-invocation-result condition))
-         "")
+         (prog1 ""
+           (m4-push-macro lexer (macro-defn-invocation-result condition))))
        (macro-invocation-condition (condition)
-         (lexer-unread-sequence lexer (macro-invocation-result condition))
-         "")))))
+         (prog1 ""
+           (lexer-unread-sequence lexer (macro-invocation-result condition))))))))
 
 (defun parse-m4 (lexer)
   (do* ((token (multiple-value-list (stream-read-token lexer))
@@ -186,9 +186,9 @@
            ((equal :macro-name class)
             (parse-m4-macro lexer image))
            ((equal :macro-token class)
-            (if (macro-token-p image)
-                (string (macro-token-name image))
-              ""))
+            (prog1 ""
+              (when (macro-token-p image)
+                (lexer-unread-sequence lexer (expand-macro-token image)))))
            (t image)))))
 
 

src/m4/m4-util.lisp

@@ -28,8 +28,8 @@
 (define-condition macro-dnl-invocation-condition (error) ())
 
 (define-condition macro-defn-invocation-condition (error)
-  ((macros :initarg :macros
-           :reader macro-defn-invocation-result)))
+  ((macro :initarg :macro
+          :reader macro-defn-invocation-result)))
 
 
 ;; utilities
@@ -186,3 +186,9 @@
                (remhash diversion *m4-diversion-table*)))))
     (mapcar #'flush (or diversions
                         (sort (alexandria:hash-table-keys *m4-diversion-table*) #'<)))))
+
+(defun expand-macro-token (token)
+  (concatenate 'string
+               *m4-quote-start*
+               (funcall (macro-token-m4macro token) nil :expansion)
+               *m4-quote-end*))

test/m4/m4-builtin.lisp

@@ -32,8 +32,7 @@
   :signal macro-dnl-invocation-condition
   :error (format nil "cl-m4:?:?: excess arguments to builtin `dnl' ignored~%"))
 
-(defm4test macro-defn-no-args "defn" ()
-  :signal macro-defn-invocation-condition)
+(defm4test macro-defn-no-args "defn" ())
 
-(defm4test macro-defn-empty-args "defn" (nil)
+(defm4test macro-defn-empty-args "defn" ("defn")
   :signal macro-defn-invocation-condition)

test/m4/m4-macros.lisp

@@ -131,7 +131,7 @@ m4
 
 #>m4>
 
-The macro
+The macro 
 The macro dnl is very useful
 
 m4