nydp 0.4.3 → 0.4.5

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

@@ -85,6 +85,16 @@
 (examples-for mod
   ("modulus for two ints" (mod 64 6) 4))
 
+(examples-for abs
+  ("a positive integer"  (abs   64)   64)
+  ("a negative integer"  (abs  -42)   42)
+  ("zero"                (abs    0)    0)
+  ("negative zero"       (abs   -0)    0)
+  ("float zero"          (abs  0.0)    0)
+  ("float negative zero" (abs -0.0)    0)
+  ("float negative"      (abs -1.6)  1.6)
+  ("float positive"      (abs  4.2)  4.2))
+
 (examples-for inspect
   ("truth"            (inspect t)        "t")
   ("nil"              (inspect nil)      "nil")

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

@@ -0,0 +1,14 @@
+(examples-for 'case
+  ("expands to an if-expression"
+   (do (reset-uniq-counter)
+       (explain-mac 1
+                    `(case eq? person.name
+                           "conan" (greet person)
+                           "egg"   (delete person)
+                           "bach"  (play person)
+                           else    (interrogate person))))
+   (let caseval-1 (dot-syntax person name)
+     (if (eq? caseval-1 "conan") (greet person)
+         (eq? caseval-1 "egg")   (delete person)
+         (eq? caseval-1 "bach")  (play person)
+         (interrogate person)))))

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

@@ -18,6 +18,9 @@
  ("navigates to week end from sun"   (let d (date 2015 11  1) (to-string d.end-of-week))         "2015-11-01" )
  ("navigates to week end"            (let d (date 2015 11  6) (to-string d.end-of-week))         "2015-11-08" )
 
+ ("works with apply"       (to-string (apply date '(2006 6 21))) "2006-06-21")
+ ("works with apply again" (to-string (apply date 2006 6 21 nil)) "2006-06-21")
+
  ("parses string" (let d (date "2004-03-12") (list d.year d.month d.day)) (2004 3 12))
 
  ("can act as hash key"
@@ -47,4 +50,54 @@
  ("adds days"             (let d (date 2015 11  8) (to-string (+ d  1))) "2015-11-09")
  ("adds more days"        (let d (date 2015 11  8) (to-string (+ d 10))) "2015-11-18")
  ("subtracts a day"       (let d (date 2015 11 18) (to-string (- d  1))) "2015-11-17")
- ("subtracts more days"   (let d (date 2015 11 18) (to-string (- d  5))) "2015-11-13"))
+ ("subtracts more days"   (let d (date 2015 11 18) (to-string (- d  5))) "2015-11-13")
+
+ ("advances by -2 weeks"   (let d (date 1965  6  8) (to-string (+ d '(-2 week)))) "1965-05-25")
+ ("advances by -1 week"    (let d (date 1965  6  8) (to-string (+ d '(-1 week)))) "1965-06-01")
+ ("advances by  1 week"    (let d (date 1965  6  8) (to-string (+ d '( 1 week)))) "1965-06-15")
+ ("advances by  2 weeks"   (let d (date 1965  6  8) (to-string (+ d '( 2 week)))) "1965-06-22")
+
+ ("advances by -2 weeks"   (let d (date 1965  6  8) (to-string (+   d '(-2 week)))) "1965-05-25")
+ ("advances by -1 week"    (let d (date 1965  6  8) (to-string (+   d '(-1 week)))) "1965-06-01")
+ ("advances by  1 week"    (let d (date 1965  6  8) (to-string (+   d '( 1 week)))) "1965-06-15")
+ ("advances by  2 weeks"   (let d (date 1965  6  8) (to-string (+   d '( 2 week)))) "1965-06-22")
+
+ ("advances by -2 days"    (let d (date 1965  6  8) (to-string (+   d '(-2 day)))) "1965-06-06")
+ ("advances by -1 day"     (let d (date 1965  6  8) (to-string (+   d '(-1 day)))) "1965-06-07")
+ ("advances by  1 day"     (let d (date 1965  6  8) (to-string (+   d '( 1 day)))) "1965-06-09")
+ ("advances by  2 days"    (let d (date 1965  6  8) (to-string (+   d '( 2 day)))) "1965-06-10")
+
+ ("advances by -2 months"  (let d (date 1965  6  8) (to-string (+   d '(-2 month)))) "1965-04-08")
+ ("advances by -1 month"   (let d (date 1965  6  8) (to-string (+   d '(-1 month)))) "1965-05-08")
+ ("advances by  1 month"   (let d (date 1965  6  8) (to-string (+   d '( 1 month)))) "1965-07-08")
+ ("advances by  2 months"  (let d (date 1965  6  8) (to-string (+   d '( 2 month)))) "1965-08-08")
+
+ ("advances by -2 years"   (let d (date 1965  6  8) (to-string (+   d '(-2 year)))) "1963-06-08")
+ ("advances by -1 year"    (let d (date 1965  6  8) (to-string (+   d '(-1 year)))) "1964-06-08")
+ ("advances by  1 year"    (let d (date 1965  6  8) (to-string (+   d '( 1 year)))) "1966-06-08")
+ ("advances by  2 years"   (let d (date 1965  6  8) (to-string (+   d '( 2 year)))) "1967-06-08")
+
+ ("adapts for leap years"         (let d (date 2019 12 31) (to-string (+   d '( 2 month)))) "2020-02-29")
+ ("jumps one year"                (let d (date 2019 12 31) (to-string (+   d '( 1 year) ))) "2020-12-31")
+ ("jumps to 28 feb a year later"  (let d (date 2019 12 31) (to-string (+   d '(14 month)))) "2021-02-28")
+ ("jumps to end of june"          (let d (date 2019 12 31) (to-string (+   d '( 6 month)))) "2020-06-30")
+ ("jumps to end of july"          (let d (date 2019 12 31) (to-string (+   d '( 7 month)))) "2020-07-31")
+ ("jumps from end feb to end feb" (let d (date 2020 02 29) (to-string (+   d '(12 month)))) "2021-02-28")
+
+ ("finds anniversary before a given date in previous year"
+  (to-string (anniversary/previous (date 2019 6 21) (date 1949 10 3)))
+  "2018-10-03")
+
+ ("finds anniversary before a given date in same year"
+  (to-string (anniversary/previous (date 2019 11 20) (date 1949 10 3)))
+  "2019-10-03")
+
+ ("finds anniversary after a given date in same year"
+  (to-string (anniversary/next (date 2019 6 21) (date 1949 10 3)))
+  "2019-10-03")
+
+
+ ("finds anniversary after a given date in following year"
+  (to-string (anniversary/next (date 2019 11 20) (date 1949 10 3)))
+  "2020-10-03")
+ )

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

@@ -26,6 +26,18 @@
            "zz")
    nil)
 
+  ("empty list"
+   (detect present? nil)
+   nil)
+
+  ("present? for list of empty things"
+   (detect present? (list "" nil {} ()))
+   nil)
+
+  ("present? for mostly empty things"
+   (detect present? (list "" nil 42 {} ()))
+   42)
+
   ("nil for nil"
    (detect nil nil)
    nil)

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

@@ -0,0 +1,24 @@
+(examples-for dp
+  ("returns nil for nil"
+   (dp)
+   nil)
+
+  ("returns nil when everything is empty"
+   (dp "" nil {} ())
+   nil)
+
+  ("returns the first item if not empty"
+   (dp 'a "" {} ())
+   a)
+
+  ("returns the second item if not empty"
+   (dp "" 'b "" {} ())
+   b)
+
+  ("returns the third item if not empty"
+   (dp "" {} 'c "" {} ())
+   c)
+
+  ("returns the last item if not empty"
+   (dp "" {} () 'd)
+   d))

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

@@ -18,7 +18,7 @@
   ("nonzero"       (present? "foo-bar")  t)
   ("zero"          (present? "")         nil)
   ("blank"         (present? "  ")       t)
-  ("nil is t"      (present? nil)        nil)
+  ("nil is nil"    (present? nil)        nil)
   ("sym is t"      (present? 'abc)       t)
   ("number is t"   (present? 234)        t)
 

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

@@ -20,10 +20,10 @@
                     (on-err (error "bar")
                             (on-err (error "toto")
                                     (error "primum errorum")))))
-    "\"foo\"
-\"bar\"
-\"toto\"
-\"primum errorum\"")
+    "foo
+bar
+toto
+primum errorum")
 
   ("handles errors but any ensuring clause gets called first"
    (with (x nil y nil)

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

@@ -1,3 +1,20 @@
+(examples-for hash-replace-keys
+  ("changes strings to symbols"
+   (let h (hash-replace-keys λk(sym k) { "a" 1 "b" 2 "c" 3 })
+     (list (hash-keys h) (hash-values h)))
+   ((a b c) (1 2 3)))
+
+  ("appends a character to keys"
+   (let h (hash-replace-keys λk(string-pieces k "!") { "a" 1 "b" 2 "c" 3 })
+     (list (hash-keys h) (hash-values h)))
+   (("a!" "b!" "c!") (1 2 3))))
+
+(examples-for hash
+  ("builds a hash"
+   (let h (hash "a" 1 'b 2 '(x y) 3)
+     (list (hash-keys h) (hash-values h)))
+   (("a" b (x y)) (1 2 3))))
+
 (examples-for hash-values
   ("returns the list of values of the given hash"
    (hash-values { a 1 b 2 c 'c d "hello" })

data/lib/lisp/tests/list-grep-examples.nydp

@@ -0,0 +1,40 @@
+(examples-for list/grep
+  ("it finds strings"
+   (list/grep
+    string?
+    (list 'foo "bar" '(a b "c d" e) { ignores "hash elements" }))
+   ("bar" "c d"))
+
+  ("it finds items whose car is carryon"
+   (list/grep
+    λf(caris 'carryon f)
+    '(foo
+      (carryon 1 2 3 42)
+      (bar (40 41 42 (carryon 43 (carryon 42) 41)))
+      42
+      99))
+   ((carryon 1 2 3 42)
+    (carryon 43 (carryon 42) 41)
+    (carryon 42)))
+
+  ("it finds items of length 3"
+   (list/grep
+    λf(eq? 3 (len f))
+    '(foo
+      (2 3 42)
+      (bar (40 41 42) (43 (x y z) 41))
+      42
+      99))
+   ((2 3 42)
+    (bar (40 41 42) (43 (x y z) 41))
+    (40 41 42)
+    (43 (x y z) 41)
+    (x y z)))
+
+  ("it finds code within interpolated strings"
+   (list/seek-cars 'include (parse-in-string "
+<div>~~(include \"empty-name.html\")</div>
+<div>~~(map λn(let name n (include \"show-name.html\")) {names})'</div>
+"))
+   ((include "empty-name.html")
+    (include "show-name.html"))))

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

@@ -205,3 +205,42 @@
   ("finds value corresponding to given key"
    (alref 'c '((a b) (c d)))
    d))
+
+(examples-for list/fill
+  ("returns an overfull list unchanged"
+   (list/fill '(a b c) λ(just 'x) 2)
+   (a b c))
+
+  ("returns a full list unchanged"
+   (list/fill '(a b c) λ(just 'x) 3)
+   (a b c))
+
+  ("returns an unfull list with extra items"
+   (list/fill '(a b c) λ(just 'x) 4)
+   (a b c x))
+
+  ("returns an unfull list with extra items"
+   (let idx 0
+     (list/fill '(a b c) λ(++ idx) 10))
+   (a b c 1 2 3 4 5 6 7)))
+
+(examples-for list/last
+  ("returns the thing if it's nil"
+   (list/last nil)
+   nil)
+
+  ("returns the thing if it's not a pair"
+   (list/last 42)
+   42)
+
+  ("returns the cdr if it's not a pair"
+   (list/last '(x . y))
+   y)
+
+  ("returns the last item in the list"
+   (list/last '(x y z))
+   z)
+
+  ("returns nil if it's the last item in the list"
+   (list/last '(x y z nil))
+   nil))

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

@@ -0,0 +1,10 @@
+(examples-for module
+  ("it overrides external namespace internally"
+   (with (x (fn (n) "the old outside x ~n")
+          y (fn (n) "the old outside y ~n"))
+     (module foo
+       (def x (n) (* 2 n))
+       (def y (n) (+ 2 n))
+       (export bar (a b) (* (x a) (y b))))
+    (list (foo/bar 3 5) (x 43) (y 44)))
+   (42 "the old outside x 43" "the old outside y 44")))

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

@@ -29,6 +29,22 @@
    (parse "%this.and.that")
    ((percent-syntax || (dot-syntax this and that))) )
 
+  ("parses a plain at-symbol"
+   (pre-compile (car (parse "@")))
+   @)
+
+  ("parses a plain at-prefix-syntax symbol"
+   (parse "@this")
+   ((at-syntax || this)))
+
+  ("parses an at-prefix-mixed-with-dot-syntax symbol"
+   (parse "@this.and.that")
+   ((dot-syntax (at-syntax || this) and that)))
+
+  ("at-prefix-mixed-with-dot-syntax expands to plain hash lookup: @this.and.that equivalent to @.this.and.that"
+   (pre-compile (car (parse "@this.and.that")))
+   (hash-get (hash-get (hash-get @ (quote this)) (quote and)) (quote that)))
+
   ("parses a dot-syntax symbol"
    (parse "this.that.zozo")
    ((dot-syntax this that zozo)) )

data/lib/lisp/tests/pretty-print-tests.nydp

@@ -286,5 +286,11 @@ toto")
    "%x.y")
 
   ("brace list"
-   (pp '(&x {a 1 b "two" c 'three d ,four e (sub invocation) f {sub brace list} }))
-   "(&x { a 1 b \"two\" c 'three d ,four e (sub invocation) f { sub brace list } })"))
+   (pp '(let hello {a 1 b "two" c 'three d ,four e (sub invocation) f {sub brace list here} }))
+"(let hello { a 1
+       b \"two\"
+       c 'three
+       d ,four
+       e (sub invocation)
+       f { sub brace
+         list here } })"))

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

@@ -17,7 +17,7 @@
 
   ("wraps arg in a fn expression if it is a hash"
    (settings/fn '{ a 1 b 2 })
-   (fn (_) { a 1 b 2 }))
+   (k { a 1 b 2 }))
 
   ("wraps arg in a fn expression if it is a complex expression"
    (settings/fn '(let foo this that (rfnwith (complex stuff) (%td.tricky#syntax))))

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 ")

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/nydp.rb

@@ -11,6 +11,9 @@ module Nydp
     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
@@ -48,9 +51,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 > "

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