heist 0.2.1 → 0.3.0

data/History.txt

@@ -1,3 +1,20 @@
+=== Version 0.3.0 (2009-07-31)
+
+We've got all your data types now
+* Vectors are supported, including the full R5RS library, macro and quasiquoting support
+* Characters are available, including named characters (#\newline, #\space, #\tab)
+* The full R5RS character and string libraries are implemented
+* Complex numbers work correctly on Ruby1.9
+* Dotted tail notation properly supported in macro templates
+
+
+=== Version 0.2.1 (2009-05-19)
+
+* Fixed a bug in (append) where '() is the last argument
+* Implemented (begin) in Ruby rather than Scheme for performance reasons
+* Fixed a macro bug relating to binding of macro keywords
+
+
 === Version 0.2.0 (2009-04-01)
 
 The 'lists' release

data/Manifest.txt

@@ -6,6 +6,7 @@ bin/heist
 lib/bin_spec.rb
 lib/heist.rb
 lib/repl.rb
+lib/trie.rb
 lib/builtin/library.scm
 lib/builtin/primitives.rb
 lib/builtin/syntax.scm
@@ -20,9 +21,11 @@ lib/runtime/callable/macro.rb
 lib/runtime/callable/macro/matches.rb
 lib/runtime/callable/macro/tree.rb
 lib/runtime/callable/macro/expansion.rb
+lib/runtime/data/character.rb
 lib/runtime/data/cons.rb
 lib/runtime/data/expression.rb
 lib/runtime/data/identifier.rb
+lib/runtime/data/vector.rb
 lib/runtime/binding.rb
 lib/runtime/frame.rb
 lib/runtime/runtime.rb
@@ -51,7 +54,9 @@ test/macro-helpers.scm
 test/macros.scm
 test/numbers.scm
 test/plt-macros.txt
+test/strings.scm
 test/test_heist.rb
 test/unhygienic.scm
 test/vars.scm
+test/vectors.scm
 

data/README.txt

@@ -46,52 +46,63 @@ Currently implemented R5RS features include:
 * Numeric literals for integers, reals, rationals and complexes. The
   latter two are mapped to Ruby's <tt>Rational</tt> and <tt>Complex</tt>
   objects and Ruby handles all math procedures.
-* String and symbol literals
+* Character, string and symbol literals
 * Proper and improper lists and full (quasi)quoting with <tt>'</tt>,
   <tt>`</tt>, <tt>,</tt>, <tt>,@</tt>
-* Macros: <tt>syntax-rules</tt>, <tt>define-syntax</tt>,
-  <tt>let-syntax</tt>, <tt>letrec-syntax</tt>. Supports keywords,
-  lists, pattern variables and ellipses down to arbitrary depth, as
-  well as the R6RS ellipsis-escaping feature (<tt>(... ...)</tt>) to
-  better enable macro-writing macros
-* Continuations: <tt>call-with-current-continuation</tt>, aliased
-  as <tt>call/cc</tt>
-* Proper tail recursion
-* Variable assignment: <tt>define</tt> and <tt>set!</tt>
-* Lambda expressions: <tt>(lambda (x ...) body ...)</tt>, including lexical
-  scoping and closures. Supports varargs using <tt>(lambda args body ...)</tt>
-  and <tt>(lambda (x y . rest) body ...)</tt> forms.
-* Control flow: <tt>begin</tt>, <tt>if</tt>, <tt>cond</tt>,
-  <tt>case</tt>
-* Binding constructs: <tt>let</tt>, <tt>let*</tt>, <tt>letrec</tt>
+* Vector literals, also with quasiquoting support
+* Definition and assignment: <tt>define</tt>, <tt>set!</tt>
+* Lambdas: <tt>(lambda (x y) body ...)</tt>, <tt>(lambda args body ...)</tt>,
+  <tt>(lambda (x y . rest) body ...)</tt>
+* Conditionals: <tt>if</tt>, <tt>cond</tt>, <tt>case</tt>
+* Binding constructs: <tt>let</tt>, <tt>let*</tt>, <tt>letrec</tt>, <tt>begin</tt>
 * Iteration: named <tt>let</tt>, <tt>do</tt>
+* Quoting: <tt>quote</tt>, <tt>quasiquote</tt> and shorthands <tt>'</tt>,
+  <tt>`</tt>, <tt>,</tt>, <tt>,@</tt>
+* Macros: <tt>let-syntax</tt>, <tt>letrec-syntax</tt>, <tt>define-syntax</tt>,
+  <tt>syntax-rules</tt>
 * Delayed evaluation: <tt>delay</tt> and <tt>force</tt>
-* Logical connectives: <tt>and</tt>, <tt>or</tt>, <tt>not</tt>
-* Type checking: <tt>boolean?</tt>, <tt>number?</tt>, <tt>complex?</tt>,
-  <tt>real?</tt>, <tt>rational?</tt>, <tt>integer?</tt>, <tt>exact?</tt>,
-  <tt>inexact?</tt>, <tt>symbol?</tt>, <tt>string?</tt>, <tt>pair?</tt>,
-  <tt>list?</tt>, <tt>null?</tt>, <tt>procedure?</tt>
-* Comparators: <tt>eq?</tt>, <tt>eqv?</tt>, <tt>equal?</tt>, <tt>=</tt>,
-  <tt><</tt>, <tt><=</tt>, <tt>></tt>, <tt>>=</tt>
-* Numeric library: <tt>max</tt>, <tt>min</tt>, <tt>+</tt>, <tt>-</tt>,
-  <tt>*</tt>, <tt>/</tt>, <tt>quotient</tt>, <tt>remainder</tt>,
-  <tt>modulo</tt>, <tt>numerator</tt>, <tt>denominator</tt>, <tt>floor</tt>,
-  <tt>ceiling</tt>, <tt>truncate</tt>, <tt>round</tt>, <tt>exp</tt>,
-  <tt>log</tt>, <tt>sin</tt>, <tt>cos</tt>, <tt>tan</tt>, <tt>asin</tt>,
-  <tt>acos</tt>, <tt>atan</tt>, <tt>expt</tt>, <tt>sqrt</tt>,
-  <tt>zero?</tt>, <tt>positive?</tt>, <tt>negative?</tt>, <tt>odd?</tt>,
-  <tt>even?</tt>, <tt>abs</tt>, <tt>gcd</tt>, <tt>lcm</tt>,
+* Continuations: <tt>call-with-current-continuation</tt>, aliased as <tt>call/cc</tt>
+* Equivalance predicates: <tt>eqv?</tt>, <tt>eq?</tt>, <tt>equal?</tt>
+* Numeric library: <tt>number?</tt>, <tt>complex?</tt>, <tt>real?</tt>,
+  <tt>rational?</tt>, <tt>integer?</tt>, <tt>exact?</tt>, <tt>inexact?</tt>,
+  <tt>=</tt>, <tt><</tt>, <tt>></tt>, <tt><=</tt>, <tt>>=</tt>, <tt>zero?</tt>,
+  <tt>positive?</tt>, <tt>negative?</tt>, <tt>odd?</tt>, <tt>even?</tt>,
+  <tt>max</tt>, <tt>min</tt>, <tt>+</tt>, <tt>*</tt>, <tt>-</tt>, <tt>/</tt>,
+  <tt>abs</tt>, <tt>quotient</tt>, <tt>remainder</tt>, <tt>modulo</tt>,
+  <tt>gcd</tt>, <tt>lcm</tt>, <tt>numerator</tt>, <tt>denominator</tt>,
+  <tt>floor</tt>, <tt>ceiling</tt>, <tt>truncate</tt>, <tt>round</tt>,
+  <tt>exp</tt>, <tt>log</tt>, <tt>sin</tt>, <tt>cos</tt>, <tt>tan</tt>,
+  <tt>asin</tt>, <tt>acos</tt>, <tt>atan</tt>, <tt>sqrt</tt>, <tt>expt</tt>,
   <tt>make-rectangular</tt>, <tt>make-polar</tt>, <tt>real-part</tt>,
-  <tt>imag-part</tt>, <tt>magnitude</tt>, <tt>angle</tt>, <tt>factorial</tt>,
-  <tt>number->string</tt>
-* List library: <tt>cons</tt>, <tt>car</tt>, <tt>cdr</tt>, <tt>set-car!</tt>,
-  <tt>set-cdr!</tt>, <tt>c[ad]{1,4}r</tt>, <tt>list</tt>, <tt>length</tt>,
-  <tt>append</tt>, <tt>reverse</tt>, <tt>list-tail</tt>, <tt>list-ref</tt>,
-  <tt>memq</tt>, <tt>memv</tt>, <tt>member</tt>, <tt>assq</tt>, <tt>assv</tt>,
-  <tt>assoc</tt>, <tt>apply</tt>, <tt>map</tt>, <tt>for-each</tt>
-* String library: <tt>display</tt>, <tt>newline</tt>, <tt>string->number</tt>
-* File loading: <tt>(load "foo.scm")</tt>, paths are relative to the
-  current file
+  <tt>imag-part</tt>, <tt>magnitude</tt>, <tt>angle</tt>, <tt>number->string</tt>,
+  <tt>string->number</tt>
+* Boolean library: <tt>and</tt>, <tt>or</tt>, <tt>not</tt>, <tt>boolean?</tt>
+* List library: <tt>pair?</tt>, <tt>cons</tt>, <tt>car</tt>, <tt>cdr</tt>,
+  <tt>set-car!</tt>, <tt>set-cdr!</tt>, <tt>caar</tt>, <tt>cadr</tt> ...
+  <tt>cdddar</tt>, <tt>cddddr</tt>, <tt>null?</tt>, <tt>list?</tt>, <tt>list</tt>,
+  <tt>length</tt>, <tt>append</tt>, <tt>reverse</tt>, <tt>list-tail</tt>,
+  <tt>list-ref</tt>, <tt>memq</tt>, <tt>memv</tt>, <tt>member</tt>, <tt>assq</tt>,
+  <tt>assv</tt>, <tt>assoc</tt>
+* Symbol library: <tt>symbol?</tt>, <tt>symbol->string</tt>, <tt>string->symbol</tt>
+* Character library: <tt>char?</tt>, <tt>char=?</tt>, <tt>char<?</tt>,
+  <tt>char>?</tt>, <tt>char<=?</tt>, <tt>char>=?</tt>, <tt>char-ci=?</tt>,
+  <tt>char-ci<?</tt>, <tt>char-ci>?</tt>, <tt>char-ci<=?</tt>, <tt>char-ci>=?</tt>,
+  <tt>char-alphabetic?</tt>, <tt>char-numeric?</tt>, <tt>char-whitespace?</tt>,
+  <tt>char-upper-case?</tt>, <tt>char-lower-case?</tt>, <tt>char->integer</tt>,
+  <tt>integer->char</tt>, <tt>char-upcase</tt>, <tt>char-downcase</tt>
+* String library: <tt>string?</tt>, <tt>make-string</tt>, <tt>string</tt>,
+  <tt>string-length</tt>, <tt>string-ref</tt>, <tt>string-set!</tt>,
+  <tt>string=?</tt>, <tt>string-ci=?</tt>, <tt>string<?</tt>, <tt>string>?</tt>,
+  <tt>string<=?</tt>, <tt>string>=?</tt>, <tt>string-ci<?</tt>, <tt>string-ci>?</tt>,
+  <tt>string-ci<=?</tt>, <tt>string-ci>=?</tt>, <tt>substring</tt>,
+  <tt>string-append</tt>, <tt>string->list</tt>, <tt>list->string</tt>,
+  <tt>string-copy</tt>, <tt>string-fill!</tt>
+* Vector library: <tt>vector?</tt>, <tt>make-vector</tt>, <tt>vector</tt>,
+  <tt>vector-length</tt>, <tt>vector-ref</tt>, <tt>vector-set!</tt>,
+  <tt>vector->list</tt>, <tt>list->vector</tt>, <tt>vector-fill!</tt>
+* Control features: <tt>procedure?</tt>, <tt>apply</tt>, <tt>map</tt>,
+  <tt>for-each</tt>, <tt>eval</tt>, <tt>load</tt>
+* Input/output: <tt>display</tt>, <tt>newline</tt>
 
 In addition to the above R5RS features, the following are provided. Heist
 allows the behaviour of some of these features to be configured on a
@@ -194,16 +205,17 @@ For example, using our <tt>Heist::Runtime</tt> instance from above:
   scheme.exec [:square, 9]
   #=> 81
 
-Arrays map directly to Scheme lists, symbols map to identifiers, strings
-and numbers are treated as literals, and any other data is interpreted
-verbatim. So, you can use any piece of Ruby data in these expressions
-as long as the functions you're calling can operate on it.
+Arrays map directly to Scheme lists, symbols map to identifiers, strings,
+numbers and booleans are treated as literals, and any other data is
+interpreted verbatim. So, you can use any piece of Ruby data in these
+expressions as long as the functions you're calling can operate on it.
 
-Due to syntactic limitations, some Scheme syntax cannot be used in this
-interface. Quoting is out, so the expression <tt>'(1 2 3)</tt> would
-need to be written <tt>[:quote, [1, 2, 3]]</tt>. Dotted pairs and
-improper lists are also not available, though you can work around
-this to some extent using <tt>:cons</tt>.
+Due to syntactic limitations, some Scheme constructs cannot be used in this
+interface. Quoting syntax is out, so the expression <tt>'(1 2 3)</tt> would
+need to be written <tt>[:quote, [1, 2, 3]]</tt>. Dotted pairs and improper
+lists are also not available, though you can work around this to some extent
+using <tt>:cons</tt>. Vectors should be written as <tt>[:vector, 1, 2, 3]</tt>
+for example. Characters are not supported at all.
 
 
 == Notes
@@ -217,7 +229,9 @@ and can be assumed to be reasonably stable.
 I have not documented how to write your own syntax using Ruby because
 it requires far too much knowledge of Heist's plumbing at present (I
 suspect this may be unavoidable). Besides, we have macros so if you
