rb-scheme 0.3.5

data/lib/rb-scheme/evaluator.rb

@@ -0,0 +1,26 @@
+module RbScheme
+  class Evaluator
+    extend Forwardable
+    include Helpers
+    include Symbol
+
+    def_delegator :@compiler, :compile
+    def_delegator :@vm, :exec, :vm_exec
+
+    def initialize
+      @compiler = Compiler.new
+      @vm = VM.new
+      Primitive.new.initialize_vm_primitive!
+      Extension.initialize_compound!(self)
+    end
+
+    def vm_eval(obj)
+      c = compile(obj, list, Set.new, list(intern("halt")))
+      vm_exec(list,
+              c,
+              0,
+              list,
+              0)
+    end
+  end # Evaluator
+end # RbScheme

data/lib/rb-scheme/executer.rb

@@ -0,0 +1,55 @@
+module RbScheme
+  class Executer
+    extend Forwardable
+    include Helpers
+
+    def_delegator :@parser, :read_expr
+    def_delegator :@evaluator, :vm_eval
+    def_delegator :@printer, :puts_lisp_object
+
+    def self.run(source)
+      new(source).exec
+    end
+
+    def initialize(source)
+      set_source!(source)
+      @evaluator = Evaluator.new
+      @printer = Printer.new
+    end
+
+    def set_source!(source)
+      @source = source
+      @parser = Parser.new(source)
+    end
+
+    def exit?(expr)
+      expr.is_a?(LSymbol) && expr.name == "exit"
+    end
+
+    def exec
+      if File.file?(@source)
+        exec_file
+      else
+        exec_repl
+      end
+    end
+
+    def exec_file
+      loop do
+        expr = read_expr
+        break if expr.nil?
+        vm_eval(expr)
+      end
+    end
+
+    def exec_repl
+      loop do
+        print "> "
+        expr = read_expr
+        return if expr.nil?
+        return if exit?(expr)
+        puts_lisp_object(vm_eval(expr))
+      end
+    end
+  end # Executer
+end # RbScheme

data/lib/rb-scheme/extension.rb

@@ -0,0 +1,17 @@
+module RbScheme
+  module Extension
+    def self.initialize_compound!(evaluator)
+      base = File.dirname(File.expand_path(__FILE__))
+      definitions = File.join(base, "extension/procedures.scm")
+
+      File.open(definitions) do |io|
+        parser = Parser.new(io)
+        loop do
+          expr = parser.read_expr
+          break if expr.nil?
+          evaluator.vm_eval(expr)
+        end
+      end
+    end
+  end # Extension
+end # RbScheme

data/lib/rb-scheme/extension/procedures.scm

@@ -0,0 +1,7 @@
+(define cadr
+  (lambda (lst)
+    (car (cdr lst))))
+
+(define cddr
+  (lambda (lst)
+    (cdr (cdr lst))))

data/lib/rb-scheme/global.rb

@@ -0,0 +1,25 @@
+module RbScheme
+  module Global
+    @@global_table = {}
+
+    def self.defined?(key)
+      raise unless key.is_a? LSymbol
+      @@global_table.member?(key)
+    end
+
+    def self.put(key, value)
+      raise unless key.is_a? LSymbol
+      @@global_table[key] = value
+      value
+    end
+
+    def self.get(key)
+      raise unless key.is_a? LSymbol
+      @@global_table[key]
+    end
+
+    def self.variables
+      @@global_table.keys
+    end
+  end # Global
+end

data/lib/rb-scheme/helpers.rb

@@ -0,0 +1,42 @@
+module RbScheme
+  module Helpers
+    # Constructor
+    def cons(car, cdr)
+      LCell.new(car, cdr)
+    end
+
+    def acons(key, val, cdr)
+      cons(cons(key, val), cdr)
+    end
+
+    def list(*args)
+      args.any? ? convert_to_list(args) : LCell.new
+    end
+
+    def convert_to_list(array)
+      result = list
+      array.reverse_each do |e|
+        result = cons(e, result)
+      end
+      result
+    end
+
+    def boolean(value)
+      value ? LTrue.instance : LFalse.instance
+    end
+
+    def check_length!(lst, n, name)
+      c = lst.count
+      unless c == n
+        raise ArgumentError, "#{name}: wrong number of arguments(given #{c}, expected #{n})"
+      end
+    end
+
+    def check_min_length!(lst, min, name)
+      c = lst.count
+      unless c >= min
+        raise ArgumentError, "#{name}: wrong number of arguments(given #{c}, expected #{min}..)"
+      end
+    end
+  end
+end # RbScheme

