Add some builtin functions and some examples.

README.md

@@ -56,3 +56,7 @@ The repl can also be run with the CMake run target.
 ```sh
 make run
 ```
+
+### Example
+
+See the lin directory for some example dst code.

lib/fizzbuzz.dst

@@ -0,0 +1,13 @@
+# A simple fizz buzz example
+
+(defn fizzbuzz
+ "Prints the fizzbuzz problem."
+ []
+ (for [i 1 101]
+  (let [fizz (zero? (% i 3))
+        buzz (zero? (% i 5))]
+    (print (cond
+        (and fizz buzz) "fizzbuzz"
+        fizz "fizz"
+        buzz "buzz"
+        i)))))

lib/hello.dst

@@ -0,0 +1,3 @@
+# Prints hello
+
+(print "hello, world!")

lib/pp.dst

@@ -1,31 +1,7 @@
-(def a (fn [] 2))
-#
-# Copyright (c) 2017 Calvin Rose
-#
-# 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.
-#
+# Implements a simple pretty printer. Offers similar functionality
+# as the describe function.
 
-# Define a simple pretty printer
-
-(def pp (do
-
-(defn pp-seq [pp seen buf a start end]
+(defn- pp-seq [pp seen buf a start end]
  (if (get seen a)
   (buffer-push-string buf "<cycle>")
   (do
@@ -35,11 +11,10 @@
    (for [i 0 len]
     (when (not= i 0) (buffer-push-string buf " "))
     (pp seen buf (get a i)))
-   (buffer-push-string buf end)
-  ))
+   (buffer-push-string buf end)))
  buf)
-  
-(defn pp-dict [pp seen buf a start end]
+
+(defn- pp-dict [pp seen buf a start end]
  (if (get seen a)
   (buffer-push-string buf "<cycle>")
   (do
@@ -52,26 +27,26 @@
     (buffer-push-string buf " ")
     (pp seen buf v)
     (varset! k (next a k))
-    (when k (buffer-push-string buf " "))
-   )
-   (buffer-push-string buf end)
-  ))
+    (when k (buffer-push-string buf " ")))
+   (buffer-push-string buf end)))
  buf)
 
-(def _printers {
+(def printers :private {
  :array  (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]"))
  :tuple  (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
  :table  (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}"))
  :struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
 })
 
-(defn _default_printer [pp seen buf x] 
+(defn- default_printer [pp seen buf x] 
  (buffer-push-string buf (string x)) 
  buf)
 
-(defn pp1 [seen buf x]
-  (def pmaybe (get _printers (type x)))
-  (def p (if pmaybe pmaybe _default_printer))
+(defn- pp1 [seen buf x]
+  (def pmaybe (get printers (type x)))
+  (def p (if pmaybe pmaybe default_printer))
   (p pp1 seen buf x))
 
-(fn [x] (print (pp1 @{} @"" x)))))
+(defn pp 
+ "Pretty print a value x."
+ [x] (print (pp1 @{} @"" x)))

lib/primes.dst

@@ -0,0 +1,14 @@
+# Return an array of primes. This is a trivial and extremely naive algorithm.
+
+(defn primes
+ "Returns a list of prime numbers less than n."
+ [n]
+ (def list [])
+ (for [i 2 n]
+  (var isprime? true)
+  (def len (length list))
+  (for [j 0 len]
+   (def trial (get list j))
+   (if (zero? (% i trial)) (varset! isprime? false)))
+  (if isprime? (array-push list i)))
+ list)

src/compiler/boot.dst

@@ -4,7 +4,7 @@
  "A var that points to the current environment."
  _env)
 
-(def defn macro
+(def defn :macro
  "Define a function"
   (fn [name & more] 
    (def fstart (fn recur [i]
@@ -18,19 +18,19 @@
    (def formargs (array-concat ['def name] (array-slice more 0 start) [fnbody]))
    (apply tuple formargs)))
 
-(def defmacro macro
+(def defmacro :macro
  "Define a macro."
  (do
   (def defn* (get (get _env 'defn) 'value))
   (fn [name & more] 
-   (def args (array-concat [] name 'macro more))
+   (def args (array-concat [] name :macro more))
    (apply defn* args))))
 
 (defmacro defn-
  "Define a private function that will not be exported."
  [name & more]
  (apply tuple (array-concat
-  ['defn name 'private] more)))
+  ['defn name :private] more)))
 
 (defmacro comment
  "Ignores the body of the comment."
@@ -143,8 +143,28 @@ If no match is found, returns nil"
    (reduce f (f start (next)) s)
    start))
 
+(defn filter [pred s]
+ (def s (seq s))
+ (def {:more more :next next} s)
+ (var alive true)
+ (var temp nil)
+ (var isnew true)
+ (defn nextgood []
+   (if alive
+    (if (more)
+     (do
+      (def n (next))
+      (if (pred n) n (nextgood)))
+     (varset! alive false))))
+ (defn nnext [] (def ret temp) (varset! temp (nextgood)) ret)
+ (defn nmore [] (when isnew (varset! isnew false) (nnext)) alive)
+ {:more nmore :next nnext})
+
 (defn even? [x] (== 0 (% x 2)))
 (defn odd? [x] (== 1 (% x 2)))
+(defn nil? [x] (= x nil))
+(defn zero? [x] (== x 0))
+(defn one? [x] (== x 1))
 (defn inc [x] (+ x 1))
 (defn dec [x] (- x 1))
 
@@ -206,12 +226,6 @@ If no match is found, returns nil"
      (tuple-prepend body 'do)
      (tuple 'varset! sym (tuple '+ sym inc)))))
 
-(defn make-env [parent]
- (def parent (if parent parent _env))
- (def newenv (setproto @{} parent))
- newenv)
-(put _env '_env nil)
-
 (defmacro ->
  [x & forms]
  (defn fop [last nextform]
@@ -230,10 +244,16 @@ If no match is found, returns nil"
   (def [h t] (if (= :tuple (type n))
         [(get n 0) (array-slice n 1)]
         [n []]))
-  (def parts (array-concat [h] t last))
+  (def parts (array-concat [h] t [last]))
   (apply tuple parts))
  (reduce fop x forms))
 
+(defn make-env [parent]
+ (def parent (if parent parent _env))
+ (def newenv (setproto @{} parent))
+ newenv)
+(put _env '_env nil)
+
 (def run-context 
 "Run a context. This evaluates expressions of dst in an environment,
 and is encapsulates the parsing, compilation, and evaluation of dst.
@@ -324,7 +344,7 @@ onvalue."
   :prefix prefix
   } (apply table args))
  (defn one [[k v]]
-  (when (not (get v 'private))
+  (when (not (get v :private))
    (put *env* (symbol (if prefix prefix "") k) v)))
  (doseq (map one (pairs env))))
 

src/compiler/compile.c

@@ -817,7 +817,7 @@ recur:
                             Dst entry = dst_table_get(env, headval);
                             for (;;) {
                                 if (dst_checktype(entry, DST_NIL)) break;
-                                if (dst_checktype(dst_get(entry, dst_csymbolv("macro")), DST_NIL)) break;
+                                if (dst_checktype(dst_get(entry, dst_csymbolv(":macro")), DST_NIL)) break;
                                 fn = dst_get(entry, dst_csymbolv("value"));
                                 if (!dst_checktype(fn, DST_FUNCTION)) break;
                                 if (macrorecur++ > DST_RECURSION_GUARD) {