nydp 0.0.1

data/lib/nydp/cond.rb

@@ -0,0 +1,56 @@
+module Nydp
+  class ExecuteConditionalInstruction
+    extend Helper
+    attr_reader :when_true, :when_false
+
+    def initialize when_true, when_false
+      @when_true, @when_false = when_true, when_false
+    end
+
+    def execute vm
+      arg = vm.pop_arg
+      truth = !Nydp.NIL.is?(arg)
+      vm.push_instructions (truth ? when_true : when_false), vm.peek_context
+    end
+
+    def inspect
+      "when_true:#{when_true.inspect}:when_false:#{when_false.inspect}"
+    end
+    def to_s
+      "#{when_true.car.to_s} #{when_false.car.to_s}"
+    end
+  end
+
+  class Cond
+    extend Helper
+    include Helper
+    attr_reader :condition, :conditional
+
+    def initialize cond, when_true, when_false
+      @condition, @conditional = cond, cons(ExecuteConditionalInstruction.new(when_true, when_false))
+    end
+
+    def execute vm
+      vm.push_instructions conditional, vm.peek_context
+      vm.push_instructions condition,   vm.peek_context
+    end
+
+    def inspect
+      "cond:#{condition.inspect}:#{conditional.inspect}"
+    end
+    def to_s
+      "(cond #{condition.car.to_s} #{conditional.to_s})"
+    end
+
+    def self.build expressions, bindings
+      if expressions.is_a? Nydp::Pair
+        cond       = cons Compiler.compile expressions.car, bindings
+        when_true  = cons Compiler.compile expressions.cdr.car, bindings
+        when_false = cons Compiler.compile expressions.cdr.cdr.car, bindings
+        new(cond, when_true, when_false)
+      else
+        raise "can't compile Cond: #{expr.inspect}"
+      end
+    end
+  end
+end

data/lib/nydp/context_symbol.rb

@@ -0,0 +1,22 @@
+module Nydp
+  class ContextSymbol
+    attr_accessor :depth, :name
+
+    def initialize depth, name
+      @depth, @name = depth, name
+    end
+
+    def value context
+      context.nth(depth).at(name)
+    end
+
+    def assign value, context
+      context.nth(depth).set(name, value)
+    end
+
+    def inspect; to_s; end
+    def to_s
+      "[#{depth}]#{name}"
+    end
+  end
+end

data/lib/nydp/error.rb

@@ -0,0 +1,4 @@
+module Nydp
+  class Error < StandardError
+  end
+end

data/lib/nydp/function_invocation.rb

@@ -0,0 +1,52 @@
+module Nydp
+  class InvokeFunctionInstruction
+    def initialize arg_count, source_expression
+      @source_expression = source_expression
+      @arg_count = arg_count
+    end
+
+    def execute vm
+      args = vm.pop_args @arg_count
+      args.car.invoke vm, args.cdr
+    rescue Exception => e
+      puts "failed to execute fn #{args.inspect}"
+      puts "source was #{source}"
+      puts "function was #{args.car.inspect}"
+      vm.error e
+    end
+
+    def inspect
+      "#{self.class.name}:#{source}"
+    end
+
+    def source
+      @source_expression
+    end
+
+    def to_s
+      source
+    end
+  end
+
+  class FunctionInvocation
+    extend Helper
+
+    def self.build expression, bindings
+      new cons(InvokeFunctionInstruction.new(expression.size, expression)), Compiler.compile_each(expression, bindings), expression
+    end
+
+    def initialize function_instruction, argument_instructions, source
+      @function_instruction, @argument_instructions, @source = function_instruction, argument_instructions, source
+    end
+
+    def execute vm
+      vm.push_instructions @function_instruction,  vm.peek_context
+      vm.push_instructions @argument_instructions, vm.peek_context
+    end
+
+    def inspect; "#function_invocation:#{to_s}"; end
+    def to_s
+      @source.to_s
+    end
+  end
+end

data/lib/nydp/helper.rb

@@ -0,0 +1,32 @@
+module Nydp
+  module Helper
+    def sym? expr, name
+      expr.is_a?(Nydp::Symbol) && (expr.is? name)
+    end
+
+    def pair? expr
+      expr.is_a?(Nydp::Pair)
+    end
+
+    def cons a, b=Nydp.NIL
+      Nydp::Pair.new a, b
+    end
+
+    def list *args
+      Nydp::Pair.from_list args
+    end
+
+    def sym name, ns
+      Nydp::Symbol.mk name, ns
+    end
+
+    def literal? expr
+      case expr
+      when String, Float, Integer, Fixnum, Nydp.NIL, Nydp::Symbol, Nydp::StringAtom, Nydp::Truth, Nydp::Nil
+        true
+      else
+        false
+      end
+    end
+  end
+end

data/lib/nydp/interpreted_function.rb

