diff --git a/prick_functions.lisp b/prick_functions.lisp new file mode 100644 index 0000000..a551b64 --- /dev/null +++ b/prick_functions.lisp @@ -0,0 +1,79 @@ +;;; prick_functions.lisp - 2026-03-07 + +;; Copyright (C) 2026 Aryadev Chavali + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Unlicense +;; for details. + +;; You may distribute and modify this code under the terms of the +;; Unlicense, which you should have received a copy of along with this +;; program. If not, please go to . + +;;; Commentary: + +;; A set of useful functions that I've designed for use in Common Lisp. There +;; are a couple ways you may utilise this file: +;; 1) Copy file and load it in your main.lisp. Ensure your code is in a +;; separate package for namespacing purposes. +;; 2) Copy file, move `defpackage' form into your packages.lisp, and add this +;; file as a component in your ASDF system definition. + +;;; Code: + +(defpackage #:prick.functions + (:use :cl) + (:export + :range :split :remove-at-indices :rev-map)) + +(in-package #:prick.functions) + +(defun range (&key (start 0) (end 0) (step 1)) + "Return list of integers in interval [`start', `end'). If `step' is not 1, +then each member is `step' distance apart i.e. {`start' + (n * `step') | n from 0 +till END}. + +If END is not given, return interval [0, START)." + (declare (type integer start end step)) + (if (< end start) + (error (format nil "~a < ~a" end start)) + (loop :for i :from start :to (1- end) :by step + :collect i))) + +(defun split (n lst) + "Return two sequences of `lst': lst[0..`n'] and lst[`n'..]." + (declare (type integer n) + (type sequence lst)) + (values (subseq lst 0 n) + (subseq lst n))) + +(defun remove-at-indices (indices lst) + "Return `lst' with all items at an index specified in `indices' removed. + +i.e. (remove-at-indices indices (l-1...l-m)) => (l_x where x is not in indices)." + (declare (type list indices) + (type lst sequence)) + (loop :for i :from 0 :to (1- (length lst)) + :for item :in (coerce lst 'list) + :if (not (member i indices)) + :collect item)) + +(defun rev-map (indicator lst &key (key-eq #'eq)) + "Given some sequence of elements `lst' and a function `indicator': `lst' -> A for +some set A, return the reverse mapping of `indicator' on `lst' + +i.e. Return `indicator'^-1: A -> {`lst'}. + +`key-eq' is used for testing if any two elements of A are equivalent." + (declare (type (function (t) t) indicator) + (type sequence lst) + (type (function (t t) boolean) key-eq)) + (loop :with assoc-list := nil + :for element :in (coerce lst 'list) + :for key := (funcall indicator element) + :if (assoc key assoc-list :test key-eq) + :do (push element (cdr (assoc key assoc-list :test key-eq))) + :else + :do (setq assoc-list (cons (list key element) assoc-list)) + :finally (return assoc-list))) diff --git a/prick_macros.lisp b/prick_macros.lisp new file mode 100644 index 0000000..c452e60 --- /dev/null +++ b/prick_macros.lisp @@ -0,0 +1,138 @@ +;;; prick_macros.lisp - 2026-03-07 + +;; Copyright (C) 2026 Aryadev Chavali + +;; This program is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +;; FOR A PARTICULAR PURPOSE. See the Unlicense for details. + +;; You may distribute and modify this code under the terms of the Unlicense, +;; which you should have received a copy of along with this program. If not, +;; please go to . + +;;; Commentary: + +;; A set of useful macros I've designed for use in Common Lisp. There are a +;; couple ways you may utilise this file: +;; 1) Copy file and load it in your main.lisp. Ensure your code is in a +;; separate package for namespacing purposes. +;; 2) Copy file, move `defpackage' form into your packages.lisp, and add this +;; file as a component in your ASDF system definition. + +;;; Code: + +(defpackage #:prick.macros + (:use :cl) + (:export + ;; Threading macros + :--> :->> :-<> + ;; Anonymous function constructors utilising threading macros + :$-> :$>> :$<> + ;; Strictly typed functions and function calling + :-> :fn :call-rev)) + +(in-package #:prick-macros) + +(defun --transform-symbols-to-unary (form) + (if (symbolp form) + (list form) + form)) + +(defmacro --> (placeholder &body forms) + "Fold `forms' recursively such that, given consecutive forms, the first form is +lexically bound to `placeholder' for the second form. Evaluate the form +generated after folding has completed. + +(--> x (a1 a2...) (b1 b2...) (c1 c2...)) => +(let ((x (a1 a2 ...))) + (let ((x (b1 b2 ...))) + (let ((x (c1 c2 ...))) + x))) + +Includes transformer where symbols (after the first form) are considered +unary functions i.e. +(--> x a b c) => +(let ((x a)) + (let ((x (b x))) + (let ((x (c x))) + x)))" + `(let* ,(loop :for i :from 1 + :for f :in (cdr forms) + :for canon-f := (if (symbolp f) + (list f placeholder) + f) + :collect `(,placeholder ,canon-f) :into xs + :finally (return (cons `(,placeholder ,(car forms)) xs))) + ,placeholder)) + +(defmacro ->> (&rest forms) + "Fold FORMS recursively such that, given consecutive forms, the first form +becomes the last argument of the second form. Evaluate the form generated after +folding has completed. + +(->> (a1 ... al) (b1 ... bm) (c1 ... cm)) => (c1 ... cm (b1 ... bn (a1 ... al))) + +Includes transformer where symbols (after the first form) are considered unary +functions i.e. (->> a b c) => (c (b a))" + (loop :with acc := (car forms) + :for func :in (cdr forms) + :for canon-func := (--transform-symbols-to-unary func) + :do (setq acc (append canon-func (list acc))) + :finally (return acc))) + +(defmacro -<> (&rest forms) + "Fold FORMS recursively such that, given consecutive forms, the first form +becomes the first argument of the second form. Evaluate the form generated +after folding has completed. + +(-<> (a1 ... al) (b1 ... bm) (c1 ... cn)) => (c1 (b1 (a1 ... al) ... bm) ... cn) + +Includes transformer where symbols (after the first form) are considered unary +functions i.e. (-<> a b c) => (c (b a))" + (loop :with acc = (car forms) + :for func :in (cdr forms) + :for canon-func := (if (symbolp func) (list func) func) + :do (push acc (cdr canon-func)) + :do (setq acc canon-func) + :finally (return acc))) + +(defmacro $-> (capture &rest forms) + "Return an anonymous unary function (with argument named `capture') that feeds +its argument into a `-->' chain composed of `forms'. Note that `capture' is +also used as the placeholder value in said `-->' chain." + `(lambda (,capture) + (--> ,capture ,capture ,@forms))) + +(defmacro $>> (&rest forms) + "Return an anonymous unary function that feeds its argument into a `->>' chain +composed of `forms'." + (let ((capture (gensym))) + `(lambda (,capture) + (->> ,capture ,@forms)))) + +(defmacro $<> (&rest forms) + "Return an anonymous unary function that feeds its argument into a `-<>' chain +composed of `forms'." + (let ((capture (gensym))) + `(lambda (,capture) + (-<> ,capture ,@forms)))) + +(deftype -> (args result) + "Simple type alias for functions." + `(function ,args ,result)) + +(defmacro fn (name lambda-list type &body body) + "Construct a function `name' that takes arguments `lambda-list' with body +`body'. `type' is used as the type of the function constructed via a declaim." + `(progn + (declaim (ftype ,type ,name)) + (defun ,name ,lambda-list + ,@body))) + +(defmacro call-rev (func-name &rest arguments) + "Call function `func-name' with `arguments' reversed. + +i.e. (call-rev f arg-1 ... arg-n) => (f arg-n ... arg-1). + +Interacts well with the threading macro family (`-->', `->>', `-<>')" + `(,func-name ,@(reverse arguments)))