nydp 0.3.0 → 0.4.0

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

@@ -0,0 +1,26 @@
+(examples-for ampersand-syntax
+  ("shortcut for hash-get"
+   (&key { key 'value })
+   value)
+
+  ("acts as function"
+   (map &key (list { key 1 } { key 2 } { key 3 }))
+   (1 2 3))
+
+  ("assigns to key"
+   (let h { key 12 }
+     (= (&key h) 13)
+     h.key)
+   13)
+
+  ("assigns to key.subkey"
+   (let h { key { subkey 41 } }
+     (= (&key.subkey h) 42)
+     h.key.subkey)
+   42)
+
+  ("even works with 'push"
+   (let h { key { subkey '(1 2 3) } }
+     (push 99 (&key.subkey h))
+     h.key.subkey)
+   (99 1 2 3)))

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

@@ -7,7 +7,7 @@
 (mac make-make-op (opname op)
   `(mac ,opname (name n . body)
      `(mac ,name (x)
-        `(,',',op ,,n ,x))))
+        `(',',,op ,,n ,x))))
 
 (make-make-op make-mult *)
 (make-make-op make-plus +)

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

@@ -22,6 +22,10 @@
    (collect (fn (x) (eq? (len x) 2)) '("aa" "bbb" "cc" "ddd" . "ee"))
    ("aa" "cc" . "ee"))
 
+  ("preserves structure of improper list: returns just the lastcdr"
+   (collect (fn (x) (eq? (len x) 2)) '("aaa" "bbb" "ccc" "ddd" . "ee"))
+   "ee")
+
   ("returns nil if it's an atom and doesn't match"
    (collect (fn (x) (eq? (len x) 20))
             "zz")

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

@@ -16,7 +16,7 @@
     (b c)      (nth 1 xxx)
     (d (e f))  (nth 2 xxx)
     g          (nth 3 xxx)
-    h          (lastcdr xxx))))
+    h          (nthcdr 4 xxx))))
 
 (examples-for destructure/build
   ("with no args"
@@ -56,6 +56,23 @@
              (nth 0 destructure-2)
              (nth 1 destructure-2))) (nth 0 destructure-1) (nth 1 destructure-1))))
 
