shen-ruby 0.3.1 → 0.4.0

data/k_lambda_spec/primitives/lists_spec.rb

@@ -0,0 +1,40 @@
+require 'spec_helper'
+
+describe 'Primitives for lists' do
+  describe '(cons Hd Tl)' do
+    it 'creates a list with Hd as the head and Tl as the tail' do
+      kl_eval('(cons a ())').should be_kind_of Kl::Cons
+      kl_eval('(hd (cons a ()))').should == :a
+      kl_eval('(tl (cons a (cons b ())))').should == kl_eval('(cons b ())')
+    end
+
+    it 'allows Tl to be a non-list' do
+      kl_eval('(tl (cons a b))').should == :b
+    end
+
+    include_examples 'partially-applicable function', %w(cons a b)
+    include_examples 'applicative order evaluation', %w(cons a b)
+  end
+
+  describe '(hd L)' do
+    it 'returns the head of L' do
+      kl_eval('(hd (cons a b))').should == :a
+    end
+
+    include_examples 'argument types', [:hd, "(cons a b)"], 1 => [:list, :dotted_pair]
+    include_examples 'partially-applicable function', [:hd, "(cons a b)"]
+  end
+
+  describe '(tl L)' do
+    it 'returns the tail of L' do
+      kl_eval('(tl (cons a b))').should == :b
+    end
+
+    include_examples 'argument types', [:tl, "(cons a b)"], 1 => [:list, :dotted_pair]
+    include_examples 'partially-applicable function', [:tl, "(cons a b)"]
+  end
+
+  describe 'cons?' do
+    include_examples 'type predicate', 'cons?', [:list, :dotted_pair]
+  end
+end

data/k_lambda_spec/primitives/strings_spec.rb

@@ -0,0 +1,77 @@
+require 'spec_helper'
+
+describe 'Primitives for strings' do
+  describe '(pos S N)' do
+    it 'returns the character at zero-based index N of S as a unit string' do
+      kl_eval('(pos "ABC" 1)').should == "B"
+    end
+
+    it 'raises an error if N is negative' do
+      expect {
+        kl_eval('(pos "ABC" -1)')
+      }.to raise_error(Kl::Error, "out of bounds")
+    end
+
+    it 'raises an error if N is >= the length of S' do
+      expect {
+        kl_eval('(pos "ABC" 3)')
+      }.to raise_error(Kl::Error, "out of bounds")
+      expect {
+        kl_eval('(pos "ABC" 99)')
+      }.to raise_error(Kl::Error, "out of bounds")
+    end
+
+    include_examples 'argument types', %w(pos "string" 1),
+                     1 => [:string],
+                     2 => [:integer]
+    include_examples 'partially-applicable function', %w(pos "string" 1)
+    include_examples 'applicative order evaluation', %w(pos "string" 1)
+  end
+
+  describe '(tlstr S)' do
+    it 'returns a string containing all but the first character of S' do
+      kl_eval('(tlstr "string")').should == "tring"
+    end
+
+    it 'raises an error when S is the empty string' do
+      expect {
+        kl_eval('(tlstr "")')
+      }.to raise_error(Kl::Error, 'attempted to take tail of an empty string')
+    end
+
+    include_examples 'argument types', %w(tlstr "string"), 1 => [:string]
+    include_examples 'partially-applicable function', %w(tlstr "string")
+  end
+
+  describe 'string?' do
+    include_examples 'type predicate', 'string?', [:string]
+  end
+
+  describe '(n->string N)' do
+    it 'returns a unit string containing the character with ASCII code N' do
+      kl_eval('(n->string 65)').should == "A"
+    end
+
+    include_examples 'argument types', %w(n->string 65), 1 => [:integer]
+    include_examples 'partially-applicable function', %w(n->string 65)
+  end
+
+  describe '(string->n S)' do
+    it 'returns the ASCII code of the unit string S' do
+      kl_eval('(string->n "A")').should == 65
+    end
+
+    it 'returns the ASCII code of the first character of non-unit string S' do
+      kl_eval('(string->n "AB")').should == 65
+    end
+
+    it 'raises an error when S is the empty string' do
+      expect {
+        kl_eval('(string->n "")')
+      }.to raise_error(Kl::Error, 'attempted to get code point of empty string')
+    end
+
+    include_examples 'argument types', %w(string->n "A"), 1 => [:string]
+    include_examples 'partially-applicable function', %w(string->n "A")
+  end
+end

