rubylisp 0.2.1 → 1.0.2

data/lib/rubylisp/character.rb

@@ -3,278 +3,6 @@ module Lisp
 
   class Character < Atom
 
-    def self.register
-      Primitive.register("char->name", "(char->name char)\n\nReturns a string corresponding to the printed representation of char. This is the character or character-name component of the external representation.") do |args, env|
-        Lisp::Character::char_name_impl(args, env)
-      end
-      
-      Primitive.register("name->char", "(name->char string)\n\nConverts a string that names a character into the character specified. If string does not name any character, name->char signals an error.") do |args, env|
-        Lisp::Character::name_char_impl(args, env)
-      end
-      
-      Primitive.register("char=?", "(char=? char1 char2)\n\nReturn whether char1 and char2 are the same") do |args, env|
-        Lisp::Character::char_eq_impl(args, env)
-      end
-      
-      Primitive.register("char<?", "(char<? char1 char2)\n\nReturn whether char1 is less than char2") do |args, env|
-        Lisp::Character::char_lt_impl(args, env)
-      end
-      
-      Primitive.register("char>?", "(char>? char1 char2)\n\nReturn whether char1 is greater than char2") do |args, env|
-        Lisp::Character::char_gt_impl(args, env)
-      end
-      
-      Primitive.register("char<=?", "(char<=? char1 char2)\n\nReturn whether char1 is less than or equal to char2") do |args, env|
-        Lisp::Character::char_lteq_impl(args, env)
-      end
-      
-      Primitive.register("char>=?", "(char>=? char1 char2)\n\nReturn whether char1 is greater than or equal to char2") do |args, env|
-        Lisp::Character::char_gteq_impl(args, env)
-      end
-      
-      Primitive.register("char-ci=?", "(char=? char1 char2)\n\nReturn whether char1 is equal to char2, ignoring case") do |args, env|
-        Lisp::Character::char_ci_eq_impl(args, env)
-      end
-      
-      Primitive.register("char-ci<?", "(char=? char1 char2)\n\nReturn whether char1 is less than char2, ignoring case") do |args, env|
-        Lisp::Character::char_ci_lt_impl(args, env)
-      end
-      
-      Primitive.register("char-ci>?", "(char=? char1 char2)\n\nReturn whether char1 is greater than char2, ignoring case") do |args, env|
-        Lisp::Character::char_ci_gt_impl(args, env)
-      end
-      
-      Primitive.register("char-ci<=?", "(char=? char1 char2)\n\nReturn whether char1 is less than or equal to char2, ignoring case") do |args, env|
-        Lisp::Character::char_ci_lteq_impl(args, env)
-      end
-      
-      Primitive.register("char-ci>=?", "(char=? char1 char2)\n\nReturn whether char1 is greater than orequal to char2, ignoring case") do |args, env|
-        Lisp::Character::char_ci_gteq_impl(args, env)
-      end
-      
-      Primitive.register("char?", "(char? sexpr)\n\nReturns #t if object is a character; otherwise returns #f.") do |args, env|
-        Lisp::Character::charp_impl(args, env)
-      end
-      
-      Primitive.register("char-upcase", "(char-upcase char)\n\nReturns the uppercase equivalent of char if char is a letter; otherwise returns char. These procedures return a character char2 such that (char-ci=? char char2).") do |args, env|
-        Lisp::Character::char_upcase_impl(args, env)
-      end
-      
-      Primitive.register("char-downcase", "(char-downcase char)\n\nReturns the lowercase equivalent of char if char is a letter; otherwise returns char. These procedures return a character char2 such that (char-ci=? char char2).") do |args, env|
-        Lisp::Character::char_downcase_impl(args, env)
-      end
-      
-      Primitive.register("char->digit", "(char->digit char [radix])\n\nIf char is a character representing a digit in the given radix, returns the corresponding integer value. If you specify radix (which must be an integer between 2 and 36 inclusive), the conversion is done in that base, otherwise it is done in base 10. If char doesn’t represent a digit in base radix, char->digit returns #f.\n\nNote that this procedure is insensitive to the alphabetic case of char.") do |args, env|
-        Lisp::Character::char_digit_impl(args, env)
-      end
-      
-      Primitive.register("digit->char", "(digit->char digit [radix])\n\nReturns a character that represents digit in the radix given by radix. Radix must be an exact integer between 2 and 36 (inclusive), and defaults to 10. Digit, which must be a non-negative integer, should be less than radix; if digit is greater than or equal to radix, digit->char returns #f.") do |args, env|
-        Lisp::Character::digit_char_impl(args, env)
-      end
-      
-      Primitive.register("char->integer", "(char->integer char)\n\nchar->integer returns the character code representation for char.") do |args, env|
-        Lisp::Character::char_int_impl(args, env)
-      end
-      
-      Primitive.register("integer->char", "(integer->char k)\n\ninteger->char returns the character whose character code representation is k.") do |args, env|
-        Lisp::Character::int_char_impl(args, env)
-      end
-    end
-
-
-    def self.find_character_for_chr(ch)
-      @@character_constants.each_value {|v| return v if v.value == ch}
-      return @@character_constants[ch] = Lisp::Character.new(ch)
-    end
-
-
-    def self.find_character_for_name(n)
-      return @@character_constants[n] if @@character_constants.has_key?(n)
-      if n.length == 1
-        ch = self.new(n[0])
-       return @@character_constants[n] = ch
-      end
-      nil
-    end
-
-
-    def self.char_name_impl(args, env)
-      return Lisp::Debug.process_error("char->name requires a single argument, found #{args.length}", env) unless args.length == 1
-      char = args.car.evaluate(env)
-      return Lisp::Debug.process_error("char->name requires a character argument", env) unless char.character?
-      kv = @@character_constants.rassoc(char)
-      return Lisp::String.with_value(kv[0]) unless kv.nil?
-      return Lisp::Debug.process_error("char->name was passed an invalid character", env)
-    end
-
-
-    def self.name_char_impl(args, env)
-      return Lisp::Debug.process_error("name->char requires a single argument, found #{args.length}", env) unless args.length == 1
-      name = args.car.evaluate(env)
-      return Lisp::Debug.process_error("name->char requires a string argument", env) unless name.string?
-      ch = find_character_for_name(name.value)
-      return ch unless ch.nil?
-      return Lisp::Debug.process_error("There is no character with the name #{name}", env)
-    end
-
-
-    def self.get_one_character_arg(func, args, env)
-      return Lisp::Debug.process_error("#{func} requires a character argument, found no args", env) unless args.length >= 1
-      char1 = args.car.evaluate(env)
-      return Lisp::Debug.process_error("#{func} requires a character argument, found #{char1}", env) unless char1.character?
-      return char1
-    end
-
-
-    def self.get_two_character_args(func, args, env)
-      return Lisp::Debug.process_error("#{func} requires two arguments, found
-                                ##{args.length}", env) unless args.length == 2
-      char1 = args.car.evaluate(env)
-      return Lisp::Debug.process_error("#{func} requires character arguments, found #{char1}", env) unless char1.character?
-      char2 = args.cadr.evaluate(env)
-      return Lisp::Debug.process_error("#{func} requires character arguments, found #{char2}", env) unless char2.character?
-      return [char1, char2]
-    end
-
-
-    def self.char_eq_impl(args, env)
-      char1, char2 = get_two_character_args("char=?", args, env)
-      Lisp::Boolean.with_value(char1.value == char2.value)
-    end
-
-
-    def self.char_lt_impl(args, env)
-      char1, char2 = get_two_character_args("char<?", args, env)
-      Lisp::Boolean.with_value(char1.value < char2.value)
-    end
-
-
-    def self.char_gt_impl(args, env)
-      char1, char2 = get_two_character_args("char>?", args, env)
-      Lisp::Boolean.with_value(char1.value > char2.value)
-    end
-
-
-    def self.char_lteq_impl(args, env)
-      char1, char2 = get_two_character_args("char<=?", args, env)
-      Lisp::Boolean.with_value(char1.value <= char2.value)
-    end
-
-
-    def self.char_gteq_impl(args, env)
-      char1, char2 = get_two_character_args("char>=?", args, env)
-      Lisp::Boolean.with_value(char1.value >= char2.value)
-    end
-
-
-    def self.char_ci_eq_impl(args, env)
-      char1, char2 = get_two_character_args("char-ci=?", args, env)
-      Lisp::Boolean.with_value(char1.value.downcase == char2.value.downcase)
-    end
-
-
-    def self.char_ci_lt_impl(args, env)
-      char1, char2 = get_two_character_args("char-ci<?", args, env)
-      Lisp::Boolean.with_value(char1.value.downcase < char2.value.downcase)
-    end
-
-
-    def self.char_ci_gt_impl(args, env)
-      char1, char2 = get_two_character_args("char-ci>?", args, env)
-      Lisp::Boolean.with_value(char1.value.downcase > char2.value.downcase)
-    end
-
-
-    def self.char_ci_lteq_impl(args, env)
-      char1, char2 = get_two_character_args("char-ci<=?", args, env)
-      Lisp::Boolean.with_value(char1.value.downcase <= char2.value.downcase)
-    end
-
-
-    def self.char_ci_gteq_impl(args, env)
-      char1, char2 = get_two_character_args("char-ci>=?", args, env)
-      Lisp::Boolean.with_value(char1.value.downcase >= char2.value.downcase)
-    end
-
-
-    def self.charp_impl(args, env)
-      return Lisp::Debug.process_error("char->name requires a single argument, found #{args.length}", env) unless args.length == 1
-      char = args.car.evaluate(env)
-      Lisp::Boolean.with_value(char.character?)
-    end
-
-
-    def self.char_upcase_impl(args, env)
-      char = get_one_character_arg("char->digit", args, env)
-      find_character_for_chr(char.value.upcase)
-    end
-
-
-    def self.char_downcase_impl(args, env)
-      char = get_one_character_arg("char->digit", args, env)
-      find_character_for_chr(char.value.downcase)
-    end
-
-
-    def self.char_digit_impl(args, env)
-      char = get_one_character_arg("char->digit", args, env)
-      base = if args.length == 1
-               10
-             else
-               b = args.cadr.evaluate(env)
-               return Lisp::Debug.process_error("Base for char->digit has to be an integer", env) unless b.integer?
-               return Lisp::Debug.process_error("Base for char->digit has to be between 2 and 36", env) unless b.value >=2 && b.value <= 36
-               b.value
-             end
-      ch = char.value.upcase
-      value = case ch
-              when /[0-9]/
-                ch[0].ord - 48
-              when /[A-Z]/
-                10 + ch[0].ord - 65
-              else
-                -1
-              end
-      if value == -1
-        Lisp::FALSE
-      elsif value >= base
-        Lisp::FALSE
-      else
-        Lisp::Number.with_value(value)
-      end
-    end
-
-
-    def self.digit_char_impl(args, env)
-      d = args.car.evaluate(env)
-      return Lisp::Debug.process_error("Digit value for digit->char has to be an integer", env) unless d.integer?
-      base = if args.length == 1
-               10
-             else
-               b = args.cadr.evaluate(env)
-               return Lisp::Debug.process_error("Base for char->digit has to be an integer", env) unless b.integer?
-               return Lisp::Debug.process_error("Base for char->digit has to be between 2 and 36", env) unless b.value >=2 && b.value <= 36
-               b.value
-             end
-      val = d.value
-      return Lisp::FALSE if val < 0 || val >= base 
-      find_character_for_chr((((val < 10) ? 48 : 55) + val).chr)
-    end
-
-
-    def self.char_int_impl(args, env)
-      char = get_one_character_arg("char->int", args, env)
-      Lisp::Number.with_value(char.value.ord)
-    end
-
-
-    def self.int_char_impl(args, env)
-      i = args.car.evaluate(env)
-      return Lisp::Debug.process_error("Integer value for int->char has to be an integer", env) unless i.integer?
-      find_character_for_chr(i.value.chr)
-    end
-
-
     def initialize(n)
       @value = n
     end
@@ -289,6 +17,12 @@ module Lisp
       true
     end
 
+    
+    def eqv?(other)
+      return false unless other.character?
+      @value == other.value
+    end
+
 
     def type
       :character
@@ -363,9 +97,14 @@ module Lisp
     @@character_constants["DEL"]       = Lisp::Character.new("\x7F")
 
 
+    def self.character_constants()
+      @@character_constants
+    end
+
+    
     def self.with_value(n)
       if n.length == 1
-        ch = find_character_for_chr(n[0])
+        ch = Lisp::PrimCharacter.find_character_for_chr(n[0])
         return ch unless ch.nil?
         ch = self.new(n[0])
         @@character_constants[n] = ch
@@ -373,9 +112,9 @@ module Lisp
       elsif @@character_constants.has_key?(n)
         @@character_constants[n]
       elsif n[0..1] == "U+"
-        find_character_for_chr(n[2..-1].to_i(16).chr)
+        Lisp::PrimCharacter.find_character_for_chr(n[2..-1].to_i(16).chr)
       else
-        return Lisp::Debug.process_error("Invalid character name: #{n}", env)
+        return Lisp::Debug.process_error("Invalid character name: #{n}", Lisp::EnvironmentFrame.global)
       end
     end
 

data/lib/rubylisp/class_object.rb

@@ -0,0 +1,56 @@
+# -*- coding: utf-8 -*-
+module Lisp
+
+  class ClassObject < Atom
+
+    def self.new_instance
+      self.new(@value.alloc.init)
+    end
+
+
+    def self.with_class(c)
+      self.new(c)
+    end
+
+    
+    def initialize(c)
+      @value = c
+    end
+
+    
+    def with_value(&block)
+      block.call(@value)
+    end
+
+    
+    def class?
+      true
+    end
+
+    
+    def type
+      :class
+    end
+
+    
+    def native_type
+      @value.class
+    end
+
+    
+    def to_s
+      "<a class: #{@value.name}>"
+    end
+
+    
+    def true?
+      @value != nil
+    end
+
+    
+    def false?
+      @value == nil
+    end
+
+  end
+end

data/lib/rubylisp/cons_cell.rb

@@ -5,6 +5,7 @@ module Lisp
     attr_reader :car, :cdr
 
     def self.cons(a=nil, b=nil)
+      b = nil if b.pair? && b.empty?
       ConsCell.new(a, b)
     end
 
@@ -31,8 +32,9 @@ module Lisp
 
 
     def set_nth!(n, d)
+      return nil if empty?
       c = self
-      (n-1).times {|i| c = c.cdr}
+      n.times {|i| c = c.cdr}
       c.set_car!(d)
     end
 
@@ -93,10 +95,6 @@ module Lisp
       true
     end
 
-    def alist?
-      false
-    end
-
     def frame?
       false
     end
@@ -104,10 +102,21 @@ module Lisp
     def vector?
       false
     end
+
+    def eq?(other)
+      return true if empty? && (other.nil? || (other.pair? && other.empty?))
+      other.pair? && self == other
+    end
+
+    def eqv?(other)
+      return true if empty? && (other.nil? || (other.pair? && other.empty?))
+      other.pair? && self == other
+    end
     
-    def eq?(sexpr)
-      return false unless sexpr.pair?
-      (@car == sexpr.car || @car.eq?(sexpr.car)) && (@cdr == sexpr.cdr || @cdr.eq?(sexpr.cdr))
+    def equal?(other)
+      return true if empty? && (other.nil? || (other.pair? && other.empty?))
+      return false unless other.pair?
+      @car.equal?(other.car) && @cdr.equal?(other.cdr)
     end
     
     def type
@@ -124,7 +133,7 @@ module Lisp
       return "()" if self.empty?
       return "'#{@cdr.car.to_s}" if @car.symbol? && @car.name == "quote"
       return "{#{@cdr.to_s_helper}}" if @car.symbol? && @car.name == "make-frame"
-      return "[#{@cdr.to_s_helper}]" if @car.symbol? && @car.name == "make-vector"
+      return "#(#{@cdr.to_s_helper})" if @car.symbol? && @car.name == "make-vector"
       return "(#{@car.to_s} . #{@cdr.to_s})" if !@cdr.nil? && !@cdr.pair?
       return "(#{self.to_s_helper})"
     end
@@ -137,22 +146,24 @@ module Lisp
       return "()" if self.empty?
       return "'#{@cdr.car.print_string}" if @car.symbol? && @car.name == "quote"
       return "{#{@cdr.print_string_helper}}" if @car.symbol? && @car.name == "make-frame"
-      return "[#{@cdr.print_string_helper}]" if @car.symbol? && @car.name == "make-vector"
+      return "#(#{@cdr.print_string_helper})" if @car.symbol? && @car.name == "make-vector"
       return "(#{@car.print_string} . #{@cdr.print_string})" if !@cdr.nil? && !@cdr.pair?
       return "(#{self.print_string_helper})"
     end
 
     def to_a
       a = []
+      return a if empty?
       c = self
       until c.nil?
-        a << c.car()
+        a << c.car
         c = c.cdr
       end
       a
     end
 
     def each &block
+      return if empty?
       c = self
       if self.length > 0
         until c.nil?
@@ -163,11 +174,11 @@ module Lisp
     end
 
     def self.array_to_list(cells, tail=nil)
-      return tail if cells.empty?
+      return cons() if cells.empty? && tail.nil?
       head = ConsCell.new
       last_cell = head
-      cells.each do |d|
-        new_cell = self.cons(d, nil)
+      (0...cells.length).each do |i|
+        new_cell = self.cons(cells[i], nil)
         last_cell.set_cdr!(new_cell)
         last_cell = new_cell
       end
@@ -176,11 +187,12 @@ module Lisp
     end
 
     def traverse(path)
-      return self if path.empty?
-      next_cell = (path[0] == ?a) ? @car : @cdr
-      return next_cell if path.length == 1
-      return nil if next_cell.nil?  || !next_cell.pair?
-      next_cell.traverse(path[1..-1])
+      next_cell = self
+      path.chars.each do |p|
+        return nil if next_cell.nil?  || !next_cell.pair?
+        next_cell = ((p == ?a) ? next_cell.car : next_cell.cdr)
+      end
+      next_cell
     end
 
     def method_missing(name, *args, &block)
@@ -193,13 +205,13 @@ module Lisp
 
     def nth(n)
       c = self
-      (n-1).times {|i| c = c.cdr}
+      n.times {|i| c = c.cdr}
       c.car
     end
 
     def nth_tail(n)
       c = self
-      (n-1).times {|i| c = c.cdr}
+      n.times {|i| c = c.cdr}
       c
     end
 
@@ -225,6 +237,7 @@ module Lisp
           Lisp::Debug.debug_repl(env)
         end
       end
+
       result = func.apply_to(@cdr, env)
       env.current_code.shift() if !Lisp::Debug.eval_in_debug_repl && Lisp::Debug.interactive
       Lisp::Debug.log_result(result, env)
@@ -236,8 +249,8 @@ module Lisp
       return self if empty?
       sexpr = if @car.symbol?
                 key = @car
-                frame = nth(2)
-                value = nth(3)
+                frame = nth(1)
+                value = nth(2)
                 
                 s = key.name
                 if s.end_with?(":")
@@ -246,6 +259,10 @@ module Lisp
                   ConsCell.array_to_list([Symbol.named("set-slot!"), frame, Symbol.named(s[0..-2]), value])
                 elsif s.end_with?(":?")
                   ConsCell.array_to_list([Symbol.named("has-slot?"), frame, Symbol.named(s[0..-2])])
+                elsif s.end_with?(":>")
+                  ConsCell.array_to_list([Symbol.named("send"), frame, Symbol.named(s[0..-2])] << self.cdddr)
+                elsif s.end_with?(":^")
+                  ConsCell.array_to_list([Symbol.named("send-super"), frame, Symbol.named(s[0..-2])] << self.cdddr)
                 else
                   self
                 end
@@ -256,6 +273,7 @@ module Lisp
     end
 
     def evaluate_each(env)
+      return nil if empty?
       result = @car.evaluate(env)
       return result if @cdr.nil?
       @cdr.evaluate_each(env)
@@ -287,9 +305,22 @@ module Lisp
       c
     end
 
+    def print_ary(a)
+      (0...a.length).map {|i| puts (a[i].nil? ? "nil" : a[i])}
+    end
+    
     def flatten
-      ary = to_a.collect {|s| s.list? ? s.to_a : s}
-      ConsCell.array_to_list(ary.flatten)
+      ary = []
+      to_a.each do |s|
+        if s.nil?
+          ary << nil
+        elsif s.list?
+          s.to_a.each {|e| ary << e}
+        else
+          ary << s
+        end
+      end
+      ConsCell.array_to_list(ary)
     end
     
     

data/lib/rubylisp/debug.rb

@@ -18,28 +18,26 @@ module Lisp
       self.on_entry = Set.new
       self.single_step = false
       self.interactive = false
-
-      Primitive.register("debug-trace") {|args, env| Lisp::Debug::debug_trace_impl(args, env) }
-      Primitive.register("debug-on-error") {|args, env| Lisp::Debug::debug_on_error_impl(args, env) }
-      Primitive.register("debug-on-entry") {|args, env| Lisp::Debug::debug_on_entry_impl(args, env) }
-      Primitive.register("add-debug-on-entry") {|args, env| Lisp::Debug::add_debug_on_entry_impl(args, env) }
-      Primitive.register("remove-debug-on-entry") {|args, env| Lisp::Debug::remove_debug_on_entry_impl(args, env) }
-      Primitive.register("debug") {|args, env| Lisp::Debug::debug_impl(args, env) }
-      Primitive.register("dump") {|args, env| Lisp::Debug::dump_imp2l(args, env) }
+      
+      Primitive.register("debug-trace", "1") {|args, env| Lisp::Debug::debug_trace_impl(args, env) }
+      Primitive.register("debug-on-error", "1") {|args, env| Lisp::Debug::debug_on_error_impl(args, env) }
+      Primitive.register("debug-on-entry", "0") {|args, env| Lisp::Debug::debug_on_entry_impl(args, env) }
+      Primitive.register("add-debug-on-entry", "1") {|args, env| Lisp::Debug::add_debug_on_entry_impl(args, env) }
+      Primitive.register("remove-debug-on-entry", "1") {|args, env| Lisp::Debug::remove_debug_on_entry_impl(args, env) }
+      Primitive.register("debug", "0") {|args, env| Lisp::Debug::debug_impl(args, env) }
+      Primitive.register("dump", "0") {|args, env| Lisp::Debug::dump_imp2l(args, env) }
     end
-
+    
 
     def self.debug_trace_impl(args, env)
-      return Lisp::Debug.process_error("debug-trace requires 1 argument", env) unless args.length == 1
-      flag = args.car.evaluate(env)
+      flag = args.car
       return Lisp::Debug.process_error("the argument to debug-trace has to be a boolean", env) unless flag.boolean?
       self.trace = flag.value
       flag
     end
   
     def self.debug_on_error_impl(args, env)
-      return Lisp::Debug.process_error("debug-on-error requires 1 argument", env) unless args.length == 1
-      flag = args.car.evaluate(env)
+      flag = args.car
       return Lisp::Debug.process_error("the argument to debug-on-error has to be a boolean", env) unless flag.boolean?
       self.on_error = flag.value
       flag
@@ -50,8 +48,7 @@ module Lisp
     end
   
     def self.add_debug_on_entry_impl(args, env)
-      return Lisp::Debug.process_error("add-debug-on-error requires 1 argument", env) unless args.length == 1
-      f = args.car.evaluate(env)
+      f = args.car
       return Lisp::Debug.process_error("the argument to add-debug-on-error has to be a function", env) unless f.function? || f.primitive?
 
       self.on_entry.add(f.name)
@@ -59,8 +56,7 @@ module Lisp
     end
   
     def self.remove_debug_on_entry_impl(args, env)
-      return Lisp::Debug.process_error("remove-debug-on-error requires 1 argument", env) unless args.length == 1
-      f = args.car.evaluate(env)
+      f = args.car
       return Lisp::Debug.process_error("the argument to remove-debug-on-error has to be a function", env) unless f.function?
 
       self.on_entry.remove(f.name)
@@ -232,7 +228,7 @@ module Lisp
         puts(" #{result.to_s}")
       end
     end
-    
-  
+
   end
+
 end

data/lib/rubylisp/environment.rb

@@ -0,0 +1,27 @@
+module Lisp
+
+  class Environment < Atom
+
+    def self.with_value(e)
+      self.new(e)
+    end
+
+    def initialize(e)
+      @value = e
+    end
+
+    def environment?
+      true
+    end
+
+    def equal?(other)
+      other.environment? && @value == other.value
+    end
+
+    def type
+      :environment
+    end
+
+  end
+
+end