rubylisp 0.1.0

checksums.yaml

@@ -0,0 +1,7 @@
+---
+SHA1:
+  metadata.gz: 3e43b771e458951f6724a4ea368359b651af68aa
+  data.tar.gz: 32043fab0730d6414558a3fed26e3063b0a16943
+SHA512:
+  metadata.gz: 13a455aa9220f5f7850a5a2f9e6c54f2544cc6b5f946d3529cc056a0d4b589ca856f426da3604f22e1c986ff7535b1b96690a08fd4d30f25883eed3c2151a23a
+  data.tar.gz: c5fd927f7d655390e1dc5d9a415f1ccb04fb1ed775e59d8b60aa5b16da3eb19325aeb99bc74aff20ef76321736c7c6866fbb77593deefad49bcee2a404b7499d

data/bin/rubylisp

@@ -0,0 +1,14 @@
+#!/usr/bin/env ruby
+
+require 'rubylisp'
+require 'readline'
+
+Lisp::Initializer.register_builtins
+
+puts 'RubyLisp REPL'
+parser = Lisp::Parser.new
+
+while line = Readline.readline('> ', true)
+  puts parser.parse(line).evaluate(Lisp::EnvironmentFrame.global).to_s
+end
+

data/lib/rubylisp/alist.rb

@@ -0,0 +1,230 @@
+module Lisp
+
+  class AList < Object
+    include Enumerable
+
+    def self.register
+      Primitive.register("acons")         {|args, env| Lisp::AList::acons_impl(args, env) }
+      Primitive.register("assoc")         {|args, env| Lisp::AList::assoc_impl(args, env) }
+      Primitive.register("rassoc")        {|args, env| Lisp::AList::rassoc_impl(args, env) }
+      Primitive.register("dissoc")        {|args, env| Lisp::AList::dissoc_impl(args, env) }
+      Primitive.register("zip")           {|args, env| Lisp::AList::zip_impl(args, env) }
+      Primitive.register("alist-to-list") {|args, env| Lisp::AList::alist_to_list_impl(args, env) }
+      Primitive.register("list-to-alist") {|args, env| Lisp::AList::list_to_alist_impl(args, env) }
+    end
+
+    def self.acons_impl(args, env)
+      raise "acons require at least 2 or 3 arguments" 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?
+
+      if alist.nil?
+        Lisp::AList.new({key => value})
+      else
+        alist.acons(key, value)
+      end
+    end
+
+    def self.assoc_impl(args, env)
+      raise "assoc require 2 arguments" 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?
+      alist.assoc(key)
+    end
+
+    def self.rassoc_impl(args, env)
+      raise "assoc require 2 arguments" 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?
+      alist.rassoc(value)
+    end
+
+    def self.dissoc_impl(args, env)
+      raise "assoc require 2 arguments" 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?
+      alist.dissoc(key)
+    end
+
+    def self.zip_impl(args, env)
+      raise "assoc require 2 or 3arguments" 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?
+      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
+
+      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?
+        alist.zip(key_list.to_a, value_list.to_a)
+      else
+        Lisp::AList.zip(key_list.to_a, value_list.to_a)
+      end
+    end
+
+    def self.alist_to_list_impl(args, env)
+      raise "alist-to-list requires 1 arguments" 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?
+            
+      alist.to_list
+    end
+    
+    def self.list_to_alist_impl(args, env)
+      raise "list-to-alist requires 1 arguments" unless args.length == 1
+      list = args.car.evaluate(env)
+      raise "the argument to list-to-alist has to be a list" unless list.list?
+            
+      Lisp::AList.from_list(list)
+    end
+
+    
+    def initialize(h=nil)
+      @value = h || {}
+    end
+
+    def lisp_object?
+      true
+    end
+    
+    def eq?(sexpr)
+      return false unless sexpr.alist?
+      @value == sexpr.value
+    end
+    
+    def empty?
+      @value.empty?
+    end
+
+    def string?
+      false
+    end
+
+    def character?
+      false
+    end
+
+    def number?
+      false
+    end
+
+    def positive?
+      false
+    end
+
+    def zero?
+      false
+    end
+
+    def negative?
+      false
+    end
+
+    def symbol?
+      false
+    end
+
+    def primitive?
+      false
+    end
+
+    def function?
+      false
+    end
+
+    def macro?
+      false
+    end
+
+    def pair?
+      true
+    end
+
+    def list?
+      true
+    end
+
+    def alist?
+      true
+    end
+
+    def frame?
+      false
+    end
+    
+    def length
+      return @value.length
+    end
+
+    def car
+      @value.first
+    end
+
+    def cdr
+    end
+
+    def acons(k, v)
+      @value[k] = v
+      self
+    end
+
+    def assoc(k)
+      v = @value[k]
+      Lisp::ConsCell.cons(k, v)
+    end
+
+    def rassoc(value)
+      @value.each do |k, v|
+        return Lisp::ConsCell.cons(k, v) if value == v || value.eq?(v)
+      end
+    end
+
+    def dissoc(k)
+      @value.delete(k)
+      self
+    end
+
+    def zip(keys, values)
+      keys.zip(values).each {|k, v| @value[k] = v}
+      self
+    end
+    
+    def self.zip(keys, values)
+      self.new.zip(keys, values)
+    end
+
+    def self.from_list(list)
+      h = {}
+      list.each do |pair|
+        h[pair.car] = pair.cdr
+      end
+      self.new(h)
+    end
+
+    def to_list
+      Lisp::ConsCell.array_to_list(@value.map {|k, v| Lisp::ConsCell.cons(k, v)})
+    end
+
+    def to_s
+      to_list.to_s
+    end
+
+   def print_string
+      self.to_s
+    end
+
+  end
+
+end

