apricot 0.0.1 → 0.0.2

data/benchmarks/interpolate.rb

@@ -0,0 +1,20 @@
+$LOAD_PATH.unshift(File.expand_path('../../lib', __FILE__))
+require 'apricot'
+
+begin
+	require 'benchmark/ips'
+rescue LoadError
+	$stderr.puts "The benchmark-ips gem is not installed."
+	exit 1
+end
+
+apr = Apricot::Compiler.eval <<CODE
+  #(str "hello. " 42 " is the best number")
+CODE
+
+rbx = lambda { "hello. #{42} is the best number" }
+
+Benchmark.ips do |x|
+  x.report("rbx", &rbx)
+  x.report("apr", &apr)
+end

data/bin/apricot

@@ -1,20 +1,7 @@
-#!/usr/bin/env rbx
-# vim: ft=ruby:
-
-unless defined?(Rubinius)
-  $stderr.puts "Error: Apricot must be run on Rubinius."
-  exit 1
-end
-
-unless Rubinius.ruby19?
-  $stderr.puts "Warning: Apricot must be run in Ruby 1.9 mode, executing rbx -X19..."
-  exec("/usr/bin/env", "rbx", "-X19", file, *ARGV)
-end
-
+#!/usr/bin/env ruby
 require 'apricot'
 
 evals = []
-bytecode = false
 
 options = Rubinius::Options.new "Usage: #{$0} [options] [program]", 20
 options.doc "OPTIONS:"
@@ -23,10 +10,6 @@ options.on "-e", "CODE", "evaluate CODE and print the result" do |code|
   evals << [:eval, code]
 end
 
-options.on "-B", "--bytecode", "print bytecode after compiling" do
-  bytecode = true
-end
-
 options.on "-h", "--help", "display this help" do
   puts options
   exit
@@ -39,7 +22,7 @@ end
 if evals.empty?
   if $stdin.tty?
     require 'apricot/repl'
-    Apricot::REPL.new('apr> ', bytecode).run
+    Apricot::REPL.new.run
   else
     evals << [:stdin]
   end
@@ -48,11 +31,10 @@ end
 evals.each do |type, *args|
   case type
   when :eval
-    Apricot::Compiler.eval(args.first, "(eval)", 1, bytecode)
+    Apricot::Compiler.eval(args.first, "(eval)", 1)
   when :stdin
-    Apricot::Compiler.eval(STDIN.read, "(stdin)", 1, bytecode)
+    Apricot::Compiler.eval(STDIN.read, "(stdin)", 1)
   when :file
-    # The code is executed as it compiles.
-    Apricot::Compiler.compile(args.first, nil, bytecode)
+    Apricot::CodeLoader.require(File.expand_path(args.first))
   end
 end

data/examples/bot.apr

@@ -1,7 +1,4 @@
-; An example IRC bot. This does not reflect our vision for Apricot, just what
-; features we currently have working.
-
-(require "socket")
+(require-ruby "socket")
 
 (defn send [io & parts]
   (let [msg (apply str parts)]

data/examples/cinch-bot.apr

@@ -1,10 +1,10 @@
-(require "cinch")
+(require-ruby "cinch")
 
 (doto (Cinch::Bot.)
   (.configure | #(doto %
-                   (.server= "irc.tenthbit.net")
+                   (.server= "irc.freenode.net")
                    (.nick= "apribot")
-                   (.channels= ["#programming"])))
+                   (.channels= ["#apricot"])))
 
   (.on :message #r/^apribot[:,]?\s+(.+)/
        | (fn [m msg] (.reply m msg true)))

data/examples/sinatra.apr

