heist 0.3.1 → 0.3.2

data/History.txt

@@ -1,3 +1,15 @@
+=== Version 0.3.2 (2010-01-16)
+
+* Built-in library code is executed in a protected scope so that redefinitions of
+  core functions in user code do not break implementations of library functions
+* The core library is compiled to a Ruby representation that loads faster
+* Macros correctly transcribe empty lists appearing in the input
+* Macro variables may appear at greater ellipsis depth in templates than in corresponding patterns
+* Fix bug in macro literal identifier recognition
+* Identifier comparison is now case-insensitive
+* The REPL prints quote/unquote expressions using shorthand notation
+
+
 === Version 0.3.1 (2009-08-23)
 
 * Added the (rationalize) procedure

data/Manifest.txt

@@ -8,6 +8,7 @@ lib/heist.rb
 lib/repl.rb
 lib/trie.rb
 lib/builtin/library.scm
+lib/builtin/library.rb
 lib/builtin/primitives.rb
 lib/builtin/syntax.scm
 lib/parser/nodes.rb
@@ -34,29 +35,30 @@ lib/runtime/stack.rb
 lib/runtime/stackless.rb
 lib/stdlib/benchmark.scm
 lib/stdlib/birdhouse.scm
-test/arithmetic.scm
-test/benchmarks.scm
-test/booleans.scm
-test/closures.scm
-test/conditionals.scm
-test/continuations.scm
-test/define_functions.scm
-test/define_values.scm
-test/delay.scm
-test/equivalence.scm
-test/file_loading.scm
-test/functional.scm
-test/hygienic.scm
-test/let.scm
-test/lib.scm
-test/lists.scm
-test/macro-helpers.scm
-test/macros.scm
-test/numbers.scm
+test/helpers/lib.scm
+test/helpers/macro-helpers.scm
+test/helpers/vars.scm
+test/scheme_tests/arithmetic.scm
+test/scheme_tests/benchmarks.scm
+test/scheme_tests/booleans.scm
+test/scheme_tests/closures.scm
+test/scheme_tests/conditionals.scm
+test/scheme_tests/continuations.scm
+test/scheme_tests/define_functions.scm
+test/scheme_tests/define_values.scm
+test/scheme_tests/delay.scm
+test/scheme_tests/equivalence.scm
+test/scheme_tests/file_loading.scm
+test/scheme_tests/functional.scm
+test/scheme_tests/hygienic.scm
+test/scheme_tests/let.scm
+test/scheme_tests/lists.scm
+test/scheme_tests/macros.scm
+test/scheme_tests/numbers.scm
+test/scheme_tests/protection.scm
+test/scheme_tests/strings.scm
+test/scheme_tests/unhygienic.scm
+test/scheme_tests/vectors.scm
 test/plt-macros.txt
-test/strings.scm
 test/test_heist.rb
-test/unhygienic.scm
-test/vars.scm
-test/vectors.scm
 

data/Rakefile

@@ -9,6 +9,13 @@ Hoe.spec('heist') do |p|
   p.extra_deps = %w(oyster treetop)
 end
 
+file "lib/builtin/library.rb" => "lib/builtin/library.scm" do |t|
+  program = Heist.parse(File.read t.prerequisites.first).convert!
+  File.open(t.name, 'w') { |f| f.write 'program ' + program.to_ruby.inspect }
+end
+
+task :compile => "lib/builtin/library.rb"
+
 namespace :spec do
   task :r5rs do
     procedures = Dir['r5rs/*.html'].

data/lib/builtin/library.rb

@@ -0,0 +1 @@
+program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:foldr, [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:foldr, [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:foldr, :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:foldr, :proc, :value, [:cdr, :list]]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci<?", [:"char-compare-ci", :"char<?"]], [:define, :"char-ci>?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char<?", :"char>?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci<?", :"char-ci>?"]]], [:define, [:"string<?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char<?", :"char>?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char<?", :"char>?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string<?", :string1, :string2]]], [:define, [:"string-ci<?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci<?", :"char-ci>?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci<?", :"char-ci>?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-ci<?", :string1, :string2]]], [:define, [:substring, :string, :start, :end], [:"list->string", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]]]

data/lib/builtin/library.scm

@@ -258,15 +258,12 @@
 ; The final argument is not copied and the return value of
 ; (append) shares structure with it.
 (define (append first . rest)
-  (if (null? rest)
-      first
-      (if (null? first)
-          (apply append rest)
-          (let ([copy (apply list first)])
-            (do ([pair copy (cdr pair)])
-                ((null? (cdr pair))
-                  (set-cdr! pair (apply append rest))))
-            copy))))
+  (cond [(null? rest) first]
+        [(null? first) (apply append rest)]
+        [else
+          (cons (car first)
+                (append (cdr first)
+                        (apply append rest)))]))
 
 ; (reverse list)
 ; Returns a newly allocated list consisting of the
