rubymotionlisp 0.1.4 → 0.2.0

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: 490db605233e6a3d1bae6cf46d8e1409b40a574f
-  data.tar.gz: e824c1b27bc82ef51da8e3eeb5361afba60b22e8
+  metadata.gz: 9cd26bad53833fe2ee3f15b08e989595f835762a
+  data.tar.gz: 8bc181d5653cb58ce352f6ca4e1ff79a0d66e6fc
 SHA512:
-  metadata.gz: fb3ccd4f6c3303ced67a6b5d952560019938644e0234db70ccfaf5d959f4ba2a4e75eb6608a1e8b2e647d5c34968232b69fff7c1f50b8159b75b2611b3d65ee7
-  data.tar.gz: cb6574334fac4294650d0d9ceaed4e878e7e42d103570005018e8727719f2fbe51d9bf00aa7c3fd4b73e1899685bbe315c6556213058f69ed40dcbc3df331e40
+  metadata.gz: 85e9ff41520cad81442bb0299bd9087e296dc3cc250df0f9b316d1201201d27ab585f9770cb96b1590833c3d50e49e364537b9321b1a79b06a5e9dba93d1428a
+  data.tar.gz: 5e27bb3023a10c31605901fcfb9c8493a441371129e0a59c50389d00b73ee928170299096be4a2a689fb0808eeb228e3efa8c4b13e23f28c7ca072c7b7972b4a

data/lib/rubylisp/alist.rb

@@ -14,12 +14,12 @@ module Lisp
     end
 
     def self.acons_impl(args, env)
-      raise "acons require at least 2 or 3 arguments" unless args.length == 2 || args.length == 3
+      return Lisp::Debug.process_error("acons require at least 2 or 3 arguments", env) unless args.length == 2 || args.length == 3
       key = args.car.evaluate(env)
       value = args.cadr.evaluate(env)
       alist = args.length == 2 ? nil : args.caddr.evaluate(env)
       alist = Lisp::AList.from_list(alist) if !alist.nil? && alist.list? && !alist.alist?
-      raise "the last argument to acons has to be an association list" unless alist.nil? || alist.alist?
+      return Lisp::Debug.process_error("the last argument to acons has to be an association list", env) unless alist.nil? || alist.alist?
 
       if alist.nil?
         Lisp::AList.new({key => value})
@@ -29,44 +29,44 @@ module Lisp
     end
 
     def self.assoc_impl(args, env)
-      raise "assoc require 2 arguments" unless args.length == 2
+      return Lisp::Debug.process_error("assoc require 2 arguments", env) unless args.length == 2
       key = args.car.evaluate(env)
       alist = args.cadr.evaluate(env)
       alist = Lisp::AList.from_list(alist) if alist.list? && !alist.alist?
-      raise "the last argument to assoc has to be an association list" unless alist.alist?
+      return Lisp::Debug.process_error("the last argument to assoc has to be an association list", env) unless alist.alist?
       alist.assoc(key)
     end
 
     def self.rassoc_impl(args, env)
-      raise "assoc require 2 arguments" unless args.length == 2
+      return Lisp::Debug.process_error("assoc require 2 arguments", env) unless args.length == 2
       value = args.car.evaluate(env)
       alist = args.cadr.evaluate(env)
       alist = Lisp::AList.from_list(alist) if alist.list? && !alist.alist?
-      raise "the last argument to rassoc has to be an association list" unless alist.alist?
+      return Lisp::Debug.process_error("the last argument to rassoc has to be an association list", env) unless alist.alist?
       alist.rassoc(value)
     end
 
     def self.dissoc_impl(args, env)
-      raise "assoc require 2 arguments" unless args.length == 2
+      return Lisp::Debug.process_error("assoc require 2 arguments", env) unless args.length == 2
       key = args.car.evaluate(env)
       alist = args.cadr.evaluate(env)
       alist = Lisp::AList.from_list(alist) if alist.list? && !alist.alist?
-      raise "the last argument to dissoc has to be an association list" unless alist.alist?
+      return Lisp::Debug.process_error("the last argument to dissoc has to be an association list", env) unless alist.alist?
       alist.dissoc(key)
     end
 
     def self.zip_impl(args, env)
