let/named-let を backend にそのまま渡す

mosh
  • psyntax-system-macros に core-macro として let を追加
  • psyntax-system-macros から (let (macro . let)) を削除
  • build.ss に buile-let, build-named-let 追加
  • expander.ss core-macro-transformer に let 追加
  • expander.ss に let-transformer 追加

ポイントは

  • let-transformer で rhs の展開を rib の外側でやること。（letrec との違いはここにある）
  • named-let の name を lexical 環境を表現した rib と r に追加すること
  • expander.ss の構造を見極める→http://wiki.monaos.org/edit.php?Mosh%2Fpsyntax%2Fexpander
(define build-let
  (lambda (ae vars val-exps body-exp)
    (if (null? vars) body-exp `(let ,(map list vars val-exps) ,body-exp))))

(define build-named-let
    (lambda (ae name vars val-exps body-exp)
      `(let ,name ,(map list vars val-exps) ,body-exp)))	

(define let-transformer
    (lambda (e r mr)
      (syntax-match e ()
        ((_ ((lhs* rhs*) ...) b b* ...)
         (if (not (valid-bound-ids? lhs*))
             (invalid-fmls-error e lhs*)
             (let ((lex* (map gen-lexical lhs*))
                   (lab* (map gen-label lhs*))
                   (rhs* (chi-expr* rhs* r mr)))
               (let ((rib (make-full-rib lhs* lab*))
                     (r (add-lexicals lab* lex* r)))
                 (let ((body (chi-internal
                               (add-subst rib (cons b b*)) r mr)))
                   (build-let no-source lex* rhs* body))))))
        ((_ loop ((lhs* rhs*) ...) b b* ...)
         (if (not (valid-bound-ids? lhs*))
             (invalid-fmls-error e lhs*)
             (let ((lex* (map gen-lexical lhs*))
                   (lab* (map gen-label lhs*))
                   (rhs* (chi-expr* rhs* r mr))
                   (loop-lex (gen-lexical loop))
                   (loop-lab (gen-label loop)))
               (let ((rib (make-full-rib (cons loop lhs*) (cons loop-lab lab*)))
                     (r (add-lexicals (cons loop-lab lab*) (cons loop-lex lex*) r)))
                 (let ((body (chi-internal
                               (add-subst rib (cons b b*)) r mr)))
                   (build-named-let no-source loop-lex lex* rhs* body)))))))))

ToDo

test/lists.ss が失敗するので追求。