shen-ruby 0.1.0

data/lib/kl/cons.rb

@@ -0,0 +1,51 @@
+require 'kl/empty_list'
+
+module Kl
+  class Cons
+    include Enumerable
+
+    attr_reader :hd, :tl
+
+    def initialize(hd, tl)
+      @hd = hd
+      @tl = tl
+    end
+
+    def ==(other)
+      other.kind_of?(Kl::Cons) && hd == other.hd && tl == other.tl
+    end
+
+    def each
+      cell = self
+      while !cell.kind_of? Kl::EmptyList
+        yield cell.hd
+        cell = cell.tl
+      end
+    end
+
+    class << self
+      def list(array)
+        if array.empty?
+          Kl::EmptyList.instance
+        else
+          index = array.size - 1
+          head = new(array[index], Kl::EmptyList.instance)
+          index = index - 1
+          while index >= 0
+            head = new(array[index], head)
+            index = index - 1
+          end
+          head
+        end
+      end
+
+      def list_to_string(f)
+        if f.kind_of? Kl::Cons
+          '(' + f.map {|x| list_to_string(x)}.join(' ') + ')'
+        else
+          f.to_s
+        end
+      end
+    end
+  end
+end

data/lib/kl/empty_list.rb

@@ -0,0 +1,12 @@
+require 'singleton'
+
+module Kl
+  class EmptyList
+    include Singleton
+    include Enumerable
+
+    def each
+      # no-op
+    end
+  end
+end

data/lib/kl/environment.rb

@@ -0,0 +1,123 @@
+require 'kl/compiler'
+require 'kl/primitives/booleans'
+require 'kl/primitives/symbols'
+require 'kl/primitives/strings'
+require 'kl/primitives/assignments'
+require 'kl/primitives/error_handling'
+require 'kl/primitives/lists'
+require 'kl/primitives/generic_functions'
+require 'kl/primitives/vectors'
+require 'kl/primitives/streams'
+require 'kl/primitives/time'
+require 'kl/primitives/arithmetic'
+
+module Kl
+  class Environment
+    include ::Kl::Primitives::Booleans
+    include ::Kl::Primitives::Symbols
+    include ::Kl::Primitives::Strings
+    include ::Kl::Primitives::Assignments
+    include ::Kl::Primitives::ErrorHandling
+    include ::Kl::Primitives::Lists
+    include ::Kl::Primitives::GenericFunctions
+    include ::Kl::Primitives::Vectors
+    include ::Kl::Primitives::Streams
+    include ::Kl::Primitives::Time
+    include ::Kl::Primitives::Arithmetic
+
+    def initialize
+      @dump_code = false
+      @tramp_fn = @tramp_args  = nil
+      @variables = {}
+      @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
+        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
+          end
+        end
+
+        if fn = @tramp_fn
+          # Bounce on the trampoline
+          args = @tramp_args
+          @tramp_args = nil
+        end
+      end
+      result
+    rescue SystemStackError
+      raise ::Kl::Error, 'maximum stack depth exceeded'
+    end
+
+    def __eval(form)
+      if @dump_code
+        puts "=" * 70
+        puts "Compiling:"
+        puts Kl::Cons.list_to_string(form)
+        puts '-----'
+      end
+      code = ::Kl::Compiler.compile(form, {}, true)
+      if @dump_code
+        puts code
+        puts "=" * 70
+      end
+      @tramp_fn = nil
+      result = instance_eval(code)
+      # Handle top-level trampolines
+      if @tramp_fn
+        fn = @tramp_fn
+        args = @tramp_args
+        @tramp_fn = nil
+        @tramp_args = nil
+        __apply(fn, args)
+      else
+        result
+      end
+    end
+
+    class << self
+      def load_file(env, path)
+        File.open(path, 'r') do |file|
+          reader = Kl::Reader.new(file)
+          while form = reader.next
+            env.__eval(form)
+          end
+        end
+      end
+    end
+  end
+end

data/lib/kl/error.rb

@@ -0,0 +1,4 @@
+module Kl
+  class Error < StandardError
+  end
+end

data/lib/kl/internal_error.rb

@@ -0,0 +1,7 @@
+module Kl
+  # Internal errors represent inconsistent state within the compiler
+  # or runtime environment. They are not catchable by application-level
+  # code.
+  class InternalError < StandardError
+  end
+end

data/lib/kl/lexer.rb

