heist 0.3.2 → 0.3.3

data/lib/heist/builtin/lib/string.scm

@@ -0,0 +1,117 @@
+; (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)
+  (list->string (sublist (string->list string) start end)))
+
+; (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))))

data/lib/heist/builtin/lib/util.scm

@@ -0,0 +1,18 @@
+; Any built-in functions that we can implement directly
+; in Scheme should go here. If at all possible, write
+; builtins in Scheme rather than Ruby.
+
+(define quit exit)
+
+; (newline)
+; prints a new-line character
+(define (newline)
+  (display "\n"))
+
+; (force)
+; Extracts the value of a promise created using (delay)
+(define (force promise) (promise))
+
+; (call/cc)
+; Alias for (call-with-current-continuation)
+(define call/cc call-with-current-continuation)

data/lib/heist/builtin/lib/vector.scm

@@ -0,0 +1,27 @@
+; (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)))

data/lib/{builtin → heist/builtin}/syntax.scm

@@ -5,18 +5,18 @@
 ; found, its consequent is tail-called and no further
 ; preconditions are evaluated.
 (define-syntax cond (syntax-rules (else =>)
-  [(cond) #f]
-  [(cond (else expr1 expr2 ...))
-    (begin expr1 expr2 ...)]
-  [(cond (test => function) clause ...)
-    (let ([temp test])
+  ((cond) #f)
+  ((cond (else expr1 expr2 ...))
+    (begin expr1 expr2 ...))
+  ((cond (test => function) clause ...)
+    (let ((temp test))
       (if temp
           (function temp)
-          (cond clause ...)))]
-  [(cond (test expression ...) clause ...)
+          (cond clause ...))))
+  ((cond (test expression ...) clause ...)
     (if test
         (begin expression ...)
-        (cond clause ...))]))
+        (cond clause ...)))))
 
 ; (case) acts like Ruby's case statement. The value of the
 ; given expression is compared against a series of lists;
@@ -24,17 +24,17 @@
 ; following the list are evaluated and no further lists
 ; are tested.
 (define-syntax case (syntax-rules (else)
-  [(case key) #f]
-  [(case key (else expr1 expr2 ...))
-    (begin expr1 expr2 ...)]
-  [(case key
+  ((case key) #f)
+  ((case key (else expr1 expr2 ...))
+    (begin expr1 expr2 ...))
+  ((case key
          ((cell ...) expr1 expr2 ...)
          clause ...)
-    (let ([temp key])
+    (let ((temp key))
       (if (member temp '(cell ...))
           (begin expr1 expr2 ...)
           (case temp
-                clause ...)))]))
+                clause ...))))))
 
 ;----------------------------------------------------------------
 
@@ -47,33 +47,33 @@
 ; (let) evaluates values in the enclosing scope, so lambdas will
 ; not be able to refer to other values assigned using the (let).
 (define-syntax let (syntax-rules ()
-  [(let ([variable init] ...) body ...)
+  ((let ((variable init) ...) body ...)
     ((lambda (variable ...)
         body ...)
-     init ...)]
-  [(let name ([variable init] ...) body ...)
-    (letrec ([name (lambda (variable ...)
-                     body ...)])
-      (name init ...))]))
+     init ...))
+  ((let name ((variable init) ...) body ...)
+    (letrec ((name (lambda (variable ...)
+                     body ...)))
+      (name init ...)))))
 
 ; (let*) creates a new scope for each variable and evaluates
 ; each expression in its enclosing scope. Basically a shorthand
 ; for several nested (let)s. Variables may refer to those that
 ; preceed them but not vice versa.
 (define-syntax let* (syntax-rules ()
-  [(let* ([n1 e1] [n2 e2] [n3 e3] ...) body ...)  ; 2 or more bindings
-    (let ([n1 e1])
-      (let* ([n2 e2] [n3 e3] ...) body ...))]
-  [(let* ([name expression] ...) body ...)        ; 0 or 1 binding
-    (let ([name expression] ...) body ...)]))
+  ((let* ((n1 e1) (n2 e2) (n3 e3) ...) body ...)  ; 2 or more bindings
+    (let ((n1 e1))
+      (let* ((n2 e2) (n3 e3) ...) body ...)))
+  ((let* ((name expression) ...) body ...)        ; 0 or 1 binding
+    (let ((name expression) ...) body ...))))
 
 ; (letrec) evaluates values in the inner scope, so lambdas are
 ; able to refer to other values assigned using the (letrec).
 (define-syntax letrec (syntax-rules ()
-  [(letrec ([variable init] ...) body ...)
+  ((letrec ((variable init) ...) body ...)
     ((lambda ()
       (define variable init) ...
-      body ...))]))
+      body ...)))))
 
 (define let-syntax let)
 (define letrec-syntax letrec)