@@ -0,0 +1,79 @@
+require 'nydp/lexical_context'
+require 'nydp/closure'
+
+module Nydp
+  class PopArg
+    def self.execute vm
+      vm.pop_arg
+    end
+
+    def self.to_s
+      ""
+    end
+
+    def self.inspect
+      "#pop_arg"
+    end
+  end
+
+  class InterpretedFunction
+    include Helper
+    extend Helper
+
+    attr_accessor :arg_names, :body
+
+    def invoke vm, parent_context, arg_values
+      lc = LexicalContext.new parent_context
+      setup_context lc, arg_names, arg_values
+      vm.push_instructions self.body, lc
+    end
+
+    def setup_context context, names, values
+      if pair? names
+        context.set names.car, values.car
+        setup_context context, names.cdr, values.cdr
+      elsif Nydp.NIL.isnt? names
+        context.set names, values
+      end
+    end
+
+    def self.build arg_list, body, bindings
+      my_params = { }
+      index_parameters arg_list, my_params
+      ifn = Nydp::InterpretedFunction.new
+      ifn.arg_names = arg_list
+      ifn.body = compile_body body, cons(my_params, bindings), []
+      ifn
+    end
+
+    def self.compile_body body_forms, bindings, instructions
+      instructions << Nydp::Compiler.compile(body_forms.car, bindings)
+
+      rest = body_forms.cdr
+      if Nydp.NIL.is? rest
+        return Pair.from_list(instructions)
+      else
+        instructions << PopArg
+        compile_body rest, bindings, instructions
+      end
+    end
+
+    def self.index_parameters arg_list, hsh
+      if pair? arg_list
+        index_parameters arg_list.car, hsh
+        index_parameters arg_list.cdr, hsh
+      elsif Nydp.NIL.isnt? arg_list
+        hsh[arg_list] = hsh.size
+      end
+    end
+
+    def execute vm
+      vm.push_arg Closure.new(self, vm.peek_context)
+    end
+
+    def inspect; to_s; end
+    def to_s
+      "(fn #{arg_names.to_s} #{body.map { |b| b.to_s}.join(' ')})"
+    end
+  end
+end

data/lib/nydp/lexical_context.rb

@@ -0,0 +1,38 @@
+class Nydp::LexicalContext
+  attr_reader :values, :parent
+
+  def initialize parent
+    @parent = parent
+    @values = { }
+  end
+
+  def nth n
+    case n
+    when 0
+      self
+    when -1
+      raise "wrong nesting level"
+    else
+      parent.nth(n - 1)
+    end
+  end
+
+  def at name
+    values[name]
+  end
+
+  def set name, value
+    values[name] = value
+  end
+
+  def to_s_with_indent str
+    me = @values.map { |k, v|
+      [str, k, "=>", v].join ' '
+    }.join "\n"
+    me + (parent ? parent.to_s_with_indent("  #{str}") : '')
+  end
+
+  def to_s
+    to_s_with_indent ''
+  end
+end

data/lib/nydp/literal.rb

@@ -0,0 +1,40 @@
+module Nydp
+  class Literal
+    attr_reader :expression
+
+    def initialize expression
+      @expression = expression
+    end
+
+    def lisp_apply
+      expression
+    end
+
+    def self.build expression, bindings
+      new expression
+    end
+
+    def execute vm
+      vm.push_arg expression
+    end
+
+    def inspect; @expression.inspect; end
+    def to_s   ; @expression.to_s   ; end
+
+    def coerce _
+      [_, expression]
+    end
+
+    def > other
+      other < expression
+    end
+
+    def < other
+      other > expression
+    end
+
+    def == other
+      other.is_a?(Literal) && (self.expression == other.expression)
+    end
+  end
+end

data/lib/nydp/pair.rb

@@ -0,0 +1,112 @@
+class Nydp::Pair
+  include Nydp::Helper, Enumerable
+  extend Nydp::Helper
+
+  attr_accessor :car, :cdr
+
+  def initialize car, cdr
+    @car, @cdr = car, cdr
+  end
+
+  def self.mk a, b
+    new a, b
+  end
+
+  def caar; car.car; end
+  def cadr; cdr.car; end
+  def cdar; car.cdr; end
+  def cddr; cdr.cdr; end
+
+  def self.parse_list list
+    if sym? list.slice(-2), "."
+      from_list(list[0...-2], list.slice(-1))
+    else
+      from_list list
+    end
+  end
+
+  def self.from_list list, last=Nydp.NIL, n=0
+    if n >= list.size
+      last
+    else
+      mk list[n], from_list(list, last, n+1)
+    end
+  end
+
+  def copy
+    cons(car, cdr.copy)
+  end
+
+  def + other
+    copy.append other
+  end
+
+  def == other
+    (other.respond_to? :car) && (self.car == other.car) && (self.cdr == other.cdr)
+  end
+
+  def size
+    1 + (cdr.is_a?(Nydp::Pair) ? cdr.size : 0)
+  end
+
+  def each &block
+    yield car
+    cdr.each(&block) unless Nydp.NIL.is?(cdr)
+  end
+
+  def inspect
+    "(#{inspect_rest})"
+  end
+
+  def to_s
+    if car.is_a?(Nydp::Symbol) && car.is?(:quote)
+      if Nydp.NIL.is? cdr.cdr
+        "'#{cdr.car.to_s}"
+      else
+        "'#{cdr.to_s}"
+      end
+    else
+      "(#{to_s_rest})"
+    end
+  end
+
+  def to_s_rest
+    cdr_s = if cdr.is_a?(self.class)
+              cdr.to_s_rest
+            elsif Nydp.NIL.is? cdr
+              nil
+            else
+              ". #{cdr.to_s}"
+            end
+
+    [car.to_s, cdr_s].compact.join " "
+  end
+
+  def inspect_rest
+    cdr_s = if cdr.is_a?(self.class)
+              cdr.inspect_rest
+            elsif cdr == Nydp.NIL
+              nil
+            else
+              ". #{cdr.inspect}"
+            end
+
+    [car.inspect, cdr_s].compact.join " "
+  end
+
+  def append pair
+    if Nydp.NIL.is? self.cdr
+      self.cdr = pair
+    elsif pair? self.cdr
+      self.cdr.append pair
+    else
+      raise "can't append #{pair} to list #{self} : cdr is #{self.cdr.inspect}"
+    end
+    self
+  end
+
+  def repush instructions, _
+    instructions.push self
+  end
+
+end