data/lib/rb-scheme/lisp-objects.rb

@@ -0,0 +1,105 @@
+require 'singleton'
+
+module RbScheme
+  class LInt
+    attr_accessor :value
+
+    def initialize(value)
+      @value = value
+    end
+
+    def ==(another)
+      return false unless another.is_a? LInt
+      value == another.value
+    end
+  end
+
+  class LCell
+    include Enumerable
+
+    attr_accessor :car, :cdr
+
+    def initialize(car = nil, cdr = nil)
+      @car = car
+      @cdr = cdr
+    end
+
+    def each
+      list = self
+      until list.null?
+        yield(list.car)
+        list = list.cdr
+      end
+    end
+
+    def null?
+      car == nil && cdr == nil
+    end
+
+    def cadr
+      @cdr.car
+    end
+
+    def cddr
+      @cdr.cdr
+    end
+
+    def caddr
+      @cdr.cdr.car
+    end
+
+    def cadddr
+      @cdr.cdr.cdr.car
+    end
+
+    def list?
+      cdr = @cdr
+      loop do
+        return false unless LCell === cdr
+        return true if cdr.null?
+        cdr = cdr.cdr
+      end
+    end
+
+    def ==(another)
+      l1 = self
+      l2 = another
+      loop do
+        if l1.is_a?(LCell) && l2.is_a?(LCell)
+          return false unless l1.car == l2.car
+          l1 = l1.cdr
+          l2 = l2.cdr
+        elsif !l1.is_a?(LCell) && !l2.is_a?(LCell)
+          return l1 == l2
+        else
+          return false
+        end
+      end
+    end
+
+  end
+
+  class LSymbol
+    attr_accessor :name
+
+    def initialize(name)
+      @name = name
+    end
+  end
+
+  class LDot
+    include Singleton
+  end
+
+  class LCloseParen
+    include Singleton
+  end
+
+  class LTrue
+    include Singleton
+  end
+
+  class LFalse
+    include Singleton
+  end
+end # RbScheme

data/lib/rb-scheme/parser.rb

@@ -0,0 +1,146 @@
+module RbScheme
+  class Parser
+    extend Forwardable
+    include Helpers
+    include Symbol
+
+    EOF = nil
+
+    def_delegator :@input, :getc
+
+    def self.read_expr(input)
+      new(input).read_expr
+    end
+
+    def initialize(input)
+      @input = input
+    end
+
+    def read_expr
+      loop do
+        c = getc
+        case c
+        when /\s/
+          next
+        when EOF
+          return nil
+        when ';'
+          skip_line
+          next
+        when '('
+          return read_list
+        when ')'
+          return LCloseParen.instance
+        when '.'
+          return LDot.instance
+        when '\''
+          return read_quote
+        when /\d/
+          return LInt.new(read_number(c.to_i))
+        when negative_number_pred
+          return LInt.new(-read_number(c.to_i))
+        when '#'
+          return read_hash
+        when symbol_rp
+          return read_symbol(c)
+        else
+          raise "Unexpected character - #{c}"
+        end
+      end
+    end
+
+    private
+
+      def peek
+        c = getc
+        @input.ungetc(c)
+        c
+      end
+
+      def reverse_list(lst)
+        return lst if lst.null?
+        lst.reduce(list) { |res, e| cons(e, res) }
+      end
+
+      def skip_line
+        loop do
+          c = getc
+          case c
+          when EOF, "\n"
+            return
+          when "\r"
+            getc if "\n" == peek
+            return
+          end
+        end
+      end
+
+      def read_list
+        acc = list
+        loop do
+          obj = read_expr
+          raise "read_list: Unclosed parenthesis" if obj.nil?
+
+          case obj
+          when LCloseParen
+            return reverse_list(acc)
+          when LDot
+            last = read_expr
+            close = read_expr
+            if close.nil? || !(LCloseParen === close)
+              raise "read_list: Unclosed parenthesis"
+            end
+            if acc.null?
+              raise "read_list: dotted list must have car"
+            end
+
+            return acc.reduce(last) { |res, e| cons(e, res) }
+          else
+            acc = cons(obj, acc)
+          end
+        end
+      end
+
+      def read_quote
+        sym = intern("quote")
+        list(sym, read_expr)
+      end
+
+      def read_number(value)
+        result = value
+        while /\d/ === peek
+          result = result * 10 + getc.to_i
+        end
+        result
+      end
+
+      def read_hash
+        c = getc
+        case c
+        when 't'
+          LTrue.instance
+        when 'f'
+          LFalse.instance
+        else
+          raise "Unexpected hash literal #{c}"
+        end
+      end
+
+      def read_symbol(first_char)
+        result = first_char
+        while symbol_rp === peek
+          result += getc
+        end
+        intern(result)
+      end
+
+      def negative_number_pred
+        Proc.new {|c| '-' == c && /\d/ === peek}
+      end
+
+      def symbol_rp
+        allowed = '~!@$%^&*-_=+:/?<>'
+        Regexp.new("[A-Za-z0-9#{Regexp.escape(allowed)}]")
+      end
+  end # Parser
+end # RbScheme