-want new syntax we've got you covered.
+want new syntax we've got you covered. In fact, writing syntax using
+macros makes sure that new syntactic forms support continuations
+correctly, and Heist itself eschews Ruby-based syntax where possible.
 
 Heist is extremely liberal as regards symbols. Any sequence of
 characters that does not contain any spaces or parentheses and that

data/Rakefile

@@ -4,9 +4,33 @@ require 'rubygems'
 require 'hoe'
 require './lib/heist.rb'
 
-Hoe.new('heist', Heist::VERSION) do |p|
+Hoe.spec('heist') do |p|
   p.developer('James Coglan', 'jcoglan@googlemail.com')
   p.extra_deps = %w(oyster treetop)
 end
 
+namespace :spec do
+  task :r5rs do
+    procedures = Dir['r5rs/*.html'].
+                 map { |f| File.read(f) }.
+                 join("\n").
+                 split(/\n+/).
+                 grep(/(syntax|procedure)\:/).
+                 map { |s| s.gsub(/<\/?[^>]+>/, '').
+                             scan(/\(([^\) ]+)/).
+                             flatten.
+                             first }.
+                 uniq.
+                 compact.
+                 map { |s| s.gsub('&lt;', '<').
+                             gsub('&gt;', '>') }
+    
+    scope = Heist::Runtime.new.top_level
+    procedures.each do |proc|
+      message = scope.defined?(proc) ? scope.exec(proc) : 'MISSING'
+      puts "    %-32s %-48s" % [proc, message]
+    end
+  end
+end
+
 # vim: syntax=Ruby

