rubylisp 0.2.1 → 1.0.2

data/lib/rubylisp/{object.rb → native_object.rb}

@@ -1,21 +1,6 @@
 module Lisp
 
   class NativeObject < Atom
-
-    def self.register
-      Primitive.register("wrap-object")  {|args, env| Lisp::NativeObject::wrap_impl(args, env) }
-    end
-
-    def self.wrap_impl(args, env)
-      return Lisp::Debug.process_error("wrap-object requires 1 argument", env) unless args.length == 1
-      raw_val = args.car.evaluate(env)
-      val = if raw_val.list?
-              raw_val.to_a
-            else
-              raw_val
-            end
-      NativeObject.with_value(val)
-    end
     
     def self.new_instance_of(c)
       self.new(c.alloc.init)

data/lib/rubylisp/number.rb

@@ -42,6 +42,11 @@ module Lisp
       @value < 0
     end
 
+    def eqv?(sexpr)
+      return false unless sexpr.number?
+      @value == sexpr.value
+    end
+
     def type
       :number
     end

data/lib/rubylisp/parser.rb

@@ -10,7 +10,7 @@ module Lisp
     end
 
     def make_hex_number(str)
-      Lisp::Number.with_value(str.gsub("#x", "0x").to_i(0))
+      Lisp::Number.with_value(["0x", str].join.to_i(0))
     end
 
     def make_float(str)
@@ -18,7 +18,7 @@ module Lisp
     end
 
     def make_string(str)
-      Lisp::String.with_value(str[1...-1])
+      Lisp::String.with_value(str)
     end
 
     def make_symbol(str)
@@ -33,7 +33,7 @@ module Lisp
       tok, lit = tokens.next_token
       if tok == :RPAREN
         tokens.consume_token
-        return nil
+        return Lisp::ConsCell.cons()
       end
 
       car = nil
@@ -45,67 +45,85 @@ module Lisp
           cdr = self.parse_sexpr(tokens)
           return nil if tokens.next_token[0] == :EOF
           tok, lit = tokens.next_token
-          return Lisp::Debug.process_error("Expected ')' to follow a dotted tail on line #{tokens.line_number}", env) if tok != :RPAREN
+          return Lisp::Debug.process_error("Expected ')' to follow a dotted tail on line #{tokens.line_number}", Lisp::EnvironmentFrame.global) if tok != :RPAREN
           tokens.consume_token
           return Lisp::ConsCell.array_to_list(cells, cdr)
         else
           car = self.parse_sexpr(tokens)
