heist 0.2.1 → 0.3.0

data/lib/runtime/frame.rb

@@ -63,6 +63,13 @@ module Heist
             stack = @scope.runtime.stack
             stack << Frame.new(@current.car, @scope)
         
+          # If it's a Vector (it will be unquoted if it has arrived here, copy
+          # it and return it. We cannot freeze it for fear of breaking macros,
+          # and we must copy it so that vector-set! cannot modify the parse tree.
+          when Vector then
+            @complete = true
+            @expression.dup
+        
           # If the expression is an +Identifier+, just look it up.
           when Identifier then
             @complete = true

data/lib/runtime/runtime.rb

@@ -11,7 +11,8 @@ module Heist
   #
   class Runtime
     
-    %w[ data/expression     data/identifier   data/cons
+    %w[ data/expression     data/identifier   data/character
+        data/cons           data/vector
         callable/function   callable/syntax   callable/macro  callable/continuation
         frame               stack             stackless
         scope               binding

data/lib/runtime/scope.rb

@@ -20,7 +20,7 @@ module Heist
       # The parent may also be a +Runtime+ instance, indicating that the
       # new +Scope+ is being used as the top level of a runtime environment.
       def initialize(parent = {})
-        @symbols = {}
+        @symbols = Trie.new
         is_runtime = (Runtime === parent)
         @parent = is_runtime ? {} : parent
         @runtime = is_runtime ? parent : parent.runtime
@@ -145,14 +145,10 @@ module Heist
       end
       alias :exec :eval
       
-      # Returns all the variable names visible in the receiving +Scope+ that
-      # match the given regex +pattern+. Used by the REPL for tab completion.
-      def grep(pattern)
-        base = (Scope === @parent) ? @parent.grep(pattern) : []
-        @symbols.each do |key, value|
-          base << key if key =~ pattern
-        end
-        base.uniq
+      # Returns the longest shared prefix match for the given variable name
+      # stub, used to support autocompletion in the REPL.
+      def longest_prefix(name)
+        @symbols.longest_prefix(to_name(name))
       end
       
       # Runs the given Scheme or Ruby definition file in the receiving

data/lib/runtime/stackless.rb

@@ -68,6 +68,13 @@ module Heist
             expression.replace(value.expression)
             return Frame.new(value.expression, scope)
         
+          # If the expression is a Vector (unquoted if found here), duplicate
+          # it and return it. We don't want to freeze unquoted vectors as this
+          # stops macros working, but also we don't want to allow procedures
+          # such as vector-set! to modify the parse tree.
+          when Vector then
+            expression.dup
+        
           # If the expression is an identifier, look up its value in
           # the current scope
           when Identifier then

data/lib/trie.rb

@@ -0,0 +1,141 @@
+module Heist
+  
+  # A +Trie+ is a special type of key-value store, one in which the keys are all
+  # sequences of some kind: they could be strings, or arrays, or lists. We use
+  # tries to store symbol tables in Heist because it makes autocompletion easier
+  # to implement, and one aim of Heist is to be a pleasant interactive Scheme.
+  #
+  # In our particular implementation, keys (strings representing variable names)
+  # are split into arrays and stored in a series of nested hashtables whose keys
+  # are single characters. Strings sharing a common prefix share part of the tree
+  # structure. The <tt>Trie#inspect</tt> method provides a good representation
+  # of this (values omitted for the sake of brevity):
+  #
+  #   tree = Trie.new
+  #   tree['foo'] = 1
+  #   
+  #   tree #=> {"f"=>{"o"=>{"o"=>{}}}}
+  #   
+  #   tree['bar'] = 2
+  #   tree['baz'] = 3
+  #   
+  #   tree #=> {"b"=>{"a"=>{"z"=>{}, "r"=>{}}}, "f"=>{"o"=>{"o"=>{}}}}
+  #
+  # A trie is a recursive structure; each key in a trie points to another trie.
+  # Every trie contains a list of its children (a hash mapping characters to
+  # subtries) and may contain a value if it appears at the end of a sequence
+  # making up a full key of the root trie.
+  #
+  # For more information, see http://en.wikipedia.org/wiki/Trie
+  #
+  class Trie
+    attr_accessor :value
+    
+    # A +Trie+ is initialized with an optional +value+. The value may be
+    # omitted if the trie does not represent the end of a key sequence.
+    def initialize(value = nil)
+      @value = value
+      @children = {}
+    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.
+    def has_key?(key)
+      trie = traverse(key)
+      trie and not trie.value.nil?
+    end
+    
+    # Returns the value corresponding to +key+, or +nil+ if none is found.
+    def [](key)
+      trie = traverse(key)
+      trie ? trie.value : nil
+    end
+    
+    # Assigns +value+ to the given +key+.
+    def []=(key, value)
+      traverse(key, true).value = value
+    end
+    
+    # Walks the +Trie+ structure using the given +key+, returning the
+    # resulting subtrie or +nil+ if the key is absent. Pass +true+ as the
+    # second argument to create a subtrie for the key if none exists.
+    def traverse(key, create_if_absent = false)
+      key = convert_key(key)
+      return self if key.empty?
+      trie = @children[key.first]
+      return nil if trie.nil? and not create_if_absent
+      trie = @children[key.first] = Trie.new if trie.nil?
+      trie.traverse(key[1..-1], create_if_absent)
+    end
+    
+    # Returns an array of all the characters used as keys in this +Trie+.
+    # That is, this method returns the initial letters of all the keys
+    # stored in the +Trie+.
+    def prefixes
+      @children.keys
+    end
+    
+    # Returns +true+ if the +Trie+ has no value and only one child. Used
+    # in +longest_prefix+ to find the longest unique prefix from some
+    # starting point.
+    def singular?
+      @value.nil? and @children.size == 1
+    end
+    
+    # Returns the longest unique key prefix that starts with +key+. This
+    # is used for autocompletion in the REPL. Given a string, this method
+    # returns another string such that the start of the output is the
+    # same as the input, and the output may contain zero or more additional
+    # characters such that all the keys that begin with the input also begin
+    # with the output.
+    #
+    #   tree = Trie.new
+    #   tree['foo'] = 1
+    #   tree['bar'] = 2
+    #   tree['baz'] = 3
+    #   
+    #   tree.longest_prefix 'f'
+    #   #=> "foo"
+    #   tree.longest_prefix 'b'
+    #   #=> "ba"
+    #
+    def longest_prefix(key)
+      prefix = convert_key(key).dup
+      trie = traverse(key)
+      return nil if trie.nil?
+      while trie.singular?
+        next_key = trie.prefixes.first
+        prefix << next_key
+        trie = trie.traverse(next_key)
+      end
+      case key
+        when String then prefix.join('')
+        when Symbol then prefix.join('').to_sym
+        else prefix
+      end
+    end
+    
+    # Returns a string representation of the trie's internal structure.
+    # Values are not printed; the main purpose of this method is to inspect
+    # the internal tree structure.
+    def inspect
+      @children.inspect
+    end
+    
+  private
+    
+    # Returns an array from the given +key+, making it ready for use as
+    # a key sequence.
+    def convert_key(key)
+      case key
+      when Array      then key
+      when Symbol     then key.to_s.split('')
+      when String     then key.split('')
+      when Enumerable then key.entries
+      end
+    end
+  end
+  
+end
+

data/test/equivalence.scm

@@ -10,10 +10,17 @@
 (assert (not (eqv? 42 #f)))
 (assert (not (eqv? 42 42.0)))
 
+(assert (eqv? #\A #\A))
+(assert (not (eqv? #\A #\B)))
+(assert (not (eqv? #\A #\a)))
+
 (assert (eqv? '() '()))
 (assert (not (eqv? '(1 2) '(1 2))))
 (assert (not (eqv? '() '(1 2))))
 
+(assert (not (eqv? #() #())))
+(assert (not (eqv? #(4) #(4))))
+
 (assert (eqv? ceil ceiling))
 
 

data/test/let.scm

@@ -40,3 +40,16 @@
 
 (assert-equal 720 (do-factorial 6))
 
+
+; R5RS compliance test -- http://okmij.org/ftp/Scheme/lambda-derived.txt
+(assert-equal '(1 1 1 1 1 1 1)
+              (let ((foo (lambda (x) x)))
+                (list
+                  (foo ((lambda () (define a 1) a)))
+                  (foo (let ()  (define a 1) a))
+                  (foo (let* ()  (define a 1) a))
+                  (foo (letrec ()  (define a 1) a))
+                  (foo (letrec ()  (define (b) (define a 1) a) (b)))
+                  (foo (let-syntax () (define a 1) a))
+                  (foo (letrec-syntax () (define a 1) a)))))
+

data/test/lists.scm

@@ -1,10 +1,9 @@
-(assert (eqv? '() '()))
-(assert (not (eqv? '(5) '(5))))
-
 (assert (null? '()))
 (assert (list? '()))
 (assert (not (pair? '())))
 
+(assert (not (vector? '(1 2 3))))
+
 (define foo-list (list (+ 3 2) (* 4 5) 6))
 (assert (not (eqv? '(5 20 6) foo-list)))
 (assert (equal? '(5 20 6) foo-list))

data/test/macros.scm

@@ -88,12 +88,26 @@
   [(_ foo bar . rest)
     rest]))
 (assert-equal 10 (rest 4 5 + 3 7))
+
 (let-syntax ([foo (syntax-rules ()
                     [(_ expr ...)
                       (list expr ...)])])
   (assert-equal '(1 2 3) (foo 1 2 3))
   (assert-raise SyntaxError (foo 1 2 3 . 4)))
 
+(let-syntax ([foo (syntax-rules ()
+    [(_ bindings body ...)
+      '(defun (proc . bindings) body ...)])])
+  
+  (assert-equal '(defun (proc x y) (display x) y)
+                (foo (x y) (display x) y))
+  
+  (assert-equal '(defun (proc x y . z) z)
+                (foo (x y . z) z))
+  
+  (assert-equal '(defun (proc . z) z)
+                (foo z z)))
+
 
 ; Test input execution - example from R5RS
 

data/test/strings.scm

@@ -0,0 +1,110 @@
+(assert (equal? (symbol->string 'foo) "foo"))
+(assert (eqv? (string->symbol "foo") 'foo))
+
+(assert (char? #\a))
+(assert (char? #\ ))
+(assert (char? #\)))
+(assert (char? #\tab))
+
+(assert (char=? #\F #\F))
+(assert (char=? #\space #\space))
+(assert (char=? #\space #\ ))
+(assert (char=? #\  #\space))
+(assert (not (char=? #\F #\f)))
+(assert (not (char=? #\8 #\f)))
+
+(assert (char<? #\A #\B))
+(assert (char<? #\a #\b))
+(assert (char<? #\0 #\9))
+
+(assert (char=? (integer->char 97) #\a))
+(assert-equal 100 (char->integer #\d))
+
+(assert (char=? #\A (char-upcase #\a)))
+(assert (char=? #\h (char-downcase #\H)))
+
+(assert (char-alphabetic? #\A))
+(assert (char-alphabetic? #\Z))
+(assert (char-alphabetic? #\a))
+(assert (char-alphabetic? #\z))
+(assert (not (char-alphabetic? #\0)))
+(assert (not (char-alphabetic? #\[)))
+
+(assert (char-numeric? #\0))
+(assert (char-numeric? #\9))
+(assert (not (char-numeric? #\k)))
+
+(assert (char-whitespace? #\ ))
+(assert (char-whitespace? #\tab))
+(assert (char-whitespace? #\newline))
+(assert (char-whitespace? #\space))
+(assert (not (char-whitespace? #\s)))
+
+(assert (char-ci=? #\A #\a))
+(assert (not (char-ci=? #\A #\b)))
+
+(assert (string? "foo"))
+(assert (not (string? 'foo)))
+(assert (not (string? #\a)))
+(assert (not (string? 9)))
+
+(assert-equal "    " (make-string 4))
+(assert-equal ")))))))" (make-string 7 #\)))
+
+(let ([g (lambda () "***")])
+  (assert-raise ImmutableError (string-set! (g) 0 #\?))
+  (assert-equal "***" (g)))
+
+(assert-equal 13 (string-length "smoked salmon"))
+(assert-equal #\o (string-ref "salmon" 4))
+(assert-raise BadIndexError (string-ref "salmon" 7))
+
+(let ([s (string-copy "saLMON")])
+  (string-set! s 4 #\k)
+  (assert-equal "saLMkN" s)
+  (assert (eqv? s s))
+  (assert (not (eqv? (string-copy s) s)))
+  (assert (equal? (string-copy s) s))
+  (string-fill! s #\G)
+  (assert-equal "GGGGGG" s))
+
+(assert-equal "alm" (substring "salmon" 1 4))
+
+(assert-equal "foo" (string #\f #\o #\o))
+(assert-equal "" (string))
+
+(assert-equal '(#\f #\o #\o) (string->list "foo"))
+(assert-equal "foo" (list->string '(#\f #\o #\o)))
+
+(assert-equal "foo bar baz" (string-append "foo " "ba" "r baz" ""))
+
+(assert (string=? "foo" "foo"))
+(assert (not (string=? "foo" "Foo")))
+(assert (not (string=? "foo" "food")))
+(assert (not (string=? "food" "foo")))
+(assert (string-ci=? "foo" "Foo"))
+(assert (not (string-ci=? "food" "Fool")))
+
+(assert (string<? "abacus" "badger"))
+(assert (string<? "badger" "badges"))
+(assert (string<? "string" "stringify"))
+(assert (not (string<? "stringify" "string")))
+(assert (not (string<? "badger" "badger")))
+(assert (not (string<? "badges" "badger")))
+
+(assert (not (string>? "abacus" "badger")))
+(assert (not (string>? "badger" "badges")))
+(assert (not (string>? "string" "stringify")))
+(assert (string>? "stringify" "string"))
+(assert (not (string>? "badger" "badger")))
+(assert (string>? "badges" "badger"))
+
+(assert (string<=? "foo" "foo"))
+(assert (string<=? "foo" "goo"))
+(assert (string<=? "Foo" "foo"))
+(assert (not (string<=? "foo" "Foo")))
+
+(assert (string-ci<=? "foo" "Foo"))
+(assert (not (string-ci>=? "abacus" "Badger")))
+(assert (string>? "abacus" "Badger"))
+

data/test/test_heist.rb

@@ -30,6 +30,8 @@ Class.new(Test::Unit::TestCase) do
   %w[   booleans
         numbers
         lists
+        vectors
+        strings
         equivalence
         arithmetic
         define_values

data/test/vectors.scm

@@ -0,0 +1,83 @@
+(assert (equal? #() #()))
+(assert (equal? #(1 8 7) #(1 8 7)))
+(assert (equal? #(1 (2 3) 7) #(1 (2 3) 7)))
+(assert (not (equal? #(1 (2 3) 7) #(1 (2 4) 7))))
+
+(assert (vector? #(1 2 3)))
+(assert (vector? #()))
+(assert (vector? #((1 2 3))))
+
+(for-each (lambda (predicate)
+            (assert (not (predicate #()))))
+          `(,pair? ,list? ,null?))
+
+(assert (vector? (vector 1 3)))
+(assert-equal #(1 4) (vector 1 4))
+(assert (not (equal? #(2 4) (vector 2 4 5))))
+
+(assert (not (equal? '(1 2) #[1 2])))
+(assert (equal? '(1 2) (vector->list #(1 2))))
+(assert (equal? (list->vector '(1 2)) #(1 2)))
+
+(assert-equal #(() () ()) (make-vector 3))
+(assert-equal #(foo foo foo foo) (make-vector 4 'foo))
+
+(assert-equal 0 (vector-length #()))
+(assert-equal 3 (vector-length #(1 8 9)))
+
+(assert-equal 8 (vector-ref '#(1 1 2 3 5 8 13 21) 5))
+
+(assert-equal 13 (vector-ref '#[1 1 2 3 5 8 13 21]
+                             (round (* 2 (acos -1)))))
+
+(assert-equal #(0 ("Sue" "Sue") "Anna") (let ((vec (vector 0 '(2 2 2 2) "Anna")))
+                                          (vector-set! vec 1 '("Sue" "Sue"))
+                                          vec))
+
+(assert-raise ImmutableError (vector-set! '#(0 1 2) 1 "doe"))
+(assert-equal #(0 "doe" 2) (let ([v #(0 1 2)])
+                             (vector-set! v 1 "doe")
+                             v))
+
+(assert-equal #(23 23 23) (let ([v (vector 1 2 3)])
+                            (vector-fill! v 23)
+                            v))
+
+(define (create-unquoted-vector)
+  #(1 2 3))
+
+(let ([a (create-unquoted-vector)])
+  (vector-set! a 1 7)
+  (assert-equal #(1 2 3) (create-unquoted-vector))
+  (assert-equal '#(1 7 3) a))
+
+(define (create-quoted-vector)
+  '#(1 2 3))
+
+(let ([a (create-quoted-vector)])
+  (assert-raise ImmutableError (vector-set! a 1 7)))
+
+(define-syntax vector-mac (syntax-rules ()
+  ((_ #(a (b c) d ...))
+    c)
+  ((_ #(a b c))
+    a)))
+
+(assert-equal 3 (vector-mac #(3 8 7)))
+(assert-raise SyntaxError (vector-mac #(1 2)))
+(assert-raise SyntaxError (vector-mac #(1 2 3 4)))
+(assert-raise SyntaxError (vector-mac (1 2 3)))
+
+(assert-equal 5 (vector-mac #(3 (4 5))))
+(assert-equal 5 (vector-mac #(3 (4 5) 6)))
+(assert-equal 3 (vector-mac #(3 #(4 5) 6)))
+
+(assert-equal #(1 2 3) '#(1 2 3))
+(assert-equal #(1 2 3) `#(1 2 3))
+(assert-equal #(1 (* 7 4) 3) `#(1 (* 7 4) 3))
+(assert-equal #(1 28 3) `#(1 ,(* 7 4) 3))
+(assert-equal #(1 28 9 5) `#(1 ,(* 7 4) ,@'(9 5)))
+(assert-equal #(1 28 9 5 8) `#(1 ,(* 7 4) ,@'(9 5) 8))
+(assert-equal #(9 5 8) `#(,@'(9 5) 8))
+(assert-equal #((9 5) 8) `#(,'(9 5) 8))
+