data/lib/builtin/library.scm

@@ -25,14 +25,6 @@
 (define (not x)
   (if x #f #t))
 
-; (negate x)
-; Returns a negated form of x, like (not) but also
-; works on functions
-(define (negate proc)
-  (if (procedure? proc)
-      (lambda args (not (apply proc args)))
-      (not proc)))
-
 ; Longhand aliases for boolean constants
 (define true #t)
 (define false #f)
@@ -50,9 +42,19 @@
 ; Returns true iff x is any type of number
 (define number? complex?)
 
+; (exact? x)
+; Returns true iff the given number is exact i.e. an integer, a
+; rational, or a complex made of integers or rationals
+(define (exact? x)
+  (or (rational? x)
+      (and (not (zero? (imag-part x)))
+           (exact? (real-part x))
+           (exact? (imag-part x)))))
+
 ; (inexact? x)
 ; Returns true iff x is not an exact number
-(define inexact? (negate exact?))
+(define (inexact? x)
+  (not (exact? x)))
 
 ; Returns true iff all arguments are numerically equal
 (define (= . args)
@@ -336,3 +338,236 @@
       (proc (car list)
             (foldr proc value (cdr list)))))
 
+;----------------------------------------------------------------
+
+; Character functions
+
+; (char-upper-case? letter)
+; Returns true iff letter is an uppercase letter
+(define (char-upper-case? letter)
+  (and (char? letter)
+       (let ([code (char->integer letter)])
+         (and (>= code 65)
+              (<= code 90)))))
+
+; (char-lower-case? letter)
+; Returns true iff letter is a lowercase letter
+(define (char-lower-case? letter)
+  (and (char? letter)
+       (let ([code (char->integer letter)])
+         (and (>= code 97)
+              (<= code 122)))))
+
+; (char-alphabetic? char)
+; Returns true iff char is an alphabetic character
+(define (char-alphabetic? char)
+  (or (char-upper-case? char)
+      (char-lower-case? char)))
+
+; (char-numeric? char)
+; Returns true iff char is a numeric character
+(define (char-numeric? char)
+  (and (char? char)
+       (let ([code (char->integer char)])
+         (and (>= code 48)
+              (<= code 57)))))
+
+; (char-whitespace? char)
+; Returns true iff char is a whitespace character
+(define (char-whitespace? char)
+  (and (char? char)
+       (if (member (char->integer char)
+                  '(9 10 32))
+           #t
+           #f)))
+
+; (char-upcase char)
+; Returns an uppercase copy of char
+(define (char-upcase char)
+  (let ([code (char->integer char)])
+    (if (and (>= code 97) (<= code 122))
+        (integer->char (- code 32))
+        (integer->char code))))
+
+; (char-downcase char)
+; Returns a lowercase copy of char
+(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>=?))
+
+;----------------------------------------------------------------
+
+; String functions
+
+; (string char ...)
+; Returns a new string formed by combining the given characters
+(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 '()])
+          ((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 '()]))])))))
+
+; (string=? string1 string2)
+; Returns true iff string1 and string2 are equal strings
+(define (string=? string1 string2)
+  (zero? (string-compare string1 string2 char<? char>?)))
+
+; (string-ci=? string1 string2)
+; Returns true iff string1 and string2 are equal strings, ignoring case
+(define (string-ci=? string1 string2)
+  (zero? (string-compare string1 string2 char-ci<? char-ci>?)))
+
+; (string<? string1 string2)
+; Returns true iff string1 is lexicographically less than string2
+(define (string<? string1 string2)
+  (= (string-compare string1 string2 char<? char>?) -1))
+
+; (string>? string1 string2)
+; Returns true iff string1 is lexicographically greater than string2
+(define (string>? string1 string2)
+  (= (string-compare string1 string2 char<? char>?) 1))
+
+; (string<=? string1 string2)
+; Returns true iff string1 is lexicographically less than or equal
+; to string2
+(define (string<=? string1 string2)
+  (not (string>? string1 string2)))
+
+; (string>=? string1 string2)
+; Returns true iff string1 is lexicographically greater than or equal
+; to string2
+(define (string>=? string1 string2)
+  (not (string<? string1 string2)))
+
+; (string-ci<? string1 string2)
+; Returns true iff string1 is lexicographically less than string2,
+; ignoring differences in case
+(define (string-ci<? string1 string2)
+  (= (string-compare string1 string2 char-ci<? char-ci>?) -1))
+
+; (string-ci>? string1 string2)
+; Returns true iff string1 is lexicographically greater than string2,
+; ignoring differences in case
+(define (string-ci>? string1 string2)
+  (= (string-compare string1 string2 char-ci<? char-ci>?) 1))
+
+; (string-ci<=? string1 string2)
+; Returns true iff string1 is lexicographically less than or equal
+; to string2, ignoring differences in case
+(define (string-ci<=? string1 string2)
+  (not (string-ci>? string1 string2)))
+
+; (string-ci>=? string1 string2)
+; Returns true iff string1 is lexicographically greater than or equal
+; to string2, ignoring differences in case
+(define (string-ci>=? string1 string2)
+  (not (string-ci<? string1 string2)))
+
+; (substring string start end)
+; 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 chars)
+; Returns a new string formed by combining the list
+(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)))))
+
+; (string->list string)
+; Returns a newly allocated list of the characters in the string
+(define (string->list string)
+  (let ([size (string-length string)])
+    (do ([i size (- i 1)]
+         [list '() (cons (string-ref string (- i 1)) list)])
+        ((zero? i) list))))
+
+; (string-copy string)
+; Returns a newly allocated copy of the string
+(define (string-copy string)
+  (list->string (string->list string)))
+
+; (string-fill! string char)
+; Replaces every character of string with char
+(define (string-fill! string char)
+  (let ([size (string-length string)])
+    (do ([i size (- i 1)])
+        ((zero? i) string)
+      (string-set! string (- i 1) char))))
+
+; (string-append string ...)
+; Returns a new string formed by concatenating the arguments
+(define (string-append . strings)
+  (list->string (apply append (map string->list strings))))
+
+;----------------------------------------------------------------
+
+; Vector functions
+
+; (vector object ...)
+; Returns a newly allocated vector from its arguments
+(define (vector . args) (list->vector args))
+
+; (list->vector list)
+; Returns a newly allocated vector from a list
+(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)))))
+
+; (vector->list vector)
+; Returns a newly allocated proper list from a vector
+(define (vector->list vector)
+  (do ([i (vector-length vector) (- i 1)]
+       [pair '() (cons (vector-ref vector (- i 1)) pair)])
+      ((zero? i) pair)))
+
+; (vector-fill! vector fill)
+; Sets every element of vector to fill
+(define (vector-fill! vector fill)
+  (do ([i (vector-length vector) (- i 1)])
+      ((zero? i) vector)
+    (vector-set! vector (- i 1) fill)))
+