guile/guile-lightning lightning.scm

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/03/24 20:31:37

Modified files:
        guile-lightning: lightning.scm 

Log message:
        * lightning.scm (asm-macros, register-asm-macro, get-asm-macro,
        asm-macroexpand, define-asm-macro): New, export
        (register-asm-macro and define-asm-macro):
        (assemble): Pass instructions thru asm-macroexpand before
        assembling.

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-lightning/lightning.scm.diff?r1=1.1.1.1&r2=1.2

Patches:
Index: guile/guile-lightning/lightning.scm
diff -u guile/guile-lightning/lightning.scm:1.1 
guile/guile-lightning/lightning.scm:1.2
--- guile/guile-lightning/lightning.scm:1.1     Mon Mar 19 15:52:01 2001
+++ guile/guile-lightning/lightning.scm Sat Mar 24 20:31:36 2001
@@ -1,5 +1,37 @@
 (define-module (lightning))
 
+(export assemble disassemble register-asm-macro define-asm-macro)
+
 (dynamic-call "scm_init_lightning" (dynamic-link "libguile-lightning"))
+
+(define asm-macros (make-hash-table 31))
+
+(define (register-asm-macro name transformer)
+  (hashq-set! asm-macros name transformer))
+
+(define (get-asm-macro name)
+  (hashq-ref asm-macros name #f))
+
+(define (asm-macroexpand insns)
+  (let loop ((res '())
+            (insns insns))
+    (cond 
+     ((null? insns)
+      (reverse! res))
+     ((and (list? (car insns))
+          (get-asm-macro (caar insns)))
+      => (lambda (transformer)
+          (loop res
+                (append! (apply transformer (cdar insns))
+                         (cdr insns)))))
+     (else
+      (loop (cons (car insns) res)
+           (cdr insns))))))
+
+(define prim-assemble assemble)
+
+(define (assemble insns)
+  (prim-assemble (asm-macroexpand insns)))
 
-(export assemble disassemble)
+(define-macro (define-asm-macro head . body)
+  `(register-asm-macro ',(car head) (lambda ,(cdr head) ,@body)))