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:
parent
2b1dd79f55
commit
9cb7c92ca7
@ -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
13
lib/fizzbuzz.dst
Normal 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
3
lib/hello.dst
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
# Prints hello
|
||||||
|
|
||||||
|
(print "hello, world!")
|
55
lib/pp.dst
55
lib/pp.dst
@ -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
14
lib/primes.dst
Normal 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)
|
@ -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))))
|
||||||
|
|
||||||
|
@ -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) {
|
||||||
|
Loading…
Reference in New Issue
Block a user