+  ("nested improper arguments"
+   (let (a (b c . d) e) (list "A" (list "B" "C" "D0" "D1" "D2") "E")
+     (string-pieces a b c d e))
+   "ABCD0D1D2E")
+
+  ; a lot of ceremony here to suppress side-effects of compiling really crap code and just get the warnings
+  ("warns about arg names shadowing macro names"
+   (do (without-hooks 'warnings/new
+                      λ(on-err nil
+                               (pre-compile '(fun (aif (and or) . when)
+                                                  "ignore"))))
+       warnings/list)
+   ((arg-shadows-macro "arg " when " shadows macro " when " in arg list " (aif (and or) . when))
+    (arg-shadows-macro "arg " or " shadows macro " or " in arg list " (aif (and or) . when))
+    (arg-shadows-macro "arg " and " shadows macro " and " in arg list " (aif (and or) . when))
+    (arg-shadows-macro "arg " aif " shadows macro " aif " in arg list " (aif (and or) . when))))
+
   ("implicit in 'let and 'with"
    (with ((a b)       (list "h" "e")
           (c (d e f)) (list "l" (list "l" "o" " ")))

data/lib/lisp/tests/fill-bucket-examples.nydp

@@ -1,6 +1,6 @@
 (examples-for fill-bucket
   ("fills a bucket with 12 characters"
-   (fill-bucket '("1" "2345" "67" "890" "1" "2345" "678")
+   (bucket/fill '("1" "2345" "67" "890" "1" "2345" "678")
                 nil
                 len
                 0
@@ -10,7 +10,7 @@
     ("2345" "678")))
 
   ("fills a bucket up to 100"
-   (fill-bucket '(1 2 3 4 5 6 7 8 9 10)
+   (bucket/fill '(1 2 3 4 5 6 7 8 9 10)
                 nil
                 λx(* x x)
                 0
@@ -18,3 +18,47 @@
    ((1 2 3 4 5 6)
     91
     (7 8 9 10))))
+
+(examples-for fill-buckets
+  ("returns an empty list for no items"
+   (let pages (fill-buckets '() 30   nil λx(* x x) 'line-items)
+     (= pages (fill-buckets '() 30 pages       len 'history   ))
+     (= pages (fill-buckets '() 30 pages     (k 1) 'payments  ))
+     (rev:map λb(list 'size b.bucket-size 'line-items b.line-items 'history b.history 'payments b.payments)
+              pages))
+   ())
+
+  ("returns a single bucket for few items"
+   (let pages (fill-buckets '()                               30   nil λx(* x x) 'line-items)
+     (= pages (fill-buckets '("aa" "bbbb" "c" "ddddd" "eeee") 30 pages       len 'history   ))
+     (= pages (fill-buckets '()                               30 pages     (k 1) 'payments  ))
+     (rev:map λb(list 'size b.bucket-size 'line-items b.line-items 'history b.history 'payments b.payments)
+              pages))
+   ((size 16 line-items nil history ("aa" "bbbb" "c" "ddddd" "eeee") payments nil)))
+
+  ("returns a single overfilled bucket for an oversized item"
+   (let pages (fill-buckets '("aa34567890123456" "eeee") 12 nil len 'history   )
+     (rev:map λb(list 'size b.bucket-size b.history)
+              pages))
+   ((size 16 ("aa34567890123456"))
+    (size  4 ("eeee"))))
+
+  ("accumulates subsequent items in subsequent buckets"
+   (let pages (fill-buckets '(1 2 2 4 3 3 1)   30   nil λx(* x x) 'line-items)
+     (= pages (fill-buckets '()                30 pages       len 'history   ))
+     (= pages (fill-buckets '(pay pay pay pay) 30 pages     (k 3) 'payments  ))
+     (rev:map λb(list 'size b.bucket-size 'line-items b.line-items 'history b.history 'payments b.payments)
+              pages))
+   ((size 25 line-items (1 2 2 4) history nil payments nil)
+    (size 28 line-items (3 3 1)   history nil payments (pay pay pay))
+    (size  3 line-items nil       history nil payments (pay))))
+
+  ("use fill-buckets for complex pagination where you have several sets of elements, each element having a different size"
+   (let pages (fill-buckets '(1 2 2 4 3 3 1)                   30   nil λx(* x x) 'line-items)
+     (= pages (fill-buckets '("aa" "bbbb" "c" "ddddd" "eeee")  30 pages       len 'history   ))
+     (= pages (fill-buckets '(pay pay pay pay)                 30 pages     (k 1) 'payments  ))
+     (rev:map λb(list 'size b.bucket-size 'line-items b.line-items 'history b.history 'payments b.payments)
+              pages))
+   ((size 25 line-items (1 2 2 4) history nil               payments nil)
+    (size 26 line-items (3 3 1)   history ("aa" "bbbb" "c") payments nil)
+    (size 13 line-items nil       history ("ddddd" "eeee")  payments (pay pay pay pay)))))

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

@@ -0,0 +1,58 @@
+(examples-for ⌊
+  ("rounds the given to the nearest integer below"
+   (⌊ 12.5)
+   12)
+
+  ("rounds the given to the nearest integer below"
+   (⌊ 32.32)
+   32)
+
+  ("rounds the given to the nearest integer below negatively"
+   (⌊ -32.32)
+   -33)
+
+  ("alias for 'math-floor"
+   (math-floor 3.1415)
+   3))
+
+(examples-for ⌈
+  ("rounds the given to the nearest integer above"
+   (⌈ 25.25)
+   26)
+
+  ("rounds the given to the nearest integer above"
+   (⌈ 12.5)
+   13)
+
+  ("rounds the given to the nearest integer above negatively"
+   (⌈ -25.25)
+   -25)
+
+  ("alias for 'math-ceiling"
+   (math-ceiling 3.1415)
+   4))
+
+(examples-for round
+  ("rounds the given to the nearest integer"
+   (math-round 3.1415)
+   3)
+
+  ("rounds the given to the nearest integer"
+   (math-round -3.1415)
+   -3)
+
+  ("rounds the given to the nearest negative integer"
+   (math-round -3.999)
+   -4)
+
+  ("rounds the given to the nearest integer"
+   (math-round 3.999)
+   4)
+
+  ("rounds half-away from zero"
+   (math-round 12.5)
+   13)
+
+  ("rounds negatively half-away from zero"
+   (math-round -1.5)
+   -2))

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

@@ -0,0 +1,5 @@
+(examples-for k
+  ("returns a constant function"
+   (let f (k 1)
+     (list (f) (f) (f) (f)))
+   (1 1 1 1)))

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

@@ -0,0 +1,16 @@
+(examples-for **
+  ("2 ** 10"
+   (** 2 10)
+   1024)
+
+  ("10 ** 3"
+   (** 10 3)
+   1000)
+
+  ("1024 ** 0.5"
+   (** 1024 0.5)
+   32)
+
+  ("16 ** 1.5"
+   (** 16 1.5)
+   64))

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

@@ -3,6 +3,10 @@
    (string-split "a and b and c and d" " and ")
    ("a" "b" "c" "d"))
 
+  ("with no delimiter argument, returns chars in string"
+   (collect !empty? (string-split "word"))
+   ("w" "o" "r" "d"))
+
   ("returns empty leading, internal, and trailing segments"
    (string-split "and" "and")
    ("" ""))
@@ -21,6 +25,10 @@
    "a x b x c x d"))
 
 (examples-for string-match
+  ("no match returns nil"
+   (string-match "this that another" "XXXX")
+   nil)
+
   ("match with regexp"
    (let m (string-match "a and b and c and d" "and")
      (list m.match m.captures))

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

@@ -23,6 +23,12 @@
            '(a b c d e f))
    "a:b:c:d:e:f")
 
+  ("with no args"
+   (let x 15
+     (let y λ(* x x)
+       (y)))
+   225)
+
   ("with two args, to be sure"
    (λpq(+ p (* p q)) 3 5)
    18))

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

@@ -0,0 +1,16 @@
+(examples-for zip
+  ("joins two lists"
+   (zip '(a b c) '(1 2 3))
+   ((a 1) (b 2) (c 3)))
+
+  ("joins more lists"
+   (zip '(a b) '(1 2) '(p q) '(41 42 43) '(x y zip))
+   ((a 1 p 41 x) (b 2 q 42 y)))
+
+  ("resulting list is as long as first list"
+   (zip '(a b) '(1 2 3 4 5 6) nil)
+   ((a 1 nil) (b 2 nil)))
+
+  ("resulting list is nil if first list is nil"
+   (zip nil '(1 2 3 4 5) '(p q r))
+   nil))

data/lib/nydp.rb

@@ -5,6 +5,7 @@ module Nydp
   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
@@ -18,6 +19,8 @@ module Nydp
   def self.eval_src      ns, src_txt, name=nil ; eval_with Nydp::Runner, ns, src_txt, name                  ; end
   def self.eval_with runner, ns, src_txt, name ; runner.new(VM.new(ns), ns, reader(src_txt), nil, name).run ; end
   def self.ms                           t1, t0 ; ((t1 - t0) * 1000).to_i                                    ; end
+  def self.new_tokeniser                reader ; Nydp::Tokeniser.new reader                                 ; end
+  def self.new_parser                       ns ; Nydp::Parser.new(ns)                                       ; end
 
   def self.indent_message indent, msg
     msg.split(/\n/).map { |line| "#{indent}#{line}" }.join("\n")
@@ -47,12 +50,13 @@ module Nydp
 
   def self.repl options={ }
     toplevel do
-      silent = options[:silent]
+      silent = options.delete :silent
+      ns     = options.delete :ns
       launch_time = Time.now
       last_script_time = Time.now
       puts "welcome to nydp #{options.inspect}" unless silent
       reader = Nydp::ReadlineReader.new $stdin, "nydp > "
-      ns     = build_nydp do |script|
+      ns   ||= build_nydp do |script|
         this_script_time = Time.now
         puts "script #{script} time #{ms this_script_time, last_script_time}ms" if options[:verbose]
         last_script_time = this_script_time

data/lib/nydp/assignment.rb

@@ -38,8 +38,7 @@ module Nydp
     def inspect; to_s ; end
 
     def execute vm
-      vm.instructions.push @instructions
-      vm.contexts.push vm.current_context
+      vm.push_ctx_instructions @instructions
     end
   end
 end

data/lib/nydp/builtin/ensuring.rb

@@ -21,8 +21,7 @@ class Nydp::Builtin::Ensuring
     fn_tricky = args.cdr.car
 
     protection_instructions = Nydp::Pair.from_list [InvokeProtection.new(fn_ensure), Nydp::PopArg]
-    vm.instructions.push protection_instructions
-    vm.contexts.push vm.current_context
+    vm.push_ctx_instructions protection_instructions
 
     fn_tricky.invoke vm, Nydp::NIL
   end

data/lib/nydp/builtin/greater_than.rb

@@ -2,11 +2,11 @@ class Nydp::Builtin::GreaterThan
   include Nydp::Builtin::Base, Singleton
 
   def builtin_invoke vm, args
-    vm.push_arg (greater_than(args.car, args.cdr) ? Nydp::T : Nydp::NIL)
+    vm.push_arg(greater_than(args.car, args.cdr) || Nydp::NIL)
   end
 
   def greater_than arg, args
-    return true if Nydp::NIL.is? args
+    return arg if Nydp::NIL.is? args
     (arg > args.car) && greater_than(args.car, args.cdr)
   end
 

data/lib/nydp/builtin/handle_error.rb

@@ -39,8 +39,7 @@ class Nydp::Builtin::HandleError
     fn_tricky = args.cdr.car
 
     catcher_instructions = Nydp::Pair.from_list [CatchError.new(fn_handle, vm.args.size)]
-    vm.instructions.push catcher_instructions
-    vm.contexts.push vm.current_context
+    vm.push_ctx_instructions catcher_instructions
 
     fn_tricky.invoke vm, Nydp::NIL
   end

data/lib/nydp/builtin/less_than.rb

@@ -2,11 +2,11 @@ class Nydp::Builtin::LessThan
   include Nydp::Builtin::Base, Singleton
 
   def builtin_invoke vm, args
-    vm.push_arg (less_than(args.car, args.cdr) ? Nydp::T : Nydp::NIL)
+    vm.push_arg(less_than(args.car, args.cdr) || Nydp::NIL)
   end
 
   def less_than arg, args
-    return true if Nydp::NIL.is? args
+    return arg if Nydp::NIL.is? args
     (arg < args.car) && less_than(args.car, args.cdr)
   end
 

data/lib/nydp/builtin/math_ceiling.rb

@@ -0,0 +1,7 @@
+class Nydp::Builtin::MathCeiling
+  include Nydp::Builtin::Base, Singleton
+
+  def builtin_invoke vm, args
+    vm.push_arg(args.car.ceil)
+  end
+end

data/lib/nydp/builtin/math_floor.rb

@@ -0,0 +1,7 @@
+class Nydp::Builtin::MathFloor
+  include Nydp::Builtin::Base, Singleton
+
+  def builtin_invoke vm, args
+    vm.push_arg(args.car.floor)
+  end
+end

data/lib/nydp/builtin/math_power.rb

@@ -0,0 +1,7 @@
+class Nydp::Builtin::MathPower
+  include Nydp::Builtin::Base, Singleton
+
+  def builtin_invoke vm, args
+    vm.push_arg(args.car ** args.cdr.car)
+  end
+end

data/lib/nydp/builtin/math_round.rb

@@ -0,0 +1,7 @@
+class Nydp::Builtin::MathRound
+  include Nydp::Builtin::Base, Singleton
+
+  def builtin_invoke vm, args
+    vm.push_arg(args.car.round)
+  end
+end

data/lib/nydp/builtin/parse.rb

@@ -2,8 +2,8 @@ class Nydp::Builtin::Parse
   include Nydp::Builtin::Base, Singleton
 
   def builtin_invoke vm, args
-    parser = Nydp::Parser.new(vm.ns)
-    tokens = Nydp::Tokeniser.new Nydp::StringReader.new args.car.to_s
+    parser = Nydp.new_parser(vm.ns)
+    tokens = Nydp.new_tokeniser Nydp::StringReader.new args.car.to_s
     exprs  = []
     while !tokens.finished
       expr = parser.expression(tokens)

data/lib/nydp/builtin/parse_in_string.rb

@@ -2,10 +2,10 @@ class Nydp::Builtin::ParseInString
   include Nydp::Builtin::Base, Singleton
 
   def builtin_invoke vm, args
-    parser = Nydp::Parser.new(vm.ns)
+    parser = Nydp.new_parser(vm.ns)
     parsable = args.car.to_s
-    tokens = Nydp::Tokeniser.new Nydp::StringReader.new parsable
-    expr = parser.string(tokens, "", :eof)
+    tokens = Nydp.new_tokeniser Nydp::StringReader.new parsable
+    expr = parser.embedded(tokens)
     vm.push_arg expr
   rescue StandardError => e
     new_msg = "parse error: #{e.message.inspect} in\n#{Nydp.indent_text parsable}"

data/lib/nydp/builtin/pre_compile.rb

@@ -2,7 +2,6 @@ class Nydp::Builtin::PreCompile
   include Nydp::Builtin::Base, Singleton
 
   def builtin_invoke vm, args
-    raise Nydp:Error.new("pre-compile: expects one arg, got #{args.inspect}") unless Nydp::NIL == args.cdr
     vm.push_arg args.car
   end
 end