Poor man's constant folding

[Ludovic Courtès]

Hello!

Here’s an experiment to implement constant folding using plain macros
(while waiting for an implementation of Wadell’s inlining algorithm ;-)):

--8<---------------cut here---------------start------------->8---
(use-modules (srfi srfi-1))

(define-syntax define-nary-constructor
  (lambda (s)
    (syntax-case s ()
      ((_ name pred)
       (identifier? #'name)
       (let ((p (symbol-append '% (syntax->datum #'name) '-proc)))
         (with-syntax ((proc-name (datum->syntax #'name p)))
           #'(begin
               (eval-when (expand)
                 (define proc-name name))
               (define-syntax name
                 (lambda (x)
                   (syntax-case x ()
                     ((_ . args)
                      (every pred (syntax->datum #'args))
                      (apply proc-name (syntax->datum #'args)))
                     ((_ . args)
                      #'(proc-name . args))
                     (_ #'proc-name)))))))))))

(define-nary-constructor + number?)
(define-nary-constructor - number?)
(define-nary-constructor / number?)
(define-nary-constructor * number?)
--8<---------------cut here---------------end--------------->8---

It works transparently in all the cases I could think of:

   scheme@(guile-user)> (+ 2 3)
   5
   scheme@(guile-user)> +
   #<procedure + (#:optional _ _ . _)>
   scheme@(guile-user)> %+-proc
   #<procedure + (#:optional _ _ . _)>
   scheme@(guile-user)> ,c (+ "a" "b")
   Disassembly of #<objcode 16f08c8>:

      0    (assert-nargs-ee/locals 0)      
      2    (load-symbol "%+-proc")         ;; %+-proc
     13    (link-now)                      
     14    (variable-ref)                  
     15    (load-string "a")               ;; "a"
     20    (load-string "b")               ;; "b"
     25    (tail-call 2)                   
  
   scheme@(guile-user)> (use-modules (oop goops))
   scheme@(guile-user)> (define-method (+ (a <string>) (b <string>))
                          (string-append a b))
   scheme@(guile-user)> (+ "a" "b")
   "ab"

The main shortcoming is that it doesn’t work recursively:

  scheme@(guile-user)> ,c (+ 1 (+ 2 (+ 3 4)))
  Disassembly of #<objcode 1c1df88>:

     0    (assert-nargs-ee/locals 0)      
     2    (load-symbol "%+-proc")         ;; %+-proc
    13    (link-now)                      
    14    (variable-ref)                  
    15    (make-int8:1)                   ;; 1
    16    (new-frame)                     
    17    (load-symbol "%+-proc")         ;; %+-proc
    28    (link-now)                      
    29    (variable-ref)                  
    30    (make-int8 2)                   ;; 2
    32    (make-int8 7)                   ;; 7
    34    (call 2)                        
    36    (tail-call 2)                   

I’m not sure this can be worked around reasonably.

Comments?

Thanks,
Ludo’.