242 lines
7.6 KiB
Plaintext
242 lines
7.6 KiB
Plaintext
(define-syntax when (condition :rest body)
|
|
"Doc String for 'when'"
|
|
`(if ,condition ,(pair prog body) nil))
|
|
|
|
(define-syntax unless (condition :rest body)
|
|
`(if ,condition nil ,(pair prog body)))
|
|
|
|
;; (define-syntax defun (name arguments :rest body)
|
|
;; ;; (type-assert arguments :pair)
|
|
;; ;; `(define ,name (lambda ,arguments ,body))
|
|
;; ;; TODO(Felix: I think we do not need to wrap the body of the lamba
|
|
;; ;; in a prog
|
|
|
|
;; ;; see if we have a docstring
|
|
;; (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
|
|
;; (list 'define name (list 'lambda arguments (first body) (pair 'prog (rest body))))
|
|
;; (list 'define name (list 'lambda arguments (pair 'prog body)))))
|
|
|
|
|
|
;; (define-syntax defspecial (name arguments :rest body)
|
|
;; ;; (type-assert arguments :pair)
|
|
;; ;; `(define ,name (lambda ,arguments ,body))
|
|
|
|
;; ;; see if we have a docstring
|
|
;; (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
|
|
;; (list 'define name (list 'special-lambda arguments (first body) (pair 'prog (rest body))))
|
|
;; (list 'define name (list 'special-lambda arguments (pair 'prog body)))))
|
|
|
|
;; (define (fib n))
|
|
;; (define-syntax define (name :rest value)
|
|
;; (print name)
|
|
;; (print (type name))
|
|
;; (if (= (type name) :pair)
|
|
;; (prog
|
|
;; ;; (print `(define ,(first name) ,`(pair lambda (pair (rest name) value))))
|
|
;; ;; (print rest)
|
|
;; (print "\naa\n")
|
|
;; (list 'define (first name) (pair 'lambda (pair (rest name) value))))
|
|
;; (prog
|
|
;; ;; (print (pair 'define (pair name value)))
|
|
;; (print "\nbb\n")
|
|
;; (pair 'define (pair name value)))))
|
|
|
|
;; (define-syntax cond (:rest clauses)
|
|
;; (define (rec clauses)
|
|
;; (if (= nil clauses)
|
|
;; nil
|
|
;; (list 'if (first (first clauses))
|
|
;; (pair 'prog (rest (first clauses)))
|
|
;; (rec (rest clauses)))))
|
|
;; (rec clauses))
|
|
|
|
(define (nil? x)
|
|
"Checks if the argument is nil."
|
|
(= x nil))
|
|
|
|
(define (number? x)
|
|
"Checks if the argument is a number."
|
|
(= (type x) :number))
|
|
|
|
(define (symbol? x)
|
|
"Checks if the argument is a symbol."
|
|
(= (type x) :symbol))
|
|
|
|
(define (keyword? x)
|
|
"Checks if the argument is a keyword."
|
|
(= (type x) :keyword))
|
|
|
|
(define (pair? x)
|
|
"Checks if the argument is a pair."
|
|
(= (type x) :pair))
|
|
|
|
(define (string? x)
|
|
"Checks if the argument is a string."
|
|
(= (type x) :string))
|
|
|
|
(define (lambda? x)
|
|
"Checks if the argument is a function."
|
|
(= (type x) :dynamic-function))
|
|
|
|
(define (special-lambda? x)
|
|
"Checks if the argument is a macro."
|
|
(= (type x) :dynamic-macro))
|
|
|
|
(define (built-n-function? x)
|
|
"Checks if the argument is a built-in function."
|
|
(= (type x) :built-in-function))
|
|
|
|
(define (apply fun seq)
|
|
"Applies the funciton to the sequence, as in calls the function with
|
|
ithe sequence as arguemens."
|
|
(eval (pair fun seq)))
|
|
|
|
(define (end seq)
|
|
"Returns the last pair in the sqeuence."
|
|
(if (or (nil? 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 (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)
|
|
(prog
|
|
(define e (end seq))
|
|
(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 nil)))
|
|
|
|
(define-syntax extend! (seq elem)
|
|
"test"
|
|
`(mutate ,seq (extend ,seq ,elem)))
|
|
|
|
(define-syntax append! (seq elem)
|
|
`(mutate ,seq (append ,seq ,elem)))
|
|
|
|
(define (length seq)
|
|
"Returns the length of the given sequence."
|
|
(if (nil? seq)
|
|
0
|
|
(+ 1 (length (rest seq)))))
|
|
|
|
(define (increment val)
|
|
"Adds one to the argument."
|
|
(+ val 1))
|
|
|
|
(define (decrement val)
|
|
"Subtracts one from the argument."
|
|
(- val 1))
|
|
|
|
;; (defmacro n-times (@times @action)
|
|
;; "Executes @action @times times."
|
|
;; (unless (<= (eval @times) 0)
|
|
;; (eval @action)
|
|
;; (apply n-times (list (list - @times 1) @action))))
|
|
|
|
;; (defmacro for (@symbol @from @to :rest @for-body)
|
|
;; "Designed to resemble a C style for loop. It takes a symbol as
|
|
;; well as its starting number and end number and executes the
|
|
;; @for-body with the defined symbol for all numbers between @from
|
|
;; to @to, where @to is exclusive."
|
|
;; (if (< (eval @from) (eval @to))
|
|
;; (macro-define @op incr)
|
|
;; (if (> (eval @from) (eval @to))
|
|
;; (macro-define @op decr)
|
|
;; (macro-define @op nil)))
|
|
;; (when @op
|
|
;; (macro-define (eval @symbol) (eval @from))
|
|
;; (eval (pair prog @for-body))
|
|
;; (eval (extend (list for @symbol (@op @from) @to) @for-body))))
|
|
|
|
(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-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)
|
|
(prog
|
|
(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 (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-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 (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 (zip l1 l2)
|
|
(if (and (nil? l1) (nil? l2))
|
|
nil
|
|
(pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
|
|
|
|
(define (printf :keys sep :defaults-to " " end :defaults-to "\n" :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)
|
|
(prog (print (eval @end)) nil)
|
|
(prog
|
|
(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-syntax pe (expr)
|
|
`(printf ',expr "evaluates to" ,(eval expr)))
|