data/lib/rubylisp/assignment.rb

@@ -0,0 +1,65 @@
+module Lisp
+
+  class Assignment
+
+    def self.register
+      Primitive.register("set!", "(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.") do |args, env|
+        Lisp::Assignment::setbang_impl(args, env)
+      end
+      
+      Primitive.register("set-car!", "(set-car! _cons-cell_ _new-value_)\n\nSet the `car` pointer of `cons-cell`.") do |args, env|
+        Lisp::Assignment::setcarbang_impl(args, env)
+      end
+      
+      Primitive.register("set-cdr!", "(set-cdr! _cons-cell_ _new-value_)\n\nSet the `cdr` pointer of `cons-cell`.") do |args, env|
+        Lisp::Assignment::setcdrbang_impl(args, env)
+      end
+      
+      Primitive.register("set-nth!", "(set-nth! _n_ _list-or-vector_ _new-value_)\n\nSets the `n`th element of `list-or-vector` to `new-value`.") do |args, env|
+        Lisp::Assignment::setnthbang_impl(args, env)
+      end
+      
+    end
+
+    
+    def self.setbang_impl(args, env)
+      sym = args.car
+      raise "set! requires a raw (unevaluated) symbol as it's first argument." unless sym.symbol?
+      value = args.cadr.evaluate(env)
+      env.set(sym, value)
+    end
+
+    
+    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?
+      value = args.cadr.evaluate(env)
+      pair.set_car!(value)
+    end
+
+    
+    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?
+      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
+      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
+
+      l = args.cadr.evaluate(env)
+      raise "set-nth! requires a list or vector as it's first argument." unless l.list? || l.vector?
+      value = args.caddr.evaluate(env)
+      l.set_nth!(n.value, value)
+      l
+    end
+
+
+  end
+end

data/lib/rubylisp/atom.rb

