nydp 0.0.1

checksums.yaml

@@ -0,0 +1,7 @@
+---
+SHA1:
+  metadata.gz: 070df0ab7e597dbbcb8e80aca7f4c6dbc444d0e9
+  data.tar.gz: a772c25f02d36b78842698bd798704dda414490c
+SHA512:
+  metadata.gz: 50400bf553e7bf65c4514f7922c0ab57f2a31ea7971f2626b45e55747bdc1994172dbae3a111350ce3a33d9933653845b19654099309991f164dae1e81f611a9
+  data.tar.gz: cf5d1475f6c57fd4dde96969ca0b469e3a1a3b9f8a338d1af237931b88d4e1eaab9ad49da6cc69872dbda56afe90f40f9468ba829b6290b10d42c7a1160a6684

data/.gitignore

@@ -0,0 +1,18 @@
+*.gem
+*.rbc
+.bundle
+.config
+.yardoc
+Gemfile.lock
+InstalledFiles
+_yardoc
+coverage
+doc/
+lib/bundler/man
+pkg
+rdoc
+spec/reports
+test/tmp
+test/version_tmp
+tmp
+.#*

data/.rspec

@@ -0,0 +1,2 @@
+--color
+--format progress

data/Gemfile

@@ -0,0 +1,4 @@
+source 'https://rubygems.org'
+
+# Specify your gem's dependencies in nydp.gemspec
+gemspec

data/LICENSE.txt

@@ -0,0 +1,22 @@
+Copyright (c) 2013 conanite
+
+MIT License
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

data/README.md

