shiro 流

map-accum と match-lambda* の組み合わせとか人生で一度も経験ない。
jmp label のために addr という seed を持ち回って評価していくのがきれいだ。
こういう職人芸は盗まねば。

;; asm  :: [Insn] -> [Byte]
(define (asm insns)
  ;; first pass. create [(p,xaddr)] where p :: (Int,[(Symbol,Int)]) -> [Byte]
  ;; and xaddr is a value of PC after the code is fetched.
  (receive (abss _)
      (map-accum (match-lambda*
                   [((? symbol? label) addr) (values (cons label addr) addr)]
                   [(insn addr) (let* ((p (asm1 (parse-insn insn)))
                                       (dummy (p addr #f))
                                       (naddr (+ addr (length dummy))))
                                  (values (cons p naddr) naddr))])
                 0 insns)
    ;; second pass
    (let1 bss (fold (^*[((p . addr) seed)
                        (if (symbol? p)
                          seed          ;ignore labels
                          (cons (p addr abss) seed))])
                    '() abss)
      (concatenate (reverse bss)))))