@@ -0,0 +1,149 @@
+module Lisp
+
+  class Atom < Object
+
+    attr_reader :value
+
+    def lisp_object?
+      true
+    end
+    
+    def string?
+      false
+    end
+
+    def character?
+      false
+    end
+
+    def number?
+      false
+    end
+
+    def positive?
+      false
+    end
+
+    def zero?
+      false
+    end
+
+    def negative?
+      false
+    end
+
+    def symbol?
+      false
+    end
+
+    def pair?
+      false
+    end
+
+    def list?
+      false
+    end
+    
+    def primitive?
+      false
+    end
+    
+    def special?
+      false
+    end
+
+    def function?
+      false
+    end
+
+    def macro?
+      false
+    end
+
+    def object?
+      false
+    end
+
+    def class?
+      false
+    end
+
+    def alist?
+      false
+    end
+
+    def frame?
+      false
+    end
+
+    def vector?
+      false
+    end
+
+    def length
+      1
+    end
+
+    def copy
+      self.class.new(self.value)
+    end
+    
+    def eq?(sexpr)
+      return false if sexpr.nil?
+      return false if self.type != sexpr.type
+      self.value == sexpr.value
+    end
+    
+    def type
+      :unknown
+    end
+
+    def evaluate(env)
+      self
+    end
+
+    def apply_to(args, env)
+      nil
+    end
+
+    def all?(&block)
+      false
+    end
+
+    def true?
+      true
+    end
+
+    def false?
+      false
+    end
+
+    def car
+      nil
+    end
+
+    def cdr
+      nil
+    end
+
+    def quoted
+      Lisp::ConsCell.cons(Symbol.named("quote"), self)
+    end
+
+    def set!(v)
+    end
+
+    def print_string
+      self.to_s
+    end
+
+    alias print_string_helper print_string
+
+    
+    def doc
+      nil
+    end
+    
+  end
+
+end

data/lib/rubylisp/binding.rb

@@ -0,0 +1,17 @@
+module Lisp
+
+  class Binding
+    attr_accessor :symbol, :value
+
+    def initialize(symbol, value)
+      @symbol = symbol
+      @value = value
+      self
+    end
+
+    def to_s
+      "#{symbol.name} -> #{value.to_s}"
+    end
+  end
+
+end

data/lib/rubylisp/boolean.rb

@@ -0,0 +1,49 @@
+module Lisp
+
+  class Boolean < Atom
+    def self.TRUE
+      @true_constant ||= Boolean.new(true)
+    end
+
+    def self.FALSE
+      @false_constant ||= Boolean.new(false)
+    end
+
+    def self.with_value(b)
+      b ? self.TRUE : self.FALSE
+    end
+
+    def initialize(b)
+      @value = b
+    end
+
+    def type
+      :boolean
+    end
+
+    def boolean?
+      true
+    end
+
+    def to_s
+      return "#t" if @value
+      "#f"
+    end
+
+    def true?
+      @value
+    end
+
+    def false?
+      !@value
+    end
+
+    def negate
+      Lisp::Boolean.with_value(!@value)
+    end
+    
+  end
+
+  TRUE = Boolean.TRUE
+  FALSE = Boolean.FALSE
+end

data/lib/rubylisp/builtins.rb

@@ -0,0 +1,31 @@
+module Lisp
+
+  class Initializer
+
+    def self.initialize_global_environment
+      Lisp::EnvironmentFrame.global.bind(Symbol.named("nil"), nil)
+    end
+
+    def self.register_builtins
+      Lisp::Equivalence.register
+      Lisp::Math.register
+      Lisp::Logical.register
+      Lisp::SpecialForms.register
+      Lisp::ListSupport.register
+      Lisp::Relational.register
+      Lisp::TypeChecks.register
+      Lisp::Assignment.register
+      Lisp::Testing.register
+      Lisp::IO.register
+      Lisp::AList.register
+      Lisp::Frame.register
+      Lisp::Character.register
+      Lisp::String.register
+      Lisp::NativeObject.register
+      Lisp::ClassObject.register
+      Lisp::System.register
+      Lisp::Vector.register
+    end
+  end
+
+end