diff options
Diffstat (limited to 'module/language/sassy/macros.scm')
| -rw-r--r-- | module/language/sassy/macros.scm | 136 |
1 files changed, 136 insertions, 0 deletions
diff --git a/module/language/sassy/macros.scm b/module/language/sassy/macros.scm new file mode 100644 index 000000000..ea586d9b4 --- /dev/null +++ b/module/language/sassy/macros.scm @@ -0,0 +1,136 @@ +; macros.scm - Sassy's macro system +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module macros +; import srfi-69 intern +; import-syntax meta-lambda +; export sassy-expand + +(define sassy-expand + (let + ((sassy-internal-macros ; permanent macros + (alist->hash-table + `((< . ,(lambda (a b) `(seq (cmp ,a ,b) l!))) + (<= . ,(lambda (a b) `(seq (cmp ,a ,b) le!))) + (> . ,(lambda (a b) `(seq (cmp ,a ,b) g!))) + (>= . ,(lambda (a b) `(seq (cmp ,a ,b) ge!))) + (= . ,(lambda (a b) `(seq (cmp ,a ,b) e!))) + (!= . ,(lambda (a b) `(seq (cmp ,a ,b) ne!))) + (zero? . ,(lambda (x) `(seq (test ,x ,x) z!))) + (asciiz . ,(lambda (x) `(bytes ,x 0))) + (alt . ,(lambda x `(inv (seq ,@(map (lambda (y) + `(inv ,y)) + x))))) + (times . ,(lambda (num e) + (cons 'begin (make-list num e)))) + (until . ,(lambda (test body) `(while (inv ,test) ,body))) + + (cs: . ,(lambda rst `(cs (& ,@rst)))) + (ds: . ,(lambda rst `(ds (& ,@rst)))) + (ss: . ,(lambda rst `(ss (& ,@rst)))) + (es: . ,(lambda rst `(es (& ,@rst)))) + (fs: . ,(lambda rst `(fs (& ,@rst)))) + (gs: . ,(lambda rst `(gs (& ,@rst)))) + + (_global_offset_table_ . ,(string->symbol "_GLOBAL_OFFSET_TABLE_")) + (get-got . (seq (call $eip) + (pop ebx) + (add ebx (reloc gotpc _global_offset_table_ 3)))) + (got-offset . ,(lambda (sym . vals) + `(reloc gotoff ,sym ,(if (null? vals) + 0 + (apply + vals))))) + (got . ,(lambda (symbol) `(reloc got32 ,symbol))) + (plt . ,(lambda (symbol) `(reloc plt32 ,symbol))) + (sym . ,(lambda (symbol) `(reloc sym32 ,symbol))))))) + + (letrec + ;sassy-user-macros is updated with a new hash-table every time + ;sassy is called, but since it keeps the last table around, + ;you can call sassy-expand yourself to see how something got + ;expanded + ((sassy-user-macros (make-hash-table)) + + (make-sassy-macro + (meta-lambda + (or (and 'lambda __ (lambda x + (eval `(lambda ,@x) + (interaction-environment)))) + ,@?))) + + (macro? (lambda (x) + (and (symbol? x) + (or (hash-table-ref + sassy-user-macros x (lambda () #f)) + (hash-table-ref + sassy-internal-macros x (lambda () #f)))))) + + (call-macro (lambda (macro-call args) + (expand (if (procedure? macro-call) + (apply macro-call args) + (cons macro-call args))))) + (do-scheme-call (lambda (scheme-call) + (expand + (eval scheme-call + (interaction-environment))))) + + (symbol-or-expand (lambda (x) (if (pair? x) (expand x) x))) + (atom? (lambda (x) (not (pair? x)))) + + (expand + (meta-lambda + (or (and ,@macro? (lambda (constant) (expand constant))) + ,@atom? + (and 'label symbol-or-expand (* expand) + (lambda (label rest) + `(label ,label ,@rest))) + (and 'locals ((* symbol-or-expand)) (* expand) + (lambda (decs rest) + `(locals ,decs ,@rest))) + (and '! ? (lambda (scheme-call) (do-scheme-call scheme-call))) + (and 'macro symbol? ? + (lambda (macro-name macro-body) + (hash-table-set! sassy-user-macros macro-name + (make-sassy-macro macro-body)) + 'void)) + (and macro? (* expand) (lambda (macro-call args) + (call-macro macro-call args))) + (and ((and '! ?)) (* expand) + (lambda (scheme-call tail) + (let ((new-head (do-scheme-call scheme-call))) + (cond ((macro? new-head) => + (lambda (mac) + (call-macro mac tail))) + ((procedure? new-head) + (call-macro new-head tail)) + (else (cons new-head tail)))))) + (and ? (* expand) (lambda (head tail) (cons head tail))) + )))) + + (lambda (list-or-hashtable) + (if (hash-table? list-or-hashtable) + (set! sassy-user-macros list-or-hashtable) + (expand list-or-hashtable)))))) |