rubylisp 0.1.0

data/lib/rubylisp/math.rb

@@ -0,0 +1,403 @@
+module Lisp
+
+  class Math
+
+    def self.register
+      self.bind("PI", ::Math::PI)
+      self.bind("E", ::Math::E)
+      
+      Primitive.register("+", "(+ number...)\n\nAdds a series of numbers.") do |args, env|
+        Lisp::Math.add_impl(args, env)
+      end
+      
+      Primitive.register("-", "(- number...)\n\nSequentially subtracts a sequence of numbers.\nAs expected, a unary form of - is available as well.") do |args, env|
+        Lisp::Math.subtract_impl(args, env)
+      end
+
+      Primitive.register("*", "(* number...)\n\nMultiplies a series of numbers.") do |args, env|
+        Lisp::Math.multiply_impl(args, env)
+      end
+
+      Primitive.register("/", "(/ number...)\n\nSequentially divides a sequence of numbers.") do |args, env|
+        Lisp::Math.quotient_impl(args, env)
+      end
+
+      Primitive.register("%", "(% number number)\n\nReturns the remainder of the division of two numbers. NOTE: modulus only works for integers.") do |args, env|
+        Lisp::Math.remainder_impl(args, env)
+      end
+
+      Primitive.register("modulo", "(modulo number number)\n\nReturns the remainder of the division of two numbers. NOTE: modulus only works for integers.") do |args, env|
+        Lisp::Math.remainder_impl(args, env)
+      end
+
+      Primitive.register("even?", "(even? number)\n\nReturns whether the argument is even.") do |args, env|
+        Lisp::Math.even_impl(args, env)
+      end
+
+      Primitive.register("odd?", "(odd? number)\n\nReturns whether the argument is odd.") do |args, env|
+        Lisp::Math.odd_impl(args, env)
+      end
+
+      Primitive.register("zero?", "(zero? _number_)\n\nReturns whether the argument is zero.") do |args, env|
+        Lisp::Math.zero_impl(args, env)
+      end
+
+      Primitive.register("positive?", "(positive? _number_)\n\nReturns whether the argument is positive.") do |args, env|
+        Lisp::Math.positive_impl(args, env)
+      end
+
+      Primitive.register("negative?", "(negative? _number_)\n\nReturns whether the argument is negative.") do |args, env|
+        Lisp::Math.negative_impl(args, env)
+      end
+
+      Primitive.register("interval", "(interval _lo_ _hi_)\n\nCreates a list of numbers from `lo` to `hi`, inclusive.") do |args, env|
+        Lisp::Math.interval_impl(args, env)
+      end
+
+      Primitive.register("truncate", "(truncate number)\n\nReturns the integer value of number. If it is an integer, it is simply returned. However, if it is a float the integer part is returned.") do |args, env|
+        Lisp::Math.truncate_impl(args, env)
+      end
+
+      Primitive.register("round", "(round number)\n\nIf number is an integer, it is simply returned. However, if it is a float the closest integer is returned.") do |args, env|
+        Lisp::Math.round_impl(args, env)
+      end
+
+      Primitive.register("ceiling", "(ceiling _number_)\n\nIf `number` is an integer, it is simply returned. However, if it is a float the smallest integer greater than or equal to `number` is returned.") do |args, env|
+        Lisp::Math.ceiling_impl(args, env)
+      end
+
+      Primitive.register("floor", "(floor _number_)\n\nIf `number` is an integer, it is simply returned. However, if it is a float the
+largest integer less than or equal to `number` is returned.") do |args, env|
+        Lisp::Math.floor_impl(args, env)
+      end
+
+      Primitive.register("random", "(random)\n\nReturns a pseudo-random floating point number between 0.0 and 1.0, including 0.0 and excluding 1.0.\n\n(random n)\n\nReturns a pseudo-random integer greater than or equal to 0 and less than n.") do |args, env|
+        Lisp::Math.random_impl(args, env)
+      end
+
+      Primitive.register("float", "(float number)\n\nReturns the floating point value of number. If it is a float, it is simply returned. However, if it is an integer it is converted to float and returned.") do |args, env|
+        Lisp::Math.float_impl(args, env)
+      end
+
+      Primitive.register("integer", "(integer number)\n\nReturns the integer value of number. If it is an integer, it is simply returned. However, if it is a float the integer part is returned. This is the same as tuncate.") do |args, env|
+        Lisp::Math.integer_impl(args, env)
+      end
+
+      Primitive.register("sqrt", "(sqrt _number_)\n\nReturns the square root of `number'.") do |args, env|
+        Lisp::Math.sqrt_impl(args, env)
+      end
+
+      Primitive.register("min", "(min _number_...)\n\nReturns the smallest of all the `number` arguments.") do |args, env|
+        Lisp::Math.min_impl(args, env)
+      end
+
+      Primitive.register("max", "(max _number_...)\n\nReturns the largest of all the `number` arguments.") do |args, env|
+        Lisp::Math.max_impl(args, env)
+      end
+
+      Primitive.register("abs", "(abs _number_)\n\nReturns the absolute value of `number'.") do |args, env|
+        Lisp::Math.abs_impl(args, env)
+      end
+
+      Primitive.register("sin", "(sin _number_)\n\nReturns the sine of `number'.") do |args, env|
+        Lisp::Math.sin_impl(args, env)
+      end
+
+      Primitive.register("cos", " (cos _number_)\n\nReturns the cosine of `number'.") do |args, env|
+        Lisp::Math.cos_impl(args, env)
+      end
+
+      Primitive.register("tan", "(tan _number_)\n\nReturns the tangent of `number'.") do |args, env|
+        Lisp::Math.tan_impl(args, env)
+      end
+
+      
+    end
+
+
+    def self.bind(name, number)
+      EnvironmentFrame.global.bind(Symbol.named(name), Number.with_value(number))
+    end
+
+    def self.add_impl(args, env)
+      raise "add needs at least 1 argument" if args.empty?
+
+      acc = 0
+      c = args
+      while !c.nil?
+        n = c.car.evaluate(env)
+        raise "add needs number arguments but was given a #{n.type}: #{n}" unless n.type == :number
+        acc += n.value
+        c = c.cdr
+      end
+
+      Number.with_value(acc)
+    end
+
+
+    def self.subtract_impl(args, env)
+      raise "subtract needs at least 1 argument" if args.empty?
+
+      return Number.with_value(-1 * args.car.evaluate(env).value) if args.length == 1
+
+      first = args.car.evaluate(env)
+      raise "subtract needs number arguments, but received #{first}"  unless first.type == :number
+      acc = first.value
+      c = args.cdr
+      while !c.nil?
+        n = c.car.evaluate(env)
+        raise "subtract needs number arguments, but received #{n}" unless n.type == :number
+        acc -= n.value
+        c = c.cdr
+      end
+
+      Number.with_value(acc)
+    end
+
+
+    def self.multiply_impl(args, env)
+      raise "multiply needs at least 1 argument" if args.empty?
+
+      acc = 1
+      c = args
+      while !c.nil?
+        n = c.car.evaluate(env)
+        raise "multiply needs number arguments, but received #{n}" unless n.type == :number
+        acc *= n.value
+        c = c.cdr
+      end
+
+      Number.with_value(acc)
+    end
+
+
+    def self.quotient_impl(args, env)
+      raise "quotient needs at least 1 argument" if args.empty?
+
+      first = args.car.evaluate(env)
+      raise "quotient needs number arguments, but received #{first}" unless first.type == :number
+      return first if args.length == 1
+      acc = first.value
+      c = args.cdr
+      while !c.nil?
+        n = c.car.evaluate(env)
+        raise "quotient needs number arguments, but received #{n}" unless n.type == :number
+        acc /= n.value
+        c = c.cdr
+      end
+
+      Number.with_value(acc)
+    end
+
+
+    def self.remainder_impl(args, env)
+      raise "remainder needs at least 1 argument" if args.empty?
+
+      first = args.car.evaluate(env)
+      raise "remainder needs number arguments, but received #{first}" unless first.type == :number
+      return first if args.length == 1
+      acc = first.value
+      c = args.cdr
+      while !c.nil?
+        n = c.car.evaluate(env)
+        raise "remainder needs number arguments, but received #{n}" unless n.type == :number
+        acc %= n.value
+        c = c.cdr
+      end
+
+      Number.with_value(acc)
+    end
+
+    def self.truncate_impl(args, env)
+      raise "truncate needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "truncate needs a number argument, but received #{arg}" unless arg.type == :number
+      Number.with_value(arg.value.truncate)
+    end
+
+
+    def self.round_impl(args, env)
+      raise "round needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "round needs a number argument, but received #{arg}" unless arg.type == :number
+      num = arg.value
+      int = num.to_i
+      Number.with_value(if (num - int).abs == 0.5
+                          if int.even?
+                            int
+                          else
+                            int + (int < 0 ? -1 : 1)
+                          end
+                        else
+                          arg.value.round
+                        end)
+    end
+
+
+    def self.ceiling_impl(args, env)
+      raise "ceiling needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "ceiling needs a number argument, but received #{arg}" unless arg.type == :number
+      Number.with_value(arg.value.ceil)
+    end
+
+
+    def self.floor_impl(args, env)
+      raise "floor needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "floor needs a number argument, but received #{arg}" unless arg.type == :number
+      Number.with_value(arg.value.floor)
+    end
+
+
+    def self.even_impl(args, env)
+      raise "even? needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "even? needs a number argument, but received #{arg}" unless arg.type == :number
+      Boolean.with_value(arg.value.even?)
+    end
+
+
+    def self.odd_impl(args, env)
+      raise "odd? needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "odd? needs a number argument, but received #{arg}" unless arg.type == :number
+      Boolean.with_value(arg.value.odd?)
+    end
+
+
+    def self.zero_impl(args, env)
+      raise "zero? needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "zero? needs a number argument, but received #{arg}" unless arg.type == :number
+      Boolean.with_value(arg.value.zero?)
+    end
+
+
+    def self.positive_impl(args, env)
+      raise "positive? needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "positive? needs a number argument, but received #{arg}" unless arg.type == :number
+      Boolean.with_value(arg.value > 0)
+    end
+
+
+    def self.negative_impl(args, env)
+      raise "negative? needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "negative? needs a number argument, but received #{arg}" unless arg.type == :number
+      Boolean.with_value(arg.value < 0)
+    end
+
+
+    def self.interval_impl(args, env)
+      raise "interval needs 2 arguments, but received #{args.length}" if args.length != 2
+      initial = args.car.evaluate(env)
+      raise "interval needs number arguments, but received #{initial}" unless initial.type == :number
+      final = args.cadr.evaluate(env)
+      raise "interval needs number arguments, but received #{final}" unless final.type == :number
+      raise "interval's arguments need to be in natural order" unless initial.value <= final.value
+      Lisp::ConsCell.array_to_list((initial.value..final.value).to_a.map {|n| Number.with_value(n)})
+    end
+
+
+    def self.random_impl(args, env)
+      arg = args.car.evaluate(env)
+      raise "random needs a number argument, but received #{arg}" unless arg.nil? || arg.type == :number
+      Number.with_value(arg.nil? ? rand() : rand(arg.value))
+    end
+
+
+    def self.float_impl(args, env)
+      raise "float needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "float needs a numeric or string argument, but received #{arg}" unless arg.number? || arg.string?
+      Number.with_value(arg.value.to_f)
+    end
+
+
+    def self.integer_impl(args, env)
+      raise "integer needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "integer needs a numeric or string argument, but received #{arg}" unless arg.number? || arg.string?
+      Number.with_value(arg.value.to_i)
+    end
+
+
+    def self.abs_impl(args, env)
+      raise "abs needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "abs needs a numeric argument, but received #{arg}" unless arg.number?
+      Number.with_value(arg.value.abs)
+    end
+
+
+    def self.sqrt_impl(args, env)
+      raise "sqrt needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "sqrt needs a numeric argument, but received #{arg}" unless arg.number?
+      Number.with_value(::Math.sqrt(arg.value).round(5))
+    end
+
+
+    def self.min_impl(args, env)
+      raise "min needs at least 1 argument" if args.length == 0
+
+      initial = args.car.evaluate(env)
+      raise "min requires numeric arguments, but received #{initial}" unless initial.type ==:number
+      acc = initial.value
+      c = args.cdr
+      while !c.nil?
+        n = c.car.evaluate(env)
+        raise "min needs number arguments, but received #{n}" unless n.type == :number
+        acc = n.value if n.value < acc
+        c = c.cdr
+      end
+
+      Number.with_value(acc)
+    end
+
+
+    def self.max_impl(args, env)
+      raise "max needs at least 1 argumenta" if args.length == 0
+      initial = args.car.evaluate(env)
+      raise "max requires numeric arguments, but received #{initial}" unless initial.type ==:number
+      acc = initial.value
+      c = args.cdr
+      while !c.nil?
+        n = c.car.evaluate(env)
+        raise "max needs number arguments, but received #{n}" unless n.type == :number
+        acc = n.value if n.value > acc
+        c = c.cdr
+      end
+
+      Number.with_value(acc)
+    end
+
+
+    def self.sin_impl(args, env)
+      raise "sin needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "sin needs a numeric argument, but received #{arg}" unless arg.number?
+      Number.with_value(::Math.sin(arg.value).round(5))
+    end
+
+
+    def self.cos_impl(args, env)
+      raise "cos needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "cos needs a numeric argument, but received #{arg}" unless arg.number?
+      Number.with_value(::Math.cos(arg.value).round(5))
+    end
+
+
+    def self.tan_impl(args, env)
+      raise "tan needs 1 argument, but received #{args.length}" if args.length != 1
+      arg = args.car.evaluate(env)
+      raise "tan needs a numeric argument, but received #{arg}" unless arg.number?
+      Number.with_value(::Math.tan(arg.value).round(5))
+    end
+
+
+  end
+end

data/lib/rubylisp/number.rb

@@ -0,0 +1,63 @@
+module Lisp
+
+  class Number < Atom
+
+    def self.with_value(n)
+      self.new(n)
+    end
+
+    def initialize(n = 0)
+      @value = n
+    end
+
+    def set!(n)
+      @value = n
+    end
+
+    def number?
+      true
+    end
+
+    def integer?
+      @value.integer?
+    end
+    
+    def float?
+      !@value.integer?
+    end
+    
+    def integer
+      @value.to_i
+    end
+
+    def positive?
+      @value > 0
+    end
+
+    def zero?
+      @value == 0
+    end
+
+    def negative?
+      @value < 0
+    end
+
+    def type
+      :number
+    end
+
+    def to_s
+      "#{@value}"
+    end
+    
+    def true?
+      @value != 0
+    end
+
+    def false?
+      @value == 0
+    end
+
+  end
+
+end

data/lib/rubylisp/object.rb

@@ -0,0 +1,62 @@
+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)
+      raise "wrap-object requires 1 argument" 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)
+    end
+
+    def self.with_value(o)
+      self.new(o)
+    end
+
+    def initialize(o=nil)
+      @value = o
+    end
+
+    def with_value(&block)
+      block.call(@value)
+    end
+    
+    def object?
+      true
+    end
+
+    def type
+      :object
+    end
+
+    def native_type
+      @value.class
+    end
+
+    def to_s
+      "<a #{@value.class}: #{@value}>"
+    end
+
+    def true?
+      @value != nil
+    end
+
+    def false?
+      @value == nil
+    end
+    
+  end
+
+end