data/lib/nydp/parser.rb

@@ -0,0 +1,123 @@
+module Nydp
+  class Parser
+    attr_accessor :ns
+
+    def initialize ns
+      @ns = ns
+    end
+
+    def sym name
+      Nydp::Symbol.mk name.to_sym, ns
+    end
+
+    def read_list token_stream, termination_token
+      list = []
+      token = token_stream.next_token
+      while token != nil && token.first != termination_token
+        list << next_form(token, token_stream)
+        token = token_stream.next_token
+      end
+      Pair.parse_list list
+    end
+
+    def prefix_list prefix, list
+      case prefix
+      when "'"
+        Pair.from_list [sym(:quote), list]
+      when "`"
+        Pair.from_list [sym(:quasiquote), list]
+      when ","
+        Pair.from_list [sym(:unquote), list]
+      when ",@"
+        Pair.from_list [sym(:"unquote-splicing"), list]
+      else
+        list
+      end
+    end
+
+    def split_sym syms, pfx
+      return Pair.from_list [pfx] + syms.map { |s| parse_symbol s }
+    end
+
+    def parse_symbol txt
+      case txt
+      when /^'(.+)$/
+        Pair.from_list [sym(:quote), parse_symbol($1)]
+      when /^`(.+)$/
+        Pair.from_list [sym(:quasiquote), parse_symbol($1)]
+      when /^,@(.+)$/
+        Pair.from_list [sym(:"unquote-splicing"), parse_symbol($1)]
+      when /^,(.+)$/
+        Pair.from_list [sym(:unquote), parse_symbol($1)]
+      else
+        syms = txt.to_s.split /\./
+        return split_sym syms, sym(:"dot-syntax") if syms.length > 1
+
+        syms = txt.split /::/
+        return split_sym syms, sym(:"colon-colon-syntax") if syms.length > 1
+
+        syms = txt.split /:/
+        return split_sym syms, sym(:"colon-syntax") if syms.length > 1
+
+        syms = txt.split /->/
+        return split_sym syms, sym(:"arrow-syntax") if syms.length > 1
+
+        syms = txt.split(/=>/)
+        return split_sym syms, sym(:"rocket-syntax") if syms.length > 1
+
+        sym txt
+      end
+    end
+
+    def close_delimiter_for opener
+      case opener
+      when '"'
+        /"/
+      when /.*{$/
+        /}/
+      when /<<(.+)$/
+        Regexp.new $1
+      end
+    end
+
+    def next_form token, token_stream
+      return nil if token.nil?
+      case token.first
+      when :embed_suffix
+        Nydp.NIL
+      when :string_open_delim
+        string token_stream, token.last, close_delimiter_for(token.last)
+      when :left_paren
+        prefix_list token[1], read_list(token_stream, :right_paren)
+      when :symbol
+        parse_symbol token.last
+      when :comment
+        Pair.from_list [sym(:comment), token.last]
+      else
+        token.last
+      end
+    end
+
+    def expression token_stream
+      next_form token_stream.next_token, token_stream
+    end
+
+    def string token_stream, open_delimiter, close_delimiter
+      fragments = [sym(:"string-pieces")]
+      string_token = token_stream.next_string_fragment(open_delimiter, close_delimiter)
+      fragments << string_token
+      while !(string_token.is_a? StringFragmentCloseToken)
+        fragments << expression(token_stream)
+        string_token = token_stream.next_string_fragment('', close_delimiter)
+        fragments << string_token
+      end
+
+      if fragments.size == 2
+        tok = fragments[1]
+        return Nydp::StringAtom.new tok.string, tok
+      else
+        return Pair.from_list fragments
+      end
+    end
+  end
+end