nydp 0.0.3 → 0.0.4

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: 373997c8dcd5597d8742b347ef75b0b68ef312e7
-  data.tar.gz: 69ab87494d38291aa35786f835489095ce1ccd71
+  metadata.gz: e96bb2970aa18753721c5faa2c5aeec53a73245f
+  data.tar.gz: 151802fddd1bcdb72ecddc6fb2e882b11c3d2ea4
 SHA512:
-  metadata.gz: 801258418b77c34f8521e8dc5f6e6218156b690fa7d1fa3a584a8b77102df8af4021f56f19c27f33be944d88c8fff33443a888c25ccf6b3f20934b5cae17628e
-  data.tar.gz: 3ddf5f9e89f7159a74ef6a2f163afcbc289ca6b4330b6b1307f3be5043f97e9ec023f2ce2fc2f3aae28fb37c05bc36a6410f6ddf8610673d558034f1c37ea65b
+  metadata.gz: 437799e27e763566d9c6febf8ea154aea63bf66a7a9db57f6e8e8c033086646d9966c687d276578840dc0a974e5fdf7fb722ce9366bfb70d840f8e1b3906936f
+  data.tar.gz: da65be98312e0b821e9c7fe3b39ae6a8944b87fc6a7d20e56aaffe6a8673f632bda2c7daa6bbefe488243d156e933e81c8f33ee29909b55aa264f2afaa570a83

data/lib/lisp/boot.nydp

@@ -1,25 +1,27 @@
 ; -*- lisp -*-
 
 (assign last-cons (fn (xs)
-  (cond (pair? (cdr xs))
-        (last-cons (cdr xs))
-        xs)))
+                      (cond (pair? (cdr xs))
+                            (last-cons (cdr xs))
+                            xs)))
 
-(assign append-list! (fn (list-1 list-2)
-  (cdr-set (last-cons list-1) list-2)
-  list-1))
-
-(assign list (fn args args))
 
-(assign caar (fn (arg) (car (car arg))))
-(assign cadr (fn (arg) (car (cdr arg))))
-(assign cddr (fn (arg) (cdr (cdr arg))))
-(assign   no (fn (arg) (eq? arg nil)))
-(assign just (fn (arg) arg))
+(assign append-list! (fn (list-1 list-2)
+                         (cdr-set (last-cons list-1) list-2)
+                         list-1))
+
+(assign list  (fn args args))
+(assign last  (fn (arg) (car (last-cons arg))))
+(assign caar  (fn (arg) (car (car arg))))
+(assign cadr  (fn (arg) (car (cdr arg))))
+(assign cddr  (fn (arg) (cdr (cdr arg))))
+(assign   no  (fn (arg) (eq? arg nil)))
+(assign just  (fn (arg) arg))
+(assign pargs (fn args (apply p args) (last args)))
 
 (assign mac-expand (fn (macfn name body)
   (cond macfn
-        (pre-compile-do (apply macfn body))
+        (pre-compile (apply macfn body))
         (cons name body))))
 
 (assign macs (hash))
@@ -36,26 +38,23 @@
         (fn (args)
             (cond args
                   (cond (pair? args)
-                        (cons (pre-compile-do (car args))
+                        (cons (pre-compile (car args))
                               (pre-compile-each (cdr args)))
                         args))))
 
 (assign pre-compile-msg
         (fn args
-            (cond *debug-pre-compile* (apply p args) (car args))))
-
-(assign pre-compile-do
-        (fn (arg)
-            (cond (pair? arg)
-                  (cond (eq? (car arg) 'quote)
-                        arg
-                        (pre-compile-each (pre-compile-expr (car arg) (cdr arg))))
-                  arg)))
+            (cond *debug-pre-compile* (apply p args))
+            (last args)))
 
 (assign pre-compile
         (fn (arg)
-            (pre-compile-msg "pre-compile" arg)
-            (pre-compile-msg (pre-compile-do arg))))
+            (pre-compile-msg "pre-compile" arg "\n  -> "
+                             (cond (pair? arg)
+                                   (cond (eq? (car arg) 'quote)
+                                         arg
+                                         (pre-compile-each (pre-compile-expr (car arg) (cdr arg))))
+                                   arg))))
 
 (hash-set macs 'def
           (fn (name args . body)
@@ -64,37 +63,74 @@
                     (+ (list 'fn args)
                        body))))
 
