slime/bin/pre.slime

(define nil ())

(define defun
  (macro (@name @params :rest @body)
    (eval (pair 'define (pair @name (pair (pair 'lambda (pair @params @body)) nil))))))

(define defmacro
  (macro (@name @params :rest @body)
    (eval (pair 'define (pair @name (pair (pair 'macro (pair @params @body)) nil))))))

(defmacro pe (@expr)
  (printf @expr "evaluates to" (eval @expr)))

(defun nil? (x)
  "Checks if the argument is nil."
  (= x nil))

(defun number? (x)
  "Checks if the argument is a number."
  (= (type x) :number))

(defun symbol? (x)
  "Checks if the argument is a symbol."
  (= (type x) :symbol))

(defun keyword? (x)
  "Checks if the argument is a keyword."
  (= (type x) :keyword))

(defun pair? (x)
  "Checks if the argument is a pair."
  (= (type x) :pair))

(defun string? (x)
  "Checks if the argument is a string."
  (= (type x) :string))

(defun dynamic-function? (x)
  "Checks if the argument is a function."
  (= (type x) :dynamic-function))

(defun dynamic-macro? (x)
  "Checks if the argument is a macro."
  (= (type x) :dynamic-macro))

(defun built-in-function? (x)
  "Checks if the argument is a built-in function."
  (= (type x) :built-in-function))

(defun apply (fun seq)
  "Applies the funciton to the sequence, as in calls the funciton with
ithe sequence as arguemens."
  (eval (pair fun seq)))

(defmacro when (@test :rest @body)
  "Executes the code in :rest if test is true"
  (if (eval @test)
      (eval (pair prog @body))
    nil))

(defmacro unless (@test :rest @body)
  "Executes the code in :rest if test is false."
  (if (eval @test)
      nil
    (eval (pair prog @body))))

(defun end (seq)
  "Returns the last pair in the sqeuence."
  (if (or (nil? seq) (not (pair? (rest seq))))
      seq
    (end (rest seq))))

(defun last (seq)
  "Returns the (first) of the last (pair) of the given sequence."
  (first (end seq)))

(defun extend (seq elem)
  "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence."
  (when (pair? seq)
    (define e (end seq))
    (mutate e (pair (first e) elem)))
  seq)

(defun incr (val)
  (+ val 1))

(defun decr (val)
  (- val 1))

(defun append (seq elem)
  (extend seq (pair elem nil)))

(defun length (seq)
  (if (nil? seq)
      0
    (incr (length (rest seq)))))

(defmacro n-times (@times @action)
  (unless (<= (eval @times) 0)
    (eval @action)
    (eval (list n-times (list - @times 1) @action))))

(defmacro for (@symbol @from @to :rest @for-body)
  (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))))

(defun 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'."
  (if (< from to)
      (pair from (range :from (+ 1 from) :to to))
    nil))

(defun map (fun seq)
  "Takes a sequence and a function 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)))))

(defun reduce (fun seq)
  "Takes a sequence and a function 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."
  (eval (pair fun seq)))

(defun reduce-binary (fun seq)
  "Takes a sequence and a function 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)))))

(defun filter (fun seq)
  (if (nil? seq)
      nil
    (if (fun (first seq))
        (pair (first seq)
              (filter fun (rest seq)))
      (filter fun (rest seq)))))

(defmacro printf-quoted (:keys @sep :defaults-to " " @end :defaults-to "\n" :rest @args)
  (if (nil? @args)
      (prog (print (eval @end)) nil)
    (prog
     (print (first @args))
     (when (not (nil? (rest @args))) (print (eval @sep)))
     (eval
      (pair printf-quoted
            (extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))

(defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
  (define command-args (extend (list :@sep (eval sep) :@end (eval end)) args))
  (eval (pair printf-quoted command-args)))