nydp 0.4.0 → 0.4.6

data/lib/lisp/tests/sort-examples.nydp

@@ -28,3 +28,11 @@
    (sort-by len
             '("short" "very long" "sport" "very song" "min" "max"))
    ("max" "min" "sport" "short" "very song" "very long")))
+
+(examples-for safe-sort-by
+  ("sorts a list of hashes by a specified key"
+   (let hh (list { a 1 b 2 } { b 9 } { a 3 b 1 } { a nil b 8 })
+     (pp (safe-sort-by &a 99 hh)))
+   "({ a 1 b 2 } { a 3 b 1 }
+              { a nil b 8 }
+              { b 9 })"))

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

@@ -1,3 +1,51 @@
+(examples-for string-eval-fn
+  ("returns a function to eval a user-supplied string"
+   (let s "hello \~|u|, \~x + \~y is \~(+ x y), thank you!"
+     (let f (string-eval-fn s '(u x y))
+       (f "world" 37 5)))
+   "hello world, 37 + 5 is 42, thank you!"))
+
+(examples-for string/eval-with-args
+  ("evals a user-supplied string"
+   (let s "hello \~|u|, \~x + \~y is \~(+ x y), thank heavens!"
+     (string/eval-with-args s '(u x y) "world" 36 6))
+   "hello world, 36 + 6 is 42, thank heavens!")
+
+  ("reports errors"
+   (on-err errors
+           (let s "hello \~|u|, \~x + \~y is \~(+ x y), thank heavens!"
+             (string/eval-with-args s '(a b c) "world" 36 6)))
+   ("error evaluating \"hello \~|u|, \~x + \~y is \~(+ x y), thank heavens!\"
+with arg names (a b c)
+and args (\"world\" 36 6)"
+    "unbound symbol: y")))
+
+(examples-for string/pad-left
+  ("does not change a string whose length is greater than the given length"
+   (string/pad-left "Toronto" 3 "X")
+   "Toronto")
+
+  ("adds left padding to a string such that the result is the given length"
+   (string/pad-left "toto" 8 "X")
+   "XXXXtoto")
+
+  ("accepts multi-character padding"
+   (string/pad-left "toto" 12 "XYZ")
+   "XYZXYZXYtoto"))
+
+(examples-for string/pad-right
+  ("does not change a string whose length is greater than the given length"
+   (string/pad-right "Toronto" 3 "X")
+   "Toronto")
+
+  ("adds right padding to a string such that the result is the given length"
+   (string/pad-right "toto" 8 "X")
+   "totoXXXX")
+
+  ("accepts multi-character padding"
+   (string/pad-right "toto" 12 "XYZ")
+   "totoXYZXYZXY"))
+
 (examples-for string-split
   ("splits a string using given expression"
    (string-split "a and b and c and d" " and ")
@@ -24,6 +72,15 @@
    (string-replace "and|or" "x" "a and b or c and d")
    "a x b x c x d"))
 
+(examples-for string-truncate
+  ("truncates a string to the given length"
+   (string-truncate "a and b and c and d" 8)
+   "a and b ")
+
+  ("truncate to zero"
+   (string-truncate "a and b and long and complex" 0)
+   ""))
+
 (examples-for string-match
   ("no match returns nil"
    (string-match "this that another" "XXXX")
@@ -81,4 +138,7 @@
 (examples-for string-strip
   ("removes leading whitespace"               (string-strip "    hello!")  "hello!" )
   ("removes trailing whitespace"              (string-strip "(world)   ") "(world)" )
-  ("removes leading and trailing whitespace"  (string-strip "\n\nme\n\n") "me"      ))
+  ("removes leading and trailing whitespace"  (string-strip "\n\nme\n\n") "me"      )
+  ("ignores leading and trailing whitespace for intenal lines"
+   (string-strip "\n\n  me  \n\n  you  \n\n\t them \t\n\n")
+   "me  \n\n  you  \n\n\t them"      ))

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

@@ -10,7 +10,11 @@
   ("dislikes no-prefix"
    (on-err (joinstr "\n" errors)
            (pre-compile '(:foo 1 2 3)))
-   "\"Irregular ': syntax: got (|| foo) : not prefix-syntax : in :foo\""))
+   "expanding
+(colon-syntax || foo)
+with
+(fn names ((orf (hash-get colon-syntax-overrides car [0#0#0]names) default-colon-syntax) [0#0#0]names))
+Irregular ': syntax: got (|| foo) : not prefix-syntax : in :foo"))
 
 (examples-for prefix-list
   ("one argument"

data/lib/lisp/tests/to-integer-examples.nydp

@@ -0,0 +1,16 @@
+(examples-for to-integer
+  ("converts a string"
+   (to-integer "1234")
+   1234)
+
+  ("converts a date"
+   (to-integer (date 2004 3 12))
+   1079046000)
+
+  ("converts a time"
+   (to-integer (time 2004 3 12 18 45))
+   1079113500)
+
+  ("returns nonsense for non-integer"
+   (to-integer { foo 'bar })
+   0))

data/lib/lisp/tests/validation-examples.nydp

@@ -0,0 +1,15 @@
+(validate/def string test-0 (if (< (len string)  6) (mf "length" "should be more than 6")))
+(validate/def string test-0 (if (> (len string) 10) (mf "length" "should be less than 10")))
+
+(examples-for validate
+  ("returns a message about a string being too short"
+   (to-string:validate "foo" 'test-0)
+   "{\"length\"=>(\"should be more than 6\")}")
+
+("returns a message about a string being too long"
+   (to-string:validate "foo bar toto titi" 'test-0)
+   "{\"length\"=>(\"should be less than 10\")}")
+
+("returns an empty hash"
+   (to-string:validate "foo bar" 'test-0)
+   "{}"))

data/lib/lisp/tests/zap-examples.nydp

@@ -0,0 +1,12 @@
+(examples-for zap
+  ("it adds a value to place"
+    (let a 10
+      (zap + a 2)
+      a)
+    12)
+
+  ("it multiplies the value in a place"
+    (let a 10
+      (zap * a 2)
+      a)
+    20))

data/lib/nydp.rb

@@ -2,17 +2,22 @@ require 'date'
 require 'set'
 
 module Nydp
+  class << self
+    attr_accessor :logger # not used by this gem but very useful in your app
+  end
+
   class Namespace < Hash
   end
 
   # TODO: write VM #apply_function so we have fewer calls to VM.new
   def self.apply_function ns, function_name, *args
-    function = r2n(function_name.to_sym, ns).value
-    args     = r2n args, ns
     vm       = VM.new(ns)
-
-    function.invoke vm, args
+    function = Symbol.mk(function_name.to_sym, ns).value
+    function.invoke vm, r2n(args)
     vm.thread
+  rescue StandardError => e
+    friendly_args = args.map { |a| a.respond_to?(:_nydp_compact_inspect) ? a._nydp_compact_inspect : a }
+    raise Nydp::Error.new("Invoking #{function_name}\nwith args #{friendly_args.inspect}")
   end
 
   def self.reader                          txt ; Nydp::StringReader.new txt                                 ; end
@@ -50,9 +55,9 @@ module Nydp
 
   def self.repl options={ }
     toplevel do
-      silent = options.delete :silent
-      ns     = options.delete :ns
-      launch_time = Time.now
+      launch_time      = Time.now
+      silent           = options.delete :silent
+      ns               = options.delete :ns
       last_script_time = Time.now
       puts "welcome to nydp #{options.inspect}" unless silent
       reader = Nydp::ReadlineReader.new $stdin, "nydp > "
@@ -89,6 +94,7 @@ require "nydp/error"
 require "nydp/truth"
 require "nydp/version"
 require "nydp/helper"
+require 'nydp/core_ext'
 require "nydp/symbol"
 require "nydp/symbol_lookup"
 require "nydp/pair"

data/lib/nydp/assignment.rb

@@ -8,6 +8,8 @@ module Nydp
 
     def execute vm
       @name.assign vm.peek_arg, vm.current_context
+    rescue
+      raise "assigning #{@name.inspect}"
     end
 
     def to_s
@@ -26,9 +28,12 @@ module Nydp
     end
 
     def initialize name, value, value_src
-      @value_src = value_src
-      n = AssignmentInstruction.new name
-      @instructions = cons(value, cons(n))
+      @name, @value, @value_src = name, value, value_src
+      @instructions = cons(value, cons(AssignmentInstruction.new(name)))
+    end
+
+    def lexical_reach n
+      [@name.lexical_reach(n), @value.lexical_reach(n)].max
     end
 
     def to_s
@@ -39,6 +44,8 @@ module Nydp
 
     def execute vm
       vm.push_ctx_instructions @instructions
+    rescue
+      raise "assigning #{@value.inspect} to #{@name.inspect}"
     end
   end
 end

data/lib/nydp/builtin.rb

@@ -32,13 +32,13 @@ module Nydp::Builtin
       handle_error e, arg_0, arg_1, arg_2
     end
 
+    # called from 'apply (among others)
     def invoke vm, args
       builtin_invoke vm, args
     rescue StandardError => e
       handle_error e, *(args.to_a)
     end
 
-
     def handle_error e, *args
       case e
       when Nydp::Error

data/lib/nydp/builtin/abs.rb

@@ -0,0 +1,8 @@
+class Nydp::Builtin::Abs
+  include Nydp::Builtin::Base, Singleton
+
+  def invoke_2         vm, a0 ; vm.push_arg(a0.abs)   ; end
+  def builtin_invoke vm, args ; invoke_2 vm, args.car ; end
+
+  def name ; "mod" ; end
+end

data/lib/nydp/builtin/cdr_set.rb

@@ -1,10 +1,5 @@
 class Nydp::Builtin::CdrSet
   include Nydp::Builtin::Base, Singleton
 
-  def builtin_invoke vm, args
-    pair = args.car
-    arg = args.cdr.car
-    pair.cdr = arg
-    vm.push_arg pair
-  end
+  def builtin_invoke vm, args ; vm.push_arg(args.car.cdr = args.cdr.car) ; end
 end

data/lib/nydp/builtin/date.rb

@@ -1,13 +1,27 @@
 class Nydp::Builtin::Date
   include Nydp::Helper, Nydp::Builtin::Base, Singleton
 
+  def builtin_invoke vm, args
+    case args.size
+    when 0 ; builtin_invoke_1 vm
+    when 1 ; builtin_invoke_2 vm, args.car
+    when 2 ; builtin_invoke_3 vm, args.car, args.cdr.car
+    when 3 ; builtin_invoke_4 vm, args.car, args.cdr.car, args.cdr.cdr.car
+    end
+  end
+
   def builtin_invoke_1 vm
     vm.push_arg(Nydp::Date.new Date.today)
   end
 
   # it's a Time object (or any object that responds to #to_date)
   def builtin_invoke_2 vm, arg
-    vm.push_arg(Nydp::Date.new arg.to_date)
+    arg = if arg.respond_to?(:to_date)
+            arg.to_date
+          elsif arg.is_a?(String)
+            ::Date.parse(arg)
+          end
+    vm.push_arg(Nydp::Date.new arg)
   end
 
   def builtin_invoke_3 vm, a0, a1

data/lib/nydp/builtin/error.rb

@@ -4,6 +4,6 @@ class Nydp::Builtin::Error
   # override #invoke on nydp/builtin/base because
   # we don't want to inherit error handling
   def builtin_invoke vm, args
-    raise Nydp::Error.new(args.to_a.map(&:inspect).join("\n"), vm.last_error)
+    raise Nydp::Error.new(args.to_a.map(&:to_s).join("\n"), vm.last_error)
   end
 end

data/lib/nydp/builtin/handle_error.rb

@@ -25,7 +25,7 @@ class Nydp::Builtin::HandleError
         e = e.cause
       end
 
-      handler.invoke_2 vm, vm.r2n(msgs)
+      handler.invoke_2 vm, r2n(msgs)
     end
 
     def to_s

data/lib/nydp/builtin/hash.rb

@@ -2,57 +2,33 @@ require "nydp/hash"
 
 class Nydp::Builtin::Hash
   include Nydp::Helper, Nydp::Builtin::Base, Singleton
+
   def builtin_invoke vm, args
-    vm.push_arg(Nydp::Hash.new)
+    vm.push_arg(build_hash Nydp::Hash.new, args)
+  end
+
+  def build_hash h, args
+    return h if Nydp::NIL.is? args
+    k = args.car
+    rest = args.cdr
+    v = rest.car
+    h[k] = v
+    build_hash h, rest.cdr
   end
 end
 
 class Nydp::Builtin::HashGet
   include Nydp::Helper, Nydp::Builtin::Base, Singleton
   def builtin_invoke vm, args
-    hsh = args.car
-    key = args.cdr.car
-    case hsh
-    when Nydp::Hash
-      vm.push_arg(hsh[key] || Nydp::NIL)
-    when NilClass, Nydp::NIL
-      vm.push_arg Nydp::NIL
-    else
-      v = hsh.respond_to?(:[]) ? hsh[n2r key] : ruby_call(hsh, key)
-      vm.push_arg(r2n v, vm.ns)
-    end
-  end
-
-  def ruby_call obj, method_name
-    if obj.respond_to? :_nydp_safe_methods
-      m       = n2r(method_name).to_s.to_sym
-      allowed = obj._nydp_safe_methods
-
-      obj.send n2r(m) if allowed.include?(m)
-    else
-      raise "hash-get: Not a hash: #{obj.class.name}"
-    end
+    vm.push_arg(args.car._nydp_get(args.cdr.car)._nydp_wrapper || Nydp::NIL)
   end
 end
 
 class Nydp::Builtin::HashSet
   include Nydp::Helper, Nydp::Builtin::Base, Singleton
   def builtin_invoke vm, args
-    hash = args.car
-    key = args.cdr.car
     value = args.cdr.cdr.car
-    case hash
-    when Nydp::Hash
-      hash[key] = value
-    when NilClass, Nydp::NIL
-      nil
-    else
-      if hash.respond_to?(:[]=)
-        hash[n2r key] = n2r value
-      else
-        raise "hash-set: Not a hash: #{hash.class.name}"
-      end
-    end
+    args.car._nydp_set(args.cdr.car, value)
     vm.push_arg value
   end
 end
@@ -60,14 +36,7 @@ end
 class Nydp::Builtin::HashKeys
   include Nydp::Helper, Nydp::Builtin::Base, Singleton
   def builtin_invoke vm, args
-    hash = args.car
-    if hash.is_a? Nydp::Hash
-      vm.push_arg Nydp::Pair.from_list hash.keys
-    elsif hash.respond_to?(:keys)
-      vm.push_arg r2n(hash.keys.to_a.sort, vm.ns)
-    else
-      vm.push_arg Nydp::NIL
-    end
+    vm.push_arg args.car._nydp_keys._nydp_wrapper
   end
 end
 
@@ -97,3 +66,16 @@ class Nydp::Builtin::HashMerge
     vm.push_arg hash_0.merge hash_1
   end
 end
+
+class Nydp::Builtin::HashSlice
+  include Nydp::Helper, Nydp::Builtin::Base, Singleton
+
+  def builtin_invoke vm, args
+    old   = args.car
+    h     = old.class.new
+    slice = args.cdr.car
+    slice = slice.map { |k| n2r k } unless old.is_a? Nydp::Hash
+    slice.each { |k| h[k] = old[k] if old.key?(k) }
+    vm.push_arg h
+  end
+end

data/lib/nydp/builtin/inspect.rb

@@ -2,6 +2,6 @@ class Nydp::Builtin::Inspect
   include Nydp::Builtin::Base, Singleton
 
   def builtin_invoke vm, args
-    vm.push_arg Nydp::StringAtom.new(args.car.inspect)
+    vm.push_arg args.car.inspect
   end
 end

data/lib/nydp/builtin/plus.rb

@@ -10,13 +10,21 @@ class Nydp::Builtin::Plus
     vm.push_arg case args.car
                 when Nydp::Pair
                   sum(args, Nydp::NIL)
-                when String, Nydp::StringAtom
-                  sum(args, Nydp::StringAtom.new(""))
+                when String
+                  string_concat("", args)
                 else
                   sum(args.cdr, args.car)
                 end
   end
 
+  def string_concat init, others
+    while others && !Nydp::NIL.is?(others)
+      init << others.car.to_s
+      others = others.cdr
+    end
+    init
+  end
+
   def sum args, accum
     while args && !Nydp::NIL.is?(args)
       accum += args.car