mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-24 17:27:18 +00:00
Code Issues 1 Releases Wiki Activity

Move functions in util.dst to boot.dst.

Browse Source
This commit is contained in:
Calvin Rose 2018-03-23 18:36:56 -04:00
parent 68bf4d460b
commit 89ecd43115
4 changed files with 115 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -25,7 +25,7 @@
PREFIX?=/usr/local
BINDIR=$(PREFIX)/bin
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O3 -s
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -s -O3
CLIBS=-lm -ldl
PREFIX=/usr/local
DST_TARGET=dst

2
examples/assembly.dst
View File

@ -9,7 +9,7 @@
(jmpi 1 :done) # if ($1) goto :done
(lds 1) # $1 = self
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0)
(push 0) # push($0), push argument for next function call
(call 2 1) # $2 = call($1)
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0)

144
examples/utils.dst
View File

@ -1,144 +0,0 @@
(defn table? [x] (= (type x) :table ))
(defn struct? [x] (= (type x) :struct))
(defn array? [x] (= (type x) :array))
(defn tuple? [x] (= (type x) :tuple))
(defn- reverse-array
"Reverses the order of the elements in a given array"
[t]
(var n (dec (length t)) )
(var reversed [])
(while (>= n 0)
(array-push reversed (get t n))
(-- n))
reversed)
(defn- reverse-tuple
"Reverses the order of the elements of a given tuple"
[t]
(def max (length t))
(var n 0)
(var reversed (tuple))
(while (< n max )
(:= reversed (tuple-prepend reversed (get t n)))
(++ n))
reversed)
'(arrays are more efficient so reverse-tuple will not be used)
(defn reverse
"Reverses order of elements in a given array or tuple"
[t]
(def the-type (type t))
(cond (= the-type :tuple) (->> t iter2array reverse-array (apply tuple) )
(= the-type :array) (reverse-array t)))
(defmacro if-not
"Sorthand for (if (not ... "
[condition exp-1 exp-2]
(tuple 'if (tuple 'not condition)
exp-1
exp-2))
(defmacro when-not
"Sorthand for (when (not ... "
[condition exp-1]
(tuple 'when (tuple 'not condition) exp-1))
(defmacro if-let
"Takes the first one or two forms in a vector and if true binds
all the forms with let and evaluates the first expression else
evaluates the second"
[bindings then else]
(def head (ast-unwrap1 bindings))
(tuple 'let head
(tuple 'if (and (get head 1) (if (get head 2) (get head 3) true))
then
else)))
(defmacro when-let
"Takes the first one or two forms in vector and if true binds
all the forms with let and evaluates body"
[bindings & body]
(def head (ast-unwrap1 bindings))
(tuple 'let head
(tuple
'when
(and (get head 1) (if (get head 2) (get head 3) true))
(apply tuple (array-concat ['do] (ast-unwrap1 body))) )))
(defn- comp0
"Compose two functions. Second function must accept only one argument)"
[f g] (fn [x] (f (g x))))
(defn comp
"Takes multiple functions and returns a function that is the composition
of those functions."
[& functions]
(def len (length functions))
(if (zero? len)
nil
(if (one? len)
(do
(def the-composition (get functions 0))
(fn [& x]
(apply the-composition x)))
(do
(def f (get functions 0))
(def g (get functions 1))
(apply comp (comp0 f g) (array-slice functions 2 -1))) )))
(defn zipcoll
"Creates an table or tuple from two arrays/tuples. Result is table if no
third argument is given"
[coll-1 coll-2 the-type]
(var zipping-table @{})
(def {:more more1 :next next1} (iter coll-1))
(def {:more more2 :next next2} (iter coll-2))
(while (more1)
(put zipping-table (next1) (next2)))
(if (= :struct the-type)
(table-to-struct zipping-table )
zipping-table))
(defn update
"Accepts a key argument and passes its associated value to a function.
The key, then is associated to that value"
[coll a-key a-function & args]
(def old-value (get coll a-key) )
(put coll a-key (apply a-function old-value args)))
(defn- create-merger [container]
(fn [x]
(var key (next x nil))
(while (not= nil key)
(put container (macroexpand1 key) (macroexpand1 (get x key)))
(:= key (next x key)))))
(defn merge
"Merges mutliple tables/structs to one. If a key appears in more than one
collection, then later values replace any previous ones.
The type of the first collection determines the type of the resulting
collection"
[& colls]
(var container @{})
(def merger (create-merger container))
(foreach colls merger)
(if (table? (get colls 0)) container (table-to-struct container)))
(defn juxt
"Takes a set of functions and returns the juxtaposition of those functions"
[& functions]
(fn [& x]
(iter2array (map (fn [f] (apply f x)) functions))))

114
src/compiler/boot.dst
View File

@ -42,11 +42,18 @@
# Basic predicates
(defn even? [x] (== 0 (% x 2)))
(defn odd? [x] (== 1 (% x 2)))
(defn nil? [x] (= x nil))
(defn zero? [x] (== x 0))
(defn pos? [x] (> x 0))
(defn neg? [x] (< x 0))
(defn one? [x] (== x 1))
(defn table? [x] (= (type x) :table ))
(defn struct? [x] (= (type x) :struct))
(defn array? [x] (= (type x) :array))
(defn tuple? [x] (= (type x) :tuple))
(defn boolean? [x] (= (type x) :boolean))
(defn true? [x] (= (type x) true))
(defn false? [x] (= (type x) false))
(defn nil? [x] (= x nil))
(def atomic? (do
(def non-atomic-types {
:array true
@ -325,6 +332,111 @@ If no match is found, returns nil"
(apply1 tuple parts))
(reduce fop x forms))
(defn reverse-array
"Reverses the order of the elements in a given array or tuple and returns a new array."
[t]
(var n (dec (length t)))
(var reversed [])
(while (>= n 0)
(array-push reversed (get t n))
(-- n))
reversed)
(defn reverse-tuple
"Reverses the order of the elements given an array or tuple and returns a tuple"
[t]
(apply1 tuple (reverse-array t)))
(defn reverse
"Reverses order of elements in a given array or tuple"
[t]
(select (type t)
:tuple (reverse-tuple t)
:array (reverse-array t)))
(defmacro if-not
"Sorthand for (if (not ... "
[condition exp-1 exp-2]
(tuple 'if (tuple not condition)
exp-1
exp-2))
(defmacro when-not
"Sorthand for (when (not ... "
[condition exp-1]
(tuple 'when (tuple not condition) exp-1))
(defmacro if-let
"Takes the first one or two forms in a vector and if true binds
all the forms with let and evaluates the first expression else
evaluates the second"
[bindings then else]
(def head (ast-unwrap1 bindings))
(tuple 'let head
(tuple 'if (and (get head 1) (if (get head 2) (get head 3) true))
then
else)))
(defmacro when-let
"Takes the first one or two forms in vector and if true binds
all the forms with let and evaluates body"
[bindings & body]
(def head (ast-unwrap1 bindings))
(tuple 'let head
(tuple
'when
(and (get head 1) (if (get head 2) (get head 3) true))
(apply1 tuple (array-concat ['do] (ast-unwrap1 body))))))
(defn comp
"Takes multiple functions and returns a function that is the composition
of those functions."
[& functions]
(select (length functions)
0 nil
1 (get functions 0)
2 (let [[f g] functions] (fn [x] (f (g x))))
3 (let [[f g h] functions] (fn [x] (f (g (h x)))))
4 (let [[f g h i] functions] (fn [x] (f (g (h (i x))))))
(let [[f g h i j] functions]
(apply comp (fn [x] (f (g (h (i (j x))))))
(array-slice functions 5 -1)))))
(defn zipcoll
"Creates an table or tuple from two arrays/tuples. Result is table if no
third argument is given"
[coll-1 coll-2 the-type]
(var zipping-table @{})
(def {:more more1 :next next1} (iter coll-1))
(def {:more more2 :next next2} (iter coll-2))
(while (and (more1) (more2))
(put zipping-table (next1) (next2)))
(if (= :struct the-type)
(table-to-struct zipping-table)
zipping-table))
(defn update
"Accepts a key argument and passes its associated value to a function.
The key, then is associated to that value"
[coll a-key a-function & args]
(def old-value (get coll a-key) )
(put coll a-key (apply a-function old-value args)))
(defn merge
"Merges mutliple tables/structs to one. If a key appears in more than one
collection, then later values replace any previous ones.
The type of the first collection determines the type of the resulting
collection"
[& colls]
(def container @{})
(for [i 0 (length colls)]
(def c (get colls i))
(var key (next c nil))
(while (not= nil key)
(put container key (get c key))
(:= key (next c key))))
(if (table? (get colls 0)) container (table-to-struct container)))
# Start pretty printer
(def pp (do
(defn- pp-seq [pp seen buf a start end checkcycle]