shen-ruby 0.1.0 → 0.2.0

data/HISTORY.md

@@ -0,0 +1,25 @@
+# ShenRuby Release History
+
+## 0.2.0 - January 16, 2013
+### Features
+- Graceful handling of Control-C in ShenRuby REPL [Bruno Deferrari]
+- Handle `do` in the K Lambda compiler so that it is eligible for tail call elimination [Bruno Deferrari]
+- Ruby->Shen interop
+  - Shen functions can now be called from Ruby by invoking the corresponding method on the `ShenRuby::Shen` instance
+  - Ruby arrays are coerced back and forth to K Lambda lists
+  - Underscores in Ruby symbols are coerced back and forth to hyphens in Shen symbols
+
+### Optimizations
+Compared to ShenRuby 0.1.0, 50% faster Shen REPL launch and 38% faster execution of the Shen Test Suite achieved by:
+- Faster application of K Lambda primitives when not partially applied
+- Inlining of list primitives when not partially applied
+
+### Bug Fixes
+- [Issue 4](https://github.com/gregspurrier/shen-ruby/issues/4) -- `and` and `or` may now be partially applied
+- [Issue 5](https://github.com/gregspurrier/shen-ruby/issues/4) -- the error raised by applying too many arguments to a function is now caught by `trap-error`.
+
+
+## 0.1.0 - December 30, 2012
+- First public release
+- Shen 7.1
+- Shen REPL available via `srrepl` executable

data/README.md

@@ -7,12 +7,12 @@ The ShenRuby project has two primary goals. The first is to be a low barrier-to-
 
 Second, ShenRuby aims to enable hybrid applications implemented using a combination of Ruby and Shen. Ruby methods should be able to invoke functions written in Shen and vice versa. Performance is a secondary part of this goal. It should be good enough that, for most tasks, the choice between Ruby and Shen is based primarily on which language is best suited for solving the problem at hand.
 
-ShenRuby 0.1.0 begins to satisfy the first goal by providing a Shen REPL accessible from the command line. The second goal is more ambitious and is the subject of ongoing work leading to the eventual 1.0.0 release.
+ShenRuby 0.1.0 began to satisfy the first goal by providing a Shen REPL accessible from the command line. The second goal is more ambitious and is the subject of ongoing work beginning with the 0.2.0 release and leading up to the eventual 1.0.0 release.
 
 ## Installation
-NOTE: ShenRuby requires Ruby 1.9 language features. It has been tested with Ruby 1.9.3 and, to a lesser extent, Rubnius in 1.9 mode. It it not yet passing the Shen Test Suite under JRuby.
+NOTE: ShenRuby requires Ruby 1.9 language features. It has been tested with Ruby 1.9.3-p362. It is not yet working under JRuby or Rubinius.
 
-ShenRuby 0.1.0 is the current release. To install it as gem, use the following command:
+ShenRuby 0.2.0 is the current release. To install it as gem, use the following command:
 
     gem install shen-ruby
 
@@ -20,19 +20,18 @@ ShenRuby 0.1.0 is the current release. To install it as gem, use the following c
 
 Once the gem has been installed, the Shen REPL can be launched via the `srrepl` (short for ShenRuby REPL) command. For example:
 
-
     % srrepl
-    Loading Shen.... Completed in 18.61 seconds.
+    Loading.... Completed in 9.93 seconds.
     
     Shen 2010, copyright (C) 2010 Mark Tarver
     www.shenlanguage.org, version 7.1
     running under Ruby, implementation: ruby 1.9.3
-    port 0.1.0 ported by Greg Spurrier
+    port 0.2.0 ported by Greg Spurrier
     
     
     (0-) 
     
-Please be patient: the Shen REPL takes a while to load (about 20 seconds on a 2.66 GHz MacBook Pro). This will be addressed in future releases.
+Please be patient: the Shen REPL takes a while to load (about 10 seconds on a 2.66 GHz MacBook Pro). This will be addressed in future releases.
 
 The `(0-)` seen above is the Shen REPL prompt. The number in the prompt increases after each expression that is entered.
 
@@ -63,6 +62,73 @@ To exit the Shen REPL, execute the `quit` function:
     (4-) (quit)
     %
 
+## Ruby<->Shen Interop
+Bidirectional interaction between Ruby and Shen is a primary goal of ShenRuby. The following sections describe the currently supported means of collaboration between Shen and Ruby.
+
+These APIs should be considered experimental and likely to evolve as ShenRuby progresses toward 1.0.
+
+### Extending the Shen Environment with Ruby Functions
+
+The Shen Environment may be extended with functions written in Ruby. Any instance method added to the ShenRuby::Shen class--whether through subclassing or adding methods to an instance's eigenclass--is available for invocation from within Shen.
+
+For example, to add a `divides?` function to an existing Shen environment object:
+
+    require 'rubygems'
+    require 'shen_ruby'
+    
+    shen = ShenRuby::Shen.new
+    class << shen
+      def divides?(a, b)
+        b % a == 0
+      end
+    end
+
+### Evaluating Shen Expressions from Ruby
+`ShenRuby::Shen#eval_string` takes a string and evaluates it as a Shen expression within the environment. For example, the `divides?` function added above may be invoked with:
+
+    shen.eval_string "(divides? 3 9)"
+    # => true
+    
+More commonly, though, `eval_string` is used with Shen `define` expressions to extend the environment with new functions that are implemented in Shen. For example, let's add a [Fizz Buzz](http://en.wikipedia.org/wiki/Fizz_buzz) function:
+
+    shen.eval_string <<-EOS
+      (define fizz-buzz
+        X -> "Fizz Buzz" where (and (divides? 3 X)
+                                   (divides? 5 X))
+        X -> "Fizz" where (divides? 3 X)
+        X -> "Buzz" where (divides? 5 X)
+        X -> (str X))
+    EOS
+    # => :"fizz-buzz"
+
+### Invoking Shen Functions from Ruby
+
+A better way to invoke most Shen functions from Ruby is to simply invoke the corresponding method on the Shen object. If the Shen function's name includes a hyphen, use an underscore instead.
+
+For example, to use the `fizz-buzz` function defined in the previous section to compute the first 20 Fizz Buzz values:
+
+    (1..20).map { |x| shen.fizz_buzz(x) }
+    # => ["1", "2", "Fizz", "4", "Buzz", "Fizz", "7", "8", "Fizz", "Buzz", "11", "Fizz", "13", "14", "Fizz Buzz", "16", "17", "Fizz", "19", "Buzz"] 
+
+The above example uses Ruby's `map` function, but could also have used Shen's version, relying on ShenRuby's interop features to coerce Ruby arrays to and from Shen lists:
+
+    shen.map(:fizz_buzz, (1..20).to_a)
+    # => ["1", "2", "Fizz", "4", "Buzz", "Fizz", "7", "8", "Fizz", "Buzz", "11", "Fizz", "13", "14", "Fizz Buzz", "16", "17", "Fizz", "19", "Buzz"]
+
+Note that the Ruby symbol `:fizz_buzz` is automatically coerced to the Shen symbol `fizz-buzz` so that refer to the function defined above.
+
+As a final example, Ruby functions may be passed as arguments to higher-order Shen functions:
+
+    shen.map(lambda {|x| x * x}, [1, 2, 3, 4, 5])
+    # => [1, 4, 9, 16, 25]
+
+#### Caveats
+Shen function invocation via methods on the Shen object only works for normal functions. It will not work for special forms like `define`.
+
+The array<->list and underscore<->hyphen automatic coercions do not take effect for Ruby functions that are added to the Shen environment or for the K Lambda [primitives](http://www.shenlanguage.org/documentation/shendoc.htm#The%20Primitive%20Functions%20of%20K%20Lambda) that form the basis of Shen. In practice, this should not be much of a limitation, but it is hoped that this restriction will be lifted in the future.
+
+Shen functions cannot be passed as arguments to functions defined in Ruby. This restriction will be removed in the future.
+
 ## Shen Resources
 
 The following resources may be helpful for those wanting to learn more about the Shen programming language:
@@ -78,17 +144,22 @@ The following resources may be helpful for those wanting to learn more about the
 
 The following features and improvements are among those planned for ShenRuby as it approaches its 1.0 release:
 
-- Ability to call Shen functions directly from Ruby
 - Ability to call Ruby methods directly from Shen
 - Support for command-line Shen scripts that under ShenRuby
-- Support for MRI, JRuby, and Rubinius
+- Support for JRuby and Rubinius
 - Improved performance
 
 ## Known Limitations
+- The "Qi interpreter - chapter 13" test case in the Shen Test Suite and some of the benchmarks are currently failing with stack overflow errors.
+- ShenRuby fails with a stack overflow when run under cygwin on Windows ([Issue #3](https://github.com/gregspurrier/shen-ruby/issues/3)). The Ruby environment installed by [RubyInstaller](http://rubyinstaller.org/), however, is capable of running ShenRuby. It is the recommended environment for running ShenRuby on Windows until the stack overflow issues seen on cygwin can be addressed.
+- ShenRuby fails to load under JRuby ([Issue #6](https://github.com/gregspurrier/shen-ruby/issues/6)) and Rubinius ([Issue #])(https://github.com/gregspurrier/shen-ruby/issues/7)].
+
+## Contributors
+The following people are gratefully acknowledged for their contributions of code to ShenRuby:
 
-The "Qi interpreter - chapter 13" test case in the Shen Test Suite and some of the benchmarks are currently failing with stack overflow errors.
+- Bruno Deferrari
 
 ## License
 Shen is Copyright (c) 2010-2012 Mark Tarver and released under the Shen License. A copy of the Shen License may be found in [shen/license.txt](https://github.com/gregspurrier/shen-ruby/blob/master/shen/license.txt). A detailed description of the license, along with questions and answers, may be found at http://shenlanguage.org/license.html. The entire contents of the [shen directory](https://github.com/gregspurrier/shen-ruby/tree/master/shen), including the implementation of the `ShenRuby::Shen` class, is part of Shen and is subject to the Shen license.
 
-The remainder of ShenRuby--i.e., everything outside of the shen directory--is Copyright (c) 2012 Greg Spurrier and released under the MIT License. A copy of the MIT License may be found in [MIT_LICENSE.txt](https://github.com/gregspurrier/shen-ruby/blob/master/MIT_LICENSE.txt).
+The remainder of ShenRuby--i.e., everything outside of the shen directory--is Copyright (c) 2012-2013 Greg Spurrier and released under the MIT License. A copy of the MIT License may be found in [MIT_LICENSE.txt](https://github.com/gregspurrier/shen-ruby/blob/master/MIT_LICENSE.txt).

data/bin/srrepl

@@ -1,6 +1,9 @@
 #!/usr/bin/env ruby
 require 'shen_ruby'
 
+# Leave gracefully if someone hits Control-C during loading
+Signal.trap("INT") { puts "\nLeaving..."; exit 1 }
+
 # Load the Shen Envinronment
 print "Loading..."
 STDOUT.flush
@@ -9,6 +12,11 @@ shen = ShenRuby::Shen.new
 now = Time.now.to_f
 puts ". Completed in %0.2f seconds.\n" % (now - start)
 
+# Now that the Shen environment is loaded, repurpose the SIGINT
+# handler to interrupt the current execution.
+class ReplInterrupt < StandardError; end
+Signal.trap("INT") { raise ReplInterrupt }
+
 # Launch the REPL
 command = :"shen-shen"
 begin
@@ -17,7 +25,11 @@ rescue StandardError => e
   # K Lambda simple errors are already handled by the Shen REPL. Therefore
   # this must be another type of exception. Print it as such and reenter
   # the REPL without re-display the initial credits.
-  puts "Ruby exception: #{e.message}"
+  if e.kind_of? ReplInterrupt
+    puts "Execution interrupted. If you are trying to exit the REPL, use (quit)."
+  else
+    puts "Ruby exception: #{e.message}"
+  end
   command = :"shen-loop"
   retry
 end

data/k_lambda_spec/atom_spec.rb

@@ -0,0 +1,85 @@
+require 'spec_helper'
+
+describe 'Atoms:' do
+  describe 'a string' do
+    it 'is self-evaluating' do
+      kl_eval('"string"').should == 'string'
+    end
+  end
+
+  describe 'a symbol' do
+    it 'is self-evaluating' do
+      kl_eval('symbol').should == :symbol
+    end
+
+    it 'may include any of the legal characters for symbol' do
+      # See http://www.shenlanguage.org/documentation/shendoc.htm#The%20Syntax%20of%20Symbols
+      all_legal_chars = 'abcdefghijklmnopqrstuvwxyz' +
+          'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
+          '0123456789' +
+          '=-*/+_?$!@~.><&%\'#`;:{}'
+      kl_eval(all_legal_chars).should == all_legal_chars.to_sym
+    end
+
+    it 'may begin with any legal character other than a digit' do
+      legal_non_digits = 'abcdefghijklmnopqrstuvwxyz' +
+          'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
+          '=-*/+_?$!@~.><&%\'#`;:{}'
+      legal_non_digits.each_char do |char|
+        kl_eval(char).should == char.to_sym
+      end
+    end
+
+    it 'may not begin with a digit' do
+      digits = '01234567890'
+      digits.each_char do |char|
+        kl_eval(char).should_not be_kind_of Symbol
+      end
+    end
+  end
+
+  describe 'numbers' do
+    it 'parses integers as integers' do
+      result = kl_eval('123')
+      result.should == 123
+      result.should be_kind_of Fixnum
+    end
+
+    it 'parses floating point numbers as reals' do
+      result = kl_eval('12.3')
+      result.should == 12.3
+      result.should be_kind_of Float
+    end
+
+    describe 'with leading sign characters' do
+      it 'recognizes negative numbers' do
+        kl_eval('-123').should == -123
+      end
+
+      it 'treats any odd number of minuses as negative' do
+        kl_eval('---123').should == -123
+      end
+
+      it 'treats any even number of minuses as positive' do
+        kl_eval('----123').should == 123
+      end
+
+      it 'ignores leading plusses' do
+        kl_eval('+123').should == 123
+        kl_eval('--+-123').should == -123
+      end
+    end
+  end
+
+  describe 'true' do
+    it 'evaluates to boolean true rather than a symbol' do
+      kl_eval('true').should == true
+    end
+  end
+
+  describe 'false' do
+    it 'evaluates to boolean false rather than a symbol' do
+      kl_eval('false').should == false
+    end
+  end
+end

data/k_lambda_spec/primitives/boolean_operations_spec.rb

@@ -0,0 +1,136 @@
+require 'spec_helper'
+
+describe 'Primitives for Boolean Operations' do
+  describe 'if special form' do
+    include_examples "non-partially-applicable function", %w(if true a b)
+
+    it 'evaluates its first argument' do
+      define_kl_do
+      kl_eval('(set flag clear)')
+      kl_eval('(if (kl-do (set flag set) true) a b)')
+      kl_eval('(value flag)').should == :set
+    end
+
+    describe 'when its first argument evaluates to true' do
+      it 'returns the normal form of its second argument' do
+        kl_eval('(if true (+ 1 2) 10)').should == 3
+      end
+
+      it 'does not evaluate its third argument' do
+        define_kl_do
+        kl_eval('(set flag clear)')
+        kl_eval('(if true 1 (kl-do (set flag set) 2))')
+        kl_eval('(value flag)').should == :clear
+      end
+    end
+
+    describe 'when its first argument evaluates to false' do
+      it 'returns the normal form of its third argument' do
+        kl_eval('(if false 1 (+ 1 2))').should == 3
+      end
+
+      it 'does not evaluate its second argument' do
+        define_kl_do
+        kl_eval('(set flag clear)')
+        kl_eval('(if false (kl-do (set flag set) 1) 2)')
+        kl_eval('(value flag)').should == :clear
+      end
+    end
+  end
+
+  describe 'and special form' do
+    it 'evaluates its first argument' do
+      define_kl_do
+      kl_eval('(set flag clear)')
+      kl_eval('(and (kl-do (set flag set) true) false)')
+      kl_eval('(value flag)').should == :set
+    end
+
+    describe 'when its first argument evaluates to true' do
+      it 'returns true if its second argument evaluates to true' do
+        kl_eval('(defun return-true () true)')
+        kl_eval('(and true (return-true))').should == true
+      end
+
+      it 'returns false if its second argument evaluates to false' do
+        kl_eval('(defun return-false () false)')
+        kl_eval('(and true (return-false))').should == false
+      end
+    end
+
+    describe 'when its first argument evaluates to false' do
+      it 'returns false' do
+        kl_eval('(and false true)').should == false
+      end
+
+      it 'does not evaluate it second argument' do
+        kl_eval('(set flag clear)')
+        kl_eval('(and false (kl-do (set flag set) true))').should == false
+        kl_eval('(value flag)').should == :clear
+      end
+    end
+
+    describe 'partial application' do
+      include_examples "partially-applicable function", %w(and true false)
+
+      it 'results in it no longer short-circuiting argument evaluation' do
+        define_kl_do
+        kl_eval('(set flag clear)')
+        kl_eval('((and false) (kl-do (set flag set) false)))').should == false
+        kl_eval('(value flag)').should == :set
+      end
+    end
+
+    it 'may be passed as an argument to a higher-order function' do
+      kl_eval('((lambda F (F true false)) and)').should == false
+    end
+  end
+
+  describe 'or special form' do
+    it 'evaluates its first argument' do
+      define_kl_do
+      kl_eval('(set flag clear)')
+      kl_eval('(or (kl-do (set flag set) false) false)')
+      kl_eval('(value flag)').should == :set
+    end
+
+    describe 'when its first argument evaluates to false' do
+      it 'returns true if its second argument evaluates to true' do
+        kl_eval('(defun return-true () true)')
+        kl_eval('(or false (return-true))').should == true
+      end
+
+      it 'returns false if its second argument evaluates to false' do
+        kl_eval('(defun return-false () false)')
+        kl_eval('(or false (return-false))').should == false
+      end
+    end
+
+    describe 'when its first argument evaluates to true' do
+      it 'returns true' do
+        kl_eval('(or true false)').should == true
+      end
+
+      it 'does not evaluate it second argument' do
+        kl_eval('(set flag clear)')
+        kl_eval('(or true (kl-do (set flag set) false))').should == true
+        kl_eval('(value flag)').should == :clear
+      end
+    end
+
+    describe 'partial application' do
+      include_examples "partially-applicable function", %w(or false true)
+
+      it 'results in it no longer short-circuiting argument evaluation' do
+        define_kl_do
+        kl_eval('(set flag clear)')
+        kl_eval('((or true) (kl-do (set flag set) false)))').should == true
+        kl_eval('(value flag)').should == :set
+      end
+    end
+
+    it 'may be passed as an argument to a higher-order function' do
+      kl_eval('((lambda F (F true true)) or)').should == true
+    end
+  end
+end

data/k_lambda_spec/primitives/generic_functions_spec.rb

@@ -0,0 +1,7 @@
+require 'spec_helper'
+
+describe 'Primitives for Generic Functions' do
+  describe 'freeze' do
+    # Should the frozen result be re-evaluated on each thaw?
+  end
+end

data/k_lambda_spec/spec_helper.rb

@@ -0,0 +1,29 @@
+lib_path = File.expand_path("../../lib", __FILE__)
+$LOAD_PATH << lib_path unless $LOAD_PATH.include?(lib_path)
+
+require 'kl'
+require 'stringio'
+
+# Load the support files
+Dir["./k_lambda_spec/support/**/*.rb"].sort.each {|f| require f}
+
+# Reset the K Lambda environment before every example
+RSpec.configure do |config|
+  config.before(:each) do
+    @kl_env = Kl::Environment.new
+  end
+end
+
+# Helper function that evaluates a string in the K Lambda environment and
+# returns the result as a Ruby object.
+def kl_eval(str)
+  form = Kl::Reader.new(StringIO.new(str)).next
+  @kl_env.__eval(form)
+end
+
+# Defines the 'kl-do' function in the current K Lambda environment. This is
+# used instead of 'do' because do is not an official K Lambda primitive
+# and may not be found in all K Lambda implementations.
+def define_kl_do
+  kl_eval('(defun kl-do (X Y) Y)')
+end

data/k_lambda_spec/support/shared_examples.rb

@@ -0,0 +1,33 @@
+# 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)
+#
+# The expression will be evaluated in its fully-expanded form for reference
+# and then compared against various partial application scenarios.
+shared_examples "partially-applicable function" do |args|
+  full_expression = "(#{args.join(' ')})"
+  (0...(args.length - 1)).each do |arg_count|
+    description = "supports partial application of #{arg_count} argument"
+    description << "s" unless arg_count == 1
+    it description do
+      full_result = kl_eval(full_expression)
+      partial_expression = "((#{args[0..arg_count].join(' ')}) #{args[(arg_count + 1)..-1].join(' ')})"
+      kl_eval(partial_expression).should == full_result
+    end
+  end
+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 << "s" unless arg_count == 1
+    it description do
+      partial_expression = "(#{args[0..arg_count].join(' ')})"
+      expect {
+        kl_eval(partial_expression)
+      }.to raise_error(Kl::Error, "#{args[0]} expects #{args.length - 1} arguments but was given #{arg_count}")
+    end
+  end
+
+end

data/lib/kl/compiler.rb

@@ -1,5 +1,27 @@
 module Kl
   module Compiler
+    # The K Lambda primitives are all Ruby functions and never use
+    # trampolines. They are all regarded as System Functions and
+    # therefore are not allowed to be redefined by the user at
+    # run time. Therefore, if all of their arguments have been
+    # supplied, it is safe to directly invoke them rather than going
+    # incurring the overhead of using __apply. This table holds the
+    # arities of the primitives and is used to determine whether
+    # direct invocation is possible.
+    # Kl::Primitives::Extensions is purposely omitted from this list
+    # so that it may be overridden by Shen.
+    PRIMITIVE_ARITIES = {}
+    [Kl::Primitives::Arithmetic, Kl::Primitives::Assignments,
+     Kl::Primitives::Booleans, Kl::Primitives::ErrorHandling,
+     Kl::Primitives::GenericFunctions, Kl::Primitives::Lists,
+     Kl::Primitives::Streams, Kl::Primitives::Strings,
+     Kl::Primitives::Symbols, Kl::Primitives::Time,
+     Kl::Primitives::Vectors].each do |prim_mod|
+      prim_mod.instance_methods.each do |name|
+        PRIMITIVE_ARITIES[name] = prim_mod.instance_method(name).arity
+      end
+    end
+
     class << self
       def compile(form, lexical_vars, in_tail_pos)
         case form
@@ -48,8 +70,20 @@ module Kl
           compile_or(form, lexical_vars, in_tail_pos)
         when :cond
           compile_cond(form, lexical_vars, in_tail_pos)
+        when :do
+          compile_do(form, lexical_vars, in_tail_pos)
         when :"trap-error"
           compile_trap_error(form, lexical_vars, in_tail_pos)
+        # cons, hd, tl, and cons? are crucial to performance and are inlined
+        # 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
           compile_application(form, lexical_vars, in_tail_pos)
         end
@@ -64,15 +98,17 @@ module Kl
         unless arglist.all? {|a| a.kind_of? Symbol}
           raise Kl::Error, 'function argument list may only contain symbols'
         end
+        if PRIMITIVE_ARITIES.has_key?(name)
+          raise Kl::Error, "#{name} is primitive and may not be redefined"
+        end
 
         extended_vars = add_vars(lexical_vars, arglist.to_a)
 
         fn_name = escape_symbol(name)
         fn_args = arglist.map { |arg| extended_vars[arg] }.join(",")
-        fn_arity = arglist.count
         fn_body = compile(body, extended_vars, true)
 
-        "(@eigenklass.send(:define_method, #{fn_name}, ::Kernel.lambda { |#{fn_args}| #{fn_body}}); @arity_cache[#{fn_name}] = #{fn_arity}; #{fn_name})"
+        "(@functions[#{fn_name}] = ::Kernel.lambda { |#{fn_args}| #{fn_body}}; #{fn_name})"
       end
 
       # (lambda VAR BODY)
@@ -134,16 +170,27 @@ module Kl
 
       # (and EXPR1 EXPR2)
       def compile_and(form, lexical_vars, in_tail_pos)
-        expr1, expr2 = destructure_form(form, 2)
-        compile_if(Kl::Cons.list([:if, expr1, expr2, false]),
-                   lexical_vars, in_tail_pos)
+        if form.count == 3
+          # This is the special form case
+          expr1, expr2 = destructure_form(form, 2)
+          compile_if(Kl::Cons.list([:if, expr1, expr2, false]),
+                     lexical_vars, in_tail_pos)
+        else
+          # Partial application falls back to normal application
+          compile_application(form, lexical_vars, in_tail_pos)
+        end
       end
 
       # (or EXPR1 EXPR2)
       def compile_or(form, lexical_vars, in_tail_pos)
-        expr1, expr2 = destructure_form(form, 2)
-        compile_if(Kl::Cons.list([:if, expr1, true, expr2]),
-                   lexical_vars, in_tail_pos)
+        if form.count == 3
+          expr1, expr2 = destructure_form(form, 2)
+          compile_if(Kl::Cons.list([:if, expr1, true, expr2]),
+                     lexical_vars, in_tail_pos)
+        else
+          # Partial application falls back to normal application
+          compile_application(form, lexical_vars, in_tail_pos)
+        end
       end
 
       def compile_cond(form, lexical_vars, in_tail_pos)
@@ -161,6 +208,26 @@ module Kl
         end
       end
 
+      # (do EXPR1 EXPR2)
+      # 'do' is not a K Lambda primitive, and is defined in the Shen sources as
+      # a function that receives two arguments, and returns the last one.
+      # 'do' being a function means that the compiler will not see EXPR2 as
+      # being in tail-position, inhibiting TCO.
+      # To work around this, calls to 'do' are compiled to a sequence of
+      # expressions instead of calls to a 'do' function, by doing this, EXPR2
+      # has the potential to be in tail position and optimized as such.
+      def compile_do(form, lexical_vars, in_tail_pos)
+        if form.count == 3
+          expr1, expr2 = destructure_form(form, 2)
+          body1 = compile(expr1, lexical_vars, false)
+          body2 = compile(expr2, lexical_vars, in_tail_pos)
+          "(#{body1}; #{body2})"
+        else
+          # Partial application falls back to normal application
+          compile_application(form, lexical_vars, in_tail_pos)
+        end
+      end
+
       # (trap-error EXPR ERR_HANDLER)
       def compile_trap_error(form, lexical_vars, in_tail_pos)
         expr, err_handler = destructure_form(form, 2)
@@ -178,29 +245,78 @@ module Kl
           "#{catch_clause}; end)"
       end
 
+      # Inlined version of (cons HD TL)
+      def compile_cons(form, lexical_vars, in_tail_pos)
+        if form.count == 3
+          hd, tl = destructure_form(form, 2)
+          hd_expr = compile(hd, lexical_vars, false)
+          tl_expr = compile(tl, lexical_vars, false)
+          "::Kl::Cons.new(#{hd_expr}, #{tl_expr})"
+        else
+          compile_application(form, lexical_vars, in_tail_pos)
+        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
+          expr = compile(form.tl.hd, lexical_vars, false)
+          "(#{expr}).kind_of?(::Kl::Cons)"
+        else
+          compile_application(form, lexical_vars, in_tail_pos)
+        end
+      end
+
       # Normal function application
       def compile_application(form, lexical_vars, in_tail_pos)
         f = form.hd
         args = form.tl
-        
-        rator = compile(f, lexical_vars, false)
-        rands = args.map { |arg| compile(arg, lexical_vars, false) }.join(',')
-
-        tfn = gen_sym
-        targs = gen_sym
-
-        if in_tail_pos
-          "(
-             #{tfn} = #{rator};
-             #{targs} = [#{rands}];
-             @tramp_fn = #{tfn};
-             @tramp_args = #{targs}
-            )"
+
+        if PRIMITIVE_ARITIES[f] == args.count
+          # This is a non-partial primitive application. No need for __apply
+          # or trampolines.
+          send_args = form.map {|f| compile(f, lexical_vars, false)}.join(',')
+          "send(#{send_args})"
         else
-          "__apply(#{rator}, [#{rands}])"
+          rator = compile(f, lexical_vars, false)
+          rands = args.map { |arg| compile(arg, lexical_vars, false) }.join(',')
+
+          if in_tail_pos
+            tfn = gen_sym
+            targs = gen_sym
+
+            "(
+               #{tfn} = #{rator};
+               #{targs} = [#{rands}];
+               @tramp_fn = #{tfn};
+               @tramp_args = #{targs}
+              )"
+          else
+            "__apply(#{rator}, [#{rands}])"
+          end
         end
       end
-      
+
       # Escape single quotes and backslashes
       def escape_string(str)
         new_str = ""

data/lib/kl/environment.rb

@@ -1,4 +1,3 @@
-require 'kl/compiler'
 require 'kl/primitives/booleans'
 require 'kl/primitives/symbols'
 require 'kl/primitives/strings'
@@ -10,6 +9,8 @@ require 'kl/primitives/vectors'
 require 'kl/primitives/streams'
 require 'kl/primitives/time'
 require 'kl/primitives/arithmetic'
+require 'kl/primitives/extensions'
+require 'kl/compiler'
 
 module Kl
   class Environment
@@ -24,52 +25,47 @@ module Kl
     include ::Kl::Primitives::Streams
     include ::Kl::Primitives::Time
     include ::Kl::Primitives::Arithmetic
+    include ::Kl::Primitives::Extensions
 
     def initialize
       @dump_code = false
       @tramp_fn = @tramp_args  = nil
-      @variables = {}
+      @variables = Hash.new do |_, k|
+        raise Kl::Error, "variable #{k} has no value"
+      end
+      @functions = Hash.new do |h, k|
+        if respond_to? k
+          fn = method(k).to_proc
+          h[k] = fn
+        else
+          raise Kl::Error, "The function #{k} is undefined"
+        end
+      end
       @eigenklass = class << self; self; end
-      @arity_cache = Hash.new { |h, k| h[k] = method(k).arity }
     end
 
     # Trampoline-aware function application
     def __apply(fn, args)
       while fn
         @tramp_fn = nil
-        if fn.kind_of? Symbol
-          if respond_to? fn
-            arity = @arity_cache[fn]
-            if arity == args.size || arity == -1
-              result = send(fn, *args)
-            elsif arity > args.size
-              # Partial application
-              result = method(fn).to_proc.curry.call(*args)
-            else
-              # Uncurrying. Apply fn to its expected number of arguments
-              # and hope that the result is a function that can be applied
-              # to the remainder.
-              fn = __apply(fn, args[0, arity])
-              args = args[arity..-1]
-              next
-            end
-          else
-            raise Kl::Error,  "The function #{fn} is undefined"
-          end
+        fn = @functions[fn] if fn.kind_of? Symbol
+        arity = fn.arity
+        if arity == args.size || arity == -1
+          result = fn.call(*args)
+        elsif arity > args.size
+          # Partial application
+          result = fn.curry.call(*args)
         else
-          arity = fn.arity
-          if arity == args.size || arity == -1
-            result = fn.call(*args)
-          elsif arity > args.size
-            result = fn.curry.call(*args)
-          else
-            # Uncurrying. Apply fn to its expected number of arguments
-            # and hope that the result is a function that can be applied
-            # to the remainder.
-            fn = __apply(fn, args[0, arity])
-            args = args[arity..-1]
-            next
+          # Uncurrying. Apply fn to its expected number of arguments
+          # and hope that the result is a function that can be applied
+          # to the remainder.
+          fn = __apply(fn, args[0, arity])
+          unless fn.kind_of?(Proc) || fn.kind_of?(Symbol)
+            raise ::Kl::Error,
+                  "The value #{str(fn)} is neither a function nor a symbol."
           end
+          args = args[arity..-1]
+          next
         end
 
         if fn = @tramp_fn
@@ -109,6 +105,27 @@ module Kl
       end
     end
 
+    def method_missing(f, *args)
+      if @functions.has_key?(f)
+        fn = @functions[f]
+      else
+        coerced_f = Kl::Environment.ruby_to_kl(f)
+        if @functions.has_key?(coerced_f)
+          fn = @functions[coerced_f]
+        else
+          super
+        end
+      end
+      coerced_args = args.map { |arg| Kl::Environment.ruby_to_kl(arg)}
+      Kl::Environment.kl_to_ruby(__apply(fn, coerced_args))
+    end
+
+    def respond_to?(f)
+      @functions.has_key?(f) ||
+        @functions.has_key?(Kl::Environment.ruby_to_kl(f)) ||
+          super
+    end
+
     class << self
       def load_file(env, path)
         File.open(path, 'r') do |file|
@@ -118,6 +135,28 @@ module Kl
           end
         end
       end
+
+      # Coerce Ruby types and conventions to K Lambda
+      def kl_to_ruby(x)
+        if x.kind_of? Kl::Cons
+          x.to_a.map { |y| kl_to_ruby(y) }
+        elsif x.kind_of? Symbol
+          x.to_s.gsub(/-/, '_').to_sym
+        else
+          x
+        end
+      end
+
+      # Coerce K Lambda types and conventions to Ruby
+      def ruby_to_kl(x)
+        if x.kind_of? Array
+          Kl::Cons.list(x.map {|x| ruby_to_kl(x)})
+        elsif x.kind_of? Symbol
+          x.to_s.gsub(/_/, '-').to_sym
+        else
+          x
+        end
+      end
     end
   end
 end

data/lib/kl/primitives/assignments.rb

@@ -7,11 +7,7 @@ module Kl
       end
 
       def value(sym)
-        if @variables.has_key?(sym)
-          @variables[sym]
-        else
-          raise Kl::Error, "variable #{sym} has no value"
-        end
+        @variables[sym]
       end
     end
   end

data/lib/kl/primitives/extensions.rb

@@ -0,0 +1,12 @@
+module Kl
+  module Primitives
+    # Extensions to the official set of K Lambda primitives.
+    # Unlike the official primitives, these are allowed to be overridden
+    # by the Shen sources later.
+    module Extensions
+      define_method 'do' do |a, b|
+        b
+      end
+    end
+  end
+end

data/lib/kl/reader.rb

@@ -21,20 +21,26 @@ module Kl
 
     def read_list
       items = []
+      stack = [items]
 
-      loop do
+      until stack.empty? do
         token = @lexer.next
         raise Kl::Error, 'Unterminated list' if token.nil?
         case token
         when Kl::Lexer::OpenParen
-          items << read_list
+          items = []
+          stack.push items
         when Kl::Lexer::CloseParen
-          break
+          list = Kl::Cons.list(stack.pop)
+          unless stack.empty?
+            items = stack.last
+            items << list
+          end
         else
           items << token
         end
       end
-      Kl::Cons.list(items)
+      list
     end
   end
 end

data/lib/shen_ruby/version.rb

@@ -1,3 +1,3 @@
 module ShenRuby
-  VERSION = "0.1.0"
+  VERSION = "0.2.0"
 end

data/shen/lib/shen_ruby/shen.rb

@@ -110,6 +110,18 @@ module ShenRuby
         define_method 'set-dump-code' do |val|
           @dump_code = val
         end
+
+        # Add a way to evaluate strings, intended for use with Ruby interop.
+        # Returns the result of the last expression evaluated.
+        # Based on the implementation of read-file in reader.shen
+        def eval_string(s)
+          byte_list = Kl::Cons.list(s.bytes.to_a)
+          form = __apply(:compile, [:"shen-<st_input>", byte_list, :"read-error"])
+          result = nil
+          form.each { |f| result = __apply(:eval, [f]) }
+          result
+        end
+        alias_method :"eval-string", :eval_string
       end
 
       # Load the rest of the K Lambda files

data/spec/kl/environment_spec.rb

@@ -95,9 +95,11 @@ describe Kl::Environment do
     end
 
     it 'exposes the function for use in Ruby' do
-      pending "a clean way to handle trampolines when calling from outside"
       eval_str('(defun add7 (X) (+ X 7))')
       @env.add7(30).should == 37
+
+      eval_str('(defun add14 (X) (add7 (add7 X)))')
+      @env.add14(7).should == 21
     end
 
     it 'redefines existing functions' do
@@ -112,79 +114,15 @@ describe Kl::Environment do
                   (defun return-X () X)) 7)').should == :"return-X"
       eval_str('(return-X)').should == 7
     end
-  end
-
-  describe 'evaluation of boolean special forms' do
-    describe "if" do
-      before(:each) do
-        eval_str('(defun one () 1)')
-        eval_str('(defun two () 2)')
-      end
-
-      it 'evaluates and returns the true clause when given true' do
-        @env.should_receive(:one).and_return(1)
-        @env.should_not_receive(:two)
-        eval_str('(if true (one) (two))').should == 1
-      end
-
-      it 'evaluates and returns the false clause when given false' do
-        @env.should_not_receive(:one)
-        @env.should_receive(:two).and_return(2)
-        eval_str('(if false (one) (two))').should == 2
-      end
-    end
-
-    describe "and" do
-      before(:each) do
-        eval_str('(defun tr () true)')
-        eval_str('(defun fa () false)')
-      end
-
-      it 'returns false and does not evaluate second form if first is false' do
-        @env.should_not_receive(:tr)
-        eval_str('(and (fa) (tr))').should == false
-      end
-
-      it 'returns false when first is true and second is false' do
-        eval_str('(and (tr) (fa))').should == false
-      end
-
-      it 'returns true when both expressions evaluate to true' do
-        @env.should_receive(:tr).twice.and_return(true)
-        eval_str('(and (tr) (tr))').should == true
-      end
-
-      it 'may be passed as an argument to higher order functions' do
-        eval_str('((lambda Op (Op true true)) and)').should == true
-      end
-    end
-
-    describe "or" do
-      before(:each) do
-        eval_str('(defun tr () true)')
-        eval_str('(defun fa () false)')
-      end
-
-      it 'returns true and does not evaluate second form if first is true' do
-        @env.should_not_receive(:fa)
-        eval_str('(or (tr) (fa))').should == true
-      end
-
-      it 'returns true when first is false and second is true' do
-        eval_str('(or (fa) (tr))').should == true
-      end
-
-      it 'returns false when both expressions evaluate to false' do
-        @env.should_receive(:fa).twice.and_return(false)
-        eval_str('(or (fa) (fa))').should == false
-      end
-
-      it 'may be passed as an argument to higher order functions' do
-        eval_str('((lambda Op (Op false false)) or)').should == false
-      end
 
+    it 'raises an error when attempting to redefine a primitive' do
+      expect {
+        eval_str('(defun + (A B) (* A B))')
+      }.to raise_error(Kl::Error, '+ is primitive and may not be redefined')
     end
+  end
 
+  describe 'evaluation of boolean special forms' do
     describe "cond" do
       before(:each) do
         eval_str('(defun tr () true)')
@@ -236,6 +174,12 @@ describe Kl::Environment do
       eval_str('(set foo 37)')
       eval_str('(value foo)').should == 37
     end
+
+    it 'raises an error when fetching an unset value' do
+      expect {
+       eval_str('(value foo)')
+      }.to raise_error(Kl::Error, 'variable foo has no value')
+    end
   end
 
   describe "evaluation of freeze" do
@@ -283,6 +227,12 @@ describe Kl::Environment do
       eval_str('(defun adder (X) (lambda Y (+ X Y)))')
       eval_str('(adder 1 2)').should == 3
     end
+
+    it 'raises an error of too many arguments are given' do
+      expect {
+        eval_str('((lambda X (lambda Y (* X Y))) 6 7 8)')
+      }.to raise_error(Kl::Error, 'The value 42 is neither a function nor a symbol.')
+    end
   end
 
   describe 'tail recursion' do
@@ -302,5 +252,31 @@ describe Kl::Environment do
         eval_str('(boom)')
       }.to raise_error(Kl::Error, 'maximum stack depth exceeded')
     end
+
+    it 'doesn\'t overflow when do is in tail position' do
+      eval_str('(defun factorial-h (X Acc)
+                  (if (= X 0)
+                      Acc
+                      (do dummy (factorial-h (- X 1) (* X Acc)))))')
+      expect {
+        eval_str('(factorial-h 10000 1)')
+      }.to_not raise_error
+    end
+  end
+
+  describe 'optimized do expression' do
+    it 'evaluates to the value of the second expression' do
+      eval_str('(do (cn "fi" "rst") (cn "sec" "ond"))').should == "second"
+    end
+
+    it 'evaluates the first expression, then the second' do
+      eval_str('(set temp-value 0)')
+      eval_str('(do (set temp-value 10) (= 10 (value temp-value)))').should == true
+    end
+
+    it 'supports partial application' do
+      eval_str('((do a) b)').should == :b
+      eval_str('(((do) a) b)').should == :b
+    end
   end
 end

data/spec/kl/interop_spec.rb

@@ -0,0 +1,68 @@
+require 'spec_helper'
+
+describe 'Ruby->Shen interop' do
+  def eval_str(str)
+    form = Kl::Reader.new(StringIO.new(str)).next
+    @env.__eval(form)
+  end
+
+  before(:each) do
+    @env = Kl::Environment.new
+  end
+
+  it 'allows K Lambda functions to be invoked as methods on environment' do
+    eval_str('(defun square (X) (* X X))')
+    @env.respond_to?(:square).should be true
+    @env.square(7).should == 49
+  end
+
+  it 'hides the details of trampolines for tail recursive functions' do
+    eval_str('(defun countdown (X) (if (= X 0) true (countdown (- X 1))))')
+    @env.countdown(10001).should == true
+  end
+
+  it 'coerces underscores to hyphens in function names' do
+    eval_str('(defun typical-function-name (X) X)')
+    @env.respond_to?(:typical_function_name).should be true
+    @env.typical_function_name(37).should == 37
+  end
+
+  it 'raises NoMethodError if the function cannot be found' do
+    expect {
+      @env.undefined_function
+    }.to raise_error(NoMethodError)
+  end
+
+  describe 'when invoking non-primitives' do
+    it 'coerces array arguments to K Lambda lists ' do
+      eval_str('(defun first (X) (hd X))')
+      @env.first([1, 2, 3]).should == 1
+    end
+
+    it 'coerces nested array arguments to K Lambda lists ' do
+      eval_str('(defun caadr (X) (hd (hd (tl X))))')
+      @env.caadr([1, [2, 3]]).should == 2
+    end
+
+    it 'coerces list results to Ruby arrays' do
+      eval_str('(defun a-list () (cons 1 (cons 2 ())))')
+      @env.a_list.should == [1, 2]
+    end
+
+    it 'coerces nested list results to Ruby arrays' do
+      eval_str('(defun a-list () (cons 1 (cons (cons 2 (cons 3 ())) ())))')
+      @env.a_list.should == [1, [2, 3]]
+    end
+
+    it 'coerces underscore to hyphen in symbol arguments' do
+      eval_str('(defun foo (X) (set result X))')
+      @env.foo(:a_symbol)
+      eval_str('(value result)').should == :"a-symbol"
+    end
+
+    it 'coerces hyphen to underscore in results' do
+      eval_str('(defun foo () a-symbol)')
+      @env.foo.should == :a_symbol
+    end
+  end
+end

data/spec/kl/reader_spec.rb

@@ -22,6 +22,12 @@ describe Kl::Reader do
                                                    Kl::Cons.list([3]),
                                                    Kl::EmptyList.instance])])
     end
+
+    it 'raises an error on unterminated lists' do
+      expect {
+        reader('(1').next
+      }.to raise_error(Kl::Error, 'Unterminated list')
+    end
   end
 
   describe 'Reading booleans' do

metadata

@@ -1,7 +1,7 @@
 --- !ruby/object:Gem::Specification
 name: shen-ruby
 version: !ruby/object:Gem::Version
-  version: 0.1.0
+  version: 0.2.0
   prerelease: 
 platform: ruby
 authors:
@@ -10,7 +10,7 @@ authors:
 autorequire: 
 bindir: bin
 cert_chain: []
-date: 2012-12-31 00:00:00.000000000 Z
+date: 2013-01-17 00:00:00.000000000 Z
 dependencies:
 - !ruby/object:Gem::Dependency
   name: rspec
@@ -41,10 +41,16 @@ files:
 - .rspec
 - Gemfile
 - Gemfile.lock
+- HISTORY.md
 - MIT_LICENSE.txt
 - README.md
 - bin/shen_test_suite.rb
 - bin/srrepl
+- k_lambda_spec/atom_spec.rb
+- k_lambda_spec/primitives/boolean_operations_spec.rb
+- k_lambda_spec/primitives/generic_functions_spec.rb
+- k_lambda_spec/spec_helper.rb
+- k_lambda_spec/support/shared_examples.rb
 - lib/kl.rb
 - lib/kl/absvector.rb
 - lib/kl/compiler.rb
@@ -58,6 +64,7 @@ files:
 - lib/kl/primitives/assignments.rb
 - lib/kl/primitives/booleans.rb
 - lib/kl/primitives/error_handling.rb
+- lib/kl/primitives/extensions.rb
 - lib/kl/primitives/generic_functions.rb
 - lib/kl/primitives/lists.rb
 - lib/kl/primitives/streams.rb
@@ -66,7 +73,6 @@ files:
 - lib/kl/primitives/time.rb
 - lib/kl/primitives/vectors.rb
 - lib/kl/reader.rb
-- lib/kl/trampoline.rb
 - lib/shen_ruby.rb
 - lib/shen_ruby/version.rb
 - shen-ruby.gemspec
@@ -148,6 +154,7 @@ files:
 - shen/release/test_programs/yacc.shen
 - spec/kl/cons_spec.rb
 - spec/kl/environment_spec.rb
+- spec/kl/interop_spec.rb
 - spec/kl/lexer_spec.rb
 - spec/kl/primitives/generic_functions_spec.rb
 - spec/kl/primitives/symbols_spec.rb
@@ -182,6 +189,7 @@ summary: ShenRuby is a Ruby port of the Shen programming language
 test_files:
 - spec/kl/cons_spec.rb
 - spec/kl/environment_spec.rb
+- spec/kl/interop_spec.rb
 - spec/kl/lexer_spec.rb
 - spec/kl/primitives/generic_functions_spec.rb
 - spec/kl/primitives/symbols_spec.rb

data/lib/kl/trampoline.rb

@@ -1,14 +0,0 @@
-module Kl
-  # Trampolines hold a function and a list of its already-evaluated
-  # arguments. They are used to keep the strack from growing on
-  # tail calls.
-  class Trampoline
-    attr_reader :fn, :args, :f
-    
-    def initialize(fn, args, f)
-      @fn = fn
-      @args = args
-      @f = f
-    end
-  end
-end