klam 0.0.1

data/lib/klam/cons.rb

@@ -0,0 +1,18 @@
+module Klam
+  class Cons
+    attr_reader :hd, :tl
+
+    def initialize(hd, tl)
+      @hd = hd
+      @tl = tl
+    end
+
+    def ==(other)
+      other.instance_of?(Cons) && other.hd == @hd && other.tl == @tl
+    end
+
+    def hash
+      [@hd, @tl].hash
+    end
+  end
+end

data/lib/klam/converters.rb

@@ -0,0 +1,4 @@
+this_dir = File.dirname(__FILE__)
+Dir[File.join(this_dir, 'converters', '*.rb')].each do |file|
+  require file
+end

data/lib/klam/converters/list.rb

@@ -0,0 +1,29 @@
+module Klam
+  module Converters
+    # Utility methods to convert between Ruby Arrays and Kl Lists
+    module List
+      include Klam::Primitives::Lists
+
+      def arrayToList(array)
+        list = EMPTY_LIST
+        (array.length - 1).downto(0) do |index|
+          item = array[index]
+          item = arrayToList(item) if item.kind_of?(Array)
+          list = cons(item, list)
+        end
+        list
+      end
+
+      def listToArray(list)
+        array = []
+        while list != EMPTY_LIST
+          item = hd(list)
+          item = listToArray(item) if cons?(item) || item == EMPTY_LIST
+          array << item
+          list = tl(list)
+        end
+        array
+      end
+    end
+  end
+end

data/lib/klam/environment.rb

@@ -0,0 +1,61 @@
+module Klam
+  class Environment < BasicObject
+    include ::Klam::Primitives::BooleanOperations
+    include ::Klam::Primitives::Symbols
+    include ::Klam::Primitives::Strings
+    include ::Klam::Primitives::Assignments
+    include ::Klam::Primitives::ErrorHandling
+    include ::Klam::Primitives::Lists
+    include ::Klam::Primitives::GenericFunctions
+    include ::Klam::Primitives::Vectors
+    include ::Klam::Primitives::Streams
+    include ::Klam::Primitives::Time
+    include ::Klam::Primitives::Arithmetic
+
+    def initialize
+      # The global assignments namespace. Errors are thrown here in the
+      # missing element handler rather than in the value primitive in order
+      # to facilitate inlining later.
+      @assignments = ::Hash.new do |_, name|
+        ::Kernel.raise ::Klam::Error, "The variable #{name} is unbound."
+      end
+
+      @arities = ::Hash.new { |h, k| h[k] = __arity(k) }
+      @curried_methods = ::Hash.new { |h, k| h[k] = __method(k).to_proc.curry }
+      @loop_cache = {}
+
+      # Grab a handle to this object's eigenclass for use later when the
+      # compiled code needs to reference it. It is used, e.g., when renaming
+      # methods.
+      @eigenclass = class << self; self; end
+
+      # The open primitive depends on having *home-directory* assigned.
+      set(:"*home-directory*", ::Dir.pwd)
+    end
+
+    def __apply(rator, *rands)
+      if rator.kind_of?(::Symbol)
+        @curried_methods[rator].call(*rands)
+      else
+        rator.call(*rands)
+      end
+    end
+
+    def __method(sym)
+      @eigenclass.instance_method(sym).bind(self)
+    end
+
+    def __arity(sym)
+      @eigenclass.instance_method(sym).arity
+    rescue ::NameError
+      -1
+    end
+
+    class << self
+      def rename_method(old_name, new_name)
+        alias_method(new_name, old_name)
+        remove_method(old_name)
+      end
+    end
+  end
+end

data/lib/klam/error.rb

@@ -0,0 +1,4 @@
+module Klam
+  class Error < StandardError; end
+  class SyntaxError < Error; end
+end

data/lib/klam/lexer.rb

@@ -0,0 +1,185 @@
+require 'singleton'
+
+module Klam
+  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 Klam::SyntaxError, "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 Klam::SyntaxError, "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/klam/primitives.rb

@@ -0,0 +1,4 @@
+this_dir = File.dirname(__FILE__)
+Dir[File.join(this_dir, 'primitives', '*.rb')].each do |file|
+  require file
+end

data/lib/klam/primitives/arithmetic.rb

@@ -0,0 +1,49 @@
+module Klam
+  module Primitives
+    module Arithmetic
+      def +(a, b)
+        a + b
+      end
+
+      def -(a, b)
+        a - b
+      end
+
+      def *(a, b)
+        a * b
+      end
+
+      def /(a, b)
+        # Kl does not make a distinction between integers and reals.  Dividing
+        # the integer 3 by the interger 2 must yield 1.5 rather than 1.  We'd
+        # like to keep things in integers as much as possible, so we coerce a
+        # to a float only if integer division is not possible.
+        if a.kind_of?(Fixnum) && b.kind_of?(Fixnum) && a.remainder(b) != 0
+          a = a.to_f
+        end
+
+        a / b
+      end
+
+      def <(a, b)
+        a < b
+      end
+
+      def >(a, b)
+        a > b
+      end
+
+      def <=(a, b)
+        a <= b
+      end
+
+      def >=(a, b)
+        a >= b
+      end
+
+      def number?(a)
+        a.kind_of?(Numeric)
+      end
+    end
+  end
+end

data/lib/klam/primitives/assignments.rb

@@ -0,0 +1,13 @@
+module Klam
+  module Primitives
+    module Assignments
+      def set(name, value)
+        @assignments[name] = value
+      end
+
+      def value(name)
+        @assignments[name]
+      end
+    end
+  end
+end

data/lib/klam/primitives/boolean_operations.rb

@@ -0,0 +1,22 @@
+module Klam
+  module Primitives
+    # All of the boolean operations are special forms, but if, and, and or
+    # are also available as normal functions to facilitate partial application.
+    # When partially applied, they are no longer short circuiting.
+    module BooleanOperations
+      def _if(a, b, c)
+        a ? b : c
+      end
+      alias_method :'if', :_if
+      remove_method :_if
+
+      def and(a, b)
+        a && b
+      end
+
+      def or(a, b)
+        a || b
+      end
+    end
+  end
+end

data/lib/klam/primitives/error_handling.rb

@@ -0,0 +1,19 @@
+module Klam
+  module Primitives
+    module ErrorHandling
+      def simple_error(msg)
+        ::Kernel.raise ::Klam::Error, msg
+      end
+      alias_method :"simple-error", :simple_error
+      remove_method :simple_error
+
+      # trap-error is a special form and implemented in the compiler
+
+      def error_to_string(err)
+        err.message
+      end
+      alias_method :"error-to-string", :error_to_string
+      remove_method :error_to_string
+    end
+  end
+end

data/lib/klam/primitives/generic_functions.rb

@@ -0,0 +1,19 @@
+module Klam
+  module Primitives
+    module GenericFunctions
+      def equal(a, b)
+        a == b
+      end
+      alias_method :"=", :equal
+      remove_method :equal
+
+      def eval_kl(form)
+        compiler = Klam::Compiler.new(self)
+        code = compiler.compile(form)
+        instance_eval code
+      end
+      alias_method :"eval-kl", :eval_kl
+      remove_method :eval_kl
+    end
+  end
+end