@@ -0,0 +1,186 @@
+require 'singleton'
+require 'kl/error'
+
+module Kl
+  class Lexer
+    SYMBOL_CHARS = /[-=*\/+_?$!\@~><&%'#`;:{}a-zA-Z0-9.]/
+
+    # Syntax tokens
+    class OpenParen
+      include Singleton
+    end
+    class CloseParen
+      include Singleton
+    end
+
+    def initialize(stream)
+      @stream = stream
+      @buffer = []
+    end
+
+    def eof?
+      @buffer.empty? && @stream.eof?
+    end
+
+    def getc
+      if @buffer.empty?
+        @stream.getc
+      else
+        @buffer.pop
+      end
+    end
+    
+    def ungetc(c)
+      @buffer.push(c)
+    end
+    
+    def next
+      drain_whitespace
+      unless eof?
+        c = getc
+        case c
+        when '('
+          OpenParen.instance
+        when ')'
+          CloseParen.instance
+        when '"'
+          consume_string
+        when SYMBOL_CHARS
+          ungetc(c)
+          consume_number_or_symbol
+        else
+          raise Error, "illegal character: #{c}"
+        end
+      end
+    end
+
+  private
+    def drain_whitespace
+      until eof?
+        c = getc
+        if c =~ /\S/
+          ungetc(c)
+          break
+        end
+      end
+    end
+
+    def consume_string
+      chars = []
+      loop do
+        raise Error, "unterminated string" if eof?
+        c = getc
+        break if c == '"'
+        chars << c
+      end
+      chars.join
+    end
+
+    def consume_number
+      # Shen allows multiple leading plusses and minuses. The plusses
+      # are ignored and an even number of minuses cancel each other.
+      # Thus '------+-7' is read as 7. 
+      #
+      # The Shen reader parses "7." as the integer 7 and the symbol '.'
+      decimal_seen = false
+      negative = false
+      past_sign = false
+      chars = []
+      loop do
+        break if eof?
+        c = getc
+        if c =~ /\d/
+          past_sign = true
+          chars << c
+        elsif c == '.' && !decimal_seen
+          past_sign = true
+          decimal_seen = true
+          chars << c
+        elsif c == '+' && !past_sign
+          # ignore
+        elsif c == '-' && !past_sign
+          negative = !negative
+        else
+          ungetc c
+          break
+        end
+      end
+      chars.unshift('-') if negative
+      if chars.last == '.'
+        # A trailing decimal point is treated as part of the next
+        # token. Forget we saw it.
+        ungetc(chars.pop)
+        decimal_seen = false
+      end
+      str = chars.join
+      decimal_seen ? str.to_f : str.to_i
+    end
+
+    def consume_symbol
+      chars = []
+      loop do
+        break if eof?
+        c = getc
+        unless c =~ SYMBOL_CHARS
+          ungetc c
+          break
+        end
+        chars << c
+      end
+      str = chars.join
+
+      case str
+      when 'true'
+        true
+      when 'false'
+        false
+      else
+        str.to_sym
+      end
+    end
+
+    def consume_number_or_symbol
+      # First drain optional leading signs
+      # Then drain optional decimal point
+      # If there is another character and it is a digit, then it
+      # is a number. Otherwise it is a symbol.
+      chars = []
+      loop do
+        break if eof?
+        c = getc
+        unless c =~ /[-+]/
+          ungetc c
+          break
+        end
+        chars << c
+      end
+      if eof?
+        chars.reverse.each {|x| ungetc x}
+        return consume_symbol
+      end
+
+      c = getc
+      chars << c
+      if c == '.'
+        if eof?
+          chars.reverse.each {|x| ungetc x}
+          return consume_symbol
+        end
+        c = getc
+        chars << c
+        chars.reverse.each {|x| ungetc x}
+        if c =~ /\d/
+          return consume_number
+        else
+          return consume_symbol
+        end          
+      elsif c =~ /\d/
+        chars.reverse.each {|x| ungetc x}
+        return consume_number
+      else
+        chars.reverse.each {|x| ungetc x}
+        return consume_symbol
+      end
+    end
+  end
+end

data/lib/kl/primitives/arithmetic.rb

@@ -0,0 +1,60 @@
+module Kl
+  module Primitives
+    module Arithmetic
+      def +(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        a + b
+      end
+      
+      def -(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        a - b
+      end
+      
+      def *(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        a * b
+      end
+      
+      def /(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        if a.kind_of?(Fixnum) && b.kind_of?(Fixnum) && a % b != 0
+          a = a.to_f
+        end
+        a / b
+      end
+      
+      def >(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        a > b
+      end
+
+      def <(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        a < b
+      end
+      
+      def >=(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        a >= b
+      end
+      
+      def <=(a, b)
+        raise ::Kl::Error, "#{a} is not a number" unless a.kind_of? Numeric
+        raise ::Kl::Error, "#{b} is not a number" unless b.kind_of? Numeric
+        a <= b
+      end
+      
+      def number?(a)
+        a.kind_of?(Numeric)
+      end
+    end
+  end
+end