-          return Lisp::Debug.process_error("Unexpected EOF (expected ')') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
+          return Lisp::Debug.process_error("Unexpected EOF (expected ')') on line #{tokens.line_number}", Lisp::EnvironmentFrame.global) if tokens.next_token[0] == :EOF
           cells << car
         end
         tok, lit = tokens.next_token
       end
 
       tokens.consume_token
-      return Lisp::ConsCell.array_to_list(cells)
+      Lisp::ConsCell.array_to_list(cells)
     end
 
-    def parse_map(tokens)
+    def parse_frame(tokens, literal)
       m = {}
       tok, lit = tokens.next_token
       if tok == :RBRACE
         tokens.consume_token
-        return ConsCell.cons(Symbol.named("make-frame"), nil)
-      end
-
-      cells = []
-      while tok != :RBRACE
-        item = self.parse_sexpr(tokens)
-        return Lisp::Debug.process_error("Unexpected EOF (expected '}') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
-        cells << item
-        tok, lit = tokens.next_token
+        if literal
+          Lisp::Frame.new
+        else
+          Lisp::ConsCell.cons(Lisp::Symbol.named("make-frame"), nil)
+        end
+      else
+        cells = []
+        while tok != :RBRACE
+          item = self.parse_sexpr(tokens)
+          return Lisp::Debug.process_error("Unexpected EOF (expected '}') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
+          cells << item
+          tok, lit = tokens.next_token
+        end
+        
+        tokens.consume_token
+        keys_and_values = Lisp::ConsCell.array_to_list(cells)
+        if literal
+          Lisp::PrimFrame.make_frame_impl(keys_and_values, Lisp::EnvironmentFrame.global)
+        else
+          Lisp::ConsCell.cons(Lisp::Symbol.named("make-frame"), keys_and_values)
+        end
       end
-
-      tokens.consume_token
-      return ConsCell.cons(Symbol.named("make-frame"), ConsCell.array_to_list(cells))
     end
 
 
-    def parse_vector(tokens)
+    def parse_vector(tokens, literal)
       v = []
       tok, lit = tokens.next_token
-      if tok == :RBRACKET
+      if tok == :RPAREN
         tokens.consume_token
-        return ConsCell.cons(Symbol.named("make-vector"), nil)
-      end
-
-      cells = []
-      while tok != :RBRACKET
-        item = self.parse_sexpr(tokens)
-        return Lisp::Debug.process_error("Unexpected EOF (expected ']') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
-        cells << item
-        tok, lit = tokens.next_token
+        if literal
+          Lisp::Vector.new
+        else
+          Lisp::ConsCell.cons(Lis::Symbol.named("vector"), nil)
+        end
+      else
+        cells = []
+        while tok != :RPAREN
+          item = self.parse_sexpr(tokens)
+          return Lisp::Debug.process_error("Unexpected EOF (expected ')') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
+          cells << item
+          tok, lit = tokens.next_token
+        end
+        
+        tokens.consume_token
+        
+        if literal
+          Lisp::Vector.with_array(cells)
+        else
+          Lisp::ConsCell.cons(Lisp::Symbol.named("vector"), Lisp::ConsCell.array_to_list(cells))
+        end
       end
-
-      tokens.consume_token
-      return ConsCell.cons(Symbol.named("make-vector"), ConsCell.array_to_list(cells))
     end
 
     
     def parse_sexpr(tokens)
       while true
         tok, lit = tokens.next_token
-        #puts "token: <#{tok}, #{lit}>"
+        # puts "token: <#{tok}, #{lit}>"
         return nil if tok == :EOF
         tokens.consume_token
         case tok
@@ -124,33 +142,37 @@ module Lisp
         when :LPAREN
           return parse_cons_cell(tokens)
         when :LBRACE
-          return parse_map(tokens)
-        when :LBRACKET
-          return parse_vector(tokens)
+          return parse_frame(tokens, false)
+        when :QUOTE_LBRACE
+          return parse_frame(tokens, true)
+        when :HASH_LPAREN
+          return parse_vector(tokens, false)
+        when :QUOTE_HASH_LPAREN
+          return parse_vector(tokens, true)
         when :SYMBOL
           return make_symbol(lit)
         when :FFI_NEW_SYMBOL
-          return FfiNew.new(lit)
+          return Lisp::FfiNew.new(lit)
         when :FFI_SEND_SYMBOL
-          return FfiSend.new(lit)
+          return Lisp::FfiSend.new(lit)
         when :FFI_STATIC_SYMBOL
-          return FfiStatic.new(lit)
+          return Lisp::FfiStatic.new(lit)
         when :FALSE
           return Lisp::FALSE
         when :TRUE
           return Lisp::TRUE
         when :QUOTE
           expr = parse_sexpr(tokens)
-          return ConsCell.array_to_list([Symbol.named('quote'), expr])
+          return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('quote'), expr])
         when :BACKQUOTE
           expr = parse_sexpr(tokens)
-          return ConsCell.array_to_list([Symbol.named('quasiquote'), expr])
+          return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('quasiquote'), expr])
         when :COMMA
           expr = parse_sexpr(tokens)
-          return ConsCell.array_to_list([Symbol.named('unquote'), expr])
+          return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('unquote'), expr])
         when :COMMAAT
           expr = parse_sexpr(tokens)
-          return ConsCell.array_to_list([Symbol.named('unquote-splicing'), expr])
+          return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('unquote-splicing'), expr])
         when :ILLEGAL
           return Lisp::Debug.process_error("Illegal token: #{lit} on line #{tokens.line_number}", Lisp::EnvironmentFrame.global)
         else