data/k_lambda_spec/primitives/symbols_spec.rb

@@ -0,0 +1,24 @@
+require 'spec_helper'
+
+describe 'Primitives for symbols' do
+  describe 'intern' do
+    it 'converts a string to its corresponding symbol' do
+      kl_eval('(intern "foo")').should == :foo
+    end
+
+    it 'supports characters not allowed in symbol literals' do
+      kl_eval('(intern "[{|}]")').should == :"[{|}]"
+    end
+
+    it 'converts the string "true" to boolean true' do
+      kl_eval('(intern "true")').should == true
+    end
+
+    it 'converts the string "false" to boolean false' do
+      kl_eval('(intern "false")').should == false
+    end
+
+    include_examples 'argument types', %w(intern "foo"), 1 => [:string]
+    include_examples 'partially-applicable function', %w(intern "foo")
+  end
+end

data/k_lambda_spec/primitives/vectors_spec.rb

@@ -0,0 +1,92 @@
+require 'spec_helper'
+
+describe 'Primitive functions for vectors' do
+  describe '(absvector N)' do
+    it 'returns a new absolute vector of size N' do
+      kl_eval('(absvector 3)').should be_kind_of Kl::Absvector
+    end
+
+    include_examples 'argument types', %w(absvector 7), 1 => [:integer]
+    include_examples 'partially-applicable function', %w(absvector 7)
+  end
+
+  describe '(address-> V N Value)' do
+    before(:each) do
+      kl_eval('(set *vec* (absvector 5))')
+    end
+
+    it 'returns the vector V updated with Value at index N' do
+      kl_eval('(address-> (value *vec*) 3 37)').should be_kind_of Kl::Absvector
+      kl_eval('(<-address (value *vec*) 3)').should == 37
+    end
+
+    it 'raises an error if N is negative' do
+      expect {
+        kl_eval('(address-> (value *vec*) -1 37)')
+      }.to raise_error(Kl::Error, "out of bounds")
+    end
+
+    it 'raises an error if N is >= the size of the vector' do
+      expect {
+        kl_eval('(address-> (value *vec*) 5 37)')
+      }.to raise_error(Kl::Error, "out of bounds")
+      expect {
+        kl_eval('(address-> (value *vec*) 99 37)')
+      }.to raise_error(Kl::Error, "out of bounds")
+    end
+
+    include_examples 'argument types',
+                     ['address->', '(value *vec*)', '0', '37'],
+                     1 => [:vector],
+                     2 => [:integer]
+    include_examples 'partially-applicable function',
+                     ['address->', '(value *vec*)', '0', '37']
+    include_examples 'applicative order evaluation',
+                     ['address->', '(value *vec*)', '0', '37']
+  end
+
+  describe '(<-address V N)' do
+    before(:each) do
+      kl_eval('(set *vec* (absvector 5))')
+    end
+
+    it 'returns the value previously stored at index N in V' do
+      kl_eval('(address-> (value *vec*) 3 37)')
+      kl_eval('(<-address (value *vec*) 3)').should == 37
+    end
+
+    it 'returns an unspecified value if index N has not been stored to' do
+      expect {
+        kl_eval('(<-address (value *vec*) 3)')
+      }.to_not raise_error
+    end
+
+    it 'raises an error if N is negative' do
+      expect {
+        kl_eval('(<-address (value *vec*) -1)')
+      }.to raise_error(Kl::Error, "out of bounds")
+    end
+
+    it 'raises an error if N is >= the size of the vector' do
+      expect {
+        kl_eval('(<-address (value *vec*) 5)')
+      }.to raise_error(Kl::Error, "out of bounds")
+      expect {
+        kl_eval('(<-address (value *vec*) 99)')
+      }.to raise_error(Kl::Error, "out of bounds")
+    end
+
+    include_examples 'argument types',
+                     ['<-address', '(value *vec*)', '0'],
+                     1 => [:vector],
+                     2 => [:integer]
+    include_examples 'partially-applicable function',
+                     ['address->', '(value *vec*)', '0', '37']
+    include_examples 'applicative order evaluation',
+                     ['address->', '(value *vec*)', '0', '37']
+  end
+
+  describe 'absvector?' do
+    include_examples 'type predicate', 'absvector?', [:vector]
+  end
+end

data/k_lambda_spec/support/shared_examples.rb

@@ -1,7 +1,7 @@
 # args should be an array containing the components of an example expression.
 # E.g., to test partial application of +, you could use:
 #