@@ -89,19 +89,19 @@
 ; loop is halted and the value of the expression following
 ; the test is returned.
 (define-syntax do (syntax-rules ()
-  [(do ([variable init step ...] ...)   ; Allow 0 or 1 step
+  ((do ((variable init step ...) ...)   ; Allow 0 or 1 step
        (test expression ...)
        command ...)
-    (let loop ([variable init] ...)
+    (let loop ((variable init) ...)
       (if test
           (begin expression ...)
           (begin
             command ...
-            (loop (do "step" variable step ...) ...))))]
-  [(do "step" variable)
-    variable]
-  [(do "step" variable step)
-    step]))
+            (loop (do "step" variable step ...) ...)))))
+  ((do "step" variable)
+    variable)
+  ((do "step" variable step)
+    step)))
 
 ;----------------------------------------------------------------
 
@@ -111,23 +111,23 @@
 ; of expressions, or returns the value of the last expression
 ; if all values are truthy.
 (define-syntax and (syntax-rules ()
-  [(and test) test]
-  [(and test1 test2 ...)
-    (let ([temp test1])
+  ((and test) test)
+  ((and test1 test2 ...)
+    (let ((temp test1))
       (if (not temp)
           temp
-          (and test2 ...)))]))
+          (and test2 ...))))))
 
 ; (or) returns the first truthy value returned by the list
 ; of expressions, or returns the value of the last expression
 ; if all values are falsey.
 (define-syntax or (syntax-rules ()
-  [(or test) test]
-  [(or test1 test2 ...)
-    (let ([temp test1])
+  ((or test) test)
+  ((or test1 test2 ...)
+    (let ((temp test1))
       (if temp
           temp
-          (or test2 ...)))]))
+          (or test2 ...))))))
 
 ;----------------------------------------------------------------
 
@@ -139,16 +139,16 @@
 ; ever evaluated once, so a promise can be implemented as a
 ; memoized closure.
 (define-syntax delay (syntax-rules ()
-  [(delay expression)
-    (let ([forced #f]
-          [memo #f])
+  ((delay expression)
+    (let ((forced #f)
+          (memo #f))
       (lambda ()
         (if forced
             memo
             (begin
               (set! memo expression)
               (set! forced #t)
-              memo))))]))
+              memo)))))))
 
 ;----------------------------------------------------------------
 
@@ -159,10 +159,10 @@
 ; it will evaluate it and insert the result into the
 ; surrounding quoted list.
 (define-syntax quasiquote (syntax-rules (unquote unquote-splicing)
-  [`,expr                 expr]
-  [`(,@first . rest)      (append first `rest)]
-  [`(first . rest)        (cons `first `rest)]
-  [`#(,@first rest ...)   (list->vector `(,@first rest ...))]
-  [`#(expr ...)           (list->vector `(expr ...))]
-  [`expr                  'expr]))
+  (`,expr                 expr)
+  (`(,@first . rest)      (append first `rest))
+  (`(first . rest)        (cons `first `rest))
+  (`#(,@first rest ...)   (list->vector `(,@first rest ...)))
+  (`#(expr ...)           (list->vector `(expr ...)))
+  (`expr                  'expr)))
 

data/lib/{runtime → heist/runtime}/binding.rb

@@ -52,6 +52,11 @@ module Heist
       def innermost_binding(identifier)
         @scope
       end
+      
+      # Returns a Rubyish representation of the binding's expression.
+      def to_ruby
+        @expression.respond_to?(:to_ruby) ? @expression.to_ruby : @expression
+      end
 
       # Returns a string representation of the binding's +Expression+.
       def to_s

data/lib/{runtime → heist/runtime}/callable/continuation.rb

@@ -28,8 +28,13 @@ module Heist
       # replace it with the stack returned by this method before continuing
       # execution.
       def call(scope, cells)
+        apply(cells.to_a)
+      end
+      
+      # TODO support call-with-values
+      def apply(params)
         stack = @stack.copy
-        stack.fill!(@target, cells.car)
+        stack.fill!(@target, Value.new(params.first))
         stack
       end
       

data/lib/{runtime → heist/runtime}/callable/macro.rb

@@ -62,7 +62,7 @@ module Heist
         rule, matches = *rule_for(cells, scope)
         return Expansion.new(@scope, scope, rule.cdr.car, matches) if rule
         raise SyntaxError.new(
-          "Bad syntax: no macro expansion found for #{Cons.new(@name, cells)}")
+          "Bad syntax: no macro expansion found for #{Cons.new(Identifier.new(@name), cells)}")
       end
       
       # Returns a string placeholder for the +Macro+, containing its

data/lib/heist/runtime/data/value.rb

@@ -0,0 +1,14 @@
+module Heist
+  class Runtime
+    
+    class Value
+      attr_reader :value
+      
+      def initialize(value)
+        @value = value
+      end
+    end
+    
+  end
+end
+

data/lib/{runtime → heist/runtime}/frame.rb

@@ -95,6 +95,9 @@ module Heist
       # +value+. When a hole is filled, the <tt>@current</tt> pointer is moved
       # to the next subexpression that needs evaluating.
       def fill!(subexpr, value)
+        value = value.value if Value === value and @values and
+                               not (Syntax === @values.car)
+        
         epair, vpair = @expression, @values
         while Cons === epair and not epair.null?
           if epair.car.equal?(subexpr)