-      raise "assoc require 2 or 3arguments" unless args.length == 2 || args.length == 3
+      return Lisp::Debug.process_error("assoc require 2 or 3arguments", env) unless args.length == 2 || args.length == 3
       key_list = args.car.evaluate(env)
-      raise "the keys supplied to zip has to be a list" unless key_list.list?
+      return Lisp::Debug.process_error("the keys supplied to zip has to be a list", env) unless key_list.list?
       value_list = args.cadr.evaluate(env)
-      raise "the values supplied to zip has to be a list" unless value_list.list?
-      raise "zip requires the same number of keys and values" unless key_list.length == value_list.length
+      return Lisp::Debug.process_error("the values supplied to zip has to be a list", env) unless value_list.list?
+      return Lisp::Debug.process_error("zip requires the same number of keys and values", env) unless key_list.length == value_list.length
 
       if args.length == 3
         alist = args.caddr.evaluate(env)
         alist = Lisp::AList.from_list(alist) if alist.list? && !alist.alist?
-        raise "the third argument to zip has to be an association list" unless alist.alist?
+        return Lisp::Debug.process_error("the third argument to zip has to be an association list", env) unless alist.alist?
         alist.zip(key_list.to_a, value_list.to_a)
       else
         Lisp::AList.zip(key_list.to_a, value_list.to_a)
@@ -74,18 +74,18 @@ module Lisp
     end
 
     def self.alist_to_list_impl(args, env)
-      raise "alist-to-list requires 1 arguments" unless args.length == 1
+      return Lisp::Debug.process_error("alist-to-list requires 1 arguments", env) unless args.length == 1
       alist = args.car.evaluate(env)
       return alist if alist.list? && !alist.alist?
-      raise "the argument to alist-to-list has to be an association list" unless alist.alist?
+      return Lisp::Debug.process_error("the argument to alist-to-list has to be an association list", env) unless alist.alist?
             
       alist.to_list
     end
     
     def self.list_to_alist_impl(args, env)
-      raise "list-to-alist requires 1 arguments" unless args.length == 1
+      return Lisp::Debug.process_error("list-to-alist requires 1 arguments", env) unless args.length == 1
       list = args.car.evaluate(env)
-      raise "the argument to list-to-alist has to be a list" unless list.list?
+      return Lisp::Debug.process_error("the argument to list-to-alist has to be a list", env) unless list.list?
             
       Lisp::AList.from_list(list)
     end

data/lib/rubylisp/assignment.rb

@@ -25,7 +25,7 @@ The `new-value` sexpr is evaluated to arrive at the new value to be bound to. Us
     
     def self.setbang_impl(args, env)
       sym = args.car
-      raise "set! requires a raw (unevaluated) symbol as it's first argument." unless sym.symbol?
+      return Lisp::Debug.process_error("set! requires a raw (unevaluated) symbol as it's first argument.", env) unless sym.symbol?
       value = args.cadr.evaluate(env)
       env.set(sym, value)
     end
@@ -33,7 +33,7 @@ The `new-value` sexpr is evaluated to arrive at the new value to be bound to. Us
     
     def self.setcarbang_impl(args, env)
       pair = args.car.evaluate(env)
-      raise "set-car! requires a pair as it's first argument." unless pair.pair?
+      return Lisp::Debug.process_error("set-car! requires a pair as it's first argument.", env) unless pair.pair?
       value = args.cadr.evaluate(env)
       pair.set_car!(value)
     end
@@ -41,20 +41,20 @@ The `new-value` sexpr is evaluated to arrive at the new value to be bound to. Us
     
     def self.setcdrbang_impl(args, env)
       pair = args.car.evaluate(env)
-      raise "set-cdr! requires a pair as it's first argument." unless pair.pair?
+      return Lisp::Debug.process_error("set-cdr! requires a pair as it's first argument.", env) unless pair.pair?
       value = args.cadr.evaluate(env)
       pair.set_cdr!(value)
     end
 
 
     def self.setnthbang_impl(args, env)