-#   include_examples "a partially-applicable function", %w(+ 1 2)
+#   include_examples "partially-applicable function", %w(+ 1 2)
 #
 # The expression will be evaluated in its fully-expanded form for reference
 # and then compared against various partial application scenarios.
@@ -20,7 +20,7 @@ end
 
 shared_examples "non-partially-applicable function" do |args|
   (0...(args.length - 1)).each do |arg_count|
-    description = "raises an error when applied to #{arg_count} argument"
+    description = "raises an error when given #{arg_count} argument"
     description << "s" unless arg_count == 1
     it description do
       partial_expression = "(#{args[0..arg_count].join(' ')})"
@@ -29,5 +29,96 @@ shared_examples "non-partially-applicable function" do |args|
       }.to raise_error(Kl::Error, "#{args[0]} expects #{args.length - 1} arguments but was given #{arg_count}")
     end
   end
+end
+
+# args should be an array containing the components of an example expression.
+# E.g., to test applicative order evaluation of +, you could use:
+#
+#   include_examples "applicative order evaluation", %w(+ 1 2)
+shared_examples 'applicative order evaluation' do |args|
+  it 'evaluates its arguments from left to right' do
+    operator = args.shift
+    arg_indexes = (0...args.size).to_a
+    instrumented_args = args.zip(arg_indexes).map do |(arg, idx)|
+      "(kl-do (set *arg-order* (cn (value *arg-order*) \"#{idx}\")) #{arg})"
+    end
+    expected = arg_indexes.join
+
+    define_kl_do
+    kl_eval('(set *arg-order* "")')
+    kl_eval("(#{operator} #{instrumented_args.join(' ')})")
+    kl_eval('(value *arg-order*)').should == expected
+  end
+end
+
+KL_TYPE_EXAMPLES = {
+  integer: '1',
+  real: '1.0',
+  string: '"a string"',
+  symbol: 'a-symbol',
+  boolean: 'true',
+  list: '(cons 1 ())',
+  dotted_pair: '(cons 1 2)',
+  empty_list: '()',
+  function: '(lambda X X)',
+  vector: '(absvector 3)'
+}
+
+def type_with_article(type)
+  name = type.to_s.gsub(/_/, ' ')
+  if [:integer, :empty_list].include?(type)
+    'an ' + name
+  else
+    'a ' + name
+  end
+end
+
+shared_examples 'type predicate' do |predicate, accepted_types|
+  accepted_types.each do |type|
+    it "returns true when its argument is #{type_with_article(type)}" do
+      kl_eval("(#{predicate} #{KL_TYPE_EXAMPLES[type]})").should == true
+    end
+  end
+
+  it 'returns false when its argument is of any other type' do
+    rejected_types = KL_TYPE_EXAMPLES.keys - accepted_types
+    rejected_types.each do |type|
+      kl_eval("(#{predicate} #{KL_TYPE_EXAMPLES[type]})").should == false
+    end
+  end
+end
+
+POSITION_NAMES = { 1 => 'first', 2 => 'second', 3 => 'third' }
 
+def types_to_s(types)
+  if types.length > 2
+    types[0..-2].map { |t| type_with_article(t) }.join(', ') +
+      ', or ' + type_with_article(types[-1])
+  else
+    types.map { |t| type_with_article(t) }.join(' or ')
+  end
+end
+
+shared_examples 'argument types' do |expr, accepted_argument_types|
+  accepted_argument_types.to_a.sort.each do |(idx, accepted_types)|
+    type_str = types_to_s(accepted_types)
+    it "raises an error if its #{POSITION_NAMES[idx]} argument is not #{type_str}" do
+      accepted_types.each do |type|
+        other_expr = expr.dup
+        other_expr[idx] = KL_TYPE_EXAMPLES[type]
+        expect {
+          kl_eval("(#{other_expr.join(' ')})")
+        }.to_not raise_error
+      end
+
+      rejected_types = KL_TYPE_EXAMPLES.keys - accepted_types
+      rejected_types.each do |type|
+        other_expr = expr.dup
+        other_expr[idx] = KL_TYPE_EXAMPLES[type]
+        expect {
+          kl_eval("(#{other_expr.join(' ')})")
+        }.to raise_error(Kl::Error, /is not a/)
+      end
+    end
+  end
 end

data/k_lambda_spec/tail_recursion_spec.rb

