From 9cb7c92ca7ece45b2e265faed3c7bfefe6b63e18 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 13 Mar 2018 16:40:56 -0400 Subject: [PATCH] Add some builtin functions and some examples. --- README.md | 4 +++ lib/fizzbuzz.dst | 13 ++++++++++ lib/hello.dst | 3 +++ lib/pp.dst | 57 ++++++++++++------------------------------ lib/primes.dst | 14 +++++++++++ src/compiler/boot.dst | 44 +++++++++++++++++++++++--------- src/compiler/compile.c | 2 +- 7 files changed, 83 insertions(+), 54 deletions(-) create mode 100644 lib/fizzbuzz.dst create mode 100644 lib/hello.dst create mode 100644 lib/primes.dst diff --git a/README.md b/README.md index acfb4bcb..b1af4578 100644 --- a/README.md +++ b/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. diff --git a/lib/fizzbuzz.dst b/lib/fizzbuzz.dst new file mode 100644 index 00000000..17686e7d --- /dev/null +++ b/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))))) diff --git a/lib/hello.dst b/lib/hello.dst new file mode 100644 index 00000000..b27f5127 --- /dev/null +++ b/lib/hello.dst @@ -0,0 +1,3 @@ +# Prints hello + +(print "hello, world!") diff --git a/lib/pp.dst b/lib/pp.dst index 7869ba8d..52b6be81 100644 --- a/lib/pp.dst +++ b/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 "") (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 "") (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))) diff --git a/lib/primes.dst b/lib/primes.dst new file mode 100644 index 00000000..24d6bcd6 --- /dev/null +++ b/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) diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index db8840c4..3b9321d1 100644 --- a/src/compiler/boot.dst +++ b/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)))) diff --git a/src/compiler/compile.c b/src/compiler/compile.c index 34babf35..63d18436 100644 --- a/src/compiler/compile.c +++ b/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) {