@@ -0,0 +1,9 @@
+(require-ruby "sinatra")
+
+(defmacro get [route & body]
+  `(.send MAIN :get ~route | (fn ~@body)))
+
+(get "/hello/:name" [name]
+  (str "Hello " name))
+
+(.run! Sinatra::Application)

data/kernel/core.apr

@@ -25,10 +25,10 @@
                      {})
           arglists (if (.is_a? (.first body) Array)
                      (list (.first body))
-                     (.to_list
-                       (.map body | #(if (.is_a? % Apricot::List)
+                     (.to_seq
+                       (.map body | #(if (.is_a? % Apricot::Seq)
                                        (.first %)))))
-          f (.intern Apricot::Identifier (.gensym Apricot))]
+          f (Apricot/gensym)]
       (list 'let [f (concat (list 'fn name) body)]
             (list 'def name f)
             (list '.apricot_meta=
@@ -53,7 +53,7 @@
                [name doc-string? metadata? ([params ...] body) ...+])
    :macro true}
   [name & body]
-  (let [f (.intern Apricot::Identifier (.gensym Apricot))]
+  (let [f (Apricot/gensym)]
     (list 'let [f (concat (list 'defn name) body)]
           (list '.store (list '.apricot_meta f) :macro true)
           f)))
@@ -62,6 +62,26 @@
   "Create a new list containing the items."
   [& items] (.to_list items))
 
+(defn seq
+  "Return a seq on the collection. If the collection is empty, return nil.
+  (seq nil) returns nil."
+  [coll] (.to_seq coll))
+
+(defn first
+  "Return the first item in the collection. Call seq on the argument. If coll
+  is nil, return nil."
+  [coll] (.first (seq coll)))
+
+(defn rest
+  "Return a possibly empty seq of the items after the first. Call seq on the
+  argument."
+  [coll] (.rest (seq coll)))
+
+(defn next
+  "Return a seq of the items after the first. Call seq on the argument. If
+  there are no more items, return nil."
+  [coll] (.next (seq coll)))
+
 (defn concat
   "Concatenate the items in the supplied colls into a single list."
   [& colls] (.to_list (.reduce (.map colls | :to_a) [] :+)))
@@ -71,8 +91,16 @@
   [& items] items)
 
 (defn set
-  "Create a new set containing the items."
-  [& items] (Set. items))
+  "Return a set of the distinct elements of coll."
+  [coll] (Set. coll))
+
+(defn hash-set
+  "Return a new hash set with supplied keys."
+  [& keys] (Set. keys))
+
+(defn sorted-set
+  "Return a new sorted set with supplied keys."
+  [& keys] (SortedSet. keys))
 
 (defn hash
   "Create a new hash map from the items. The items are interpreted as a list of
@@ -88,6 +116,25 @@
   "Return a new list where head is the first element and tail is the rest."
   [head tail] (Apricot::Cons. head tail))
 
+(defn spread
+  {:private true}
+  [arglist]
+  (if (.nil? arglist)
+    nil
+    (if (.nil? (next arglist))
+      (seq (first arglist))
+      (cons (first arglist) (spread (next arglist))))))
+
+(defn list*
+  "Creates a new list containing the items prepended to the rest, the last of
+  which will be treated as a sequence."
+  ([args] (seq args))
+  ([a args] (cons a args))
+  ([a b args] (cons a (cons b args)))
+  ([a b c args] (cons a (cons b (cons c args))))
+  ([a b c d & more]
+     (cons a (cons b (cons c (cons d (spread more)))))))
+
 (defn apply
   "Applies fn f to the argument list formed by prepending intervening
   arguments to args."
@@ -110,16 +157,30 @@
   "Return a new identifier with a unique name. If a prefix string is supplied,
   the name is prefix__# where # is some unique number. If prefix is not
   supplied, the prefix is 'g'."
-  [[prefix "g"]]
+  [? (prefix "g")]
   (identifier (.gensym Apricot prefix)))
 
-(defn require
-  "Require the given Ruby files. Works just like using Ruby's 'require' on
-  each of the arguments."
-  [& files]
+(defn require-ruby
+  "Require the given Ruby files, skipping any which are already loaded. Just
+  like calling Ruby's require method on each argument."
+  [& names]
   ; (. Kernel require %) does not call the Rubygems custom require for some
   ; reason, so we use this method. (MAIN is the special toplevel object).
-  (.each files | #(. MAIN send :require %)))
+  (.each names | #(. MAIN send :require %))
+  nil)
+
+(defn load
+  "Load the given Apricot files, unconditionally. To skip loading files which
+  are already loaded, see 'require'."
+  [& names]
+  (.each names | #(Apricot/load %))
+  nil)
+
+(defn require
+  "Load the given Apricot files, skipping any which are already loaded."
+  [& names]
+  (.each names | #(Apricot/require %))
+  nil)
 
 (defn str
   "With no args, return the empty string. With one arg x, return x converted
@@ -130,6 +191,8 @@
   ([x & args]
    (.reduce args (.apricot_str x) | #(.concat %1 (.apricot_str %2)))))
 
+(def format Kernel/format)
+
 (defn print
   "Print the object(s) to standard output."
   [& args] (Kernel/print (apply str args)))
@@ -273,26 +336,6 @@
 
 ; Collection functions
 
-(defn seq
-  "Returns a seq on the collection. If the collection is empty, returns nil.
-  (seq nil) returns nil."
-  [coll] (.to_seq coll))
-
-(defn first
-  "Return the first item in the collection. Call seq on the argument. If coll
-  is nil, return nil."
-  [coll] (.first (seq coll)))
-
-(defn rest
-  "Return a possibly empty seq of the items after the first. Call seq on the
-  argument."
-  [coll] (.rest (seq coll)))
-
-(defn next
-  "Return a seq of the items after the first. Call seq on the argument. If
-  there are no more items, return nil."
-  [coll] (.next (seq coll)))
-
 (defn empty?
   "Return true if coll has no items - same as (not (seq coll)). Please use the
   idiom (seq x) rather than (not (empty? x))"
@@ -527,6 +570,8 @@
 (defn =
   "Return true if all of the arguments are equal, otherwise false. (=) returns
   true."
+  {:inline (fn [x y] `(. ~x == ~y))
+   :inline-arities #{2}}
   ([x] true)
   ([x y] (. x == y))
   ([x y & more]
@@ -545,7 +590,14 @@
 (defn compare
   "Return a negative number, zero, or a positive number when x is logically
   'less than', 'equal to', or 'greater than' y, respectively."
-  [x y] (. x <=> y))
+  [x y]
+  (if (nil? x)
+    (if (nil? y)
+      0
+      -1)
+    (if (nil? y)
+      1
+      (. x <=> y))))
 
 (defn >
   "Return true if nums are in monotonically decreasing order, otherwise false."
@@ -774,7 +826,7 @@
 
   If test is true, evaluate then with var bound to the value of test,
   otherwise yield else."
-  [bindings then [else nil]]
+  [bindings then ? (else nil)]
   `(let [temp# ~(bindings 1)]
      (if temp#
        (let [~(bindings 0) temp#]
@@ -839,6 +891,16 @@
 
 ; Miscellaneous (to be sorted)
 
+(defn read
+  "Read the next object from io, which must be an instance of IO. The default
+  io is stdin."
+  [? (io STDIN)]
+  (.read_one (Apricot::Reader. io)))
+
+(defn read-string
+  "Read one object from the string s."
+  [s] (read (StringIO. s)))
+
 (defn eval
   "Evaluate the form data structure (not text!) and return the result."
   [form] (Apricot::Compiler/eval_form form))
@@ -883,46 +945,33 @@
   [f]
   (let [m (meta f)]
     (println "-------------------------")
-    (println (m :name))
-    (println (m :arglists))
-    (if (m :macro)
+    (println (:name m))
+    (println (:arglists m))
+    (if (:macro m)
       (println "Macro"))
-    (println "  " (m :doc))))
-
-; REPL Utilities
-
-(defn decode
-  "Print the Rubinius bytecode for the given Proc or Method."
-  [f]
-  (case f
-    [Proc]   (Kernel/puts (.. f block compiled_code decode))
-    [Method] (Kernel/puts (.. f executable decode))
-    (raise (str "Don't know how to decode " (.inspect f)))))
-
-(defmacro time
-  "Evaluate the forms in body and return the time it took."
-  [& body]
+    (println "  " (:doc m))))
+
+; Namespaces
+
+(defn refer
+  "For each public interned var in the namespace named by the symbol, adds a
+  mapping from the name of the var to the var to the current namespace."
+  [ns]
+  (each [var (.keys (.vars ns))]
+    (.add_alias *ns* var ns))
+  nil)
+
+(defmacro ns
+  "Sets *ns* to the namespace named by name (unevaluated), creating it if
+  needed. Optionally takes a uses clause like (:use Foo Bar Baz) to important
+  vars from other namespaces."
+  [ns-sym ? (uses nil)]
   `(do
-     (require "benchmark")
-     (.realtime Benchmark | (fn [] ~@body))))
-
-(defmacro benchmark-ips
-  "clause => [label form ...]
-
-  Measure how many times per second each of the clause's bodies can be
-  executed. Output is organized using the given label strings.
-
-  This requires the benchmark-ips gem:
-    gem install benchmark-ips"
-  [& clauses]
-  (let [bm (gensym)
-        make-report (fn [clause]
-                      `(.report ~bm ~(first clause) | (fn [] ~@(rest clause))))
-        reports (map make-report clauses)]
-    `(do
-       (try
-         (require "benchmark/ips")
-         (.ips Benchmark | (fn [~bm] ~@reports))
-         (rescue [_ LoadError]
-           (raise "benchmark-ips requires the benchmark-ips gem")))
-       nil)))
+     (in-ns '~ns-sym)
+     ~(if (not= ns-sym 'Apricot::Core)
+        '(Apricot::Core/refer Apricot::Core))
+     ~@(if uses
+        (if (= :use (first uses))
+          (map (fn [ns] `(Apricot::Core/refer ~ns))
+               (rest uses))
+          (raise "Invalid clause in ns macro")))))

data/kernel/repl.apr

@@ -0,0 +1,37 @@
+; REPL Utilities
+
+(defn decode
+  "Print the Rubinius bytecode for the given Proc or Method."
+  [f]
+  (case f
+    [Proc]   (Kernel/puts (.. f block compiled_code decode))
+    [Method] (Kernel/puts (.. f executable decode))
+    (raise (str "Don't know how to decode " (.inspect f)))))
+
+(defmacro time
+  "Evaluate the forms in body and return the time it took."
+  [& body]
+  `(do
+     (require-ruby "benchmark")
+     (.realtime Benchmark | (fn [] ~@body))))
+
+(defmacro benchmark-ips
+  "clause => [label form ...]
+
+  Measure how many times per second each of the clause's bodies can be
+  executed. Output is organized using the given label strings.
+
+  This requires the benchmark-ips gem:
+    gem install benchmark-ips"
+  [& clauses]
+  (let [bm (gensym)
+        make-report (fn [clause]
+                      `(.report ~bm ~(first clause) | (fn [] ~@(rest clause))))
+        reports (map make-report clauses)]
+    `(do
+       (try
+         (require-ruby "benchmark/ips")
+         (.ips Benchmark | (fn [~bm] ~@reports))
+         (rescue [_ LoadError]
+           (raise "benchmark-ips requires the benchmark-ips gem")))
+       nil)))

data/lib/apricot.rb

@@ -1,30 +1,11 @@
+unless RUBY_VERSION.start_with?("2") && RUBY_ENGINE == "rbx" && Rubinius::VERSION.start_with?("2")
+  $stderr.puts "Apricot must be run on the stable Rubinius 2.0.0 release or newer."
+  exit 1
+end
+
 require 'set'
 
 %w[
-version misc parser compiler ast macroexpand generator stages printers
-special_forms errors seq cons list identifier ruby_ext namespace
+version misc namespace seq cons list identifier ruby_ext reader compiler
+scopes variables macroexpand generator special_forms errors code_loader boot
 ].each {|r| require "apricot/#{r}" }
-
-# Start "booting" apricot. Set up core namespace and load the core library.
-module Apricot
-  Core = Namespace.new
-
-  Core.set_var(:"*ns*", Core)
-
-  Core.set_var(:"in-ns", lambda do |constant|
-    Apricot.current_namespace = Namespace.find_or_create constant
-  end)
-
-  Core.set_var(:ns, lambda do |constant|
-    List[Identifier.intern(:"in-ns"),
-      List[Identifier.intern(:quote), constant]]
-  end)
-  Core.get_var(:ns).apricot_meta = {macro: true}
-
-  # TODO: add and use a proper code loader
-  Apricot::Compiler.compile(File.expand_path('../../kernel/core.apr', __FILE__))
-
-#  ::User = Namespace.new
-  Apricot.current_namespace = Core
-  # TODO: make Apricot::Core public vars visible in User, default to User
-end