~tim/scheme-vm

7a169229835daa55768f3c4813eead5d36cc81a0 — Tim Morgan 5 years ago 77f5537
Add let-syntax and letrec-syntax
8 files changed, 65 insertions(+), 5 deletions(-)

M compiler.rb
M compiler/lib/scheme/base.rb
M lib/scheme/base.scm
M program.rb
R spec/lib/{letrec-spec.scm => let-spec.scm}
M spec/lib_spec.rb
M todo.md
M vm.rb
M compiler.rb => compiler.rb +4 -1
@@ 36,7 36,10 @@ class Compiler
  attr_accessor :filename

  def compile(code = nil, keep_last: false, halt: true)
    @sexps = Parser.new(code, filename: filename).parse if code
    if code
      @source[@filename] = code
      @sexps = Parser.new(code, filename: filename).parse
    end
    compile_sexps(@sexps, options: { syntax: @syntax, locals: @locals }, halt: halt, keep_last: keep_last)
  end


M compiler/lib/scheme/base.rb => compiler/lib/scheme/base.rb +28 -0
@@ 130,6 130,34 @@ class Compiler
          end
        end

        def base_let_syntax((bindings, *body), options)
          compile_let_syntax_body(bindings, body, {}, options)
        end

        def base_letrec_syntax((bindings, *body), options)
          initial_bindings = bindings.each_with_object({}) do |(name), hash|
            hash[name] = true
          end
          compile_let_syntax_body(bindings, body, initial_bindings, options)
        end

        def compile_let_syntax_body(bindings, body, initial_bindings, options)
          body_opts = options.merge(
            use: true,
            locals: options[:locals].dup,
            syntax: options[:syntax].merge(initial_bindings)
          )
          bindings.each do |name, transformer|
            body_opts[:syntax][name] = {
              locals: body_opts[:locals].keys + body_opts[:syntax].keys + [name],
              transformer: transformer
            }
          end
          body.each_with_index.map do |sexp, index|
            compile_sexp(sexp, body_opts.merge(use: index == body.size - 1))
          end
        end

        def base_list(args, options)
          members = args.flat_map do |arg|
            expr = compile_sexp(arg, options.merge(use: true))

M lib/scheme/base.scm => lib/scheme/base.scm +4 -0
@@ 32,6 32,8 @@
   length
   let
   let*
   let-syntax
   letrec-syntax
   letrec
   letrec*
   list


@@ 81,6 83,8 @@
    (--define-native if base_if)
    (--define-native integer? base_integer?)
    (--define-native lambda base_lambda)
    (--define-native let-syntax base_let_syntax)
    (--define-native letrec-syntax base_letrec_syntax)
    (--define-native list base_list)
    (--define-native list->string base_list_to_string)
    (--define-native null? base_null?)

M program.rb => program.rb +5 -0
@@ 24,6 24,11 @@ class Program
    @compiler.filename = f
  end

  def stdout=(io)
    @stdout = io
    @vm.stdout = io
  end

  private

  def vm

R spec/lib/letrec-spec.scm => spec/lib/let-spec.scm +19 -0
@@ 1,6 1,25 @@
(import (scheme base)
        (assert))

(define (foo)
  "old-foo")

(let-syntax
    ((foo (syntax-rules ()
            ((foo) "foo")))
     (bar (syntax-rules ()
            ((bar) "bar"))))
  (assert (eq? "foobar" (string-append (foo) (bar)))))

(letrec-syntax
    ((foo (syntax-rules ()
            ((foo) (bar))))
     (bar (syntax-rules ()
            ((bar) "bar"))))
  (assert (eq? "barbar" (string-append (foo) (bar)))))

(assert (eq? "old-foo" (foo)))

(letrec ((even?
          (lambda (n)
            (if (= n 0)

M spec/lib_spec.rb => spec/lib_spec.rb +2 -2
@@ 3,7 3,6 @@ require_relative './support/dumpable_string_io'
require 'stringio'

out = DumpableStringIO.new

program = Program.new('(import (scheme base) (assert))', stdout: out)
program.run
cached_program = Marshal.dump(program)


@@ 15,9 14,10 @@ Dir[File.expand_path('../lib/**/*.scm', __FILE__)].each do |path|
    skip = !(code =~ /^; skip/).nil?
    it 'passes all tests', focus: focus, skip: skip do
      failed = false
      out.rewind
      out = DumpableStringIO.new
      program = Marshal.load(cached_program)
      program.filename = path
      program.stdout = out
      program.run(code: code)
      out.rewind
      result = out.read

M todo.md => todo.md +1 -1
@@ 32,7 32,7 @@
- [ ] dynamic bindings, `make-parameter` (pp 19), `parameterize` (pp 20)
- [ ] exception handling, `guard` (pp 20)
- [ ] `case-lambda` (pp 21)
- [ ] `let-syntax`, `letrec-syntax` (pp 22)
- [x] `let-syntax`, `letrec-syntax` (pp 22)
- [x] hygienic macro bindings (pp 22)
- [ ] referentially transparent macro bindings (pp 22)
- [x] literals in `syntax-rules` (pp 23)

M vm.rb => vm.rb +2 -1
@@ 92,7 92,8 @@ class VM
    VM::Pair
  ]

  attr_reader :stack, :heap, :stdout, :ip, :call_stack, :closures, :call_args, :libs
  attr_reader :stack, :heap, :ip, :call_stack, :closures, :call_args, :libs
  attr_accessor :stdout

  def initialize(instructions = [], args: [], stdout: $stdout)
    @ip = 0              # instruction pointer