-(def qq-unquote-recurse (arg rest)
+(def qq-handle-unquote-splicing (arg rest level)
+     (cond (eq? level 0)
+           (qq-do-unquote-splicing arg rest level)
+           (qq-skip-unquote-splicing arg rest level)))
+
+(def qq-do-unquote-splicing (arg rest level)
+     (cond (no rest)
+           arg
+           (list '+
+                 (pre-compile arg)
+                 (qq-quasiquote rest level))))
+
+(def qq-skip-unquote-splicing (arg rest level)
+     (list 'cons
+           (list 'list ''unquote-splicing (qq-quasiquote arg (- level 1)))
+           (qq-quasiquote rest level)))
+
+(def qq-handle-quasiquote (arg rest level)
+     (list 'cons
+           (list 'list ''quasiquote (qq-quasiquote arg (+ level 1)))
+           (qq-quasiquote rest level)))
+
+(def qq-handle-unquote (arg rest level)
+     (list 'cons
+           (qq-maybe-unquote arg level)
+           (qq-quasiquote rest level)))
+
+(def qq-unquote-recurse (arg rest level)
         (list 'cons
-              (qq-quasiquote arg)
-              (qq-quasiquote rest)))
+              (qq-quasiquote arg level)
+              (qq-quasiquote rest level)))
+
+(def qq-handle-plain (arg rest level)
+     (list 'cons
+           (list 'quote arg)
+           (qq-quasiquote rest level)))
 
-(def qq-unquote? (arg rest)
+(def qq-unquote? (arg rest level)
      (cond (pair? arg)
            (cond (eq? (car arg) 'unquote)
-                 (list 'cons (cadr arg) (qq-quasiquote rest))
+                 (qq-handle-unquote (cadr arg) rest level)
                  (cond (eq? (car arg) 'unquote-splicing)
-                       (cond (no rest)
-                             (cadr arg)
-                             (list '+
-                                   (cadr arg)
-                                   (qq-quasiquote rest)))
-                       (qq-unquote-recurse arg rest)))
-           (list 'cons
-                 (list 'quote arg)
-                 (qq-quasiquote rest))))
-
-(def qq-quasiquote (xs)
-     (cond (no xs)
-           nil
-           (cond (pair? xs)
-                 (cond (eq? (car xs) 'unquote)
-                       (cadr xs)
-                       (qq-unquote? (car xs) (cdr xs)))
-                 (list 'quote xs))))
-
-(hash-set macs 'quasiquote (fn (arg)
-  (qq-quasiquote arg)))
+                       (qq-handle-unquote-splicing (cadr arg) rest level)
+                       (cond (eq? (car arg) 'quasiquote)
+                             (qq-handle-quasiquote (cadr arg) rest level)
+                             (qq-unquote-recurse arg rest level))))
+           (qq-handle-plain arg rest level)))
+
+(def qq-maybe-unquote (xs level)
+     (cond (eq? level 0)
+           (pre-compile xs)
+           (list 'list ''unquote (qq-quasiquote xs (- level 1)))))
+
+(def qq-quasiquote (xs level)
+            (cond (no xs)
+                  nil
+                  (cond (pair? xs)
+                        (cond (eq? (car xs) 'unquote)
+                              (qq-maybe-unquote (cadr xs) level)
+                              (cond (eq? (car xs) 'unquote-splicing)
+                                    (qq-handle-unquote-splicing (cadr xs) nil level)
+                                    (cond (eq? (car xs) 'quasiquote)
+                                          (list 'list ''quasiquote (qq-quasiquote (cdr xs) (+ level 1)))
+                                          (qq-unquote? (car xs) (cdr xs) level))))
+                        (list 'quote xs))))
+
+(hash-set macs 'quasiquote
+          (fn (arg) (qq-quasiquote arg 0)))
 
 (hash-set macs 'mac (fn (name args . body)
   `(hash-set macs ',name (fn ,args ,@body))))
@@ -141,10 +177,6 @@
 (mac let (var val . body)
      `(with (,var ,val) ,@body))
 
-;; (debug-pre-compile t)
-;; (let a b c d e)
-;; (debug-pre-compile nil)
-
 (def each (f acc things)
   (if things
       (each f (f acc (car things)) (cdr things))
@@ -228,3 +260,6 @@
   (if (pair? xs)
       (+ 1 (len (cdr xs)))
       0))
+
+(def build-keyword-args (pairs)
+  (map (fn (ab) `(list (quote ,(car ab)) ,@(cdr ab))) pairs))

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

@@ -0,0 +1,54 @@
+;
+; absurd contrived exaggerated example to test that macros that generate
+; macros that generate macros that generate expressions are likely to work
+;
+; may you never need to do this in real life
+;
+(mac make-make-op (opname op)
+  `(mac ,opname (name n . body)
+        `(mac ,name (x)
+              `(,',',op ,,n ,x))))
+
+(make-make-op make-mult *)
+(make-make-op make-plus +)
+
+(make-mult *five 5)
+(make-mult *seven 7)
+(make-mult *eleven 11)
+
+(make-plus +five 5)
+(make-plus +seven 7)
+(make-plus +eleven 11)
+
+(register-test
+ '(suite "Boot Tests"
+
+         (suite "quasiquote"
+                ("peeks inside nested quotes"
+                 `(a b '(c ,(+ 1 2)))
+                 (a b '(c 3)))
+                ("handles nested unquote-splicing"
+                 ``(a ,,@(list '+ 1 2) b)
+                 `((a ,(+ 1 2) b)))
+                ("returns nested quasiquotes"
+                 `(a b `(c d ,(+ 1 2) ,,(+ 3 4)))
+                 (a b `(c d ,(+ 1 2) ,7))))
+
+         (suite "build-keyword-args"
+                ("takes a list of lists and returns the list with the first item of each sublist quoted"
+                 (build-keyword-args '( (a 1) (b c) (d e "f" 22) ))
+                 ((list 'a 1) (list 'b c) (list 'd e "f" 22))))
+
+         (suite "make-macros can create macros"
+                ("make-plus example generates a plus-seven expression"
+                 (+seven 6)
+                 13)
+                ("make-mult example generates a multiply-by-seven expression"
+                 (*seven 6)
+                 42)
+                ("make-mult example generates a multiply-by-eleven expression"
+                 (*eleven 20)
+                 220)
+                ("make-make example expressions can be nested"
+                 (*eleven (*five (+seven 2)))
+                 495))))

data/lib/nydp/builtin/load_tests.rb

@@ -0,0 +1,9 @@
+class Nydp::Builtin::LoadTests
+  def initialize ns
+    @ns = ns
+  end
+  def invoke vm, args
+    Nydp.loadall vm, @ns, Nydp.testfiles
+    vm.push_arg Nydp.NIL
+  end
+end

data/lib/nydp/builtin/to_sym.rb

@@ -13,9 +13,3 @@ class Nydp::Builtin::ToSym
     vm.push_arg val
   end
 end
-
-
-
-
-
-

data/lib/nydp/core.rb

@@ -45,6 +45,7 @@ module Nydp
       Symbol.mk(:inspect,       ns).assign(Nydp::Builtin::Inspect.new)
       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)

data/lib/nydp/literal.rb

@@ -18,8 +18,9 @@ module Nydp
       vm.push_arg expression
     end
 
-    def inspect; @expression.inspect; end
-    def to_s   ; @expression.to_s   ; end
+    def nydp_type ; :literal            ; end
+    def inspect   ; @expression.inspect ; end
+    def to_s      ; @expression.to_s    ; end
 
     def coerce _
       [_, expression]

data/lib/nydp/pair.rb

@@ -66,6 +66,24 @@ class Nydp::Pair
       else
         "'#{cdr.to_s}"
       end
+    elsif car.is_a?(Nydp::Symbol) && car.is?(:quasiquote)
+      if Nydp.NIL.is? cdr.cdr
+        "`#{cdr.car.to_s}"
+      else
+        "`#{cdr.to_s}"
+      end
+    elsif car.is_a?(Nydp::Symbol) && car.is?(:unquote)
+      if Nydp.NIL.is? cdr.cdr
+        ",#{cdr.car.to_s}"
+      else
+        ",#{cdr.to_s}"
+      end
+    elsif car.is_a?(Nydp::Symbol) && car.is?(:"unquote-splicing")
+      if Nydp.NIL.is? cdr.cdr
+        ",@#{cdr.car.to_s}"
+      else
+        ",@#{cdr.to_s}"
+      end
     else
       "(#{to_s_rest})"
     end
@@ -95,13 +113,13 @@ class Nydp::Pair
     [car.inspect, cdr_s].compact.join " "
   end
 
-  def append pair
+  def append thing
     if Nydp.NIL.is? self.cdr
-      self.cdr = pair
+      self.cdr = thing
     elsif pair? self.cdr
-      self.cdr.append pair
+      self.cdr.append thing
     else
-      raise "can't append #{pair} to list #{self} : cdr is #{self.cdr.inspect}"
+      raise "can't append #{thing} to list #{self} : cdr is #{self.cdr.inspect}"
     end
     self
   end

data/lib/nydp/parser.rb

@@ -20,15 +20,16 @@ module Nydp
     end
 
     def prefix_list prefix, list
+      return list if prefix == ''
       case prefix
-      when "'"
-        Pair.from_list [sym(:quote), list]
-      when "`"
-        Pair.from_list [sym(:quasiquote), list]
-      when ","
-        Pair.from_list [sym(:unquote), list]
-      when ",@"
-        Pair.from_list [sym(:"unquote-splicing"), list]
+      when /^(.*)'$/
+        prefix_list $1, Pair.from_list([sym(:quote), list])
+      when /^(.*)`$/
+        prefix_list $1, Pair.from_list([sym(:quasiquote), list])
+      when /^(.*),$/
+        prefix_list $1, Pair.from_list([sym(:unquote), list])
+      when /^(.*),@$/
+        prefix_list $1, Pair.from_list([sym(:"unquote-splicing"), list])
       else
         list
       end
@@ -40,6 +41,10 @@ module Nydp
 
     def parse_symbol txt
       case txt
+      when /^[-+]?[0-9]*\.[0-9]+([eE][-+]?[0-9]+)?$/
+        txt.to_f
+      when /^[-+]?[0-9]+$/
+        txt.to_i
       when /^'(.+)$/
         Pair.from_list [sym(:quote), parse_symbol($1)]
       when /^`(.+)$/

data/lib/nydp/symbol.rb

@@ -29,8 +29,9 @@ class Nydp::Symbol
     ns[name.to_sym]
   end
 
-  def inspect ; to_s      ; end
-  def to_s    ; name.to_s ; end
+  def nydp_type ; :symbol    ; end
+  def inspect   ; to_s       ; end
+  def to_s      ; name.to_s  ; end
 
   def == other
     other.is_a?(Nydp::Symbol) && (self.name == other.name)

data/lib/nydp/version.rb

@@ -1,3 +1,3 @@
 module Nydp
-  VERSION = "0.0.3"
+  VERSION = "0.0.4"
 end

data/lib/nydp/vm.rb

@@ -54,7 +54,7 @@ module Nydp
       msg << "\ncontext stack"
       msg << "\n================="
       contexts.each_with_index do |ctx, ix|
-        msg << "\ncontext##{ix} : #{ctx}"
+        msg << "\ncontext##{ix} :\n#{ctx}"
       end
       msg << "\n"
       msg << "\n"

data/spec/parser_spec.rb

@@ -124,6 +124,18 @@ describe Nydp::Parser do
     expect(parse "foo.bar").to eq  pair_list([dotsyn, foo, bar])
   end
 
+  it "should spot numbers hiding in special syntax" do
+    parsed = parse("foo.2:3:4")
+    expect(parsed.inspect).to eq "(dot-syntax foo (colon-syntax 2 3 4))"
+
+    numbers = parsed.cdr.cdr.car.cdr
+    two = numbers.car
+    three = numbers.cdr.car
+    four = numbers.cdr.cdr.car
+
+    expect([two, three, four].map &:class).to eq [Fixnum, Fixnum, Fixnum]
+  end
+
   it "should parse a dotted symbol" do
     expect(parse "(list a b foo.bar c)").to eq  pair_list([sym(:list), a, b, pair_list([dotsyn, foo, bar]), c])
   end
@@ -140,10 +152,32 @@ describe Nydp::Parser do
     expect(parse "'foo").to eq pair_list([quote, foo])
   end
 
+  it "should not let quote decorations trick it into thinking numbers are symbols" do
+    two = parse("'2").cdr.car
+    expect(two.class).to eq 2.class
+    expect(two).to eq 2
+  end
+
+  it "should not let unquote decorations trick it into thinking numbers are symbols" do
+    two = parse(",2").cdr.car
+    expect(two.class).to eq 2.class
+    expect(two).to eq 2
+  end
+
+  it "should not let unquote-splicing decorations trick it into thinking numbers are symbols" do
+    two = parse(",@2").cdr.car
+    expect(two.class).to eq 2.class
+    expect(two).to eq 2
+  end
+
   it "should quote-unquote symbols" do
     expect(parse "',foo").to eq pair_list([quote, pair_list([unquote, foo])])
   end
 
+  it "should unquote-unquote_splicing symbols" do
+    expect(parse(",,@foo").inspect).to eq "(unquote (unquote-splicing foo))"
+  end
+
   it "should quote lists" do
     expect(parse "'(foo)").to eq pair_list([quote, pair_list([foo])])
   end
@@ -156,6 +190,24 @@ describe Nydp::Parser do
     expect(parse ",(bar)").to eq pair_list([unquote, pair_list([bar])])
   end
 
+  it "should do some complicated unquote stuff with lists" do
+    expect(parse("`(a b `(c d ,(+ 1 2) ,,(+ 3 4)))").inspect).to eq "(quasiquote (a b (quasiquote (c d (unquote (+ 1 2)) (unquote (unquote (+ 3 4)))))))"
+  end
+
+  it "should do some complicated unquote stuff with mixed lists and symbols" do
+    expect(parse("`(a b `(c d ,,@foo e f))").inspect).to eq "(quasiquote (a b (quasiquote (c d (unquote (unquote-splicing foo)) e f))))"
+    expect(parse("`(a b `(c d ,@,foo e f))").inspect).to eq "(quasiquote (a b (quasiquote (c d (unquote-splicing (unquote foo)) e f))))"
+    expect(parse("`(a b `(c d ,',foo e f))").inspect).to eq "(quasiquote (a b (quasiquote (c d (unquote (quote (unquote foo))) e f))))"
+  end
+
+  it "should do some complicated unquote stuff with lists" do
+    expect(parse("`(a b `(c d ,(+ 1 2) ,,@(list 3 4)))").inspect).to eq "(quasiquote (a b (quasiquote (c d (unquote (+ 1 2)) (unquote (unquote-splicing (list 3 4)))))))"
+  end
+
+  it "should do some complicated unquote stuff with symbols" do
+    expect(parse("`(a b `(c d ,(+ 1 2) ,,x))").inspect).to eq "(quasiquote (a b (quasiquote (c d (unquote (+ 1 2)) (unquote (unquote x))))))"
+  end
+
   it "should unquote-splicing atoms" do
     expect(parse ",@foo").to eq pair_list([unquote_splicing, foo])
   end

metadata

@@ -1,14 +1,14 @@
 --- !ruby/object:Gem::Specification
 name: nydp
 version: !ruby/object:Gem::Version
-  version: 0.0.3
+  version: 0.0.4
 platform: ruby
 authors:
 - Conan Dalton
 autorequire: 
 bindir: bin
 cert_chain: []
-date: 2015-02-17 00:00:00.000000000 Z
+date: 2015-03-05 00:00:00.000000000 Z
 dependencies:
 - !ruby/object:Gem::Dependency
   name: bundler
@@ -85,6 +85,7 @@ files:
 - bin/nydp-tests
 - lib/lisp/boot.nydp
 - lib/lisp/test-runner.nydp
+- lib/lisp/tests/boot-tests.nydp
 - lib/lisp/tests/foundation-test.nydp
 - lib/nydp.rb
 - lib/nydp/assignment.rb
@@ -103,6 +104,7 @@ files:
 - lib/nydp/builtin/inspect.rb
 - lib/nydp/builtin/is_equal.rb
 - lib/nydp/builtin/less_than.rb
+- lib/nydp/builtin/load_tests.rb
 - lib/nydp/builtin/millisecs.rb
 - lib/nydp/builtin/minus.rb
 - lib/nydp/builtin/plus.rb