1
0
mirror of https://github.com/janet-lang/janet synced 2024-12-26 00:10:27 +00:00

Add some builtin functions and some examples.

This commit is contained in:
Calvin Rose 2018-03-13 16:40:56 -04:00
parent 2b1dd79f55
commit 9cb7c92ca7
7 changed files with 83 additions and 54 deletions

View File

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

13
lib/fizzbuzz.dst Normal file
View File

@ -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)))))

3
lib/hello.dst Normal file
View File

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

View File

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

14
lib/primes.dst Normal file
View File

@ -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)

View File

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

View File

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