@@ -0,0 +1,30 @@
+require 'spec_helper'
+
+describe 'Tail recursion' do
+  it 'does not consume stack space for self tail calls' do
+    kl_eval <<-EOS
+      (defun count-down (X)
+        (if (= X 0)
+          success
+          (count-down (- X 1))))
+    EOS
+    kl_eval('(count-down 10000)').should == :success
+  end
+
+  it 'does not consume stack space for mutually recursive tail calls' do
+    kl_eval <<-EOS
+      (defun even? (X)
+        (if (= X 1)
+          false
+          (odd? (- X 1))))
+    EOS
+    kl_eval <<-EOS
+      (defun odd? (X)
+        (if (= X 1)
+          true
+          (even? (- X 1))))
+    EOS
+    kl_eval('(even? 100000)').should == true
+    kl_eval('(odd? 100000)').should == false
+  end
+end

data/lib/kl/compiler.rb

@@ -59,7 +59,7 @@ module Kl
         when :let
           compile_let(form, lexical_vars, in_tail_pos)
         when :freeze
-          compile_freeze(form, lexical_vars)
+          compile_freeze(form, lexical_vars, in_tail_pos)
         when :type
           compile_type(form, lexical_vars, in_tail_pos)
         when :if
@@ -78,10 +78,6 @@ module Kl
         # when all of their arguments are available.
         when :cons
           compile_cons(form, lexical_vars, in_tail_pos)
-        when :hd
-          compile_hd(form, lexical_vars, in_tail_pos)
-        when :tl
-          compile_tl(form, lexical_vars, in_tail_pos)
         when :"cons?"
           compile_consp(form, lexical_vars, in_tail_pos)
         else
@@ -93,10 +89,15 @@ module Kl
       def compile_defun(form, lexical_vars)
         name, arglist, body = destructure_form(form, 3)
         unless name.kind_of? Symbol
-          raise Kl::Error, 'first argument to defun must be a symbol'
+          raise Kl::Error, "#{name} is not a symbol"
         end
-        unless arglist.all? {|a| a.kind_of? Symbol}
-          raise Kl::Error, 'function argument list may only contain symbols'
+        unless [Kl::Cons, Kl::EmptyList].include? arglist.class
+          raise Kl::Error, "#{arglist} is not a list"
+        end
+        arglist.each do |arg|
+          unless arg.kind_of? Symbol
+            raise Kl::Error, "#{arg} is not a symbol"
+          end
         end
         if PRIMITIVE_ARITIES.has_key?(name)
           raise Kl::Error, "#{name} is primitive and may not be redefined"
@@ -115,7 +116,7 @@ module Kl
       def compile_lambda(form, lexical_vars)
         var, body = destructure_form(form, 2)
         unless var.kind_of? Symbol
-          raise Kl::Error, 'first argument to lambda must be a symbol'
+          raise Kl::Error, "#{var} is not a symbol"
         end
 
         extended_vars = add_var(lexical_vars, var)
@@ -142,12 +143,17 @@ module Kl
       end
 
       # (freeze EXPR)
-      def compile_freeze(form, lexical_vars)
-        expr = destructure_form(form, 1).first
+      def compile_freeze(form, lexical_vars, in_tail_pos)
+        if form.count == 2
+          expr = destructure_form(form, 1).first
 
-        body = compile(expr, lexical_vars, true)
+          body = compile(expr, lexical_vars, true)
 
-        "::Kernel.lambda { #{body} }"
+          "::Kernel.lambda { #{body} }"
+        else
+          # Partial application falls back to normal application
+          compile_application(form, lexical_vars, in_tail_pos)
+        end
       end
 
       # (type EXPR T)
@@ -257,26 +263,6 @@ module Kl
         end
       end
 
-      # Inlined version of (hd L)
-      def compile_hd(form, lexical_vars, in_tail_pos)
-        if form.count == 2
-          expr = compile(form.tl.hd, lexical_vars, false)
-          "(#{expr}).hd"
-        else
-          compile_application(form, lexical_vars, in_tail_pos)
-        end
-      end
-
-      # Inlined version of (tl L)
-      def compile_tl(form, lexical_vars, in_tail_pos)
-        if form.count == 2
-          expr = compile(form.tl.hd, lexical_vars, false)
-          "(#{expr}).tl"
-        else
-          compile_application(form, lexical_vars, in_tail_pos)
-        end
-      end
-
       # Inlined version of (cons? X)
       def compile_consp(form, lexical_vars, in_tail_pos)
         if form.count == 2