rubymotionlisp 0.1.3

data/lib/rubylisp/parser.rb

@@ -0,0 +1,189 @@
+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(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
+      result = nil
+      until tokenizer.eof?
+        sexpr = self.parse_sexpr(tokenizer)
+        result = sexpr.evaluate(env)
+      end
+      result
+    end
+    
+
+  end
+
+end

data/lib/rubylisp/primitive.rb

@@ -0,0 +1,45 @@
+module Lisp
+
+  class Primitive < Atom
+    
+    attr_reader :doc
+    
+    def self.register(name, doc="", special=false, env=Lisp::EnvironmentFrame.global, &implementation)
+      instance = self.new(name, doc, special, &implementation)
+      env.bind(Symbol.named(name), instance)
+    end
+
+    def initialize(name, doc, special, &implementation)
+      @name = name
+      @doc = doc
+      @special = special
+      @implementation = implementation
+    end
+
+    def apply_to(args, env)
+      @implementation.call(args, env)
+    end
+
+    def apply_to_without_evaluating(args, env)
+      @implementation.call(args, env)
+    end
+
+    def to_s
+      "<prim: #{@name}>"
+    end
+
+    def primitive?
+      true
+    end
+    
+    def special?
+      @special
+    end
+
+    def type
+      :primitive
+    end
+
+  end
+
+end

data/lib/rubylisp/relational.rb

@@ -0,0 +1,46 @@
+module Lisp
+
+  class Relational
+
+    def self.register
+      Primitive.register("<", "(< number number)\n\nReturns whether the first argument is less than the second argument.") do |args, env|
+        Lisp::Relational::lt_impl(args, env)
+      end
+
+      Primitive.register(">", "(> number number)\n\nReturns whether the first argument is greater than the second argument.") do |args, env|
+        Lisp::Relational::gt_impl(args, env)
+      end
+
+      Primitive.register("<=", "(<= number number)\n\nReturns whether the first argument is less than or equal to the second argument.") do |args, env|
+        Lisp::Relational::lteq_impl(args, env)
+      end
+
+      Primitive.register(">=", "(>= number number)\n\nReturns whether the first argument is greater than or equal to the second argument.") do |args, env|
+        Lisp::Relational::gteq_impl(args, env)
+      end
+    end
+
+
+    def self.lt_impl(args, env)
+      raise "< needs at least 2 arguments" unless args.length > 1
+      return Lisp::Boolean.with_value(args.car.evaluate(env).value < args.cadr.evaluate(env).value)
+    end
+
+    def self.gt_impl(args, env)
+      raise "> needs at least 2 arguments" unless args.length > 1
+      return Lisp::Boolean.with_value(args.car.evaluate(env).value > args.cadr.evaluate(env).value)
+    end
+
+    def self.lteq_impl(args, env)
+      raise "<= needs at least 2 arguments" unless args.length > 1
+      return Lisp::Boolean.with_value(args.car.evaluate(env).value <= args.cadr.evaluate(env).value)
+    end
+
+    def self.gteq_impl(args, env)
+      raise ">= needs at least 2 arguments" unless args.length > 1
+      return Lisp::Boolean.with_value(args.car.evaluate(env).value >= args.cadr.evaluate(env).value)
+    end
+
+
+  end
+end