macro-expanders.rkt

#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))))
  )