data/lib/rb-scheme/primitive.rb

@@ -0,0 +1,111 @@
+module RbScheme
+  class Primitive
+    extend Forwardable
+    include Helpers
+    include Symbol
+
+    def_delegators :@printer, :print_lisp_object, :puts_lisp_object
+
+    def initialize
+      @printer = Printer.new
+    end
+
+    def initialize_vm_primitive!
+      put_primitive_proc("+", lambda do |*nums|
+        sum = 0
+        nums.each do |n|
+          sum += n.value
+        end
+        LInt.new(sum)
+      end)
+
+      put_primitive_proc("-", lambda do |first, *rest|
+        result = first.value
+        if rest.any?
+          rest.each do |n|
+            result -= n.value
+          end
+        else
+          result = -result
+        end
+        LInt.new(result)
+      end)
+
+      put_primitive_proc("*", lambda do |*nums|
+        result = 1
+        nums.each do |n|
+          result *= n.value
+        end
+        LInt.new(result)
+      end)
+
+      put_primitive_proc("/", lambda do |first, *rest|
+        result = first.value
+        if rest.any?
+          rest.each do |n|
+            result /= n.value
+          end
+        else
+          result = 1 / result
+        end
+        LInt.new(result)
+      end)
+
+      put_primitive_proc("=", lambda do |n1, n2|
+        boolean(n1.value == n2.value)
+      end)
+
+      put_primitive_proc("<", lambda do |n1, n2|
+        boolean(n1.value < n2.value)
+      end)
+
+      put_primitive_proc(">", lambda do |n1, n2|
+        boolean(n1.value > n2.value)
+      end)
+
+      put_primitive_proc("null?", lambda do |lst|
+        boolean(lst.is_a?(LCell) && lst.null?)
+      end)
+
+      put_primitive_proc("cons", lambda do |e1, e2|
+        cons(e1, e2)
+      end)
+
+      put_primitive_proc("car", lambda do |c|
+        unless c.is_a?(LCell)
+          raise ArgumentError, "pair required, but got #{c}"
+        end
+        c.car
+      end)
+
+      put_primitive_proc("cdr", lambda do |c|
+        unless c.is_a?(LCell)
+          raise ArgumentError, "pair required, but got #{c}"
+        end
+        c.cdr
+      end)
+
+      put_primitive_proc("list", lambda do |*lst|
+        list(*lst)
+      end)
+
+      put_primitive_proc("display", lambda do |obj|
+        print_lisp_object(obj)
+      end)
+
+      put_primitive_proc("newline", lambda do
+        print("\n")
+      end)
+
+      put_primitive_proc("print", lambda do |obj|
+        puts_lisp_object(obj)
+      end)
+      # todo...
+    end
+
+    def put_primitive_proc(name, func)
+      prim = Procedure.new(name: name, func: func)
+      Global.put(intern(name), prim)
+    end
+  end # Primitive
+end # RbScheme