l1.l1

;; pi x 10**100:
(def pi100 (fuse '(31415926535897932384626433832795028
                   84197169399375105820974944592307816
                   406286208998628034825342117067)))

(defn identity (x)
  (doc (return the argument))
  x)

(defn concat2 (a b)
  (doc (concatenate two lists)
       (used in syntax quote expansion -- use only builtin functions)
       (as it is used during syntax quote expansion, it needs to be
           defined early and to use native functinos only)
       (examples
        (concat2 () ())
        (concat2 '(1 2) '(3 4))))
  (cond ((not a) b)
        (t (cons (car a)
                 (concat2 (cdr a) b)))))

(defn c*r (path l)
  (doc ())  ;; undocumented, for internal use for caar, cadar, cddar, etc.
  (cond ((not path) l)
        ((= 'a (car path)) (c*r (cdr path) (car l)))
        ((= 'd (car path)) (c*r (cdr path) (cdr l)))
        (t (error (concat2 '(unknown c*r path element)
                           (list COLON (car path)))))))

(defmacro if (condition then else)
  (doc (simple conditional with two branches)
       (examples
        (if t
          111
          333)
        (if ()
          'abc
          'def)))
  `(cond (~condition ~then)
         (t ~else)))

(defmacro if-not (condition then else)
  (doc (simple (inverted) conditional with two branches)
       (examples
        (if-not (odd? 3)
          '(help, they broke three)
          '(three is odd))))
  `(cond ((not ~condition) ~then)
         (t ~else)))

(defmacro comment (() . body)
  (doc (ignore the expressions in the block)
       (examples
        (comment twas brillig, and the slithy toves
                 did gyre and gimble in the wabe))))

(defmacro progn (() . body)
  (doc (execute multiple statements, returning the last)
       (examples
        (progn)
        (progn
          1
          2
          3)))
  `(let () ~@body))

(defmacro when (condition . body)
  (doc (simple conditional with single branch)
       (examples
        (when ()
          (/ 1 0))
        (when t
          '(the sun rises in the east))))
  `(cond (~condition (progn ~@body))))

(defmacro when-not (condition . body)
  (doc (complement of the when macro)
       (examples
        (when-not ()
          '(do all the things))
        (when-not t
          (error '(oh no mister bill)))))
  `(when (not ~condition)
     ~@body))

(defmacro foreach (x xs . body)
  (doc (execute body for each value in a list))
  `(map (lambda (~x)
          ~@body)
        ~xs))

(defn reduce (f x . args)
  (doc (successively apply a function against a list of arguments)
       (examples
        (reduce * (cdr (range 10)))
        (reduce (lambda (acc x)
                  (cons x acc))
                ()
                (range 10))))
  (let ((inner (lambda inner (f acc l)
                 (if (not l)
                   acc
                   (inner f
                          (f acc (car l))
                          (cdr l))))))
    (cond ((not args)        ;; no accumulator given
           (if (not x)
             (f)
             (inner f (car x) (cdr x))))
          ((= (len args) 1)  ;; x is the accumulator
           (inner f x (car args)))
          (t
           (error '(reduce needs at least two arguments))))))

(defn concat (() . lists)
  (doc (concatenenate any number of lists)
       (examples
        (concat (range 3) '(wow) (reverse (range 3)))
        ;;=> (0 1 2 wow 2 1 0)
        ))
  (let ((concat2 (lambda concat2 (a b)
                   (if (not a)
                     b
                     (cons (car a)
                           (concat2 (cdr a) b))))))
    (when lists
      (reduce concat2 lists))))

(defn reverse (l)
  (doc (reverse a list)
       (examples
        (= '(c b a) (reverse '(a b c)))))
  (when l
    (concat (reverse (cdr l))
            (cons (car l) ()))))

(defn zero? (n)
  (doc (return true iff the supplied argument is zero)
       (examples
        (zero? 'zero)
        (zero? (- 1 1))))
  (= n 0))

(defn neg? (n)
  (doc (return true iff the supplied integer argument is less than zero)
       (examples
        (map neg?
             (map (lambda (x) (- x 5))
                  (range 10)))))
  (< n 0))

(defn juxt (() . fs)
  (doc (create a function which combines multiple
               operations into a single list of results)
       (examples
        ((juxt inc dec) 0)
        (map (juxt inc dec) (range 3))
        (map (juxt even? odd? zero?)
             '(-2 -1 0 1 2))
        (map (juxt) (range 3))))
  (lambda (x)
    (map (lambda (f)
           (f x))
         fs)))

(defn pos? (n)
  (doc (return true iff the supplied integer argument is greater than zero)
       (examples
        (map pos?
             (map (lambda (x) (- x 5))
                  (range 10)))))
  (< 0 n))

(defn inc (n)
  (doc (return the supplied integer argument, plus one))
  (+ n 1))

(defn dec (n)
  (doc (return the supplied integer argument, minus one)
       (examples
        (dec 2)
        (dec -1)))
  (- n 1))

(defn range (n)
  (when (pos? n)
    (let ((inner (lambda inner (n)
                   (if (= 1 n)
                     (cons (dec n) ())
                     (cons (dec n) (inner (dec n)))))))
      (reverse (inner n)))))

(defmacro while (condition . body)
  (doc (loop for as long as condition is true)
       (examples
        (while ()
          (launch-missiles))))
  (let ((inner-sym (gensym 'inner)))
    `(let ((~inner-sym (lambda ~inner-sym ()
                         (when ~condition
                           ~@body
                           (~inner-sym)))))
       (~inner-sym))))

(defn range (n)
  (doc (list of integers from 0 to n)
       (examples
        (range 10)
        (len (range 100))))
  (when (pos? n)
    (let ((c n)
          (acc ()))
      (while (pos? c)
        (set! c (dec c))
        (set! acc (cons c acc)))
      acc)))

(defn nth (n l)
  (doc (find the nth value of a list, starting from zero)
       (examples
        (nth 3 '(one two three four five))
        (nth 1000 (range 2))))
  (cond
   ((not l) ())
   ((zero? n) (car l))
   (t (nth (dec n) (cdr l)))))

(defn last (l)
  (doc (return the last item in a list)
       (examples
        (last (range 10))
        (last (split 'ATOM!))))
  (let ((c (cdr l)))
    (if-not c
      (car l)
      (last c))))

(defn take (n l)
  (doc (take up to n items from the supplied list)
       (examples
        (take 3 (range 10))))
  (cond ((zero? n) ())
        ((not l) ())
        (t (cons (car l) (take (dec n) (cdr l))))))

(defn drop (n l)
  (doc (drop n items from a list, then return the rest)
       (examples
        (drop 3 (range 10))))
  (cond ((zero? n) l)
        ((not l) ())
        (t (drop (dec n)
                 (cdr l)))))

(defn complement (f)
  (doc (return the logical complement of the supplied function)
       (examples
        ((complement even?) 1)              ;;=> t
        (map (complement odd?) (range 5)))) ;;=> (t () t () t)
  ;; FIXME: n-ary? Need to fix `apply` to work w/ rest arguments.
  (lambda (x)
    (not (f x))))

(defn even? (n)
  (doc (return true if the supplied integer argument is even)
       (examples
        (map even? (range 5))))
  (zero? (rem n 2)))

(defn odd? (n)
  (doc (return true if the supplied integer argument is odd)
       (examples
        (map even? (range 5))))
  (not (even? n)))

(defn flatten (l)
  (doc (return a (possibly nested) list, flattened)
       (examples
        (flatten '(this is a
                        (really
                         (nested) list)))))
  (cond ((not l) ())
        ((list? l)
         (concat (flatten (car l))
                 (flatten (cdr l))))
        (t (list l))))

(defn constantly (x)
  (doc (given a value, return a function which always returns that value)
       (examples
        (map (constantly t)
             (range 10))
        ;;=> (t t t t t t t t t t)
        ))
  (lambda (() . _)
    x))

(defn repeat (n x)
  (doc (return a list of length n whose elements are all x)
       (examples
        (repeat 5 'repetitive)))
  (when (pos? n)
    (cons x (repeat (dec n) x))))

(defn repeatedly (n f)
  (doc (return a list of length n whose elements are made from calling f repeatedly)
       (examples
        (repeatedly 3 (lambda () (range 5)))))
  (when-not (zero? n)
    (cons (f) (repeatedly (dec n) f))))

(defn true? (x)
  (doc (return t if the argument is t)
       (examples
        (true? 3)
        (true? t)))
  (= x t))

(defn map (f l)
  (doc (apply the supplied function to every element in the supplied list)
       (examples
        (map odd? (range 5))
        (map true? '(foo t () t 3))))
  (when l
    (cons (f (car l))
          (map f (cdr l)))))

(defn mapcat (f l)
  (doc (map a function onto a list and concatenate results)
       (examples
        (map list (range 5))
        (mapcat list (range 5))
        (map range (range 5))
        (mapcat range (range 5))))
  (reduce concat (map f l)))

(defn filter (f l)
  (doc (keep only values for which function f is true)
       (examples
        (filter odd? (range 5))))
  (cond ((not l) ())
        ((f (car l)) (cons (car l)
                           (filter f (cdr l))))
        (t (filter f (cdr l)))))

(defn remove (f l)
  (doc (keep only values for which function f is false / the empty list)
       (examples
        (remove odd? (range 5))))
  (filter (complement f) l))

(defn ** (n m)
  (doc (exponentiation operator)
       (examples
        (** 1 0)
        (** 2 4)
        (** 10 10)))
  (if (zero? m)
    1
    (* n (** n (dec m)))))

(defn capitalize (a)
  (doc (return the atom argument, capitalized)
       (examples
        (capitalize 'hello))) ;;=> Hello
  (let ((s (split a)))
    (fuse (concat (map upcase (take 1 s))
                  (drop 1 s)))))

(defn randigits (n)
  (doc (return a random integer between 0 and the argument minus 1))
  (repeatedly n
              (lambda () (randint 10))))

(defn randchoice (l)
  (doc (return an element at random from the supplied list))
  (when-not l
    (error '(randchoice expects a nonempty list)))
  (nth (randint (len l)) l))

(defn randalpha (n)
  (doc (return a list of random (English/Latin/unaccented)
               lower-case alphabetic characters))
  (repeatedly n
              (lambda ()
                (randchoice (split 'abcdefghijklmnopqrstuvwxyz)))))

(defmacro dotimes (n . body)
  (doc (execute body for each value in a list))
  (let ((inner-sym (gensym))
        (n-sym (gensym)))
    `(let ((~n-sym ~n))
       (when-not (neg? ~n-sym)
         (let ((~inner-sym (lambda ~inner-sym (count)
                             (when-not (zero? count)
                               ~@body
                               (~inner-sym (- count 1))))))
           (~inner-sym ~n-sym))))))

(defn butlast (l)
  (doc (return everything but the last element)
       (examples
        (butlast ()) ;;=> ()
        (butlast (range 3)))) ;;=> (0 1)
  (take (dec (len l)) l))

(defn punctuate (f x)
  (doc (return x capitalized, with punctuation determined by the supplied function))
  (cond ((not x) x)
        ((= (len x) 1) (list (capitalize (f (car x)))))
        (t (cons (capitalize (car x))
                 (concat (cdr (butlast x))
                         (list (f (last x))))))))

(defn tosentence (l)
  (doc (return l as a sentence... capitalized, with a period at the end)
       (examples
        (tosentence '(to be, or not to be, that is the question))))
  (punctuate period l))

(defn exclaim (l)
  (doc (return l as a sentence... emphasized!)
       (examples
        (exclaim '(well, hello))
        (exclaim '(help))
        (exclaim '(begone, fiend))))
  (punctuate bang l))

(defn list* (() . args)
  (doc (create a list by consing everything but the last arg onto the last)
       (examples
        (list* 1 2 '(3))
        (list* 1 2 '(3 4))
        (list*)))
  (when args
    (let ((endl (last args))
          (other (butlast args)))
      (concat other endl))))

(defmacro with-screen (() . body)
  (doc (prepare for and clean up after screen operations))
  `(progn
     (screen-start)
     (let ((result
            (progn ~@body)))
       (screen-end)
       result)))

(defn some (f l)
  (doc (return f applied to first element for which that result is truthy, else ())
       (examples
        (some even? '(1 3 5 7 9 11 13))
        (some even? '(1 3 5 7 9 1000 11 13))))
  (when l
    (let ((result (f (car l))))
      (if result
        result
        (some f (cdr l))))))

(defn every (f l)
  (doc (return t if f applied to every element in l is truthy, else ())
       (examples
        (every odd? '(1 3 5))
        (every odd? '(1 2 3 5))))
  (if-not l
    t
    (let ((result (f (car l))))
      (if (not result)
        ()
        (every f (cdr l))))))

(defn punctuate-atom (a mark)
  (doc (add a punctuation mark at end of atom)
       (examples
        (punctuate-atom 'list '*)
        (punctuate-atom 'list COLON)))
  (let ((l (split a)))
    (fuse (concat l (list mark)))))

(defn bang (a)
  (doc (add an exclamation point at end of atom)
       (examples
        (bang 'Bang))) ;;=> Bang!
  (punctuate-atom a BANG))

(defn comma (a)
  (doc (add a comma at end of atom)
       (examples
        (comma 'hello))) ;;=> hello,
  (punctuate-atom a COMMA))

(defn period (a)
  (doc (add a period at end of atom)
       (examples
        (period 'Woot))) ;;=> Woot.
  (punctuate-atom a PERIOD))

(defn colon (a)
  (doc (add a colon at end of atom)
       (examples
        (colon 'remember-this))) ;;=> remember-this:
  (punctuate-atom a COLON))

(defmacro is (condition)
  (doc (assert a condition is truthy, or show failing code)
       (examples
        (is t)
        (is (car (cons () '(this one should fail))))))
  ;; FIXME: why doesn't if / if-not work here?
  (cond
   ((or (not (list? condition))
        (not (= '= (car condition)))
        (not (= 3 (len condition))))
    (let ((result (gensym 'result)))
      `(let ((~result ~condition))
         (when-not ~result
           (error '(assertion ~(fuse (list 'failed COLON)) ~condition))))))
   ;; Handle equality in more detail: show details when equality of
   ;; two terms fails:
   (t
    (let ((lhs (nth 1 condition))
          (rhs (nth 2 condition))
          (lhsym (gensym 'lhs))
          (rhsym (gensym 'rhs)))
      `(let ((~lhsym ~lhs)
             (~rhsym ~rhs))
         (when-not (= ~lhsym ~rhsym)
           (error
            (concat (list 'expression
                          (quote ~lhs)
                          '==>
                          ~lhsym)
                    '(is not equal to)
                    (list 'expression
                          (quote ~rhs)
                          '==>
                          ~rhsym)))))))))

(defmacro let* (pairs . body)
  (doc (let form with ability to refer to previously-bound
            pairs in the binding list)
       (examples
        (let* ((a 1) (b (inc a)))
          (+ a b))))
  (if-not pairs
    (list* 'progn body)
    `(let (~(car pairs))
       (let* (~@(cdr pairs))
         ~@body))))

(def first car)

(defn second (l)
  (doc (return the second element of a list,
               or () if not enough elements)
       (examples
        (second ())
        (second '(a))
        (second '(a b))
        (second '(1 2 3))))
  (car (cdr l)))

(defn comp (() . fs)
  (doc (function composition -- return a function which
                 applies a series of functions in reverse order)
       (examples
        ((comp) 'hello)
        ((comp split) 'hello)
        ((comp len split) 'hello)
        ((comp (partial apply +)
               (partial map len)
               (partial map split))
         '(hello world))))
  (let ((n (len fs))
        (f (car fs))
        (g (second fs)))
    (cond ((zero? n) identity)
          ((= n 1) f)
          ((= n 2) (lambda (() . xs)
                     (f (apply g xs))))
          (t (reduce comp (list* f g (cdr (cdr fs))))))))

(defn partial (f . args)
  (doc (partial function application)
       (return a new function which wraps the supplied arguments)
       (examples
        ((partial + 1) 1)
        ((partial + 2 3) 4 5)))
  (lambda (() . more)
    (apply f (concat args more))))

(defn max (() . args)
  (doc (find maximum of one or more numbers)
       (examples
        (max -5)
        (max 2 3)
        (apply max (range 10))))
  (let ((n (len args))
        (n1 (first args))
        (n2 (second args)))
    (cond ((zero? n) (error '(max needs at least one number)))
          ((= 1 n) n1)
          ((= 2 n) (if (< n1 n2) n2 n1))
          (t (reduce max (max n1 n2) (cdr (cdr args)))))))

(defn min (() . args)
  (doc (find minimum of one or more numbers)
       (examples
        (min -5)
        (min 2 3)
        (apply min (range 10))))
  (let ((n (len args))
        (n1 (first args))
        (n2 (second args)))
    (cond ((zero? n) (error '(min needs at least one number)))
          ((= 1 n) n1)
          ((= 2 n) (if (< n2 n1) n2 n1))
          (t (reduce min (min n1 n2) (cdr (cdr args)))))))

(defn not= (() . terms)
  (doc (complement of = function)
       (examples
        (not= 1 2)
        (not= 'a 'a)))
  (not (apply = terms)))

(defn interpose (x l)
  (doc (interpose x between all elements of l)
       (examples (interpose BANG (range 5))))
  (cond ((not l) ())
        ((not (cdr l)) l)
        (t (cons (car l)
                 (cons x (interpose x (cdr l)))))))

(defn enumerate (l)
  (doc (returning list of (i, x) pairs where i is the index
                  (from zero) and x is the original element from l)
       (examples
        (enumerate '(a b c))))
  (let ((c 0)
        (ret ()))
    (foreach x l
      (set! ret (cons (list c x)
                      ret))
      (set! c (inc c)))
    (reverse ret)))

(defn abs (x)
  (doc (return absolute value of x)
       (examples
        (abs 1)
        (abs -100)))
  (if (neg? x) (- x) x))