Created
April 8, 2021 03:02
-
-
Save wilbowma/c1be24a2c71577afc56a1ebd07f6f66a to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang racket | |
(require cpsc411/compiler-lib) | |
(module+ a | |
;; Compiler style | |
(define (expand e) | |
(define (expand-expr e) | |
(match e | |
[`(and ,e1 ,e2) | |
`(if ,(expand-expr e1) ,(expand-expr e2) #f)] | |
[`(or ,e1 ,e2) | |
`(let ([x ,(expand-expr e1)]) (if x x ,(expand-expr e2)))] | |
[`(begin ,e ,es ...) | |
(for/fold ([tail '(void)]) | |
([e (cons e es)]) | |
`(let ([_ ,(expand-expr e)]) | |
,tail))] | |
[_ e])) | |
(expand-expr e)) | |
(displayln "Expander, Compiler Style, oh oh oh") ; 근육보다 사상이 울퉁불퉁한 사나이 | |
(expand '(or #t #f)) | |
(expand '(and #t #f)) | |
(expand '(begin #t #f))) | |
;; Well that's going to get old real fast. | |
;; Let's try some abstraction. | |
(module+ b | |
;; Exogenous macro expansion | |
;; recursive style | |
;; ignores all binding | |
;; macro definition language is host language | |
(define (expander env e) | |
(match e | |
[`(,op ,es ...) | |
(cond | |
[(dict-ref env op #f) => (lambda (f) (f e))] | |
[else `(,(expander env op) ,@(map (curry expander env) es))])] | |
[_ e])) | |
(define macros-1 | |
`((and . ,(lambda (x) | |
(match x | |
[`(and ,e1 ,e2) | |
`(if ,e1 ,e2 #f)]))) | |
(or . ,(lambda (x) | |
(match x | |
[`(or ,e1 ,e2) | |
`(let ([x ,e1]) | |
(if x x ,e2))]))) | |
(begin . ,(lambda (x) | |
(match x | |
[`(begin ,es ...) | |
(for/fold ([tail '(void)]) | |
([e es]) | |
`(let ([_ ,e]) | |
,tail))]))))) | |
(displayln "Exogenous recursive style") | |
(displayln "Attempt 1") | |
(expander macros-1 '(and #t #f)) | |
(expander macros-1 '(or #t #f)) | |
(expander macros-1 '(begin #t #f)) | |
(define macros-2 | |
`((and . ,(lambda (x) | |
(match x | |
[`(and) | |
'#t] | |
[`(and ,e) | |
e] | |
[`(and ,e ,es ...) | |
`(if ,e (and ,@es) #f)]))) | |
(or . ,(lambda (x) | |
(match x | |
[`(or) | |
'#f] | |
[`(or ,e) | |
e] | |
[`(or ,e ,es ...) | |
`(let ([x ,e]) (if x x (or ,@es)))]))) | |
(begin . ,(lambda (x) | |
(match x | |
[`(begin) | |
'(void)] | |
[`(begin ,e ,es ...) | |
`(let ([_ ,e]) | |
(begin ,@es))]))))) | |
(displayln "Attempt 2") | |
(expander macros-2 '(and #t #f)) | |
(expander macros-2 '(or #t #f)) | |
(expander macros-2 '(begin #t #f)) | |
(define (expand env e [bound 14]) | |
(let ([x (expander env e)]) | |
(if (or (equal? x e) | |
(zero? bound)) | |
x | |
(expand env x (sub1 bound))))) | |
(displayln "Attempt 3") | |
(expand macros-2 '(and #t #f)) | |
(expand macros-2 '(or #t #f)) | |
(expand macros-2 '(begin #t #f))) | |
(module+ c | |
;; Exogenous macro expansion | |
;; open-recursive style | |
;; ignores all binding | |
;; macro definition language is host language | |
(define (expander env e) | |
(match e | |
[`(,op ,es ...) | |
(cond | |
[(dict-ref env op #f) | |
=> | |
(lambda (f) | |
(expander env (f e)))] | |
[else `(,(expander env op) ,@(map (curry expander env) es))])] | |
[_ e])) | |
(define macros-1 | |
`((and . ,(lambda (x) | |
(match x | |
[`(and) | |
'#t] | |
[`(and ,e) | |
e] | |
[`(and ,e ,es ...) | |
`(if ,e (and ,@es) #f)]))) | |
(or . ,(lambda (x) | |
(match x | |
[`(or) | |
'#f] | |
[`(or ,e) | |
e] | |
[`(or ,e ,es ...) | |
`(let ([x ,e]) (if x x (or ,@es)))]))) | |
(begin . ,(lambda (x) | |
(match x | |
[`(begin) | |
'(void)] | |
[`(begin ,e ,es ...) | |
`(let ([_ ,e]) | |
(begin ,@es))]))))) | |
(displayln "Attempt 1") | |
(expander macros-1 '(and #t #f)) | |
(expander macros-1 '(or #t #f)) | |
(expander macros-1 '(begin #t #f)) | |
(define macros-2 | |
`((aif . ,(lambda (x) | |
(match x | |
[`(aif ,p ,t ,f) | |
`(let ([it ,p]) | |
(if it ,t ,f))]))) | |
(and . ,(lambda (x) | |
(match x | |
[`(and) | |
'#t] | |
[`(and ,e) | |
e] | |
[`(and ,e ,es ...) | |
`(if ,e (and ,@es) #f)]))) | |
(or . ,(lambda (x) | |
(match x | |
[`(or) | |
'#f] | |
[`(or ,e) | |
e] | |
[`(or ,e ,es ...) | |
`(aif ,e it (or ,@es))]))) | |
(begin . ,(lambda (x) | |
(match x | |
[`(begin) | |
'(void)] | |
[`(begin ,e ,es ...) | |
`(let ([_ ,e]) | |
(begin ,@es))]))))) | |
(displayln "Attempt 2") | |
(expander macros-2 '(and #t #f)) | |
(expander macros-2 '(or #t #f)) | |
(expander macros-2 '(begin #t #f)) | |
(define env (box '())) | |
(define (define-macro! sym def) | |
(set-box! env (dict-set (unbox env) sym def))) | |
(define (expand e) | |
(expander (unbox env) e)) | |
(define-macro! 'aif (dict-ref macros-2 'aif)) | |
(define-macro! 'or (dict-ref macros-2 'or)) | |
(define-macro! 'and (dict-ref macros-2 'and)) | |
(define-macro! 'begin (dict-ref macros-2 'begin)) | |
(define-macro! 'let* (lambda (e) | |
(match e | |
[`(let* () ,e) | |
e] | |
[`(let* ([,x ,e1] ,binds ...) ,tail) | |
`(let ([,x ,e1]) (let* ,binds ,tail))]))) | |
(displayln "Final Exogenous Expander") | |
(expand '(let* ([x 6] [y x]) y))) | |
(module+ d | |
;; Endogenous macro expansion | |
;; open-recursive style | |
;; ignores all binding | |
;; macro definition language in object language! | |
(define (expand e) | |
(define (expander env e) | |
(match e | |
;; Going to add a local version to avoid dealing with the top-level, but | |
;; you can imagine how to add the top-level. | |
[`(let-syntax ([,x ,def]) ,e) | |
(expander (dict-set env x (compile-to-host-language def)) e)] | |
[`(,op ,es ...) | |
(cond | |
[(dict-ref env op #f) | |
=> | |
(lambda (f) | |
(expander env (f e)))] | |
[else `(,op ,@(map (curry expander env) es))])] | |
[_ e])) | |
;; Syntax -> procedure? | |
(define (compile-to-host-language e) | |
;; Oh it's an interpreter | |
(eval e (module->namespace 'racket))) | |
(expander '() e)) | |
(displayln "Endogenous expander") | |
(expand '(let-syntax ([and (lambda (x) | |
(match x | |
[`(and) | |
#t] | |
[`(and ,e) | |
e] | |
[`(and ,e ,es ...) | |
`(if ,e (and ,@es) #f)]))]) | |
(and #f #t))) | |
(displayln "Macro-generating macros") | |
(expand '(let-syntax ([let-syntax* | |
(lambda (x) | |
(match x | |
[`(let-syntax* () ,e) | |
e] | |
[`(let-syntax* ([,x ,def] ,binds ...) ,e) | |
`(let-syntax ([,x ,def]) | |
(let-syntax* (,@binds) ,e))]))]) | |
(let-syntax* ([and | |
(lambda (x) | |
(match x | |
[`(and) | |
#t] | |
[`(and ,e) | |
e] | |
[`(and ,e ,es ...) | |
`(if ,e (and ,@es) #f)]))] | |
[aif | |
(lambda (x) | |
(match x | |
[`(aif ,p ,t ,f) | |
`(let ([it ,p]) | |
(if it ,t ,f))]))] | |
[or | |
(lambda (x) | |
(match x | |
[`(or) | |
#f] | |
[`(or ,e) | |
e] | |
[`(or ,e ,es ...) | |
`(aif e it (or ,@es))]))]) | |
(or #f #t)))) | |
;; | |
(expand '(let-syntax ([let-inline | |
(lambda (stx) | |
(match stx | |
[`(let-inline ([,x ,lam]) ,e) | |
`(let-syntax ([,x (lambda (stx) | |
(match stx | |
[`(,_ ,es ...) | |
(let ([lam ',lam]) | |
`(,lam ,@es))]))]) | |
,e)]))]) | |
(let-inline ([x (lambda (y) y)]) | |
(x 5)))) | |
(displayln "The hygiene problem") | |
(expand '(let-syntax ([or | |
(lambda (x) | |
(match x | |
[`(or) | |
#f] | |
[`(or ,e) | |
e] | |
[`(or ,e ,es ...) | |
`(let ([tmp ,e]) | |
(if tmp tmp (or ,@es)))]))]) | |
(begin | |
(or #f 6) | |
(let ([tmp 6]) | |
(or #f tmp)))))) | |
;; Well, we could just use 'fresh' in our macros everywhere... | |
;; OR overengineer the h*ck out of our macro system to always do the right | |
;; thing, unless we explicitly tell it to break binding safety. | |
(module+ e | |
;; Endogenous macro expansion | |
;; open-recursive style | |
;; ignores all binding | |
;; macro definition language in object language! | |
(define (expand e) | |
(define (expander env e) | |
(match e | |
[`(let-syntax ([,x ,def]) ,e) | |
(expander (dict-set env x (compile-to-host-language def)) e)] | |
[`(,op ,es ...) | |
(cond | |
[(dict-ref env op #f) | |
=> | |
(lambda (f) | |
(expander env (f e)))] | |
[else `(,op ,@(map (curry expander env) es))])] | |
[_ e])) | |
;; Syntax -> procedure? | |
(define (compile-to-host-language e) | |
;; Oh it's an interpreter | |
(eval e (module->namespace 'racket))) | |
(expander '() e)) | |
(displayln "Endogenous expander") | |
(expand '(let-syntax ([and (lambda (x) | |
(match x | |
[`(and) | |
#t] | |
[`(and ,e) | |
e] | |
[`(and ,e ,es ...) | |
`(if ,e (and ,@es) #f)]))]) | |
(and #f #t))) | |
(displayln "Macro-generating macros") | |
(expand '(let-syntax ([let-syntax* | |
(lambda (x) | |
(match x | |
[`(let-syntax* () ,e) | |
e] | |
[`(let-syntax* ([,x ,def] ,binds ...) ,e) | |
`(let-syntax ([,x ,def]) | |
(let-syntax* (,@binds) ,e))]))]) | |
(let-syntax* ([and | |
(lambda (x) | |
(match x | |
[`(and) | |
#t] | |
[`(and ,e) | |
e] | |
[`(and ,e ,es ...) | |
`(if ,e (and ,@es) #f)]))] | |
[aif | |
(lambda (x) | |
(match x | |
[`(aif ,p ,t ,f) | |
`(let ([it ,p]) | |
(if it ,t ,f))]))] | |
[or | |
(lambda (x) | |
(match x | |
[`(or) | |
#f] | |
[`(or ,e) | |
e] | |
[`(or ,e ,es ...) | |
`(aif e it (or ,@es))]))]) | |
(or #f #t)))) | |
;; | |
(expand '(let-syntax ([let-inline | |
(lambda (stx) | |
(match stx | |
[`(let-inline ([,x ,lam]) ,e) | |
`(let-syntax ([,x (lambda (stx) | |
(match stx | |
[`(,_ ,es ...) | |
(let ([lam ',lam]) | |
`(,lam ,@es))]))]) | |
,e)]))]) | |
(let-inline ([x (lambda (y) y)]) | |
(x 5)))) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment