nydp 0.4.1 → 0.4.2

data/lib/lisp/core-110-hash-utils.nydp

@@ -0,0 +1,7 @@
+(chapter-start 'hash-manipulation "utilities for manipulating, accessing and altering hash objects")
+
+; return values for each key in hash 'h
+(def hash-values (h) (map (fn (k) h.,k) (hash-keys h)))
+
+; (auto-hash a b c) same as { a a b b c c }
+(mac auto-hash names `(brace-list ,@(flatten:map λn(list n n) names)))

data/lib/lisp/core-120-settings.nydp

@@ -0,0 +1,35 @@
+(chapter-start 'settings "Utilities for managing settings")
+
+(assign settings {})
+
+; convert expr to a function that returns the expr, unless expr is a symbol in which case we assume it already refers to a fn
+(def settings/fn (expr)
+  (if (sym? expr) expr
+      (or (atom? expr) (no expr)) `(k ,expr)
+      `(fn (_) ,expr)))
+
+; update value of setting 'name
+(mac set-setting (name value)
+  `(do (hash-cons (dox-item-by-type 'setting ',(sym name))
+                  'values
+                  { plugin this-plugin script this-script value ',value })
+       (hash-set settings ',(sym name) ,(settings/fn value))))
+
+(mac def-setting (name initial)
+  ; define a setting in the given 'context with a 'name and an 'initial value, with a 'doc to explain it
+  ; if value is a function, it is invoked with 'context and 'name to retrieve its value
+  ; if value is a constant, it is wrapped in a function to return the constant
+  (let context (car:string-split name ".")
+    `(do (dox-add-doc ',(sym name)
+                      'setting
+                      ',(fetch-and-clear-comments)
+                      nil
+                      '(def-setting ,name ,initial)
+                      '(,(sym "settings/~context"))
+                      { setting { default ',initial context ',context name ',name } })
+         (set-setting ,(sym name) ,initial))))
+
+; get the value of the given setting
+(def setting (name)
+  (on-err (error "can't get value of setting ~name")
+          ((hash-get settings (sym name)) name)))

data/lib/lisp/{core-060-benchmarking.nydp → core-900-benchmarking.nydp}

@@ -159,21 +159,49 @@
 ;;     (= h.ca v1) (= h.cb v2) (= h.cc v3) (= h.ca v4) (= h.cb v5) (= h.cc v6)
 ;;     (= h.da v1) (= h.db v2) (= h.dc v3) (= h.da v4) (= h.db v5) (= h.dc v6)))
 
-(def bm-or-lex-lex-lex (a b c) (or a b c))
-(def bm-faster-or ()
-  (bm-or-lex-lex-lex 1 2 3)
-  (bm-or-lex-lex-lex nil 2 3))
-
-(def build-mapsum-data (count data)
-  (if (> count 0)
-      (build-mapsum-data (- count 1)
-                         (cons { mappit (rand 10) }
-                               data))
-      data))
-
-(let mapsum-data (build-mapsum-data 1000)
-  (def bm-mapsum    () (mapsum &mappit mapsum-data))
-  (def bm-mapreduce () (mapreduce &mappit + mapsum-data 0)))
+  ;; (def bm-acc ()
+  ;;   (accum z
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)))
+
+  ;; (def bm-facc ()
+  ;;   (faccum z
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)
+  ;;     (z 0) (z 1) (z 2) (z 3) (z 4) (z 5) (z 6) (z 7) (z 8) (z 9)))
+
+(in-private
+  (def bm-j ()
+    (j "abc" '(d e f (g h i)) (list "jk" "lm")))
+
+  (def bm-or-lex-lex-lex (a b c) (or a b c))
+  (def bm-faster-or ()
+    (bm-or-lex-lex-lex 1 2 3)
+    (bm-or-lex-lex-lex nil 2 3))
+
+  (def build-mapsum-data (count data)
+    (if (> count 0)
+        (build-mapsum-data (- count 1)
+                           (cons { mappit (rand 10) }
+                                 data))
+        data))
+
+  (let mapsum-data (build-mapsum-data 1000)
+    (def bm-mapsum    () (mapsum &mappit mapsum-data))
+    (def bm-mapreduce () (mapreduce &mappit + mapsum-data 0))))
 
 
 
@@ -197,8 +225,10 @@
 
 (def rbs (name)
   (let summary nil
-    (push (bm "mapsum    "   bm-mapsum             10  100) summary)
-    (push (bm "mapreduce "   bm-mapreduce          10  100) summary)
+    ;; (push (bm "accum    "   bm-acc             10  500) summary)
+    ;; (push (bm "accum    "   bm-facc            10  500) summary)
+    ;; (push (bm "mapsum    "   bm-mapsum             10  100) summary)
+    ;; (push (bm "mapreduce "   bm-mapreduce          10  100) summary)
     ;; (push (bm "cond with OR       "   bm-faster-or             10  40000) summary)
     ;; (push (bm "cond with OR       "   bm-cond-9             10  40000) summary)
     ;; (push (bm "cond with OR       "   bm-cond-9             10  100000) summary)

data/lib/lisp/tests/cdr-set-examples.nydp

@@ -0,0 +1,6 @@
+(examples-for cdr-set
+  ("sets cdr of a cons cell"
+   (let things '(a b c d)
+     (cdr-set things '(x y z))
+     things)
+   (a x y z)))

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

@@ -18,6 +18,8 @@
  ("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" )
 
+ ("parses string" (let d (date "2004-03-12") (list d.year d.month d.day)) (2004 3 12))
+
  ("can act as hash key"
   (with (h {} d (date 2015 11 8))
     (hash-set h d "on this day")

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

@@ -169,3 +169,15 @@
   ("argument default value is nil"
    ( (fn (x y z) (list x y (car z))) 'a 'b )
    (a b nil)))
+
+(examples-for do
+  ("executes its content"
+   (let premesolithic 3
+     (do
+       (assign premesolithic (* premesolithic 4))
+       (let jurassic 17
+         (do
+           (= jurassic (+ jurassic premesolithic))
+           (= premesolithic (+ jurassic premesolithic))
+           (* premesolithic 2)))))
+   82))

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

@@ -28,7 +28,7 @@
   ("returns nil for a symbol"  (hash-keys 'lipstick)  nil)
 
   ("returns date operations"
-   (hash-keys (date 2015 11 18))
+   (sort:hash-keys (date 2015 11 18))
    (beginning_of_month
     beginning_of_week
     beginning_of_year

data/lib/lisp/tests/set-intersection-examples.nydp

@@ -3,14 +3,30 @@
    (⋂ '(a b c))
    (a b c))
 
+  ("returns a single nil arg"
+   (⋂ nil)
+   nil)
+
   ("returns intersection of two args"
    (⋂ '(a b c) '(a b d))
    (a b))
 
+  ("returns intersection of list and nil"
+   (⋂ '(a b c) nil)
+   nil)
+
+  ("returns intersection of nil and list"
+   (⋂ nil '(a b c))
+   nil)
+
   ("returns intersection of three args"
    (⋂ '(a b c d e) '(a b c d f) '(z b c d g))
    (b c d))
 
+  ("returns intersection of list, nil, and another list"
+   (⋂ '(a b c d e) nil '(z b c d g))
+   nil)
+
   ("returns intersection of four args"
    (⋂ '(a b c d e) '(a b c d f) '(z b d c g) '(z y g c d))
    (c d)))

data/lib/lisp/tests/set-union-examples.nydp

@@ -7,10 +7,18 @@
    (⋃ '(a b c) '(a b d))
    (a b c d))
 
+  ("returns union of arg and nil"
+   (⋃ '(a b c) nil)
+   (a b c))
+
   ("returns union of three args"
    (⋃ '(a b c d e) '(a b c d f) '(z b c d g))
    (a b c d e f z g))
 
+  ("returns union of arg nil arg"
+   (⋃ '(a b c d e) nil '(z b c d g))
+   (a b c d e z g))
+
   ("returns union of four args"
    (⋃ '(a b c d e) '(a b c d f) '(z b d c g) '(z y g c d))
    (a b c d e f z g y)))

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

@@ -0,0 +1,24 @@
+(examples-for settings/fn
+  ("returns arg if it is a sym"
+   (settings/fn 'foobar)
+   foobar)
+
+  ("returns fn wrapper for arg if it is a string"
+   (settings/fn "hello")
+   (k "hello"))
+
+  ("returns fn wrapper for arg if it is a number"
+   (settings/fn 42)
+   (k 42))
+
+  ("returns fn wrapper for arg if it is nil"
+   (settings/fn nil)
+   (k nil))
+
+  ("wraps arg in a fn expression if it is a hash"
+   (settings/fn '{ a 1 b 2 })
+   (fn (_) { 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))))
+   (fn (_) (let foo this that (rfnwith (complex stuff) ((percent-syntax || (dot-syntax td tricky#syntax))))))))

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

@@ -24,6 +24,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")

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

@@ -7,11 +7,9 @@ module Nydp
 
   # 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
   end
 
@@ -89,6 +87,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/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/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

@@ -10,49 +10,15 @@ 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 +26,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
 

data/lib/nydp/core_ext.rb

@@ -0,0 +1,41 @@
+class Object
+  def _nydp_get    a ; raise "_nydp_get : not gettable: #{a.inspect} on #{self.class.name}" ; end
+  def _nydp_set a, v ; raise "_nydp_get : not settable: #{a.inspect} on #{self.class.name}" ; end
+  def _nydp_keys     ; []   ; end
+  def _nydp_wrapper  ; self ; end
+end
+
+class NilClass
+  def _nydp_wrapper ; Nydp::NIL ; end
+end
+
+class FalseClass
+  def _nydp_wrapper ; Nydp::NIL ; end
+end
+
+class TrueClass
+  def _nydp_wrapper ; Nydp::T ; end
+end
+
+class ::Symbol
+  def _nydp_wrapper ; Nydp::FrozenSymbol.mk(self) ; end
+end
+
+class ::Date
+  def _nydp_wrapper ; Nydp::Date.new self ; end
+end
+
+class ::Array
+  def _nydp_wrapper ; Nydp::Pair.from_list map &:_nydp_wrapper ; end
+end
+
+class ::String
+  def _nydp_wrapper ; Nydp::StringAtom.new self ; end
+end
+
+class ::Hash
+  include Nydp::Helper
+  def _nydp_get a    ; self[n2r a]           ; end
+  def _nydp_set a, v ; self[n2r a] = n2r(v)  ; end
+  def _nydp_keys     ; keys                  ; end
+end

data/lib/nydp/date.rb

@@ -16,23 +16,21 @@ module Nydp
       end
     end
 
-    def initialize ruby_date
-      @ruby_date = ruby_date
-    end
+    def initialize ruby_date ; @ruby_date = ruby_date ; end
 
-    def to_s      ; ruby_date.to_s    ; end
-    def to_ruby   ; ruby_date         ; end
-    def inspect   ; ruby_date.inspect ; end
-    def nydp_type ; :date             ; end
-    def + int     ; r2n(ruby_date + int            , nil) ; end
-    def > other   ; is_date?(other) && ruby_date > other.ruby_date           ; end
-    def < other   ; is_date?(other) && ruby_date < other.ruby_date           ; end
-    def == other  ; is_date?(other) && ruby_date == other.ruby_date          ; end
-    def <=> other ; is_date?(other) && ruby_date <=> other.ruby_date         ; end
-    def eql? d    ; self == d                             ; end
-    def hash      ; ruby_date.hash                        ; end
-    def is_date? other ; other.is_a? Nydp::Date                                            ; end
-    def -        other ; r2n(ruby_date - (is_date?(other) ? other.ruby_date : other), nil) ; end
+    def to_s      ; ruby_date.to_s                                   ; end
+    def to_ruby   ; ruby_date                                        ; end
+    def inspect   ; ruby_date.inspect                                ; end
+    def nydp_type ; :date                                            ; end
+    def +     int ; r2n(ruby_date + int)                             ; end
+    def >   other ; is_date?(other) && ruby_date > other.ruby_date   ; end
+    def <   other ; is_date?(other) && ruby_date < other.ruby_date   ; end
+    def ==  other ; is_date?(other) && ruby_date == other.ruby_date  ; end
+    def <=> other ; is_date?(other) && ruby_date <=> other.ruby_date ; end
+    def eql?    d ; self == d                                        ; end
+    def hash      ; ruby_date.hash                                   ; end
+    def is_date? other ; other.is_a? Nydp::Date                                       ; end
+    def -        other ; r2n(ruby_date - (is_date?(other) ? other.ruby_date : other)) ; end
 
     @@pass_through = %i{ monday? tuesday? wednesday? thursday? friday? saturday? sunday? }
     @@keys = Set.new %i{
@@ -70,17 +68,17 @@ module Nydp
       class_eval "def #{n} * ; ruby_date.#{n} ; end"
     end
 
-    def keys                     ; @@keys                                           ; end
-    def dispatch key, y, m, d, w ; self.send(key, y, m, d, w) if keys.include?(key) ; end
+    def _nydp_keys               ; @@keys.to_a                                            ; end
+    def dispatch key, y, m, d, w ; self.send(key, y, m, d, w) if _nydp_keys.include?(key) ; end
 
-    def [] key
+    def _nydp_get key
       key = key.to_s.gsub(/-/, '_').to_sym
       y = ruby_date.year
       m = ruby_date.month
       d = ruby_date.day
       w = ruby_date.wday
 
-      r2n(dispatch(key, y, m, d, w), nil)
+      r2n(dispatch(key, y, m, d, w))
     end
   end
 end