Fix id-macro in head position

If identifier macro M is used in the head position, e.g. (M arg ...),
the expander should receive only M, not the entier (M arg ...).

#1061

src/compile-1.scm

@@ -81,7 +81,12 @@
     (receive (gval type) (global-call-type id cenv)
       (if gval
         (case type
-          [(macro)  (pass1 (call-macro-expander gval program cenv) cenv)]
+          [(macro)
+           (if (identifier-macro? gval)
+             (pass1 (cons (call-id-macro-expander gval id cenv)
+                          (cdr program))
+                    cenv)
+             (pass1 (call-macro-expander gval program cenv) cenv))]
           [(syntax) (call-syntax-handler gval program cenv)]
           [(inline) (or (pass1/expand-inliner program id gval cenv)
                         (pass1/call program ($gref id) (cdr program) cenv))]
@@ -104,7 +109,11 @@
               [(wrapped-identifier? h) (pass1/global-call h)]
               [(lvar? h) (pass1/call program ($lref h) (cdr program) cenv)]
               [(macro? h) ;; local macro
-               (pass1 (call-macro-expander h program cenv) cenv)]
+               (if (identifier-macro? h)
+                 (pass1 (cons (call-id-macro-expander h (car program) cenv)
+                              (cdr program))
+                        cenv)
+                 (pass1 (call-macro-expander h program cenv) cenv))]
               [(syntax? h);; locally rebound syntax
                (call-syntax-handler h program cenv)]
               [else (error "[internal] unknown resolution of head:" h)]))]
@@ -307,7 +316,9 @@
            (cond
             [(lvar? head) (pass1/body-finish exprs mframe vframe cenv)]
             [(macro? head)  ; locally defined macro
-             (pass1/body-macro-expand-rec head exprs mframe vframe cenv)]
+             (if (identifier-macro? head)
+               (pass1/body-id-macro-expand-rec head exprs mframe vframe cenv)
+               (pass1/body-macro-expand-rec head exprs mframe vframe cenv))]
             [(syntax? head) ; when (let-syntax ((xif if)) (xif ...)) etc.
              (pass1/body-finish exprs mframe vframe cenv)]
             [(and (pair? head) (eq? (car head) :rec))
@@ -372,7 +383,9 @@
              (or (and-let* ([gloc (id->bound-gloc head)]
                             [gval (gloc-ref gloc)]
                             [ (macro? gval) ])
-                   (pass1/body-macro-expand-rec gval exprs mframe vframe cenv))
+                   (if (identifier-macro? gval)
+                     (pass1/body-id-macro-expand-rec gval exprs mframe vframe cenv)
+                     (pass1/body-macro-expand-rec gval exprs mframe vframe cenv)))
                  (pass1/body-finish exprs mframe vframe cenv))]
             [else (error "[internal] pass1/body" head)]))
          (pass1/body-finish exprs mframe vframe cenv))]
@@ -385,6 +398,14 @@
           (cdr exprs)) ;rest
    mframe vframe cenv))
 
+(define (pass1/body-id-macro-expand-rec mac exprs mframe vframe cenv)
+  (pass1/body-rec
+   (acons (cons (call-id-macro-expander mac (caaar exprs) cenv)
+                (cdaar exprs))
+          (cdar exprs) ;src
+          (cdr exprs)) ;rest
+   mframe vframe cenv))
+
 ;; Finishing internal definitions.  If we have internal defs, we wrap
 ;; the rest by letrec.
 (define (pass1/body-finish exprs mframe vframe cenv)

test/macro.scm

@@ -283,17 +283,6 @@
 
 (test-section "er identifier macros")
 
-(test "er identifier macro" '((1 2) 3)
-      (lambda ()
-        (let ((x 1) (y 2))
-          (let-syntax ((x (make-id-transformer
-                           (er-macro-transformer
-                            (lambda (f r c)
-                              (if (pair? f)
-                                (quasirename r `(list x y))
-                                (quasirename r `(+ x y))))))))
-            (list (x) x)))))
-
 ;; global
 (define-module id-macro-test-er
   (use gauche.test)
@@ -316,6 +305,9 @@
     (set! p.car 99)
     (test "er global identifier macro hygiene" 99 (lambda () p.car))
     (test "er global identifier macro hygiene" '(6 . 7) (lambda () p)))
+
+  (set! p.car list)
+  (test "er global identifier macro in head" '(1 2 3) (lambda () (p.car 1 2 3)))
   )
 
 (define-module id-macro-test-sr
@@ -359,6 +351,9 @@
     (set! p.car 99)
     (test "er local identifier macro hygiene" 99 (lambda () p.car))
     (test "er local identifier macro hygiene" '(6 . 7) (lambda () p)))
+
+  (set! p.car list)
+  (test "er local identifier macro in head" '(1 2 3) (lambda () (p.car 1 2 3)))
   ))
 
 ;;----------------------------------------------------------------------