tvl-depot/lisp/klatre/klatre.lisp

120 lines
3.7 KiB
Common Lisp
Raw Normal View History

(in-package #:klatre)
(declaim (optimize (safety 3)))
(defmacro comment (&rest _)
(declare (ignore _)))
(defun posp (n) (> n 0))
;;; Sequence utilities
(defun slice (vector start end)
(make-array (- end start)
:element-type (array-element-type vector)
:displaced-to vector
:displaced-index-offset start))
(defun chunk-vector (size vector &key start end sharedp)
(check-type size (integer 1))
(loop
with slicer = (if sharedp #'slice #'subseq)
and low = (or start 0)
and high = (or end (length vector))
for s from low below high by size
for e from (+ low size) by size
collect (funcall slicer vector s (min e high))))
(defun chunk-list/unbounded (size list)
(loop
for front = list then next
for next = (nthcdr size front)
collect (ldiff front next)
while next))
(defun chunk-list/bounded (size list upper-limit)
(loop
for front = list then next
for next = (nthcdr (min size upper-limit) front)
collect (ldiff front next)
do (decf upper-limit size)
while (and next (plusp upper-limit))))
(defun chunk-list (size list &key (start 0) end)
"Returns successive chunks of list of size SIZE, starting at START and ending
at END."
(declare (inline chunk-list/bounded chunk-list/unbounded))
(check-type size (integer 1))
(let ((list (nthcdr start list)))
(when list
(if end
(chunk-list/bounded size list (- end start))
(chunk-list/unbounded size list)))))
(defun mapconcat (func lst sep)
"Apply FUNC to each element of LST, and concat the results as strings,
separated by SEP."
(check-type lst cons)
(check-type sep (simple-array character (*)))
(let ((vs (make-array 0
:element-type 'character
:fill-pointer 0
:adjustable t))
(lsep (length sep)))
(mapcar #'(lambda (str)
(let ((nstr (the (simple-array character (*))
(funcall func str))))
(dotimes (j (length nstr) j)
(vector-push-extend (char nstr (the fixnum j)) vs))
(dotimes (k lsep k)
(vector-push-extend (char sep (the fixnum k)) vs))))
lst)
vs))
;;;
;;; String handling
;;;
(defparameter dottime-format
'((:year 4) #\- (:month 2) #\- (:day 2)
#\T
(:hour 2) #\· (:min 2))
"`:LOCAL-TIME' format specifier for dottime")
(defun format-dottime (timestamp &optional (offset 0))
"Return TIMESTAMP formatted as dottime, with a specified offset or +00"
(check-type timestamp local-time:timestamp)
(concatenate 'string
(local-time:format-timestring nil timestamp
:format dottime-format
:timezone local-time:+utc-zone+)
(format-dottime-offset offset)))
(defun format-dottime-offset (offset)
"Render OFFSET in hours in the format specified by dottime."
(check-type offset integer)
(concatenate 'string
; render sign manually since format prints it after padding
(if (>= offset 0) "+" "-")
(format nil "~2,'0D" (abs offset))))
(comment
(format-dottime (local-time:now))
(format-dottime (local-time:now) 2))
(defun try-parse-integer (str)
"Attempt to parse STR as an integer, returning nil if it is invalid."
(check-type str string)
(handler-case (parse-integer str)
feat(nix/buildLisp): add ecl Adds ECL as a second supported implementation, specifically a statically linked ECL. This is interesting because we can create statically linked binaries, but has a few drawbacks which doesn't make it generally useful: * Loading things is very slow: The statically linked ECL only has byte compilation available, so when we do load things or use the REPL it is significantly worse than with e. g. SBCL. * We can't load shared objects via the FFI since ECL's dffi is not available when linked statically. This means that as it stands, we can't build a statically linked //web/panettone for example. Since ECL is quite slow anyways, I think these drawbacks are worth it since the biggest reason for using ECL would be to get a statically linked binary. If we change our minds, it shouldn't be too hard to provide ecl-static and ecl-dynamic as separate implementations. ECL is LGPL and some libraries it uses as part of its runtime are as well. I've outlined in the ecl-static overlay why this should be of no concern in the context of depot even though we are statically linking. Currently everything is building except projects that are using cffi to load shared libaries which have gotten an appropriate `badImplementations` entry. To get the rest building the following changes were made: * Anywhere a dependency on UIOP is expressed as `bundled "uiop"` we now use `bundled "asdf"` for all implementations except SBCL. From my testing, SBCL seems to be the only implementation to support using `(require 'uiop)` to only load the UIOP package. Where both a dependency on ASDF and UIOP exists, we just delete the UIOP one. `(require 'asdf)` always causes UIOP to be available. * Where appropriate only conditionally compile SBCL-specific code and if any build the corresponding files for ECL. * //lisp/klatre: Use the standard condition parse-error for all implementations except SBCL in try-parse-integer. * //3p/lisp/ironclad: disable SBCL assembly optimization hack for all other platforms as it may interfere with compilation. * //3p/lisp/trivial-mimes: prevent call to asdf function by substituting it out of the source since it always errors out in ECL and we hardcode the correct path elsewhere anyways. As it stands ECL still suffers from a very weird problem which happens when compiling postmodern and moptilities: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/651 Change-Id: I0285924f92ac154126b4c42145073c3fb33702ed Reviewed-on: https://cl.tvl.fyi/c/depot/+/3297 Tested-by: BuildkiteCI Reviewed-by: tazjin <mail@tazj.in> Reviewed-by: eta <tvl@eta.st>
2021-08-09 02:47:07 +02:00
(#+sbcl sb-int:simple-parse-error
#-sbcl parse-error (_) (declare (ignore _)) nil)))
;;;
;;; Function utilities
;;;
(defun partial (f &rest args)
"Return a function that calls F with ARGS prepended to any remaining
arguments"
(lambda (&rest more-args)
(apply f (append args more-args))))