@@ -365,6 +362,14 @@
       (proc (car list)
             (foldr proc value (cdr list)))))
 
+; (sublist list start end)
+(define (sublist list start end)
+  (cond [(null? list) '()]
+        [(> start 0) (sublist (cdr list) (- start 1) (- end 1))]
+        [(<= end 0) '()]
+        [else (cons (car list)
+                    (sublist (cdr list) 0 (- end 1)))]))
+
 ;----------------------------------------------------------------
 
 ; Character functions
@@ -528,16 +533,7 @@
 ; Returns a string composed of the characters from start (inclusive)
 ; to end (exclusive) in string
 (define (substring string start end)
-  (let ([size (string-length string)])
-    (cond [(< start 0)   (error "start index must be positive")]
-          [(> end size)  (error "end index must be <= the length of string")]
-          [(> start end) (error "start must be <= end index")]
-          [else
-            (let* ([subsize (- end start)]
-                   [substr (make-string subsize)])
-              (do ([i 0 (+ i 1)])
-                  ((= i subsize) substr)
-                (string-set! substr i (string-ref string (+ start i)))))])))
+  (list->string (sublist (string->list string) start end)))
 
 ; (list->string chars)
 ; Returns a new string formed by combining the list

data/lib/heist.rb

@@ -9,7 +9,7 @@ require 'treetop'
 # utility methods that don't belong anywhere else. See the README for an
 # overview of Heist's features.
 module Heist
-  VERSION = '0.3.1'
+  VERSION = '0.3.2'
   
   ROOT_PATH    = File.expand_path(File.dirname(__FILE__))
   PARSER_PATH  = ROOT_PATH + '/parser/'
@@ -24,8 +24,8 @@ module Heist
   require ROOT_PATH + '/trie'
   require ROOT_PATH + '/repl'
   
-  LOAD_PATH = [LIB_PATH]
-  FILE_EXT  = ".scm"
+  LOAD_PATH = [BUILTIN_PATH, LIB_PATH]
+  FILE_EXTS = [""] + %w[.rb .scm .ss]
   
   class HeistError            < StandardError; end
   class RuntimeError          < HeistError; end

data/lib/parser/nodes.rb

@@ -12,10 +12,10 @@ module Heist
     # In Scheme, this list includes the various quoting symbols that can be used
     # as shorthands for calling quoting functions.
     SHORTHANDS = {
-      "'"   => :quote,
-      "`"   => :quasiquote,
-      ","   => :unquote,
-      ",@"  => :'unquote-splicing'
+      "'"   => 'quote',
+      "`"   => 'quasiquote',
+      ","   => 'unquote',
+      ",@"  => 'unquote-splicing'
     }
     
     # +Program+ is the root of the parse tree; parsing any string of Scheme code

data/lib/parser/ruby.rb

@@ -12,11 +12,16 @@ module Heist
   #
   class RubyParser
     
+    DOT = :'.'
+    
     # Parses a single piece of Ruby data in
     def parse(source)
       case source
         when Array then
-          Runtime::Cons.construct(source) { |cell| parse(cell) }
+          members, tail = *(source[-2] == DOT ? [source[0..-3], source.last] : [source, nil])
+          list = Runtime::Cons.construct(members) { |cell| parse(cell) }
+          list.tail.cdr = parse(tail) if tail
+          list
         when Symbol then
           Runtime::Identifier.new(source)
         else

data/lib/repl.rb

@@ -5,7 +5,7 @@ module Heist
     
     def initialize(options = {})
       @runtime = Runtime.new(options)
-      @scope = Runtime::FileScope.new(@runtime.top_level, File.expand_path('.'))
+      @scope = Runtime::FileScope.new(@runtime.user_scope, File.expand_path('.'))
       @results = []
       
       @runtime.define('~') { |x| @results[-x] }
@@ -17,7 +17,7 @@ module Heist
       puts @runtime.info
       
       Readline.completion_append_character = nil
-      Readline.completion_proc = @runtime.top_level.method(:longest_prefix)
+      Readline.completion_proc = @runtime.user_scope.method(:longest_prefix)
       
       loop do
         begin

data/lib/runtime/binding.rb

@@ -42,6 +42,17 @@ module Heist
         force!
       end
       
+      # We provide an equality method so that a bound +Identifier+ produced
+      # by expanding a macro can be matched against literal identifiers in
+      # another macro pattern.
+      def ==(identifier)
+        @expression == identifier
+      end
+
+      def innermost_binding(identifier)
+        @scope
+      end
+
       # Returns a string representation of the binding's +Expression+.
       def to_s
         @expression.to_s

data/lib/runtime/callable/macro/matches.rb

@@ -138,7 +138,7 @@ module Heist
             sizes << tree.size(depth) if names.include?(name)
           end
           
-          sizes.uniq!
+          sizes = sizes.compact.uniq
           return sizes.first if sizes.size == 1
           
           raise MacroTemplateMismatch.new(

data/lib/runtime/callable/macro/tree.rb

@@ -88,7 +88,6 @@ module Heist
         # seeing as the pattern should be followed by the same number of ellipses
         # every time it is encountered.
         def <<(value)
-          return if Cons::NULL == value
           tail(@depth) << value
         end
         
@@ -102,6 +101,7 @@ module Heist
         # to one of the values in <tt>@indexes</tt>. The macro expander calls this
         # while walking a template to iterate over repetition branches.
         def shift!(depth)
+          return if depth > @depth
           indexes[depth] += 1
           indexes[depth] = 0 if indexes[depth] >= current(depth).size
         end
@@ -110,6 +110,7 @@ module Heist
         # read branch at the given +depth+. Returns zero if no branch exists at
         # the given indexes.
         def size(depth)
+          return nil if depth > @depth
           current(depth).size rescue 0
         end
         

data/lib/runtime/data/cons.rb

@@ -60,6 +60,10 @@ module Heist
       # An array of all the c[ad]+r functions supported by Heist
       ACCESSORS = cadr_combos
       
+      # For stringifying purposes, we need an inverted copy of the table
+      # of quoting shorthand symbols
+      SHORTHANDS = Scheme::SHORTHANDS.invert
+      
       class << self
         # Creates a new list from the elements of the enumerable object +enum+,
         # and returns the +Cons+ that forms the head of the list. If +enum+ is
@@ -214,15 +218,27 @@ module Heist
       # Returns a pure Ruby representation of the list, with any Heist
       # specific objects converted to basic Ruby equivalents.
       def to_ruby
-        map { |cell| cell.respond_to?(:to_ruby) ? cell.to_ruby : cell }
+        members = []
+        tail = each do |cell|
+          members << (cell.respond_to?(:to_ruby) ? cell.to_ruby : cell)
+        end
+        if NULL != tail.cdr
+          members << RubyParser::DOT
+          members << (tail.cdr.respond_to?(:to_ruby) ? tail.cdr.to_ruby : tail.cdr)
+        end
+        members
       end
       
       # Returns a Scheme-style string representation of the list.
       def to_s
         strings = []
-        tail = each { |value| strings << Heist.stringify(value) }.cdr
-        '(' + (strings * ' ') +
-              (tail == NULL ? '' : ' . ' + tail.to_s) + ')'
+        if Identifier === @car and SHORTHANDS.has_key?(@car.to_s) and list? and length == 2
+          SHORTHANDS[@car.to_s] + Heist.stringify(@cdr.car)
+        else
+          tail = each { |value| strings << Heist.stringify(value) }.cdr
+          '(' + (strings * ' ') +
+                (tail == NULL ? '' : ' . ' + Heist.stringify(tail)) + ')'
+        end
       end
       alias :inspect :to_s
     end

data/lib/runtime/data/identifier.rb

@@ -30,7 +30,8 @@ module Heist
       
       # Returns +true+ if the receiver has the same name as the argument.
       def ==(other)
-        Identifier === other and @orginal_name == other.name
+        return true if Binding === other and other == self
+        Identifier === other and @orginal_name.downcase == other.name.downcase
       end
       
       # Returns a raw Ruby representation of the identifier, for which

data/lib/runtime/runtime.rb

@@ -5,7 +5,14 @@ module Heist
   # the standard set of primitive functions and special forms as defined
   # in <tt>lib/builtin</tt>.
   #
-  # +Runtime+ exposes several methods from the top-level +Scope+ object,
+  # User code runs in another scope descended from the top-level. This is
+  # done so that user-level redefinitions of built-in functions do not break
+  # other built-in functions that refer to the redefined names; lexical
+  # scoping ensures that built-in functions can only refer to other bindings
+  # in the top-level scope so user-level bindings do not affect the built-in
+  # library functions.
+  #
+  # +Runtime+ exposes several methods from the user-level +Scope+ object,
   # allowing runtime objects to be used as interfaces for defining
   # functions, eval'ing code and running source files.
   #
@@ -22,9 +29,11 @@ module Heist
     end
     
     extend Forwardable
-    def_delegators(:@top_level, :[], :eval, :exec, :define, :syntax, :run)
+    def_delegators(:@user_scope, :[], :eval, :exec, :program, :define, :syntax, :run, :load)
+    
+    attr_accessor :stack, :top_level, :user_scope
     
-    attr_accessor :stack, :top_level
+    BUILTIN_LIBRARIES = %w[primitives syntax library]
     
     # A +Runtime+ is initialized using a set of options. The available
     # options include the following, all of which are +false+ unless
@@ -39,16 +48,27 @@ module Heist
       @continuations = !!options[:continuations]
       @hygienic      = !options[:unhygienic]
       
-      @top_level = Scope.new(self)
-      @stack = stackless? ? Stackless.new : Stack.new
-      
-      run("#{ BUILTIN_PATH }primitives.rb")
-      run("#{ BUILTIN_PATH }syntax.scm")
-      run("#{ BUILTIN_PATH }library.scm")
+      @top_level  = Scope.new(self)
+      @user_scope = Scope.new(@top_level)
+      @stack      = stackless? ? Stackless.new : Stack.new
       
+      load_builtins(options)
       @start_time = Time.now.to_f
     end
     
+    # To stop user-space redefinitions of built-in functions from breaking
+    # the standard library, we define builtins in a privileged scope, one up
+    # from the scope that user code runs in. We then bind the names in 'user
+    # space' to stop (set!) from reaching into our privileged top level.
+    def load_builtins(options = {})
+      libraries = (options[:only] || BUILTIN_LIBRARIES) - (options[:except] || [])
+      
+      libraries.each do |library|
+        @top_level.run(@top_level.expand_path(library))
+      end
+      @user_scope.each_var(&@user_scope.method(:[]=))
+    end
+    
     # Returns the length of time the +Runtime+ has been alive for, as a
     # number in microseconds.
     def elapsed_time

data/lib/runtime/scope.rb

@@ -135,6 +135,15 @@ module Heist
       def syntax(name, &block)
         self[name] = Syntax.new(self, &block)
       end
+      
+      # Calls the given +block+ with the name of every variable visible in
+      # the +Scope+ (given as a +Symbol+) and its corresponding value.
+      def each_var(&block)
+        @parent.each_var(&block) if @parent.respond_to?(:each_var)
+        @symbols.each do |key, value|
+          block.call((key * '').to_sym, value)
+        end
+      end
 
       # Parses and executes the given string of source code in the receiving
       # +Scope+. Accepts strings of Scheme source and arrays of Ruby data to
@@ -145,6 +154,11 @@ module Heist
       end
       alias :exec :eval
       
+      # Executes an array of Scheme statements expressed as Ruby data.
+      def program(expressions)
+        expressions.map { |expr| exec(expr) }.last
+      end
+      
       # Returns the longest shared prefix match for the given variable name
       # stub, used to support autocompletion in the REPL.
       def longest_prefix(name)
@@ -157,7 +171,6 @@ module Heist
       # sure we use 'obscure' names here.
       def run(_path)
         return instance_eval(File.read(_path)) if File.extname(_path) == '.rb'
-        _path   = _path + FILE_EXT unless File.file?(_path)
         _source = Heist.parse(File.read(_path))
         _scope  = FileScope.new(self, _path)
         _source.eval(_scope)
@@ -168,13 +181,9 @@ module Heist
       # is found, the path is assumed to refer to a module from the Heist
       # standard library. The <tt>(load)</tt> primitive is a wrapper
       # around this method.
-      def load(path)
-        dir = load_path.find do |dir|
-          File.file?("#{dir}/#{path}") or File.file?("#{dir}/#{path}#{FILE_EXT}")
-        end
-        return false unless dir
-        runtime.run("#{dir}/#{path}")
-        true
+      def load(file)
+        path = expand_path(file)
+        runtime.run(path) if path
       end
       
       # Returns the path of the current file. The receiving scope must have
@@ -183,6 +192,20 @@ module Heist
         @path || @parent.current_file rescue nil
       end
       
+      # Returns an absolute path to a requested library based on searching
+      # the current load path. The file extension may be omitted, suitable
+      # extensions being listed in Heist::FILE_EXTS.
+      def expand_path(path)
+        load_path.each do |dir|
+          test_path = File.expand_path(File.join(dir, path))
+          FILE_EXTS.each do |ext|
+            full_path = test_path + ext
+            return full_path if File.file?(full_path)
+          end
+        end
+        nil
+      end
+      
     private
       
       # Calls the named primitive function with the given arguments, and
@@ -206,7 +229,7 @@ module Heist
       # the directory of the current file if the receiving +Scope+ has a
       # +FileScope+ as an ancestor.
       def load_path
-        paths, file = [], current_file
+        paths, file = [""], current_file
         paths << File.dirname(file) if file
         paths + LOAD_PATH
       end

data/lib/trie.rb

@@ -38,6 +38,20 @@ module Heist
       @children = {}
     end
     
+    # Iterates over each child key of the +Trie+, calling the given +block+
+    # with each key and corresponding value. Like iterating over a flat +Hash+.
+    def each_child
+      @children.each { |key, subtree| yield(key, subtree) }
+    end
+    
+    # Iterates over the whole +Trie+, calling the given +block+ with each
+    # composite key and corresponding value. Each key will be an +Array+ matching
+    # the route to get from the root of the +Trie+ to the current node.
+    def each(prefix = [], &block)
+      each_child { |path, subtree| subtree.each(prefix + [path], &block) }
+      yield(prefix, @value) unless @value.nil?
+    end
+    
     # Returns +true+ iff the given +key+ is present in the +Trie+. They key
     # must match a complete key sequence that maps to a value, not a partial
     # prefix with no value attached.

data/test/{file_loading.scm → scheme_tests/file_loading.scm}

@@ -1,9 +1,9 @@
 (define (my-loader)
-  (cond ((> 5 2) (load "lib"))))
+  (cond ((> 5 2) (load "../helpers/lib"))))
 
 (my-loader)
 (assert-equal 42 secret-rule-you-didnt-know)
 
-(load "vars")
+(load "../helpers/vars")
 (assert-equal 1/137 alpha)
 

data/test/{hygienic.scm → scheme_tests/hygienic.scm}

@@ -1,4 +1,4 @@
-(load "macro-helpers")
+(load "../helpers/macro-helpers")
 
 (assert-equal 100 (let ([first 9])
                   (square-sum 1 first)))

data/test/{macros.scm → scheme_tests/macros.scm}

@@ -1,4 +1,4 @@
-(load "macro-helpers")
+(load "../helpers/macro-helpers")
 
 ; Basic test: no subpatterns or ellipses
 
@@ -43,6 +43,13 @@
 
 (assert-equal 8 (dont-rename-else #f 6 8))
 
+; Check that empty lists are stored as matches and appear in output
+(let-syntax ([quote-match (syntax-rules (quote)
+                            [(_ 'arg ...) '(arg ...)])])
+  (assert-equal '(4 5 6) (quote-match '4 '5 '6))
+  (assert-equal '(4 5 ()) (quote-match '4 '5 '()))
+  (assert-equal '(4 () 6) (quote-match '4 '() '6)))
+
 ; Check that keywords are ignored if locally bound
 ; example from R6RS -- http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.19
 (assert-equal 'ok (let ((=> #f))
@@ -83,6 +90,15 @@
 (assert-equal 3 (iffy 7 #f 3))
 
 
+; Test that bound and non-bound symbols can be matched correctly
+
+(letrec-syntax ((foo (syntax-rules (=)
+                       ((foo = x) x)))
+                (bar (syntax-rules ()
+                       ((bar x) (foo = x)))))
+  (assert-equal 5 (bar 5)))
+
+
 ; Test improper patterns
 (define-syntax rest (syntax-rules ()
   [(_ foo bar . rest)
@@ -314,6 +330,31 @@
 (assert-equal '() (double-up))
 
 
+; Test that pattern variables may appear at a greater
+; repetition depth in the template than they do in the pattern
+
+(let-syntax ((repeater (syntax-rules ()
+                         [(_ one (many ...))
+                          '((one many) ...)]))
+             
+             (root-v-2 (syntax-rules ()
+                         [(_ one (many ...) ...)
+                          '(((one many) ...) ...)]))
+             
+             (1-v-2 (syntax-rules ()
+                      [(_ (one ...) (many ...) ...)
+                       '(((one many) ...) ...)])))
+  
+  (assert-equal '((a 2) (a 3) (a 4))
+                (repeater a (2 3 4)))
+  
+  (assert-equal '(((a 1) (a 2)) ((a 6)) () ((a 3) (a 6) (a 8)))
+                (root-v-2 a (1 2) (6) () (3 6 8)))
+  
+  (assert-equal '(((a 1) (a 2)) ((b 6)) () ((d 3) (d 6) (d 8)))
+                (1-v-2 (a b c d) (1 2) (6) () (3 6 8))))
+
+
 ; R5RS version of (let), uses ellipsis after lists in patterns
 
 (define-syntax r5rs-let

data/test/scheme_tests/protection.scm

@@ -0,0 +1,13 @@
+; Check that user-level redefinitions of core functions does
+; not break other core functions implemented in Scheme
+
+(define (check-map-integrity)
+  (assert-equal '(1 4 9 16)
+                (map (lambda (x) (* x x))
+                     '(1 2 3 4))))
+(define cons #f)
+(check-map-integrity)
+
+(set! null? #f)
+(check-map-integrity)
+

data/test/{unhygienic.scm → scheme_tests/unhygienic.scm}

@@ -1,4 +1,4 @@
-(load "macro-helpers")
+(load "../helpers/macro-helpers")
 
 (assert-equal 4 (let ([first 9])
                   (square-sum 1 first)))

data/test/test_heist.rb

@@ -1,5 +1,5 @@
 $VERBOSE = nil
-$dir = File.dirname(__FILE__)
+$dir = File.expand_path(File.dirname(__FILE__))
 
 $args = ARGV.map { |opt| "-#{opt}" }
 
@@ -8,20 +8,22 @@ require $dir + "/../lib/bin_spec"
 require "test/unit"
 
 Class.new(Test::Unit::TestCase) do
-  @@env = nil
+  @env = nil
   
   def setup
-    return @@env if @@env
-    @@env = Heist::Runtime.new(Heist::BIN_SPEC.parse($args))
-    puts @@env.info
+    return @env if @env
+    @env = Heist::Runtime.new(Heist::BIN_SPEC.parse($args))
     
-    @@env.define('assert') do |value|
+    puts @env.info unless defined?(@@info_printed)
+    @@info_printed = true
+    
+    @env.define('assert') do |value|
       assert(value)
     end
-    @@env.define('assert-equal') do |expected, actual|
+    @env.define('assert-equal') do |expected, actual|
       assert_equal(expected, actual)
     end
-    @@env.syntax('assert-raise') do |scope, cells|
+    @env.syntax('assert-raise') do |scope, cells|
       exception = Heist.const_get(cells.car.to_s)
       assert_raise(exception) { scope.eval(cells.cdr.car) }
     end
@@ -43,10 +45,11 @@ Class.new(Test::Unit::TestCase) do
         file_loading
         macros
         delay
+        protection
         
   ].each do |test|
     define_method('test_' + test) do
-      @@env.run($dir + '/' + test)
+      @env.run($dir + '/scheme_tests/' + test + '.scm')
     end
   end
   
@@ -84,58 +87,62 @@ Class.new(Test::Unit::TestCase) do
   end
   
   def test_macro_hygiene
-    @@env.run($dir + '/' + (@@env.hygienic? ? 'hygienic' : 'unhygienic'))
+    @env.run($dir + '/scheme_tests/' + (@env.hygienic? ? 'hygienic' : 'unhygienic') + '.scm')
   end
   
   def test_continuations
-    return if @@env.stackless?
-    @@env.run($dir + '/continuations')
+    return if @env.stackless?
+    @env.run($dir + '/scheme_tests/continuations.scm')
   end
   
-  def test_quotes
+  def test_quotation
     cons = Heist::Runtime::Cons
     c = cons.method(:new)
     
-    assert_equal 7,                     @@env.eval("(+ 3 4)")
-    assert_equal [:+, 3, 4],            @@env.eval("'(+ 3 4)").to_ruby
-    assert cons === @@env.eval("'(+ 3 4)")
-    assert_equal 7,                     @@env.eval("(+ '3 4)")
-    assert_equal c[1,8],                @@env.eval("'(1 . 8)")
-    assert_equal c[1,8],                @@env.eval("`(1 . 8)")
-    assert_equal [:+, [:-, 7, 9], 4],   @@env.eval("'(+ (- 7 9) 4)").to_ruby
-    assert_equal [7, 9, 6],             @@env.eval("`(7 ,(+ 4 5) 6)").to_ruby
-    assert cons === @@env.eval("`(7 ,(+ 4 5) 6)")
-    assert_equal [3, 7, 6, 2, 6, 9],    @@env.eval("`(3 7 6 ,@((lambda () '(2 6))) 9)").to_ruby
-    assert_equal [1, 2, 10],            @@env.eval("`(1 2 ,(+ 4 6))").to_ruby
-    assert_equal [3, 2, 9, 8],          @@env.eval("`(,(/ 9 3) 2 ,@(list 9 8))").to_ruby
-    assert_equal [1, 2, 4, 9, 8, 5],    @@env.eval("`(,@(list 1 2) 4 ,@(list 9 8) 5)").to_ruby
-    assert_equal c[9,c[8,c[5,7]]],      @@env.eval("`(,@(list 9 8) 5 . 7)")
-    assert_equal c[9,c[8,24]],          @@env.eval("`(,@(list 9 8) . ,(* 4 6))")
-    assert_equal [:quote, []],          @@env.eval("''()").to_ruby
+    assert_equal 7,                     @env.eval("(+ 3 4)")
+    assert_equal [:+, 3, 4],            @env.eval("'(+ 3 4)").to_ruby
+    assert cons === @env.eval("'(+ 3 4)")
+    assert_equal 7,                     @env.eval("(+ '3 4)")
+    assert_equal c[1,8],                @env.eval("'(1 . 8)")
+    assert_equal c[1,8],                @env.eval("`(1 . 8)")
+    assert_equal [:+, [:-, 7, 9], 4],   @env.eval("'(+ (- 7 9) 4)").to_ruby
+    assert_equal [7, 9, 6],             @env.eval("`(7 ,(+ 4 5) 6)").to_ruby
+    assert cons === @env.eval("`(7 ,(+ 4 5) 6)")
+    assert_equal [3, 7, 6, 2, 6, 9],    @env.eval("`(3 7 6 ,@((lambda () '(2 6))) 9)").to_ruby
+    assert_equal [1, 2, 10],            @env.eval("`(1 2 ,(+ 4 6))").to_ruby
+    assert_equal [3, 2, 9, 8],          @env.eval("`(,(/ 9 3) 2 ,@(list 9 8))").to_ruby
+    assert_equal [1, 2, 4, 9, 8, 5],    @env.eval("`(,@(list 1 2) 4 ,@(list 9 8) 5)").to_ruby
+    assert_equal c[9,c[8,c[5,7]]],      @env.eval("`(,@(list 9 8) 5 . 7)")
+    assert_equal c[9,c[8,24]],          @env.eval("`(,@(list 9 8) . ,(* 4 6))")
+    assert_equal [:quote, []],          @env.eval("''()").to_ruby
   end
   
-  def test_birds
-    return unless @@env.lazy?
-    @@env.eval('(load "birdhouse")')
+  def test_birdhouse
+    return unless @env.lazy?
+    @env.eval('(load "birdhouse")')
     
-    @@env.eval <<-CODE
+    @env.eval <<-CODE
       (define factorial (Y
         (lambda (rec)
           (lambda (x)
             (if (= x 0) 1 (* x (rec (- x 1))))))))
     CODE
     assert_equal (1..6).inject { |a,b| a*b },
-                 @@env.eval("(factorial 6)")
+                 @env.eval("(factorial 6)")
     
-    assert_equal 45, @@env.eval("((K 45) 6)")
+    assert_equal 45, @env.eval("((K 45) 6)")
   end
   
   def test_ruby_execution
     expr = [[:lambda, [:x], [:+, 1, :x]], 3]
-    assert_equal 4, @@env.exec(expr)
+    assert_equal 4, @env.exec(expr)
     list = Heist.parse(expr)
     assert Heist::Runtime::Cons === list
     assert_equal expr, list.to_ruby
+    
+    cons = Heist::Runtime::Cons.method(:new)
+    assert_equal cons[3,cons[4,5]], Heist.parse([3, 4, :'.', 5])
+    assert_equal [3, 4, :'.', 5], cons[3,cons[4,5]].to_ruby
   end
 end
 

metadata

@@ -1,7 +1,7 @@
 --- !ruby/object:Gem::Specification 
 name: heist
 version: !ruby/object:Gem::Version 
-  version: 0.3.1
+  version: 0.3.2
 platform: ruby
 authors: 
 - James Coglan
@@ -9,7 +9,7 @@ autorequire:
 bindir: bin
 cert_chain: []
 
-date: 2009-08-23 00:00:00 +01:00
+date: 2010-01-16 00:00:00 +00:00
 default_executable: 
 dependencies: 
 - !ruby/object:Gem::Dependency 
@@ -32,6 +32,26 @@ dependencies:
       - !ruby/object:Gem::Version 
         version: "0"
     version: 
+- !ruby/object:Gem::Dependency 
+  name: rubyforge
+  type: :development
+  version_requirement: 
+  version_requirements: !ruby/object:Gem::Requirement 
+    requirements: 
+    - - ">="
+      - !ruby/object:Gem::Version 
+        version: 2.0.3
+    version: 
+- !ruby/object:Gem::Dependency 
+  name: gemcutter
+  type: :development
+  version_requirement: 
+  version_requirements: !ruby/object:Gem::Requirement 
+    requirements: 
+    - - ">="
+      - !ruby/object:Gem::Version 
+        version: 0.3.0
+    version: 
 - !ruby/object:Gem::Dependency 
   name: hoe
   type: :development
@@ -40,7 +60,7 @@ dependencies:
     requirements: 
     - - ">="
       - !ruby/object:Gem::Version 
-        version: 2.0.0
+        version: 2.5.0
     version: 
 description: ""
 email: 
@@ -64,6 +84,7 @@ files:
 - lib/repl.rb
 - lib/trie.rb
 - lib/builtin/library.scm
+- lib/builtin/library.rb
 - lib/builtin/primitives.rb
 - lib/builtin/syntax.scm
 - lib/parser/nodes.rb
@@ -90,33 +111,36 @@ files:
 - lib/runtime/stackless.rb
 - lib/stdlib/benchmark.scm
 - lib/stdlib/birdhouse.scm
-- test/arithmetic.scm
-- test/benchmarks.scm
-- test/booleans.scm
-- test/closures.scm
-- test/conditionals.scm
-- test/continuations.scm
-- test/define_functions.scm
-- test/define_values.scm
-- test/delay.scm
-- test/equivalence.scm
-- test/file_loading.scm
-- test/functional.scm
-- test/hygienic.scm
-- test/let.scm
-- test/lib.scm
-- test/lists.scm
-- test/macro-helpers.scm
-- test/macros.scm
-- test/numbers.scm
+- test/helpers/lib.scm
+- test/helpers/macro-helpers.scm
+- test/helpers/vars.scm
+- test/scheme_tests/arithmetic.scm
+- test/scheme_tests/benchmarks.scm
+- test/scheme_tests/booleans.scm
+- test/scheme_tests/closures.scm
+- test/scheme_tests/conditionals.scm
+- test/scheme_tests/continuations.scm
+- test/scheme_tests/define_functions.scm
+- test/scheme_tests/define_values.scm
+- test/scheme_tests/delay.scm
+- test/scheme_tests/equivalence.scm
+- test/scheme_tests/file_loading.scm
+- test/scheme_tests/functional.scm
+- test/scheme_tests/hygienic.scm
+- test/scheme_tests/let.scm
+- test/scheme_tests/lists.scm
+- test/scheme_tests/macros.scm
+- test/scheme_tests/numbers.scm
+- test/scheme_tests/protection.scm
+- test/scheme_tests/strings.scm
+- test/scheme_tests/unhygienic.scm
+- test/scheme_tests/vectors.scm
 - test/plt-macros.txt
-- test/strings.scm
 - test/test_heist.rb
-- test/unhygienic.scm
-- test/vars.scm
-- test/vectors.scm
 has_rdoc: true
 homepage: http://github.com/jcoglan/heist
+licenses: []
+
 post_install_message: 
 rdoc_options: 
 - --main
@@ -138,9 +162,9 @@ required_rubygems_version: !ruby/object:Gem::Requirement
 requirements: []
 
 rubyforge_project: heist
-rubygems_version: 1.3.1
+rubygems_version: 1.3.5
 signing_key: 
-specification_version: 2
+specification_version: 3
 summary: ""
 test_files: 
 - test/test_heist.rb