@@ -160,21 +182,23 @@ module Lisp
     end
 
     def parse(src)
-      tokenizer = Tokenizer.new(src)
-      tokenizer.init
-
-      sexpr = self.parse_sexpr(tokenizer)
-      return sexpr
+      tokenizer = Tokenizer.from_string(src)
+      self.parse_sexpr(tokenizer)
     end
 
+    def parse_object_from_file(port, env=Lisp::EnvironmentFrame.global)
+      tokenizer = Tokenizer.from_file(port)
+      result = self.parse_sexpr(tokenizer)
+      result.nil? ? Lisp::EofObject.instance : result
+    end
+    
     def parse_and_eval(src, env=Lisp::EnvironmentFrame.global)
       sexpr = self.parse(src)
       return sexpr.evaluate(env)
     end
 
     def parse_and_eval_all(src, env=Lisp::EnvironmentFrame.global)
-      tokenizer = Tokenizer.new(src)
-      tokenizer.init
+      tokenizer = Tokenizer.from_string(src)
       result = nil
       until tokenizer.eof?
         sexpr = self.parse_sexpr(tokenizer)
@@ -183,7 +207,12 @@ module Lisp
       result
     end
     
-
+    def process_file(fname)
+      File.open(fname) do |f|
+        parse_and_eval_all(f.read)
+      end
+    end
+    
   end
 
 end

data/lib/rubylisp/port.rb

@@ -0,0 +1,27 @@
+module Lisp
+
+  class Port < Atom
+
+    def self.with_value(p)
+      self.new(p)
+    end
+
+    def initialize(p)
+      @value = p
+    end
+
+    def type
+      :port
+    end
+
+    def port?
+      true
+    end
+
+    def to_s
+      "<port: #{@value}>"
+    end
+
+  end
+
+end

data/lib/rubylisp/prim_alist.rb

@@ -0,0 +1,115 @@
+module Lisp
+
+  class PrimAlist
+
+    
+    def self.register
+      Primitive.register("acons", "2|3")      {|args, env| Lisp::PrimAlist::acons_impl(args, env) }
+      Primitive.register("assq", "2")         {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.eq?(b) } }
+      Primitive.register("assv", "2")         {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.eqv?(b) } }
+      Primitive.register("assoc", "2")        {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.equal?(b) } }
+      Primitive.register("rassq", "2")        {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.eq?(b) } }
+      Primitive.register("rassv", "2")        {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.eqv?(b) } }
+      Primitive.register("rassoc", "2")       {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.equal?(b) } }
+      Primitive.register("del-assq", "2")     {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eq?(b) } }
+      Primitive.register("dissq", "2")        {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eq?(b) } }
+      Primitive.register("del-assv", "2")     {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eqv?(b) } }
+      Primitive.register("dissv", "2")        {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eqv?(b) } }
+      Primitive.register("del-assoc", "2")    {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.equal?(b) } }
+      Primitive.register("dissoc", "2")       {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.equal?(b) } }
+      Primitive.register("zip", "2|3")        {|args, env| Lisp::PrimAlist::zip_impl(args, env) }
+      Primitive.register("pairlis", "2|3")    {|args, env| Lisp::PrimAlist::zip_impl(args, env) }
+    end
+
+    
+    def self.acons_impl(args, env)
+      key = args.car
+      value = args.cadr
+      alist = args.length == 2 ? nil : args.caddr
+      return Lisp::Debug.process_error("the last argument to acons has to be a list", env) unless alist.list?
+
+      pair = ConsCell.cons(key, value)
+      if alist.nil?
+        ConsCell.cons(pair)
+      else
+        ConsCell.cons(pair, alist)
+      end
+    end
+
+    
+    def self.assoc_impl(args, env, &equivalence_block)
+      key = args.car
+      alist = args.cadr
+      return Lisp::Debug.process_error("the last argument to assoc has to be a list", env) unless alist.list?
+
+      alist.each do |pair|
+        if equivalence_block.call(pair.car, key)
+          return pair
+        end
+      end
+    end
+
+    
+    def self.rassoc_impl(args, env, &equivalence_block)
+      value = args.car
+      alist = args.cadr
+      return Lisp::Debug.process_error("the last argument to rassoc has to be a list", env) unless alist.list?
+      alist.each do |pair|
+        if equivalence_block.call(pair.cdr, value)
+          return pair
+        end
+      end
+    end
+
+    
+    def self.dissoc_impl(args, env, &equivalence_block)
+      key = args.car
+      alist = args.cadr
+      return Lisp::Debug.process_error("the last argument to dissoc has to be a list", env) unless alist.list?
+
+      new_prefix = nil
+      trailing_end = nil
+      crawler = alist
+      while !crawler.nil? 
+        if equivalence_block.call(crawler.caar, key)
+          if new_prefix.nil?
+            new_prefix = crawler.cdr
+          else
+            trailing_end.set_cdr!(crawler.cdr)
+          end
+          return new_prefix
+        else
+          new_cell = ConsCell.cons(ConsCell.cons(crawler.caar, crawler.cdar))
+          if new_prefix.nil?
+            new_prefix = new_cell
+            trailing_end = new_prefix
+          else
+            trailing_end.set_cdr!(new_cell)
+          end
+        end
+        crawler = crawler.cdr
+      end
+    end
+    
+
+    def self.zip_impl(args, env)
+      key_list = args.car
+      return Lisp::Debug.process_error("the keys supplied to zip has to be a list", env) unless key_list.list?
+      value_list = args.cadr
+      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
+
+      old_list = if args.length == 3
+                   alist = args.caddr
+                   return Lisp::Debug.process_error("the third argument to zip has to be a list", env) unless alist.list?
+                   alist
+                 else
+                   nil
+                 end
+      pairs = key_list.to_a.zip(value_list.to_a)
+      pairs.inject(old_list) {|alist, pair| ConsCell.cons(ConsCell.cons(*pair), alist)}
+    end
+    
+  end
+
+end

