(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))))) ;; TODO(Felix): else symbol (define-syntax (cond :rest clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (prog (if (not (= () (rest clauses))) (error "There are additional clauses after the else clause!") (pair 'prog (rest (first clauses))))) (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)))