-      raise "set-nth! requires 3 arguments." unless args.length == 3
+      return Lisp::Debug.process_error("set-nth! requires 3 arguments.", env) unless args.length == 3
       n = args.car.evaluate(env)
-      raise "The first argument of set-nth! has to be an number." unless n.number?
-      raise "The first argument of set-nth! has to be positive." unless n.value > 0
+      return Lisp::Debug.process_error("The first argument of set-nth! has to be an number.", env) unless n.number?
+      return Lisp::Debug.process_error("The first argument of set-nth! has to be positive.", env) unless n.value > 0
 
       l = args.cadr.evaluate(env)
-      raise "set-nth! requires a list or vector as it's first argument." unless l.list? || l.vector?
+      return Lisp::Debug.process_error("set-nth! requires a list or vector as it's first argument.", env) unless l.list? || l.vector?
       value = args.caddr.evaluate(env)
       l.set_nth!(n.value, value)
       l

data/lib/rubylisp/builtins.rb

@@ -25,6 +25,7 @@ module Lisp
       Lisp::ClassObject.register
       Lisp::System.register
       Lisp::Vector.register
+      Lisp::Debug.register
     end
   end
 

data/lib/rubylisp/character.rb

@@ -99,39 +99,40 @@ module Lisp
 
 
     def self.char_name_impl(args, env)
-      raise "char->name requires a single argument, found #{args.length}" unless args.length == 1
+      return Lisp::Debug.process_error("char->name requires a single argument, found #{args.length}", env) unless args.length == 1
       char = args.car.evaluate(env)
-      raise "char->name requires a character argument" unless char.character?
+      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?
-      raise "char->name was passed an invalid character"
+      return Lisp::Debug.process_error("char->name was passed an invalid character", env)
     end
 
 
     def self.name_char_impl(args, env)
-      raise "name->char requires a single argument, found #{args.length}" unless args.length == 1
+      return Lisp::Debug.process_error("name->char requires a single argument, found #{args.length}", env) unless args.length == 1
       name = args.car.evaluate(env)
-      raise "name->char requires a string argument" unless name.string?
+      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?
-      raise "There is no character with the name #{name}"
+      return Lisp::Debug.process_error("There is no character with the name #{name}", env)
     end
 
 
     def self.get_one_character_arg(func, args, env)
-      raise "#{func} requires a character argument, found no args" unless args.length >= 1
+      return Lisp::Debug.process_error("#{func} requires a character argument, found no args", env) unless args.length >= 1
       char1 = args.car.evaluate(env)
-      raise "#{func} requires a character argument, found #{char1}" unless char1.character?
+      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)
-      raise "#{func} requires two arguments, found #{args.length}" unless args.length == 2
+      return Lisp::Debug.process_error("#{func} requires two arguments, found
+                                ##{args.length}", env) unless args.length == 2
       char1 = args.car.evaluate(env)
-      raise "#{func} requires character arguments, found #{char1}" unless char1.character?
+      return Lisp::Debug.process_error("#{func} requires character arguments, found #{char1}", env) unless char1.character?
       char2 = args.cadr.evaluate(env)
-      raise "#{func} requires character arguments, found #{char2}" unless char2.character?
+      return Lisp::Debug.process_error("#{func} requires character arguments, found #{char2}", env) unless char2.character?
       return [char1, char2]
     end
 
@@ -197,7 +198,7 @@ module Lisp
 
 
     def self.charp_impl(args, env)
-      raise "char->name requires a single argument, found #{args.length}" unless args.length == 1
+      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
@@ -221,8 +222,8 @@ module Lisp
                10
              else
                b = args.cadr.evaluate(env)
-               raise "Base for char->digit has to be an integer" unless b.integer?
-               raise "Base for char->digit has to be between 2 and 36" unless b.value >=2 && b.value <= 36
+               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
@@ -246,13 +247,13 @@ module Lisp
 
     def self.digit_char_impl(args, env)
       d = args.car.evaluate(env)
-      raise "Digit value for digit->char has to be an integer" unless d.integer?
+      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)
-               raise "Base for char->digit has to be an integer" unless b.integer?
-               raise "Base for char->digit has to be between 2 and 36" unless b.value >=2 && b.value <= 36
+               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
@@ -269,7 +270,7 @@ module Lisp
 
     def self.int_char_impl(args, env)
       i = args.car.evaluate(env)
