prelude.bn

;;;; prelude.bn -- Basic definitions of Bone Lisp.   -*- bone -*-
;;;; Copyright (C) 2016 Wolfgang Jaehrling
;;;;
;;;; Permission to use, copy, modify, and/or distribute this software for any
;;;; purpose with or without fee is hereby granted, provided that the above
;;;; copyright notice and this permission notice appear in all copies.
;;;;
;;;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
;;;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
;;;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
;;;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
;;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
;;;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
;;;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

;; Need this first because quasiquote expands to it
(_bind 'cat #f _full-cat)
(_mac-bind 'cat #f
  (lambda args
    (cons (if (_fast=? 2 (len args)) '_fast-cat '_full-cat) args)))

(_bind '_make-nonrecursive-binder #t
  (lambda (binder spec body overwritable)
    `(,binder ',(car spec) ,overwritable
              (lambda ,(cdr spec) ,@body))))

(_bind '_make-recursive-binder #t
  (lambda (binder spec body overwritable)
    `(with ,(car spec) (lambda ,(cdr spec) ,@body)
       (,binder ',(car spec) ,overwritable ,(car spec)))))

(_bind '_make-binder-without-lambda #t
  (lambda (binder name body overwritable)
    (if (not (single? body))
        (err "too many expressions in definition of " name)
      `(,binder ',name ,overwritable ,(car body)))))

(_bind '_make-binder #t
  (lambda (binder spec body overwritable)
    ((if (sym? spec)
         _make-binder-without-lambda
       (if (not (_refers-to? body (car spec)))
          _make-nonrecursive-binder
        _make-recursive-binder))
     binder spec body overwritable)))

;; FIXME: defmac has no docstring...
(_mac-bind 'defmac #f
  (lambda (spec doc . body)
    (if (not (str? doc))
        (err "`defmac` requires a docstring - " (car spec))
      (_make-binder '_mac-bind spec body #f))))

(defmac (defsub spec doc . body)
  "Define a sub with name/args as in `spec`, docstring `doc` and code `body`."
  (if (not (str? doc))
      (err "`defsub` requires a docstring - " (car spec))
    (_make-binder '_bind spec body #f)))

(defmac (internmac spec . body)
  "Define an internal macro."
  (_make-binder '_mac-bind spec body #f))

(defmac (internsub spec . body)
  "Define an internal sub."
  (_make-binder '_bind spec body #f))

(defmac (mymac spec . body)
  "Define a locally used mac."
  (_make-binder '_mac-bind spec body #t))

(defmac (mysub spec . body)
  "Define a locally used sub."
  (_make-binder '_bind spec body #t))

(defmac (defreader name doc . body)
  "Register the reader macro `name` with code `body`; docstring being `doc`."
  `(_reader-bind ',name #f (lambda () ,@body)))

(defmac (myreader name . body)
  "Register the locally used reader macro `name` with code `body`."
  `(_reader-bind ',name #t (lambda () ,@body)))

(defmac (declare name)
  "Announce that `name` will be defined later.

It will be possible for code to refer to the binding before its
definition, but it has to be defined before that code is being run.
This is intended for making mutual recursion of subs possible."
  `(_declare ',name))

(internsub (_every-pair? compare? xs)
  (with loop (lambda (xs)
               (if (single? xs)
                 #t
                 (if (compare? (car xs) (car (cdr xs))) (loop (cdr xs)))))
    (if (nil? xs) #t (loop xs))))

(internsub (_full=? . xs) (_every-pair? _fast=? xs))
(internsub (_full>? . xs) (_every-pair? _fast>? xs))
(internsub (_full<? . xs) (_every-pair? _fast<? xs))
(internsub (_full>=? . xs) (_every-pair? _fast>=? xs))
(internsub (_full<=? . xs) (_every-pair? _fast<=? xs))

(internmac (_optimize name binary n-ary)
  `(internmac (,name . args)
     (cons (if (_fast=? 2 (len args)) ',binary ',n-ary) args)))

(_optimize + _fast+ _full+)
(_optimize - _fast- _full-)
(_optimize * _fast* _full*)
(_optimize / _fast/ _full/)
(_optimize =? _fast=? _full=?)
(_optimize >? _fast>? _full>?)
(_optimize <? _fast<? _full<?)
(_optimize >=? _fast>=? _full>=?)
(_optimize <=? _fast<=? _full<=?)
;(_optimize cat _fast-cat _full-cat) ; did this earlier
(_optimize append _fast-cat _full-cat)
(_optimize list+ _fast-cat _full-cat)

(defsub (caar x) "The `car` of the `car` of `x`." (car (car x)))
(defsub (cadr x) "The `car` of the `cdr` of `x`." (car (cdr x)))
(defsub (cdar x) "The `cdr` of the `car` of `x`." (cdr (car x)))
(defsub (cddr x) "The `cdr` of the `cdr` of `x`." (cdr (cdr x)))
(defsub (caaar x) "The `car` of the `car` of the `car` of `x`." (caar (car x)))
(defsub (caadr x) "The `car` of the `car` of the `cdr` of `x`." (caar (cdr x)))
(defsub (cadar x) "The `car` of the `cdr` of the `car` of `x`." (cadr (car x)))
(defsub (caddr x) "The `car` of the `cdr` of the `cdr` of `x`." (cadr (cdr x)))
(defsub (cdaar x) "The `cdr` of the `car` of the `car` of `x`." (cdar (car x)))
(defsub (cdadr x) "The `cdr` of the `car` of the `cdr` of `x`." (cdar (cdr x)))
(defsub (cddar x) "The `cdr` of the `cdr` of the `car` of `x`." (cddr (car x)))
(defsub (cdddr x) "The `cdr` of the `cdr` of the `cdr` of `x`." (cddr (cdr x)))

(defmac (cond . clauses)
  "Shortcut for nested `if` clauses.

Each clause in `clauses` is of the form `(condition . body)`.  The
clauses are processed in order.  The condition of a clause is
evaluated and if it gives a true value, all the expressions in the
body are evaluated; no further clauses will be processed in this case.
If the condition was false, however, the next clause will be
processed in the same way.  If no condition was true, `#f` will be
returned.

It is common to have an else-clause in the end which has `#t` as its
condition."
  (if (nil? clauses)
      #f
    (if (eq? #t (caar clauses))
        `(do ,@(cdar clauses))
      `(if ,(caar clauses)
           (do ,@(cdar clauses))
         (cond ,@(cdr clauses))))))

(defmac (and . args)
  "Logical short-circuit AND.

The `args` are evaluated in order until one yields `#f`, in which case
`#f` will also be returned. Otherwise, the result of the last argument
will be returned."
  (cond ((nil? args) #t)
        ((nil? (cdr args)) (car args))
        (#t `(if ,(car args) (and ,@(cdr args)) #f))))

(defmac (or . args)
  "Logical short-circuit OR.

The `args` are evaluated in order until one yields a true value, in
which case it will also be returned.  Otherwise, `#f` will be
returned."
  (cond ((nil? args) #f)
        ((nil? (cdr args)) (car args))
        (#t `(if ,(car args) (do) (or ,@(cdr args))))))

(defmac (when expr . body)
  "When `expr` is true, evaluate all expressions in `body`."
  `(if ,expr (do ,@body) #f))

(defmac (let bindings . body)
  "Shortcut for nested `with`: Introduce several `bindings` at once.

The `bindings` are of the form `(name value)`."
  (if (nil? bindings)
      (cons 'do body)
    `(with ,(caar bindings) ,(cadar bindings) (let ,(cdr bindings) . ,body))))

(defmac (aif expr then . else)
  "Anamorphic `if`: Bind `it` to the result of `expr`."
  `(with it ,expr (if it ,then ,@else)))

(defmac (awhen expr . body)
  "Anamorphic `when`: Bind `it` to the result of `expr`."
  `(with it ,expr (when it ,@body)))

(defmac (acond . clauses)
  "Anamorphic version of `cond`: Bind `it` to the result of the condition."
  (if (nil? clauses)
      #f
    (if (eq? #t (caar clauses))
        `(do ,@(cdar clauses))
      `(aif ,(caar clauses)
           (do ,@(cdar clauses))
         (acond ,@(cdr clauses))))))

(defmac (with-gensyms names . body)
  "Bind all of `names` to `gensym`s and evaluate `body`."
  `(let ,(map (lambda (name)
                `(,name (gensym)))
              names)
     ,@body))

(defmac (destructure bindings val . body)
  "Bind a list of `bindings` to the list `val`, thereby destructuring it."
  (with-gensyms (lst)
    `(with ,lst ,val
       (with ,(car bindings) (car ,lst)
         ,(if (nil? (cdr bindings))
              (cons 'do body)
            `(destructure ,(cdr bindings) (cdr ,lst) ,@body))))))

(defsub (equal? a b)
  "Compare `a` and `b` for structural equality."
  (cond ((str? a) (and (str? b)
                       (str=? a b)))
        ((cons? a) (and (cons? b)
                        (equal? (car a) (car b))
                        (equal? (cdr a) (cdr b))))
        (#t (eq? a b))))

(defmac (case val . clauses)
  "Choose one of the `clauses` depending on the `val`ue.

A clause is a list with the first element being a list of values
matched against `val`.  It may also have `#t` as first element instead
of the value list, in which case the branch is always taken."
  (with-gensyms (x)
    `(with ,x ,val
       (cond ,@(map (lambda (clause)
                      (cons (if (eq? #t (car clause))
                                #t
                              `(or ,@(map (lambda (candidate)
                                            `(equal? ,x ',candidate))
                                          (car clause))))
                            (cdr clause)))
                    clauses)))))

(defsub (compose sub1 sub2)
  "Return a sub that calls `sub2` with its arguments, then `sub1` on the result."
  (lambda args
    (sub1 (apply sub2 args))))

(defsub (partial sub . args)
  "Partially apply `args` to `sub`."
  (if (single? args)
      (with arg (car args)   ; fast path
        (lambda more-args
          (apply sub arg more-args)))
    (lambda more-args
      (apply sub (cat args more-args)))))

(defmac (rlambda name args . body)
  "Like `lambda`, but also binds `name` to the sub itself."
  `(with ,name (lambda ,args ,@body) ,name))

(defmac (in-reg . body)
  "Evaluate `body` while using a new memory region; copy back the result."
  `(_in-reg (lambda () ,@body)))

(defmac (reg-loop init loop)
  "Evaluate `body` repeatedly in a new region, passing its result as args to the next iteration.

First, `init` will be evaluated in a new region.  This new region will
be freed after copying the result to a another new region.  We apply
that result to the sub `loop` (while using the second new region).  It
is expected to return a list with an indicator in its car that decides
whether we want to continue the iteration (with `#f` meaning that we
should not continue).  The rest of the list will either be used as the
return value, or applied to `loop` in the next iteration after copying
to a new region and freeing the previous region.  Example:

    (reg-loop (list 1 2 3)
      | a b c (cons (<? (+ a b c) 100)
                    (map ++ (list a b c))))

This will increment the three values until their sum is larger than
100, return a list of the values eventually."
  `(_reg-loop (lambda () ,init) ,loop))

(defmac (defvar name val)
  "Define the variable `name` and set its default value to `val`."
  `(_var-bind ',name ,val))

(defmac (with-var name val . body)
  "Evaluate `body` with dynamic variable `name` bound to `val`."
  `(_with-var ',name ,val (lambda () ,@body)))

(defmac (with-file-src fname . body)
  "Evaluate `body` while reading input from the file specified by `fname`."
  `(_with-file-src ,fname (lambda () ,@body)))

(defmac (with-file-dst fname . body)
  "Evaluate `body` while printing output to the file specified by `fname`."
  `(_with-file-dst ,fname (lambda () ,@body)))

(defmac (with-src src . body)
  "Evaluate `body` while reading input from `src`."
  `(with-var *src* ,src ,@body))

(defmac (with-dst dst . body)
  "Evaluate `body` while writing output to `dst`."
  `(with-var *dst* ,dst ,@body))

(defmac (with-stdin . body)
  "Evaluate `body` while reading input from stdin."
  `(with-var *src* *stdin* ,@body))

(defmac (with-stdout . body)
  "Evaluate `body` while printing output to stdout."
  `(with-var *dst* *stdout* ,@body))

(defmac (with-stderr . body)
  "Evaluate `body` while printing output to stderr."
  `(with-var *dst* *stderr* ,@body))

(defsub (fold kons knil xs)
  "Fold the list `xs` by means of `kons` into a result, starting with `knil`."
  (with loop (lambda (rest so-far)
               (if (nil? rest)
                   so-far
                 (loop (cdr rest)
                       (kons (car rest) so-far))))
    (loop xs knil)))

(defsub (foldr kons knil xs)
  "Fold the list `xs` from right to left by means of `kons` into a result, starting with `knil`."
  (with next (lambda (rest)
               (if (nil? rest)
                   knil
                 (kons (car rest)
                       (next (cdr rest)))))
    (next xs)))

(defsub (unfold stop? seed->x next-seed seed)
  "Unfold a list.

The list is generated by creating values with `seed->x`, updating the
seed with `next-seed` and `stop?` telling us to finish."
(with next (lambda (seed)
             (if (stop? seed)
                 ()
               (cons (seed->x seed)
                     (next (next-seed seed)))))
  (next seed)))

(defsub (unfoldr stop? seed->x next-seed seed)
  "Unfold a list from the right.

The list is generated by creating values with `seed->x`, updating the
seed with `next-seed` and `stop?` telling us to finish."
  (with loop (lambda (seed so-far)
               (if (stop? seed)
                   so-far
                 (loop (next-seed seed)
                       (cons (seed->x seed) so-far))))
    (loop seed ())))

(defsub (0? n)
  "Check whether the number `n` is zero."
  (=? 0 n))

(defsub (>0? n)
  "Check whether the number `n` is positive."
  (>? n 0))

(defsub (<0? n)
  "Check whether the number `n` is negative."
  (<? n 0))

(defsub (++ n)
  "Increment `n` by one.  Short for `(+ n 1)`.

The name `++` is inspired by the operator of the same name in the C
programming language, but while the C operator mutates its operand,
the `++` sub obviously does not.  The same is true for `--`.

The traditional Lisp name for this operation was `1+`, which is mostly
fine, but the negative counter part `1-` was a very odd name (inverse
infix?) and thus was rejected in favor of the C notation."
  (+ n 1))

(defsub (-- n)
  "Decrement `n` by one.  Short for `(- n 1)`.

See `++` for background information."
  (- n 1))

(defsub (int->float n)
  "Return a floating-point number equal to integer `n`."
  (+ 0.0 n))

(defsub (xcons d a)
  "Like `cons`, but order of arguments is reversed.

This can be useful for passing to higher order functions."
  (cons a d))

(defsub (cat-lists xs)
  "Concatenate all the lists in `xs` together."
  (apply cat xs))

(defsub (nth-cons n xs)
  "Return the `n`th cons of `xs` (starting at 0), which must have enough conses."
  (if (0? n)
      xs
    (nth-cons (-- n) (cdr xs))))

(defsub (nth n xs)
  "Return the `n`th element of `xs`."
  (car (nth-cons n xs)))

(defsub (drop n xs)
  "Return the `n`th cons of `xs` (or nil if `xs` is shorter than `n`)."
  (if (or (0? n) (nil? xs))
      xs
    (drop (-- n) (cdr xs))))

(defsub (take n xs)
  "Return the first `n` elements of `xs` (or all of `xs` if it has less than `n` elements)."
  (if (or (0? n) (nil? xs))
      ()
    (cons (car xs)
          (take (-- n) (cdr xs)))))

(defsub (dropr n xs)
  "Drop the `n` elements from the end of `xs`."
  (with cnt (- (len xs) n)
    (if (<0? cnt)
        ()
      (take cnt xs))))

(defsub (taker n xs)
  "Take the `n` last elements from `xs` (or all of `xs` if it has less than `n` elements)."
  (with cnt (- (len xs) n)
    (if (<0? cnt)
        xs
      (drop cnt xs))))

(defsub (last xs)
  "Return the last value in the list `xs`."
  (car (taker 1 xs)))

(defsub (find? is? xs)
  "Return the first element in `xs` that satisfies predicate `is?`."
  (with loop (lambda (xs)
               (cond ((nil? xs) #f)
                     ((is? (car xs)) (car xs))
                     (#t (loop (cdr xs)))))
    (loop xs)))

(defsub (any? is? xs)
  "Return whether any element of `xs` satisfies predicate `is?`."
  (with loop (lambda (xs)
               (cond ((nil? xs) #f)
                     ((is? (car xs)) #t)
                     (#t (loop (cdr xs)))))
    (loop xs)))

(defsub (all? is? xs)
  "Return whether any element of `xs` satisfies predicate `is?`."
  (with loop (lambda (xs)
               (cond ((nil? xs) #t)
                     ((not (is? (car xs))) #f)
                     (#t (loop (cdr xs)))))
    (loop xs)))

(defsub (flatten xs)
  "Turn the tree `xs` into a list."
  (cat-lists (map (lambda (x)
                    (cond ((cons? x) (flatten x))
                          ((nil? x)  ())
                          (#t        (list x))))
                  xs)))

(defsub (car? x)
  "If `x` is a cons, return its car, otherwise return `#f`."
  (and (cons? x) (car x)))

(defsub (cdr? x)
  "If `x` is a cons, return its cdr, otherwise return `#f`."
  (and (cons? x) (cdr x)))

(defsub (caar? x) "The `car?` of the `car?` of `x`." (car? (car? x)))
(defsub (cadr? x) "The `car?` of the `cdr?` of `x`." (car? (cdr? x)))
(defsub (cdar? x) "The `cdr?` of the `car?` of `x`." (cdr? (car? x)))
(defsub (cddr? x) "The `cdr?` of the `cdr?` of `x`." (cdr? (cdr? x)))

(defsub (car* x)
  "If `x` is a cons, return its car; otherwise, return nil."
  (if (cons? x) (car x) ()))

(defsub (cdr* x)
  "If `x` is a cons, return its cdr; otherwise, return nil."
  (if (cons? x) (cdr x) ()))

(defsub (caar* x) "The `car*` of the `car*` of `x`." (car* (car* x)))
(defsub (cadr* x) "The `car*` of the `cdr*` of `x`." (car* (cdr* x)))
(defsub (cdar* x) "The `cdr*` of the `car*` of `x`." (cdr* (car* x)))
(defsub (cddr* x) "The `cdr*` of the `cdr*` of `x`." (cdr* (cdr* x)))

(defsub (assocar? key alist)
  "Get the first value of the list associated with `key` in `alist` (or `#f` if `key` not in `alist`)."
  (car? (assoc? key alist)))

(defsub (acons key value alist)
  "Put `(key value)` in front of the `alist`."
  (cons (list key value) alist))

(defsub (str-len s)
  "The number of characters in the str `s`."
  (len (unstr s)))

(defsub (str-nth n s)
  "Return the `n`th character in string `s`."
  (nth n (unstr s)))

(defsub (str+ . strs)
  "Concatenate all the `strs`."
  (str (cat-lists (map unstr strs))))

(defsub (str-drop n s)
  "Return str `s` without the first `n` characters."
  (str (drop n (unstr s))))

(defsub (str-take n s)
  "Return a str containing the first `n` characters of `s` (or all of `s` if it's shorter)."
  (str (take n (unstr s))))

(defsub (str-dropr n s)
  "Return str `s` without the first `n` characters."
  (str (dropr n (unstr s))))

(defsub (str-taker n s)
  "Return a str containing the first `n` characters of `s` (or all of `s` if it's shorter)."
  (str (taker n (unstr s))))

(defsub (str-suffix? suffix string)
  "Check whether the str `string` ends in `suffix`."
  (str=? suffix (str-taker (str-len suffix) string)))

(defsub (str-prefix? prefix string)
  "Check whether `string` starts with `prefix`."
  (str=? prefix (str-take (str-len prefix) string)))

(defsub (str-empty? s)
  "Check whether str `s` is the empty str."
  (str=? "" s))

(defsub (str-select from to s)
  "Extract the middle part of the str `s`, bounds being `from` and `to`."
  (str-take (- to from)
            (str-drop from s)))

(defsub (str-join separator . strs)
  "Concatenate `strs` with `separator` between each str."
  (apply str+ (cdr* (foldr (lambda (s so-far)
                             (list* separator s so-far))
                           ()
                           strs))))

;; FIXME: this is not very efficient
(defsub (str-pos? needle haystack)
  "Return the position (zero-based) of `needle` in `haystack` (or `#f` if not found)."
  (with loop (lambda (pos s)
               (cond ((str-empty? s) #f)
                     ((str-prefix? needle s) pos)
                     (#t (loop (++ pos) (str (cdr (unstr s)))))))
    (loop 0 haystack)))

(defsub (str* n s)
  "Concatenate the str `s` `n` times."
  (apply str+ (unfold 0? (lambda (x) s) -- n)))

(defsub (str-pad n s)
  "Add spaces to the left side of `s` until it is `n` characters long."
  (with l (str-len s)
    (if (>=? l n)
        s
      (str+ (str* (- n l) " ") s))))

(defsub (str-padr n s)
  "Add spaces to the right side of `s` until it is `n` characters long."
  (with l (str-len s)
    (if (>=? l n)
        s
      (str+ s (str* (- n l) " ")))))

(defsub (str-subst old-needle new-needle haystack)
  "Replace `old-needle` with `new-needle` in `haystack` (all of them are strs).

If `old-needle` is not in `haystack`, just returns `haystack`
unmodified.  Note that only one occurrence of `old-needle` will be
replaced.  If you want to replace all occurrences, use `str-gsubst`
instead."
  (aif (str-pos? old-needle haystack)
      (str+ (str-take it haystack)
            new-needle
            (str-drop (+ (str-len old-needle) it)
                      haystack))
    haystack))

(defsub (str-gsubst old-needle new-needle haystack)
  "Replace all occurrences of `old-needle` with `new-needle` in `haystack` (all strs)."
  (with loop (lambda (remain)
               (aif (str-pos? old-needle remain)
                   (str+ (str-take it remain)
                         new-needle
                         (loop (str-drop (+ (str-len old-needle) it)
                                         remain)))
                 remain))
    (loop haystack)))

(defsub (chr-skip ignore consume)
  "Read up to a character not in `ignore`, return that character (via `chr-look` if `consume` is false)."
  (with loop (lambda ()
               (if (not (member? (chr-look)
                                 (unstr ignore)))
                   (if consume (chr-read) (chr-look))
                 (do (chr-read)
                     (loop))))
    (loop)))

(defreader eval
  "Evaluate the next expression at read-time."
  (eval (read)))

(defreader chr
  "Get the code point of a character; should be followed by a 1-character str"
  (with s (read)
    (if (or (not (str? s))
            (<>? 1 (str-len s)))
        (err "chr reader requires a 1-character str")
      (car (unstr s)))))

(defsub (read-line)
  "Read a line; the returned str will not contain the newline."
  (str (unfold | c (=? c #chr "\n")
               id
               | c (chr-read)
               (chr-read))))

(defsub (str-ascii-lower s)
  "Convert upper case characters in `s` to lower case.

This is useful e.g. for checking file extensions case independently.
Note that there is no corresponding `str-ascii-upper`."
  (str (map (lambda (c)
              (if (not (<=? #chr "A" c #chr "Z"))
                  c
                (+ c (- #chr "a" #chr "A"))))
            (unstr s))))

;;;; Aliases

(defmac (alias new old)
  "Define `new` as an alias for sub `old`."
  `(_bind ',new #f ,old))

(alias + _full+)
(alias no nil?)
(alias list->str str)
(alias str->list unstr)
(alias length len)
(alias size len)
(alias str->sym intern)
(alias unintern sym->str)
(alias - _full-)
(alias * _full*)
(alias / _full/)
(alias cons* list*)
(alias contains? member?)
(alias modulo mod)
(alias % mod)
(alias =? _full=?)
(alias >? _full>?)
(alias <? _full<?)
(alias >=? _full>=?)
(alias <=? _full<=?)
(alias macroexpand-1 mac-expand-1)
(alias macroexpand mac-expand)
(alias append cat)
(alias list+ cat)
(alias =0? 0?)
(alias zero? 0?)
(alias positive? >0?)
(alias negative? <0?)
(alias str-cat str+)
(alias str-append str+)
(alias head car)
(alias tail cdr)
(alias str-nil? str-empty?)
(alias foldl fold)
(alias fold-left fold)
(alias fold-right foldr)
(alias unfoldl unfold)
(alias unfold-left unfold)
(alias unfold-right unfoldr)
(alias drop-right dropr)
(alias take-right taker)
(alias str-drop-right str-dropr)
(alias str-take-right str-taker)
(alias every? all?)
(alias for-each each)
(alias str-contains? str-pos?)
(alias str-padl str-pad)
(alias str-pad-left str-pad)
(alias str-pad-right str-padr)
(alias float->int trunc)
(alias str-replace str-subst)

;;;; Implementation information

(defsub (lisp-info item)
  "Get implementation information about `item`."
  (assocar? item _*lisp-info*))

(defsub (version major minor)
  "Declare that the following code is compatible with interpreter version `major`.`minor`."
  (when (not (and (=?  major (lisp-info 'major-version))
                  (<=? minor (lisp-info 'minor-version))))
    (err "code is not compatible with implementation version")))

;;;; Modules

(defvar _*incomplete-mods* ())
(defvar _*complete-mods* ())

(internsub (_use-mod mod)
  (cond ((member? mod _*complete-mods*) #t)
        ((member? mod _*incomplete-mods*)
         (err "ERR: recursive module inclusion\n"))
        (#t (with-var _*incomplete-mods* (cons mod _*incomplete-mods*)
              (_load mod))
            (_var! '_*complete-mods* (_pcons mod _*complete-mods*)))))

(defmac (use . mods)
  "Use the modules listed in `mods`."
  `(each _use-mod ',mods))

(defmac (reload mod)
  "Load the module `mod`; existing bindings can be overwritten by it."
  `(_reload ',mod))