data/lib/rubylisp/prim_assignment.rb

@@ -0,0 +1,61 @@
+module Lisp
+
+  class PrimAssignment
+
+    def self.register
+      Primitive.register("set!", "2",
+                         "(set! name new-value)\n\nThe way to assign (i.e. rebind) a symbol. `name` is the symbol to be rebound.
+The `new-value` sexpr is evaluated to arrive at the new value to be bound to. Use of `set!` is frowned upon, and should not be used without thought.",
+                         true) { |args, env| Lisp::PrimAssignment::setbang_impl(args, env) }
+      
+      Primitive.register("set-car!", "2",
+                         "(set-car! cons-cell new-value)\n\nSet the `car` pointer of `cons-cell`.") { |args, env| Lisp::PrimAssignment::setcarbang_impl(args, env) }
+      
+      Primitive.register("set-cdr!", "2",
+                         "(set-cdr! cons-cell new-value)\n\nSet the `cdr` pointer of `cons-cell`.") { |args, env| Lisp::PrimAssignment::setcdrbang_impl(args, env) }
+      
+      Primitive.register("set-nth!", "3",
+                         "(set-nth! n list-or-vector new-value)\n\nSets the `n`th element of `list-or-vector` to `new-value`.") { |args, env| Lisp::PrimAssignment::setnthbang_impl(args, env) }
+      
+    end
+
+    
+    def self.setbang_impl(args, env)
+      sym = args.car
+      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
+
+    
+    def self.setcarbang_impl(args, env)
+      pair = args.car
+      return Lisp::Debug.process_error("set-car! requires a pair as it's first argument.", env) unless pair.pair?
+      value = args.cadr
+      pair.set_car!(value)
+    end
+
+    
+    def self.setcdrbang_impl(args, env)
+      pair = args.car
+      return Lisp::Debug.process_error("set-cdr! requires a pair as it's first argument.", env) unless pair.pair?
+      value = args.cadr
+      pair.set_cdr!(value)
+    end
+
+
+    def self.setnthbang_impl(args, env)
+      n = args.car
+      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 non negative.", env) unless n.value >= 0
+
+      l = args.cadr
+      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
+      l.set_nth!(n.value, value)
+      l
+    end
+
+
+  end
+end