-      raise "Integer value for int->char has to be an integer" unless i.integer?
+      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
 
@@ -374,10 +375,10 @@ module Lisp
       elsif n[0..1] == "U+"
         find_character_for_chr(n[2..-1].to_i(16).chr)
       else
-        raise "Invalid character name: #{n}"
+        return Lisp::Debug.process_error("Invalid character name: #{n}", env)
       end
     end
 
-end
+  end
 
 end

data/lib/rubylisp/cons_cell.rb

@@ -123,6 +123,8 @@ module Lisp
     def to_s
       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 "(#{@car.to_s} . #{@cdr.to_s})" if !@cdr.nil? && !@cdr.pair?
       return "(#{self.to_s_helper})"
     end
@@ -134,6 +136,8 @@ module Lisp
     def print_string
       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 "(#{@car.print_string} . #{@cdr.print_string})" if !@cdr.nil? && !@cdr.pair?
       return "(#{self.print_string_helper})"
     end
@@ -203,13 +207,52 @@ module Lisp
       return nil unless obj.object?
       return obj.value
     end
+
+    
+
+    def inner_eval(env)
+      func = @car.evaluate(env)
+      return Lisp::Debug.process_error("There is no function or macro named #{@car}", env) if func.nil?
+      env.current_code.unshift(self.print_string()) if !Lisp::Debug.eval_in_debug_repl && Lisp::Debug.interactive
+
+      Lisp::Debug.log_eval(self, env)
       
+      unless Lisp::Debug.eval_in_debug_repl
+        if !Lisp::Debug.target_env.nil? && env == Lisp::Debug.target_env.previous
+          Lisp::Debug.target_env = nil
+          Lisp::Debug.debug_repl(env)
+        elsif Lisp::Debug.single_step || (func.function? && Lisp::Debug.on_entry.include?(func.name))
+          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)
+      result
+    end
+    
 
     def evaluate(env)
       return self if empty?
-      func = @car.evaluate(env)
-      raise "There is no function or macro named #{@car}" if func.nil?
-      func.apply_to(@cdr, env)
+      sexpr = if @car.symbol?
+                key = @car
+                frame = nth(2)
+                value = nth(3)
+                
+                s = key.name
+                if s.end_with?(":")
+                  ConsCell.array_to_list([Symbol.named("get-slot"), frame, key])
+                elsif s.end_with?(":!")
+                  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])])
+                else
+                  self
+                end
+              else
+                self
+              end
+      sexpr.inner_eval(env)
     end
 
     def evaluate_each(env)

data/lib/rubylisp/debug.rb

