nydp 0.0.6 → 0.0.7

data/lib/lisp/tests/error-tests.nydp

@@ -0,0 +1,22 @@
+(register-test '(suite "Error Tests"
+  ("'ensuring gets called on the way out"
+   (let x 10
+        (ensure (assign x (+ x 11))
+                (assign x (+ x 22)))
+        x)
+   43)
+
+  ("'on-err handles errors"
+   (let x nil
+        (on-err (= x "impossible")
+                (= x (nil nil nil)))
+        x)
+   "impossible")
+
+  ("'on-err handles errors but any ensuring clause gets called first"
+   (with (x nil y nil)
+        (on-err (= x 'impossible)
+                (ensure (assign y 'ensure-clause)
+                        (nil nil nil)))
+        (list x y))
+   (impossible ensure-clause))))

data/lib/lisp/tests/foundation-test.nydp

@@ -1,4 +1,9 @@
 (register-test '(suite "Foundation Tests"
+  (suite "maths"
+    ("sqrt"
+      (sqrt 6.25)
+      2.5))
+
   (suite "strings"
     (suite "string-split"
       ("splits a string using given expression"
@@ -23,6 +28,15 @@
         (type-of "foobar %%(+ 1 2)")
         string)))
 
+  (suite "eq?"
+         ("true for two empty symbols"
+          (eq? '|| '||)
+          t)
+
+         ("nil for two different symbols"
+          (eq? 'foo 'bar)
+          nil))
+
   (suite "truth and nil"
          ("t is boolean true"
           (if t "hello" "goodbye")
@@ -40,14 +54,6 @@
           (type-of nil)
           nil))
 
-  (suite "Ensuring"
-    ("gets called on the way out"
-      (let x 10
-        (ensuring (fn () (assign x (+ x 11)))
-                  (fn () (assign x (+ x 22))))
-        x)
-      43))
-
   (suite "assignment with '="
     ("assigns a symbol"
       (pre-compile '(= this 'that))
@@ -66,20 +72,6 @@
      (pre-compile '(= a.b.c.d 42))
      (hash-set (hash-get (hash-get a 'b) 'c) 'd 42)))
 
-
-  (suite "parse"
-    ("parses a colon-syntax symbol"
-     (parse "this:that")
-     ((colon-syntax this that)) )
-
-    ("parses a dot-syntax symbol"
-     (parse "this.that.zozo")
-     ((dot-syntax this that zozo)) )
-
-    ("parses an expression"
-     (parse "(foo bar \"hello, String\") 1 2 (3 t nil) nil")
-     ((foo bar "hello, String") 1 2 (3 t nil))))
-
   (suite "isa"
     ("t for 'pair for list"
       (isa 'pair '(a b c))

data/lib/lisp/tests/parser-tests.nydp

@@ -0,0 +1,55 @@
+(register-test '(suite "Parser tests"
+  (suite "brace-list"
+    ("parses an empty brace list"
+     (parse "{}")
+     ((brace-list)))
+
+    ("parses a single-item list"
+     (parse "{foo}")
+     ((brace-list foo)))
+
+    ("parses a list"
+     (parse "{foo bar 1 2 3}")
+     ((brace-list foo bar 1 2 3))))
+
+  (suite "parse"
+    ("parses an empty symbol"
+     (parse "||")
+     (||) )
+
+    ("parses a colon-syntax symbol"
+     (parse "this:that")
+     ((colon-syntax this that)) )
+
+    ("parses a dot-syntax symbol"
+     (parse "this.that.zozo")
+     ((dot-syntax this that zozo)) )
+
+    ("parses a mixed-syntax symbol"
+     (parse "this$that.zozo")
+     ((dot-syntax (dollar-syntax this that) zozo)))
+
+    ("parses a mixed-syntax prefix symbol"
+     (parse "$this.that.zozo")
+     ((dot-syntax (dollar-syntax || this) that zozo)))
+
+    ("parses a prefix dollar"
+     (parse "$this")
+     ((dollar-syntax || this)))
+
+    ("parses a prefix dollar-dot"
+     (parse "$.this")
+     ((dot-syntax (dollar-syntax || ||) this)))
+
+    ("parses an expression"
+     (parse "(foo bar \"hello, String\") 1 2 (3 t nil) nil")
+     ((foo bar "hello, String") 1 2 (3 t nil))))
+
+  (suite "parse-in-string"
+    ("parses a plain string"
+      (parse-in-string "hello, world, take me to your dealer")
+      "hello, world, take me to your dealer")
+
+    ("parses a plain string with interpolations"
+      (parse-in-string (joinstr "" (list "hello, " '~ "(world), take me to your " '~ "dealer please")))
+      (string-pieces "hello, " (world) ", take me to your " dealer " please")))))

data/lib/nydp.rb

@@ -7,33 +7,43 @@ module Nydp
   def self.loadfiles;       PLUGINS.map(&:loadfiles).flatten    ; end
   def self.testfiles;       PLUGINS.map(&:testfiles).flatten    ; end
   def self.plugin_names   ; PLUGINS.map(&:name)                 ; end
-  def self.loadall vm, ns, files
+  def self.loadall ns, files
+    vm = VM.new
     files.each { |f|
       reader = Nydp::StreamReader.new(File.new(f))
       Nydp::Runner.new(vm, ns, reader).run
     }
   end
 
-  def self.repl
-    puts "welcome to nydp"
+  def self.build_nydp extra_files=nil
     ns = { }
     setup(ns)
-    vm = VM.new
-    loadall vm, ns, loadfiles
+    loadall ns, loadfiles
+    loadall ns, extra_files if extra_files
+    ns
+  end
+
+  def self.apply_function ns, function_name, *args
+    function = Nydp::Symbol.mk(function_name, ns).value
+    args     = Nydp::Pair.from_list args
+    vm       = VM.new
+
+    function.invoke vm, args
+    return vm.pop_arg
+  end
+
+  def self.repl
+    puts "welcome to nydp"
+    puts "^D to exit"
     reader = Nydp::ReadlineReader.new $stdin, "nydp > "
-    Nydp::Runner.new(vm, ns, reader, $stdout).run
+    Nydp::Runner.new(VM.new, build_nydp, reader, $stdout).run
   end
 
   def self.tests *options
     verbose = options.include?(:verbose) ? "t" : "nil"
     puts "welcome to nydp : running tests"
-    ns = { }
-    setup(ns)
-    vm = VM.new
-    loadall vm, ns, loadfiles
-    loadall vm, ns, testfiles
     reader = Nydp::StringReader.new "(run-all-tests #{verbose})"
-    Nydp::Runner.new(vm, ns, reader).run
+    Nydp::Runner.new(VM.new, build_nydp(testfiles), reader).run
   end
 
 end

data/lib/nydp/assignment.rb

@@ -30,9 +30,11 @@ module Nydp
     end
 
     def to_s
-      "#assignment #{@instructions.cdr.car} #{@value_src}"
+      "#assignment #{@instructions.cdr.car} #{@value_src.inspect}"
     end
 
+    def inspect; to_s ; end
+
     def execute vm
       vm.push_instructions @instructions, vm.peek_context
     end

data/lib/nydp/builtin.rb

@@ -1,15 +1,12 @@
 require 'nydp'
+require 'nydp/error'
 
 module Nydp::Builtin
   module Base
-    def indent_text txt
-      txt.split(/\n/).map { |line| "  #{line}"}.join("\n")
-    end
-
     def invoke vm, args
       builtin_invoke vm, args
     rescue Exception => e
-      new_msg = "Invoking #{self.class.name}\nwith args #{args}\nraised\n#{indent_text e.message}"
+      new_msg = "Invoking #{self.class.name}\nwith args #{args}\nraised\n#{Nydp.indent_text e.message}"
       raise $!, new_msg, $!.backtrace
     end
   end

data/lib/nydp/builtin/ensuring.rb

@@ -1,7 +1,10 @@
+require "nydp/vm"
+
 class Nydp::Builtin::Ensuring
   include Nydp::Helper
 
   class InvokeProtection
+    include Nydp::VM::Finally
     attr_reader :protection
 
     def initialize protection

data/lib/nydp/builtin/eval.rb

@@ -9,6 +9,10 @@ class Nydp::Builtin::Eval
   end
 
   def to_s
-    "Builtin:eval"
+    "eval"
+  end
+
+  def inspect
+    "Nydp::Builtin::Eval"
   end
 end

data/lib/nydp/builtin/handle_error.rb

@@ -0,0 +1,39 @@
+require "nydp/vm"
+
+class Nydp::Builtin::HandleError
+  include Nydp::Helper
+
+  class CatchError
+    include Nydp::Helper, Nydp::VM::HandleError
+
+    attr_reader :handler, :vm_arg_array_size
+
+    def initialize handler, vm_arg_array_size
+      @handler, @vm_arg_array_size = handler, vm_arg_array_size
+    end
+
+    def execute vm
+      e = vm.unhandled_error
+      vm.unhandled_error = nil
+      return unless e
+
+      vm.args = vm.args[0...vm_arg_array_size]
+
+      handler.invoke vm, cons(r2n e.message, nil)
+    end
+
+    def to_s
+      "(on-err: #{handler})"
+    end
+  end
+
+  def invoke vm, args
+    fn_handle = args.car
+    fn_tricky = args.cdr.car
+
+    catcher_instructions = Nydp::Pair.from_list [CatchError.new(fn_handle, vm.args.size)]
+    vm.push_instructions catcher_instructions, vm.peek_context
+
+    fn_tricky.invoke vm, Nydp.NIL
+  end
+end

data/lib/nydp/builtin/parse_in_string.rb

@@ -0,0 +1,11 @@
+class Nydp::Builtin::ParseInString
+  def initialize ns
+    @parser = Nydp::Parser.new(ns)
+  end
+
+  def invoke vm, args
+    tokens = Nydp::Tokeniser.new Nydp::StringReader.new args.car.to_s
+    expr = @parser.string(tokens, "", :eof)
+    vm.push_arg expr
+  end
+end

data/lib/nydp/builtin/sqrt.rb

@@ -0,0 +1,5 @@
+class Nydp::Builtin::Sqrt
+  def invoke vm, args
+    vm.push_arg Math.sqrt args.car
+  end
+end

data/lib/nydp/context_symbol.rb

@@ -1,22 +1,54 @@
 module Nydp
+  class ContextLookup0 ; def self.get_context ctx; ctx; end; end
+  class ContextLookup1 ; def self.get_context ctx; ctx.parent; end; end
+  class ContextLookup2 ; def self.get_context ctx; ctx.parent.parent; end; end
+  class ContextLookup3 ; def self.get_context ctx; ctx.parent.parent.parent; end; end
+  class ContextLookup4 ; def self.get_context ctx; ctx.parent.parent.parent.parent; end; end
+  class ContextLookup5 ; def self.get_context ctx; ctx.parent.parent.parent.parent.parent; end; end
+  class ContextLookup6 ; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup7 ; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup8 ; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup9 ; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup10; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup11; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup12; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup13; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup14; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup15; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup16; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup17; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookup18; def self.get_context ctx; ctx.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent.parent; end; end
+  class ContextLookupN
+    def initialize depth ; @depth = depth  ; end
+    def get_context  ctx ; ctx.nth(@depth) ; end
+  end
+
   class ContextSymbol
-    attr_accessor :depth, :name
+    attr_accessor :depth, :name, :binding_index
 
-    def initialize depth, name
-      @depth, @name = depth, name
+    def initialize depth, name, binding_index
+      @ctx_lookup = build_lookup depth
+      @depth, @name, @binding_index = depth, name, binding_index
     end
 
+    def get_context(context); @ctx_lookup.get_context context; end
+
     def value context
-      context.nth(depth).at(name)
+      get_context(context).at_index(binding_index)
     end
 
     def assign value, context
-      context.nth(depth).set(name, value)
+      get_context(context).set_index(binding_index, value)
     end
 
     def inspect; to_s; end
     def to_s
-      "[#{depth}]#{name}"
+      "[#{depth}##{binding_index}]#{name}"
+    end
+
+    def build_lookup depth
+      fast = Nydp.const_get "ContextLookup#{depth}" rescue nil
+      return fast || ContextLookupN.new(depth)
     end
   end
 end

data/lib/nydp/core.rb

@@ -41,6 +41,7 @@ module Nydp
       Symbol.mk(:p,     ns).assign(Nydp::Builtin::Puts.new)
       Symbol.mk(:PI,    ns).assign Literal.new(3.1415)
       Symbol.mk(:nil,   ns).assign Nydp.NIL
+      Symbol.mk(:sqrt,  ns).assign Nydp::Builtin::Sqrt.new
       Symbol.mk(:t,     ns).assign Nydp.T
       Symbol.mk(:sym,   ns).assign Nydp::Builtin::ToSym.new(ns)
       Symbol.mk(:ensuring,      ns).assign(Nydp::Builtin::Ensuring.new)
@@ -48,12 +49,14 @@ module Nydp
       Symbol.mk(:comment,       ns).assign(Nydp::Builtin::Comment.new)
       Symbol.mk(:millisecs,     ns).assign(Nydp::Builtin::Millisecs.new)
       Symbol.mk("load-tests",   ns).assign(Nydp::Builtin::LoadTests.new(ns))
-      Symbol.mk("random-string",ns).assign(Nydp::Builtin::RandomString.new)
-      Symbol.mk("to-string",    ns).assign(Nydp::Builtin::ToString.new)
-      Symbol.mk("string-pieces",ns).assign(Nydp::Builtin::StringPieces.new)
-      Symbol.mk("string-replace", ns).assign(Nydp::Builtin::StringReplace.new)
-      Symbol.mk("string-split"  , ns).assign(Nydp::Builtin::StringSplit.new  )
-      Symbol.mk("thread-locals" , ns).assign(Nydp::Builtin::ThreadLocals.new)
+      Symbol.mk("handle-error"   , ns).assign(Nydp::Builtin::HandleError.new)
+      Symbol.mk("parse-in-string", ns).assign(Nydp::Builtin::ParseInString.new(ns))
+      Symbol.mk("random-string"  , ns).assign(Nydp::Builtin::RandomString.new)
+      Symbol.mk("to-string"      , ns).assign(Nydp::Builtin::ToString.new)
+      Symbol.mk("string-pieces"  , ns).assign(Nydp::Builtin::StringPieces.new)
+      Symbol.mk("string-replace" , ns).assign(Nydp::Builtin::StringReplace.new)
+      Symbol.mk("string-split"   , ns).assign(Nydp::Builtin::StringSplit.new  )
+      Symbol.mk("thread-locals"  , ns).assign(Nydp::Builtin::ThreadLocals.new)
       Symbol.mk("type-of",      ns).assign(Nydp::Builtin::TypeOf.new(ns))
       Symbol.mk(:"eq?",         ns).assign(Nydp::Builtin::IsEqual.new)
       Symbol.mk(:"pair?",       ns).assign(Nydp::Builtin::IsPair.new)

data/lib/nydp/error.rb

@@ -1,4 +1,8 @@
 module Nydp
+  def self.indent_text txt
+    txt.split(/\n/).map { |line| "  #{line}"}.join("\n")
+  end
+
   class Error < StandardError
   end
 end

data/lib/nydp/function_invocation.rb

@@ -19,7 +19,7 @@ module Nydp
       msg  =  "failed to execute invocation #{args.inspect}"
       msg +=  "\nsource was #{source.inspect}"
       msg +=  "\nfunction name was #{source.car.inspect}"
-      i_f = InvocationFailed.new "#{msg}\n#{vm.error}#{e.message}"
+      i_f = InvocationFailed.new "#{msg}\n#{e.message}"
       i_f.set_backtrace e.backtrace
       raise i_f
     end

data/lib/nydp/lexical_context.rb

@@ -1,9 +1,10 @@
 class Nydp::LexicalContext
-  attr_reader :values, :parent
+  attr_reader :names, :values, :parent
 
   def initialize parent
     @parent = parent
-    @values = { }
+    @names  = []
+    @values = []
   end
 
   def nth n
@@ -21,8 +22,17 @@ class Nydp::LexicalContext
     values[name]
   end
 
+  def at_index index
+    values[index]
+  end
+
   def set name, value
-    values[name] = value
+    names  << name
+    values << value
+  end
+
+  def set_index index, value
+    values[index] = value
   end
 
   def to_s_with_indent str