@@ -0,0 +1,58 @@
+# Nydp
+
+NYDP is "Not Your Daddy's Parentheses", a reference to [Xkcd 297](http://xkcd.com/297/) (itself a reference
+to Star Wars), as well as to the meme [Not Your Daddy's Q](http://tvtropes.org/pmwiki/pmwiki.php/Main/NotYourDaddysX), where Q is a modern,
+improved Q unlike the Q your daddy used. "NYDP" also shamelessly piggypacks on the
+catchiness and popularity of the [NYPD](https://en.wikipedia.org/wiki/NYPD_Blue) abbreviation ("New York Police Department",
+for those who have no interest in popular US TV or authoritarian politics).
+
+Macro-expansion is not built-in to the interpreter; however, the compiler will invoke 'pre-compile before compiling, passing
+the expression to compile as an argument. You can override 'pre-compile to transform the expression in any way you wish. By default,
+nydp provides an implementation of 'pre-compile that performs macro-expansion.
+
+```
+(def pre-compile (expr)
+  (map pre-compile
+    (if (mac-names (car expr))
+        (pre-compile (mac-expand (car expr) (cdr expr)))
+        expr)))
+```
+
+; blah blah
+
+```
+  ==> (comment "blah blah")
+
+  ==> (mac comment (txt) nil)
+```
+
+We do not wish to suggest by "Not Your Daddy's Parentheses" that Common Lisp,
+Scheme, Racket, Arc, Clojure or your favourite other lisp are somehow
+old-fashioned, inferior, or in need of improvement in any way.
+
+
+## Installation
+
+Add this line to your application's Gemfile:
+
+    gem 'nydp'
+
+And then execute:
+
+    $ bundle
+
+Or install it yourself as:
+
+    $ gem install nydp
+
+## Usage
+
+TODO: Write usage instructions here
+
+## Contributing
+
+1. Fork it
+2. Create your feature branch (`git checkout -b my-new-feature`)
+3. Commit your changes (`git commit -am 'Add some feature'`)
+4. Push to the branch (`git push origin my-new-feature`)
+5. Create new Pull Request

data/Rakefile

@@ -0,0 +1 @@
+require "bundler/gem_tasks"

data/bin/nydp

@@ -0,0 +1,5 @@
+#!/usr/bin/env ruby
+
+require 'nydp'
+
+Nydp.repl

data/bin/nydp-tests

@@ -0,0 +1,5 @@
+#!/usr/bin/env ruby
+
+require 'nydp'
+
+Nydp.tests

data/lib/lisp/boot.nydp

@@ -0,0 +1,219 @@
+; -*- lisp -*-
+
+(assign last-cons (fn (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 mac-expand (fn (macfn name body)
+  (cond macfn
+        (pre-compile-do (apply macfn body))
+        (cons name body))))
+
+(assign macs (hash))
+
+(assign debug-pre-compile
+        (fn (arg)
+            (assign *debug-pre-compile* arg)))
+
+(assign pre-compile-expr
+        (fn (name body)
+            (mac-expand (hash-get macs name) name body)))
+
+(assign pre-compile-each
+        (fn (args)
+            (cond args
+                  (cond (pair? args)
+                        (cons (pre-compile-do (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)))
+
+(assign pre-compile
+        (fn (arg)
+            (pre-compile-msg "pre-compile" arg)
+            (pre-compile-msg (pre-compile-do arg))))
+
+(hash-set macs 'def
+          (fn (name args . body)
+              (list 'assign
+                    name
+                    (+ (list 'fn args)
+                       body))))
+
+(def qq-unquote-recurse (arg rest)
+        (list 'cons
+              (qq-quasiquote arg)
+              (qq-quasiquote rest)))
+
+(def qq-unquote? (arg rest)
+     (cond (pair? arg)
+           (cond (eq? (car arg) 'unquote)
+                 (list 'cons (cadr arg) (qq-quasiquote rest))
+                 (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)))
+
+(hash-set macs 'mac (fn (name args . body)
+  `(hash-set macs ',name (fn ,args ,@body))))
+
+(mac if args
+     (cond (no args) nil
+           (cond (cdr args)
+                 (cond (cddr args)
+                       `(cond ,(car args) ,(cadr args) (if ,@(cddr args)))
+                       `(cond ,(car args) ,(cadr args)))
+                 (car args))))
+
+(mac and args
+  (if args
+      (if (cdr args)
+          `(if ,(car args) (and ,@(cdr args)))
+          (car args))
+      't))
+
+(mac do args
+  `((fn nil ,@args)))
+
+(mac when (condition . body)
+  `(cond ,condition (do ,@body)))
+
+(def map (f things)
+  (if (no things)
+      nil
+    (pair? things)
+    (cons (f (car things)) (map f (cdr things)))
+    (map f (list things))))
+
+(def pairs (things)
+     (if (no things)       nil
+       (no (cdr things)) (list (list (car things)))
+       (cons (list (car things) (cadr things))
+             (pairs (cddr things)))))
+
+(mac with (parms . body)
+     `((fn ,(map car (pairs parms))
+           ,@body)
+       ,@(map cadr (pairs parms))))
+
+(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))
+      acc))
+
+(def eachr (f things)
+     (when things
+       (eachr f (cdr things))
+       (f (car things))))
+
+(def zip (a b)
+  (if a
+      (cons (list (car a) (car b))
+            (zip (cdr a) (cdr b)))))
+
+(mac push (x things)
+  `(assign ,things (cons ,x ,things)))
+
+(def flatten (things)
+     (let acc nil
+          (let flattenize nil
+               (assign flattenize (fn (x)
+                                      (if (pair? x)
+                                          (eachr flattenize x)
+                                        (push x acc))))
+               (flattenize things))
+          acc))
+
+(def joinstr (txt things)
+     (apply +
+            (to-string (car things))
+            (flatten (zip (map (fn (_) txt) (cdr things))
+                          (map to-string (cdr things))))))
+
+(let uniq-counter 0
+     (def uniq (prefix)
+          (sym (joinstr "-"
+                        (list prefix
+                              (assign uniq-counter
+                                      (+ uniq-counter 1))))))
+     (def reset-uniq-counter ()
+          (assign uniq-counter 0)))
+
+(mac w/uniq (vars . body)
+     (if (pair? vars)
+         `(with ,(apply + (map (fn (n) (list n '(uniq ',n))) vars))
+                ,@body)
+       `(let ,vars (uniq ',vars) ,@body)))
+
+(mac or args
+     (cond args
+           (w/uniq ora
+                   `(let ,ora ,(car args)
+                         (cond ,ora ,ora (or ,@(cdr args)))))))
+
+(mac pop (xs)
+     (w/uniq gp
+             `(let ,gp (car ,xs)
+                   (assign ,xs (cdr ,xs))
+                   ,gp)))
+
+(def nth (n things)
+     (if (eq? n 0)
+         (car things)
+       (nth (- n 1) (cdr things))))
+
+(def iso (x y)
+     (or (eq? x y)
+         (and (pair? x)
+              (pair? y)
+              (iso (car x) (car y))
+              (iso (cdr x) (cdr y)))))

data/lib/lisp/test-runner.nydp

@@ -0,0 +1,39 @@
+(assign show-failed-only t)
+(assign all-tests nil)
+
+(def register-test (test)
+  "register a test to be run later by 'run-all-tests"
+  (push test all-tests))
+
+(def run-all-tests ()
+  "runs all tests that have been registered with 'register-test"
+  (with (passed 0 failed 0)
+    (with (f-pass (fn nil (assign passed (+ 1 passed)))
+           f-fail (fn nil (assign failed (+ 1 failed))))
+      (run-tests `(suite "all tests" ,@all-tests) f-pass f-fail)
+      (p "passed: " passed)
+      (p "failed: " failed)
+      (/ passed (+ passed failed)))))
+
+(def run-tests (tests passf failf)
+  (execute-test "" tests passf failf)
+  results)
+
+(def execute-test (desc test passf failf)
+  (if (eq? 'suite (car test))
+      (execute-tests (+ desc " - " (cadr test)) (cddr test) passf failf)
+      (execute-single-test desc test passf failf)))
+
+(def execute-single-test (desc test passf failf)
+  (with (expected (nth 2 test) result (eval (nth 1 test)))
+        (if (iso result expected)
+            (passf)
+            (do (p desc " - " (car test) " - FAILED:
+   expected " (inspect expected) ",
+   got " (inspect result) "
+")
+                (failf)))))
+
+(def execute-tests (desc tests passf failf)
+  (execute-test desc (car tests) passf failf)
+  (if (cdr tests) (execute-tests desc (cdr tests) passf failf)))

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

@@ -0,0 +1,28 @@
+(register-test '(suite "Foundation Tests"
+  (suite "Lists"
+    (suite "cons"
+      ("cons creates a list"
+        (cons 'a '(b c))
+        (a b c))
+
+      ("cons conses two strings"
+        (cons "a" "b")
+        ("a" . "b")))
+
+    (suite "car"
+      ("car of nil is nil"
+        (car nil)
+        nil)
+
+      ("car of empty list is nil"
+        (car '())
+        nil)
+
+      ("car - no need to quote empty list"
+        (car ())
+        nil)
+
+      ("car returns car of argument"
+        (car '(foo 12.34 "bar"))
+        foo)
+    ))))

data/lib/nydp.rb

@@ -0,0 +1,143 @@
+module Nydp
+  def self.compile_and_eval vm, expr
+    vm.thread Pair.new(Compiler.compile(expr, Nydp.NIL), Nydp.NIL)
+  end
+
+  def self.setup ns
+    Symbol.mk(:cons,  ns).assign(Nydp::Builtin::Cons.new)
+    Symbol.mk(:car,   ns).assign(Nydp::Builtin::Car.new)
+    Symbol.mk(:cdr,   ns).assign(Nydp::Builtin::Cdr.new)
+    Symbol.mk(:+,     ns).assign(Nydp::Builtin::Plus.new)
+    Symbol.mk(:-,     ns).assign(Nydp::Builtin::Minus.new)
+    Symbol.mk(:*,     ns).assign(Nydp::Builtin::Times.new)
+    Symbol.mk(:/,     ns).assign(Nydp::Builtin::Divide.new)
+    Symbol.mk(:>,     ns).assign(Nydp::Builtin::GreaterThan.new)
+    Symbol.mk(:<,     ns).assign(Nydp::Builtin::LessThan.new)
+    Symbol.mk(:eval,  ns).assign(Nydp::Builtin::Eval.new(ns))
+    Symbol.mk(:hash,  ns).assign(Nydp::Builtin::Hash.new)
+    Symbol.mk(:apply, ns).assign(Nydp::Builtin::Apply.new)
+    Symbol.mk(:error, ns).assign(Nydp::Builtin::Error.new)
+    Symbol.mk(:quit,  ns).assign(Nydp::Builtin::Quit.new)
+    Symbol.mk(:p,     ns).assign(Nydp::Builtin::Puts.new)
+    Symbol.mk(:PI,    ns).assign Literal.new(3.1415)
+    Symbol.mk(:nil,   ns).assign Nydp.NIL
+    Symbol.mk(:t,     ns).assign Nydp.T
+    Symbol.mk(:sym,   ns).assign Nydp::Builtin::ToSym.new(ns)
+    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("random-string",ns).assign(Nydp::Builtin::RandomString.new)
+    Symbol.mk("to-string",    ns).assign(Nydp::Builtin::ToString.new)
+    Symbol.mk(:"eq?",         ns).assign(Nydp::Builtin::IsEqual.new)
+    Symbol.mk(:"pair?",       ns).assign(Nydp::Builtin::IsPair.new)
+    Symbol.mk(:"cdr-set",     ns).assign(Nydp::Builtin::CdrSet.new)
+    Symbol.mk(:"hash-get",    ns).assign(Nydp::Builtin::HashGet.new)
+    Symbol.mk(:"hash-set",    ns).assign(Nydp::Builtin::HashSet.new)
+    Symbol.mk(:"hash-keys",   ns).assign(Nydp::Builtin::HashKeys.new)
+    Symbol.mk(:"vm-info",     ns).assign Nydp::Builtin::VmInfo.new
+    Symbol.mk(:"pre-compile", ns).assign Nydp::Builtin::PreCompile.new
+  end
+
+  class Runner
+    attr_accessor :vm, :ns
+
+    def initialize vm, ns
+      @vm = vm
+      @ns = ns
+      @precompile = Symbol.mk(:"pre-compile", ns)
+      @quote      = Symbol.mk(:quote, ns)
+    end
+
+    def quote expr
+      Pair.from_list [@quote, expr]
+    end
+
+    def precompile expr
+      Pair.from_list [@precompile, quote(expr)]
+    end
+
+    def pre_compile expr
+      Nydp.compile_and_eval(vm, precompile(expr))
+    end
+
+    def evaluate expr
+      Nydp.compile_and_eval(vm, pre_compile(expr))
+    end
+  end
+
+  class StreamRunner < Runner
+    attr_accessor :stream, :parser
+
+    def initialize vm, ns, stream
+      super vm, ns
+      @stream = stream
+      @parser = Nydp::Parser.new(ns)
+      @tokens = Nydp::Tokeniser.new stream
+    end
+
+    def prompt *_
+    end
+
+    def run
+      res = Nydp.NIL
+      prompt
+      while !@tokens.finished
+        expr = parser.expression(@tokens)
+        unless expr.nil?
+          res = evaluate expr
+          prompt res
+        end
+      end
+      res
+    end
+  end
+
+  class Repl < StreamRunner
+    def prompt val=nil
+      puts val if val
+      print "nydp > "
+    end
+  end
+
+  def self.repl
+    puts "welcome to nydp"
+    root_ns = { }
+    setup(root_ns)
+    vm = VM.new
+    boot_path = File.join File.expand_path(File.dirname(__FILE__)), 'lisp/boot.nydp'
+    StreamRunner.new(vm, root_ns, File.new(boot_path)).run
+    Repl.new(vm, root_ns, $stdin).run
+  end
+
+  def self.tests
+    puts "welcome to nydp : running tests"
+    root_ns = { }
+    setup(root_ns)
+    vm = VM.new
+    boot_path = File.join File.expand_path(File.dirname(__FILE__)), 'lisp/boot.nydp'
+    test_runner_path = File.join File.expand_path(File.dirname(__FILE__)), 'lisp/test-runner.nydp'
+    tests = Dir.glob(File.join File.expand_path(File.dirname(__FILE__)), 'lisp/tests/**/*.nydp')
+    StreamRunner.new(vm, root_ns, File.new(boot_path)).run
+    StreamRunner.new(vm, root_ns, File.new(test_runner_path)).run
+    tests.each do |tst|
+      StreamRunner.new(vm, root_ns, File.new(tst)).run
+    end
+    StreamRunner.new(vm, root_ns, "(run-all-tests)").run
+  end
+end
+
+require "nydp/error"
+require "nydp/truth"
+require "nydp/version"
+require "nydp/helper"
+require "nydp/symbol"
+require "nydp/symbol_lookup"
+require "nydp/pair"
+require "nydp/assignment"
+require "nydp/builtin"
+require "nydp/string_atom"
+require "nydp/string_token"
+require "nydp/tokeniser"
+require "nydp/parser"
+require "nydp/compiler"
+require "nydp/vm"