public
Last active

traditional lisp macros

  • Download Gist
gistfile1.scm
Scheme
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
;; outlet code for implementing traditional macro expansion
 
;; macros
 
(define (expand form)
(cond
((variable? form) form)
((literal? form) form)
((macro? (car form))
(expand ((macro-function (car form)) form)))
((eq? (car form) 'quote)
form)
((eq? (car form) 'lambda)
`(lambda ,(car (cdr form))
,@(map expand (cdr (cdr form)))))
(else (map expand form))))
 
(define _macros_ {})
 
(define (macro-function name)
(ref _macros_ (symbol->string name)))
 
(define (install-macro name func)
(put! _macros_ (symbol->string name) func))
 
(define (macro? name)
(not (eq? (ref _macros_ (symbol->string name))
undefined)))
 
;; compiler
 
(define (read src)
(vector-to-list
(reader grammar src '[begin])))
 
(install-macro 'define (lambda (form)
`(define* ,(car (cdr form))
,@(cdr (cdr form)))))
 
(let ((src (fs.readFileSync "example.ol" "utf-8")))
(pretty (expand (read src))))
 
;; (define (foo x y z)
;; (+ x y z))
;;
;; expand to:
;;
;; (define* (foo x y z)
;; (+ x y z))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.