data/lib/rubylisp/parser.rb

@@ -0,0 +1,184 @@
+module Lisp
+
+  class Parser
+
+    def initialize
+    end
+
+    def make_number(str)
+      Lisp::Number.with_value(str.to_i)
+    end
+
+    def make_hex_number(str)
+      Lisp::Number.with_value(str.gsub("#x", "0x").to_i(0))
+    end
+
+    def make_float(str)
+      Lisp::Number.with_value(str.to_f)
+    end
+
+    def make_string(str)
+      Lisp::String.with_value(str[1...-1])
+    end
+
+    def make_symbol(str)
+      Lisp::Symbol.named(str)
+    end
+
+    def make_character(ch)
+      Lisp::Character.with_value(ch)
+    end
+
+    def parse_cons_cell(tokens)
+      tok, lit = tokens.next_token
+      if tok == :RPAREN
+        tokens.consume_token
+        return nil
+      end
+
+      car = nil
+      cdr = nil
+      cells = []
+      while tok != :RPAREN
+        if tok == :PERIOD
+          tokens.consume_token
+          cdr = self.parse_sexpr(tokens)
+          return nil if tokens.next_token[0] == :EOF
+          tok, lit = tokens.next_token
+          raise "Expected ')'  on line #{tokens.line_number}" if tok != :RPAREN
+          tokens.consume_token
+          return Lisp::ConsCell.array_to_list(cells, cdr)
+        else
+          car = self.parse_sexpr(tokens)
+          raise "Unexpected EOF (expected closing parenthesis) on line #{tokens.line_number}" 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)
+    end
+
+    def parse_map(tokens)
+      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)
+        raise "Unexpected EOF (expected closing brace) on line #{tokens.line_number}" if tokens.next_token[0] == :EOF
+        cells << item
+        tok, lit = tokens.next_token
+      end
+
+      tokens.consume_token
+      return ConsCell.cons(Symbol.named("make-frame"), ConsCell.array_to_list(cells))
+    end
+
+
+    def parse_vector(tokens)
+      v = []
+      tok, lit = tokens.next_token
+      if tok == :RBRACKET
+        tokens.consume_token
+        return ConsCell.cons(Symbol.named("make-vector"), nil)
+      end
+
+      cells = []
+      while tok != :RBRACKET
+        item = self.parse_sexpr(tokens)
+        raise "Unexpected EOF (expected closing bracket) on line #{tokens.line_number}" if tokens.next_token[0] == :EOF
+        cells << item
+        tok, lit = tokens.next_token
+      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}>"
+        return nil if tok == :EOF
+        tokens.consume_token
+        case tok
+        when :COMMENT
+          next
+        when :NUMBER
+          return make_number(lit)
+        when :FLOAT
+          return make_float(lit)
+        when :HEXNUMBER
+          return make_hex_number(lit)
+        when :STRING
+          return make_string(lit)
+        when :CHARACTER
+          return make_character(lit)
+        when :LPAREN
+          return parse_cons_cell(tokens)
+        when :LBRACE
+          return parse_map(tokens)
+        when :LBRACKET
+          return parse_vector(tokens)
+        when :SYMBOL
+          return make_symbol(lit)
+        when :FFI_NEW_SYMBOL
+          return FfiNew.new(lit)
+        when :FFI_SEND_SYMBOL
+          return FfiSend.new(lit)
+        when :FFI_STATIC_SYMBOL
+          return 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])
+        when :BACKQUOTE
+          expr = parse_sexpr(tokens)
+          return ConsCell.array_to_list([Symbol.named('quasiquote'), expr])
+        when :COMMA
+          expr = parse_sexpr(tokens)
+          return ConsCell.array_to_list([Symbol.named('unquote'), expr])
+        when :COMMAAT
+          expr = parse_sexpr(tokens)
+          return ConsCell.array_to_list([Symbol.named('unquote-splicing'), expr])
+        when :ILLEGAL
+          raise "Illegal token: #{lit} on line #{tokens.line_number}"
+        else
+          return make_symbol(lit)
+        end
+      end
+    end
+
+    def parse(src)
+      tokenizer = Tokenizer.new(src)
+      tokenizer.init
+
+      sexpr = self.parse_sexpr(tokenizer)
+      return sexpr
+    end
+
+    def parse_and_eval_all(src, env=Lisp::EnvironmentFrame.global)
+      tokenizer = Tokenizer.new(src)
+      tokenizer.init
+      result = nil
+      until tokenizer.eof?
+        sexpr = self.parse_sexpr(tokenizer)
+        result = sexpr.evaluate(env)
+      end
+      result
+    end
+    
+
+  end
+
+end