From 89ecd431154db7206a40e28873b3bc1ba5a1e73b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 23 Mar 2018 18:36:56 -0400 Subject: [PATCH] Move functions in util.dst to boot.dst. --- Makefile | 2 +- examples/assembly.dst | 2 +- examples/utils.dst | 144 ------------------------------------------ src/compiler/boot.dst | 114 ++++++++++++++++++++++++++++++++- 4 files changed, 115 insertions(+), 147 deletions(-) delete mode 100644 examples/utils.dst diff --git a/Makefile b/Makefile index 8da79642..31934b97 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/examples/assembly.dst b/examples/assembly.dst index c77c7377..107c3680 100644 --- a/examples/assembly.dst +++ b/examples/assembly.dst @@ -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) diff --git a/examples/utils.dst b/examples/utils.dst deleted file mode 100644 index 42f29369..00000000 --- a/examples/utils.dst +++ /dev/null @@ -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)))) diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index 72e1c45f..9dae4faa 100644 --- a/src/compiler/boot.dst +++ b/src/compiler/boot.dst @@ -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]