generic: Add synrules automatic binding renamer

Adding a feature to add automatic binding renaming to make
pseudo-syntax-rules in Generic Runtime a bit more Hygine.

Currently, following syntax are supported:

- lambda
- define
- let
- letrec
- let*
- letrec*

Caveat: These forms MUST be appear in synrule template in complete form.
Perhaps we would have a bit more "manual" variant that would be
(with-temporary-bindings (b ...) body ...)

external/yuni-synrules.scm

@@ -45,13 +45,13 @@
     (define (next-symbol s)
       (set! count (+ count 1))
       (rename (string->symbol (string-append s (%number->string count)))))
-    (define (expand-pattern pat tmpl)
+    (define (expand-pattern pat tmpl temps)
       (let lp ((p (cdr pat))
                (x (list _cdr _expr))
                (dim 0)
                (vars '())
                (k (lambda (vars)
-                    (list _cons (expand-template tmpl vars) #f))))
+                    (list _cons (expand-template tmpl vars temps) #f))))
         (let ((v (next-symbol "v.")))
          (list
            _let (list (list v x))
@@ -194,7 +194,9 @@
          ((pair? x) (lp (car x) (lp (cdr x) free)))
          ((vector? x) (lp (vector->list x) free))
          (else free))))
-    (define (expand-template tmpl vars)
+    (define (expand-template tmpl vars temps)
+      (define tempbinds (map (lambda (e) (cons e (list _quote (rename e)))) 
+                             temps))
       (let lp ((t tmpl) (dim 0))
        (cond
          ((identifier? t)
@@ -212,7 +214,10 @@
              (if (<= (cdr cell) dim)
                t
                (error "two few ...'s"))
-             (list _baselib (list _quote t)))))
+             (let ((vn (find (lambda (v) (eq? t (car v))) tempbinds)))
+              (if vn
+                (cdr vn)
+                (list _baselib (list _quote t)))))))
          ((pair? t)
           (cond
             ((ellipsis-escape? t)
@@ -258,7 +263,13 @@
               _or
               (append
                 (map
-                  (lambda (clause) (expand-pattern (car clause) (cadr clause)))
+                  (lambda (clause) 
+                    (let* ((pat (car clause))
+                           (tmpl (cadr clause))
+                           (potential-binds (yuni/synrule-prescan-template 
+                                              ellipsis-mark?
+                                              tmpl)))
+                      (expand-pattern pat tmpl potential-binds)))
                   forms)
                 (list
                   (list _cons

lib-runtime/generic/synrules.scm

@@ -73,6 +73,88 @@
 
 (define (yuni/synrule-compare x y) (eq? x y))
 
+(define (yuni/synrule-prescan-lambda-frm ellipsis? frm)
+  (define (itr l cur)
+    (cond
+      ((and (yuni/identifier? l) (not (ellipsis? l)))
+       (cons l cur))
+      ((pair? l)
+       (let ((a (car l))
+             (d (cdr l)))
+         (cond 
+           ((and (yuni/identifier? a) (not (ellipsis? a)))
+            (itr d (cons a cur)))
+           (else
+             (itr d cur)))))
+      (else cur)))
+  (itr frm '()))
+
+(define (yuni/synrule-prescan-lambda ellipsis? frm)
+  (yuni/synrule-prescan-lambda-frm ellipsis? (cadr frm)))
+
+(define (yuni/synrule-prescan-let ellipsis? frm)
+  (define (itr bind* cur)
+    (cond
+      ((pair? bind*)
+       (let ((a (car bind*))
+             (d (cdr bind*)))
+         (cond
+           ((and (list? a) (yuni/identifier? (car a)))
+            (itr d (cons (car a) cur)))
+           (else
+             (itr d cur)))))
+      (else cur)))
+  (cond
+    ((and (yuni/identifier? (cadr frm)) (not (ellipsis? (cadr frm))))
+     (cons (cadr frm) 
+           (itr (caddr frm) '())))
+    (else
+      (itr (cadr frm) '()))))
+
+(define (yuni/synrule-prescan-define ellipsis? frm)
+  (yuni/synrule-prescan-lambda-frm ellipsis? (cadr frm)))
+
+(define (yuni/synrule-prescan-template ellipsis? tmpl) ;; => (sym ...)
+  ;; Scan syntax-rules template and emit "to-be-bound" symbols
+  ;; 
+  ;;  (let ((a 10) (b 20)) body ...) => (a b)
+  ;;  (let loop ((a 10)) body ...) => (loop a)
+  (define templates
+    (list
+      (list '(let letrec let* letrec*) yuni/synrule-prescan-let)
+      (list '(define) yuni/synrule-prescan-define)
+      (list '(lambda) yuni/synrule-prescan-lambda)))
+
+  (define (match? sym* sym)
+    (yuni/find1 (lambda (s) (eq? s sym)) sym*))
+  (define (lookup sym)
+    (yuni/find1 (lambda (e) (match? (car e) sym)) templates))
+  (define (can-be-a-binder? frm)
+    (define (itr cur cnt)
+      (cond
+        ((= cnt 2) #t)
+        ((pair? cur)
+         (itr (cdr cur) (+ 1 cnt)))
+        (else #f)))
+    (itr frm 0))
+  (define ret '())
+  (define (pass! frm)
+    (cond
+      ((pair? frm)
+       (let ((sym (car frm)))
+        (cond
+          ((and (yuni/identifier? sym) (can-be-a-binder? frm))
+           (let ((trans (lookup sym)))
+            (cond
+              (trans
+                (let ((syms ((cadr trans) ellipsis? frm)))
+                 (set! ret (append syms ret))))))))
+        (cond
+          ((list? frm)
+           (for-each pass! frm)))))))
+  (pass! tmpl)
+  ret)
+
 (define-macro (define-syntax name synrule)
   (let ((tran (yuni/syntax-rules-transformer 
                 synrule