@@ -0,0 +1,238 @@
+# Copyright 2014 David R. Astels.  All rights reserved.
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file.
+
+  
+module Lisp
+
+  class Debug
+
+    class <<self
+      attr_accessor :trace, :on_error, :on_entry, :single_step, :interactive, :target_env, :eval_in_debug_repl
+    end
+      
+
+    def self.register
+      self.trace = false
+      self.on_error = false
+      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) }
+    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)
+      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)
+      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
+    end
+  
+    def self.debug_on_entry_impl(args, env)
+      Lisp::ConsCell.array_to_list(self.on_entry.to_a.sort.map {|s| Lisp::String.with_value(s) })
+    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)
+      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)
+      f
+    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)
+      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)
+      f
+    end
+  
+    def self.debug_impl(args, env)
+    end
+  
+    def self.dump_impl(args, env)
+      env.dump()
+    end
+
+
+    def self.process_state(tokens)
+      if tokens.size != 2
+        puts "Missing on/off"
+        [false, false]
+      else
+        case tokens[1]
+        when 'on'
+          [true, true]
+        when 'off'
+          [true, false]
+        else
+          puts "on/off expected."
+          [false, false]
+        end
+      end
+    end
+
+
+    def func_or_nil(fname, env)
+      f = env.value_of(Lisp::Symbol.named(fname))
+      if f.nil? || !f.function?
+        puts "No such function."
+        nil
+      else
+        f
+      end
+    end
+
+    
+    def self.debug_repl(env)
+      parser = Lisp::Parser.new
+      puts("Debugging: #{env.current_code[0]}")
+      while line = Readline.readline('D> ', true)
+        if !line.empty?
+          if line[0] == ':'
+            tokens = line[1..-1].split
+            case tokens[0]
+            when '(+'
+              f = func_or_nil(tokens[1], env)
+              self.on_entry.add(f.name) unless f.nil?
+            when '(-'
+              f = func_or_nil(tokens[1], env)
+              self.on_entry.delete(f.name) unless f.nil?
+            when '('
+              self.on_entry.to_a.sort.each {|f| puts f}
+            when '?'
+              puts "RubyLisp Debugger"
+              puts "-----------------"
+              puts ":(+ func  - debug on entry to func"
+              puts ":(- func  - don't debug on entry to func"
+              puts ":(        - show functions marked as debug on entry"
+              puts ":?        - show this command summary"
+              puts ":b        - show the environment stack"
+              puts ":c        - continue, exiting the debugger"
+              puts ":d        - do a full of the environment stack"
+              puts ":e on/off - Enable/disable debug on error"
+              puts ":f frame# - do a full dump of a single environment frame"
+              puts ":q        - quit GoLisp"
+              puts ":r sexpr  - return from the current evaluation with the specified value"
+              puts ":s        - single step (run to the next evaluation)"
+              puts ":t on/off - Enable/disable tracing"
+              puts ":u        - continue until the enclosing environment frame is returned to"
+              puts
+            when 'b'
+              env.dump_headers()
+              puts
+            when 'c'
+              self.target_env = nil
+              self.single_step = false
+              self.eval_in_debug_repl = false
+              return
+            when 'd'
+              env.dump
+            when 'e'
+              ok, state = process_state(tokens)
+              self.on_error = state if ok
+            when 'f'
+              if tokens.size != 2
+                puts "Missing frame number."
+              else
+                fnum = tokens[1].to_i
+                env.dump_single_frame(fnum)
+              end
+            when 'q'
+              exit()
+            when 'r'
+              self.eval_in_debug_repl = true
+              code = parser.parse(tokens[1..-1].join(' '))
+              return_value = code.evaluate(env)
+              self.eval_in_debug_repl = false
+              self.target_env = nil
+              self.single_step = false
+              self.eval_in_debug_repl = false
+              return return_value
+            when 's'
+              self.single_step = true
+              return
+            when 't'
+              ok, state = process_state(tokens)
+              self.trace = state if ok
+            when 'u'
+              if env.previous.nil?
+                puts "Already at top frame."
+              else
+                self.target_env = env
+                return
+              end
+            end
+          else
+            begin 
+              self.eval_in_debug_repl = true
+              code = parser.parse(line)
+              value = code.evaluate(env)
+              self.eval_in_debug_repl = false
+              puts value.to_s
+            rescue Exception => ex
+              puts "ERROR: #{ex}"
+              puts ex.backtrace
+            end
+          end
+        end
+      end
+    end
+
+    def self.process_error(error_message, env)
+      if self.on_error && self.interactive
+        puts "ERROR: #{error_message}"
+        self.debug_repl(env)
+      else
+        raise error_message
+      end
+    end
+
+
+    def self.print_dashes(level)
+      print("-" * level)
+    end
+
+    
+    def self.log_eval(sexpr, env)
+      if !self.eval_in_debug_repl && self.trace
+        depth = env.depth
+        print("% #d: " % depth)
+        print_dashes(depth)
+        puts("> #{sexpr.to_s}")
+      end
+    end
+
+
+    def self.log_result(result, env)
+      if !self.eval_in_debug_repl && self.trace
+        depth = env.depth
+        print("% #d: <" % depth)
+        print_dashes(depth)
+        puts(" #{result.to_s}")
+      end
+    end
+    
+  
+  end
+end