~tim/scheme-vm

89be745d35505aa4f42e3386ea66b82c6003cef2 — Tim Morgan 5 years ago 45a5146
Make assert a library and fix some namespace bugs
M compiler.rb => compiler.rb +1 -10
@@ 98,7 98,7 @@ class Compiler
      do_import(args, name.filename, options)
    elsif (built_in_name = built_in_function_name(name))
      send(built_in_name, args, options)
    elsif (macro = find_syntax(name, options))
    elsif (macro = options[:syntax][name])
      compile_macro_sexp(sexp, macro, options)
    elsif options[:locals][name]
      call(sexp, options)


@@ 259,13 259,4 @@ class Compiler
    @source[filename] = code
    Parser.new(code, filename: filename).parse
  end

  # walk up the chain of options looking for a syntax definition
  def find_syntax(name, options)
    loop do
      return options[:syntax][name] if options[:syntax].key?(name)
      break unless (options = options[:parent_options])
    end
    nil
  end
end

M compiler/lib/scheme/base.rb => compiler/lib/scheme/base.rb +1 -1
@@ 124,7 124,7 @@ class Compiler
        end

        def compile_lambda_body(body, locals, options)
          body_opts = options.merge(use: true, locals: locals, syntax: {}, parent_options: options)
          body_opts = options.merge(use: true, locals: locals, syntax: options[:syntax].dup)
          body.each_with_index.map do |sexp, index|
            compile_sexp(sexp, body_opts.merge(use: index == body.size - 1))
          end

M compiler/libraries.rb => compiler/libraries.rb +3 -2
@@ 110,12 110,13 @@ class Compiler
          begins += args
        end
      end
      lib_opts = options.merge(use: true, locals: options[:locals].dup, syntax: options[:syntax].dup)
      sexp = [
        VM::SET_LIB, name.join('/'),
        begins.map { |s| compile_sexp(s, options) },
        begins.map { |s| compile_sexp(s, lib_opts) },
        VM::ENDL
      ]
      exports[:syntax] = options[:syntax]
      exports[:syntax] = lib_opts[:syntax]
      sexp
    end


M lib/assert.scm => lib/assert.scm +48 -45
@@ 1,46 1,49 @@
(import (only (scheme base) write-string newline))
(import (only (scheme base) begin define-syntax eq? eqv? if newline not quote write-string))

(define-syntax assert
  (syntax-rules (eq? eqv?)
    ((assert (eq? expected actual))
     (if (not (eq? expected actual))
         (begin
           (write-string "(assert (eq? ")
           (write-string (quote expected))
           (write-string " ")
           (write-string (quote actual))
           (write-string ")) failed:")
           (newline)
           (write-string "  expected: ")
           (write-string expected)
           (newline)
           (write-string "  actual:   ")
           (write-string actual)
           (newline))))
    ((assert (eqv? expected actual))
     (if (not (eqv? expected actual))
         (begin
           (write-string "(assert (eqv? ")
           (write-string (quote expected))
           (write-string " ")
           (write-string (quote actual))
           (write-string ")) failed:")
           (newline)
           (write-string "  expected: ")
           (write-string expected)
           (newline)
           (write-string "  actual:   ")
           (write-string actual)
           (newline))))
    ((assert expr)
     (if (not expr)
         (begin
           (write-string "(assert ")
           (write-string (quote expr))
           (write-string ") failed:")
           (newline)
           (write-string "  expected: (not #f)")
           (newline)
           (write-string "  actual:   ")
           (write-string expr)
           (newline))))))
(define-library (assert)
  (export assert)
  (begin
    (define-syntax assert
      (syntax-rules (eq? eqv?)
        ((assert (eq? expected actual))
        (if (not (eq? expected actual))
            (begin
              (write-string "(assert (eq? ")
              (write-string (quote expected))
              (write-string " ")
              (write-string (quote actual))
              (write-string ")) failed:")
              (newline)
              (write-string "  expected: ")
              (write-string expected)
              (newline)
              (write-string "  actual:   ")
              (write-string actual)
              (newline))))
        ((assert (eqv? expected actual))
        (if (not (eqv? expected actual))
            (begin
              (write-string "(assert (eqv? ")
              (write-string (quote expected))
              (write-string " ")
              (write-string (quote actual))
              (write-string ")) failed:")
              (newline)
              (write-string "  expected: ")
              (write-string expected)
              (newline)
              (write-string "  actual:   ")
              (write-string actual)
              (newline))))
        ((assert expr)
        (if (not expr)
            (begin
              (write-string "(assert ")
              (write-string (quote expr))
              (write-string ") failed:")
              (newline)
              (write-string "  expected: (not #f)")
              (newline)
              (write-string "  actual:   ")
              (write-string expr)
              (newline))))))))

M spec/compiler_spec.rb => spec/compiler_spec.rb +9 -1
@@ 1097,6 1097,14 @@ describe Compiler do
          ])
        end
      end

      context 'given a path to a library' do
        it 'does not import macros into the current namespace' do
          expect {
            subject.compile('(include "./fixtures/library-test") (macro)')
          }.to raise_error(VM::VariableUndefined)
        end
      end
    end

    context 'exit' do


@@ 1207,7 1215,7 @@ describe Compiler do

      it 'records export names for the library' do
        expect(subject.libs['my-lib/1']).to include(
          syntax: { 'define' => Hash },
          syntax: Hash,
          bindings: {
            'foo' => 'foo',
            'bar' => 'foo'

M spec/lib/bool-spec.scm => spec/lib/bool-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(assert (eq? #t (boolean? #t)))
(assert (eq? #t (boolean? #f)))

M spec/lib/cond-spec.scm => spec/lib/cond-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(assert (eq? #t (cond (else #t))))
(assert (eq? #t (cond ((= 5 5) #t))))

M spec/lib/do-spec.scm => spec/lib/do-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(define i 0)


M spec/lib/import-spec.scm => spec/lib/import-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

; import all
(begin

M spec/lib/lambda-spec.scm => spec/lib/lambda-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(define fixed-args
  (lambda (x y z)

M spec/lib/letrec-spec.scm => spec/lib/letrec-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(letrec ((even?
          (lambda (n)

M spec/lib/list-spec.scm => spec/lib/list-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(assert (eq? #t (list? '())))
(assert (eq? #t (list? (list))))

M spec/lib/logic-spec.scm => spec/lib/logic-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(assert (eq? #t (and)))
(assert (eq? #t (and #t)))

M spec/lib/pair-spec.scm => spec/lib/pair-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(assert (not (pair? 1)))
(assert (not (pair? "string")))

M spec/lib/string-spec.scm => spec/lib/string-spec.scm +2 -3
@@ 1,6 1,5 @@
(import (scheme base))

(include "assert")
(import (scheme base)
        (assert))

(assert (string? "foo"))
(assert (not (string? 1)))