lota things

This commit is contained in:
Felix Brendel
2019-06-27 11:11:18 +02:00
parent 6f5ecc87b0
commit efded2f9b8
13 changed files with 3211 additions and 199 deletions
+20 -37
View File
@@ -1,4 +1,4 @@
(define (nil? x) "Checks if the argument is =nil=." (= x nil))
(define (null? x) "Checks if the argument is =nil=." (= x nil))
(define (number? x) "Checks if the argument is a number." (= (type x) :number))
@@ -20,60 +20,43 @@
(define (callable? x) (or (lambda? x) (special-lambda? x) (macro? x) (built-in-function? x)))
(define (end seq) "Returns the last pair in the sqeuence." (if (or (nil? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
(define (end seq) "Returns the last pair in the sqeuence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(printf (end a))\n{{{example_end}}}\n" (if (or (null? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
(define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq)))
(define (last seq) "Returns the (first) of the last (pair) of the given sequence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(printf (last a))\n{{{example_end}}}\n" (first (end seq)))
(define (extend seq elem) "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))
(define (extend seq elem) "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))
(define (extend2 seq elem) "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence." (printf "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) (let ((e (end seq))) (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) elem)
(define (extend2 seq elem) "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (printf "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) (let ((e (end seq))) (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) elem)
(define (append seq elem) "Appends an element to a sequence, by extendeing the list
with (pair elem nil)." (extend seq (pair elem ())))
(define (append seq elem) "Appends an element to a sequence, by extendeing the list\nwith (pair elem nil)." (extend seq (pair elem ())))
(define (length seq) "Returns the length of the given sequence." (if (nil? seq) 0 (+ 1 (length (rest seq)))))
(define (length seq) "Returns the length of the given sequence." (if (null? seq) 0 (+ 1 (length (rest seq)))))
(define (sublist-starting-at-index seq index) (cond ((< index 0) (error "sublist-starting-at-index: index must be positive")) ((null? seq) ()) ((= 0 index) seq) (else (sublist-starting-at (rest seq) (- index 1)))))
(define (list-without-index seq index) (cond ((or (< index 0) (null? seq)) (error "list-remove-index!: index out of range")) ((= 0 index) (rest seq)) (else (pair (first seq) (list-without-index (rest seq) (- index 1))))))
(define (increment val) "Adds one to the argument." (+ val 1))
(define (decrement val) "Subtracts one from the argument." (- val 1))
(define (range :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined by the
key =from= and ends with the number defined in =to=." (when (< from to) (pair from (range :from (+ 1 from) :to to))))
(define (range :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined by the\nkey =from= and ends with the number defined in =to=." (when (< from to) (pair from (range :from (+ 1 from) :to to))))
(define (range-while :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined
by the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (mutate from (increment from)) (while (< from to) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)
(define (range-while :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined\nby the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (mutate from (increment from)) (while (< from to) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)
(define (map fun seq) "Takes a function and a sequence as arguments and returns a new
sequence which contains the results of using the first sequences
elemens as argument to that function." (if (nil? seq) seq (pair (fun (first seq)) (map fun (rest seq)))))
(define (map fun seq) "Takes a function and a sequence as arguments and returns a new\nsequence which contains the results of using the first sequences\nelemens as argument to that function." (if (null? seq) seq (pair (fun (first seq)) (map fun (rest seq)))))
(define (reduce fun seq) "Takes a function and a sequence as arguments and applies the
function to the argument sequence. This only works correctly if the
given function accepts a variable amount of parameters. If your
funciton is limited to two arguments, use [[=reduce-binary=]]
instead." (apply fun seq))
(define (reduce fun seq) "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. This only works correctly if the\ngiven function accepts a variable amount of parameters. If your\nfunciton is limited to two arguments, use [[=reduce-binary=]]\ninstead." (apply fun seq))
(define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the
function to the argument sequence. reduce-binary applies the
arguments `pair-wise' which means it works with binary functions
as compared to `reduce'." (if (nil? (rest seq)) (first seq) (fun (first seq) (reduce-binary fun (rest seq)))))
(define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. reduce-binary applies the arguments\n*pair-wise* which means it works with binary functions as compared to\n[[=reduce=]]." (if (null? (rest seq)) (first seq) (fun (first seq) (reduce-binary fun (rest seq)))))
(define (filter fun seq) "Takes a function and a sequence as arguments and applies the
function to every value in the sequence. If the result of that
funciton application returns a truthy value, the original value is
added to a list, which in the end is returned." (when seq (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))))
(define (filter fun seq) "Takes a function and a sequence as arguments and applies the\nfunction to every value in the sequence. If the result of that\nfunciton application returns a truthy value, the original value is\nadded to a list, which in the end is returned." (when seq (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))))
(define (zip l1 l2) (unless (and (nil? l1) (nil? l2)) (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
(define (zip l1 l2) (unless (and (null? l1) (null? l2)) (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
(define (unzip lists) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ()))
(define (unzip lists) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2))) (iter lists () ())))
(define (enumerate seq) (define (enumerate-inner seq next-num) (when seq (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num))))) (enumerate-inner seq 0))
(define (printf :keys sep :defaults-to " " end :defaults-to "
" :rest args) "A wrapper for the built-in (print) that accepts a variable number
of arguments and also provides keywords for specifying the printed
separators between the arguments and what should be printed after the
las argument." (define printf-quoted (special-lambda (:keys sep end :rest args) (if (nil? args) (begin (print (eval end)) nil) (begin (print (first args)) (unless (nil? (rest args)) (print (eval sep))) (eval (pair printf-quoted (extend (list :sep (eval sep) :end (eval end)) (rest args)))))))) (eval (pair printf-quoted (extend (list :sep (eval sep) :end (eval end)) args))))
(define (printf :keys sep :defaults-to " " end :defaults-to "\n" :rest args) "A wrapper for the built-in function [[=print=]] that accepts a\nvariable number of arguments and also provides keywords for specifying\nthe printed separators (=sep=) between the arguments and what should\nbe printed after the last argument (=end=)." (define (printf-inner args) (if args (begin (print (first args)) (when (rest args) (print sep)) (printf-inner (rest args))) (print end))) (printf-inner args) ())