[bootstrappable] macro expander for mes

  • From: Ricardo Wurmus <rekado@xxxxxxxxxxx>
  • To: "bootstrappable\@freelists.org" <bootstrappable@xxxxxxxxxxxxx>
  • Date: Fri, 03 Nov 2017 00:05:53 +0100

Hi,

I’ve been trying to use mes to load Guile’s eval.scm and run its version
of “primitive-eval”.

The last part of “primitive-eval” in eval.scm is this:

--8<---------------cut here---------------start------------->8---
  (let ((eval (compile
               (memoize-expression
                (if (macroexpanded? exp)
                    exp
                    ((module-transformer (current-module)) exp)))))
        (env #f))
    (eval env))
--8<---------------cut here---------------end--------------->8---

“exp” is a quoted s-expression.

I have defined this inelegant and incomplete expander procedure in mes:

--8<---------------cut here---------------start------------->8---
(mes-use-module (mes match))

;; Extend the environment ENV by shadowing all NAMES so
;; that they cannot be considered macros.
(define (shadow-env env names)
  (append (map (lambda (name)
                 (cons name 'not-a-macro))
               names)
          env))

(define (expand* exp env)
  (format #t "EXPANDING: ~a\n" exp)
  (match exp
    ;; TODO: similarly deal with let*, letrec, etc
    (('let bindings body-exps ...)
     (format #t "let:\n  bindings: ~a\n  body-exps: ~a\n" bindings body-exps)
     ;; Expand right-hand side of bindings.  Remove left-hand side
     ;; from the list of macros by shadowing the bindings.  Then
     ;; expand the body.
     (let ((bindings* (map (lambda (item)
                             (format #t "item: ~a\n" item)
                             `(,(car item)
                               ,(expand* (cadr item) env)))
                           bindings))
           (env* (shadow-env env (map car bindings))))
       (let ((expanded-body-exps (map (lambda (thing)
                                        (expand* thing env*))
                                      body-exps)))
         `(let ,bindings* ,@expanded-body-exps))))
    (('lambda bindings body-exps ...)
     (format #t "lambda!\n  bindings: ~a\n  body: ~a\n" bindings body-exps)
     ;; Record list of bound variables; remove them from
     ;; the list of macros.  Then expand the body.
     (let* ((env* (shadow-env env bindings))
            (expanded-body-exps (map (lambda (thing)
                                       (expand* thing env*))
                                     body-exps)))
       `(lambda ,bindings ,@expanded-body-exps)))
    ((head . tail)
     (format #t "list:\n  head: ~a\n  tail: ~a\n" head tail)
     ;; NOTE: first look up the symbol that "head" contains in the
     ;; environment to get the value it is bound to.  Only then we can
     ;; check the type of that value.
     (if (macro? (assoc-ref env head))
         (begin
           (format #t "expanding macro expression: ~a\n" exp)
           (eval (list core:macro-expand exp) env))
         (cons head (map (lambda (thing)
                           (expand* thing env))
                         tail))))
    ;; Can't expand this any further
    (_ exp)))

;; TODO: actually memoize expressions
(define (memoize-expression exp) exp)

;; TODO: this is fine once we actually memoize
(define (macroexpanded? exp) #f)

(define (module-transformer env)
  (lambda (exp)
    (expand* exp env)))
--8<---------------cut here---------------end--------------->8---

With a simple test case it seems to do the right thing:

--8<---------------cut here---------------start------------->8---
(define-macro (foo x) `(* ,x ,x))
(display (expand* '(let ((a 10)
                         (b (foo 3)))
                     ((lambda (a)
                        (let ((foo 1))
                          (+ a b foo))) 9))
                  (current-module)))

=> (let ((a 10)
         (b (* 3 3)))
     ((lambda (a)
        (let ((foo 1))
          (+ a b foo))) 9))
--8<---------------cut here---------------end--------------->8---

The “foo” was expanded correctly and only when it wasn’t shadowed by a
local binding.

Unfortunately, this is not enough for running Guile’s “primitive-eval”.
I renamed the procedure to “primitive-eval1” in Guile’s sources, loaded
it, and tried to run it on a trivial expression:

--8<---------------cut here---------------start------------->8---
(load "/home/rekado/dev/guile/guile/module/ice-9/eval.scm")
(primitive-eval1 '(+ 1 2))
[sexp=(primitive-eval1 (quote (+ 1 2)))]
EXPANDING: (+ 1 2)
list:
  head: +
  tail: (1 2)
EXPANDING: 1
not a pair:
  1
EXPANDING: 2
not a pair:
  2
apply: wrong number of arguments; expected: 1, got: 3
((lambda (x) (syntax-case x () ((_ type) (or (memoized-typecode (syntax->datum 
(syntax type))) (error not a typecode (syntax->datum (syntax type))))))) 
(typecode lexical-ref) <1:4531133> #<procedure eq?[11,5515]>)exception: 
wrong-number-of-args ((apply: wrong number of arguments; expected:  (lambda (x) 
(syntax-case x () ((_ type) (or (memoized-typecode (syntax->datum (syntax 
type))) (error not a typecode (syntax->datum (syntax type))))))) (typecode 
lexical-ref) #<procedure #f (x0)> #<procedure eq? (_ _)>))
--8<---------------cut here---------------end--------------->8---

Oh, “syntax-case”!  How should that be expanded?

--
Ricardo

GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
https://elephly.net



Other related posts: