merge prick_functions and prick_macros into one lisp package
This commit is contained in:
@@ -1,4 +1,4 @@
|
|||||||
;;; prick_macros.lisp - 2026-03-07
|
;;; prick.lisp - 2026-03-26
|
||||||
|
|
||||||
;; Copyright (C) 2026 Aryadev Chavali
|
;; Copyright (C) 2026 Aryadev Chavali
|
||||||
|
|
||||||
@@ -12,8 +12,9 @@
|
|||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
|
||||||
;; A set of useful macros I've designed for use in Common Lisp. There are a
|
;; A set of useful functions, macros, and types that I've implemented enough
|
||||||
;; couple ways you may utilise this file:
|
;; times to require their own prick library. There are a couple ways you can
|
||||||
|
;; use this file:
|
||||||
;; 1) Copy file and load it in your main.lisp. Ensure your code is in a
|
;; 1) Copy file and load it in your main.lisp. Ensure your code is in a
|
||||||
;; separate package for namespacing purposes.
|
;; separate package for namespacing purposes.
|
||||||
;; 2) Copy file, move `defpackage' form into your packages.lisp, and add this
|
;; 2) Copy file, move `defpackage' form into your packages.lisp, and add this
|
||||||
@@ -21,7 +22,7 @@
|
|||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(defpackage #:prick.macros
|
(defpackage #:prick
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
(:export
|
(:export
|
||||||
;; Threading macros
|
;; Threading macros
|
||||||
@@ -29,9 +30,11 @@
|
|||||||
;; Anonymous function constructors utilising threading macros
|
;; Anonymous function constructors utilising threading macros
|
||||||
:$-> :$>> :$<>
|
:$-> :$>> :$<>
|
||||||
;; Strictly typed functions and function calling
|
;; Strictly typed functions and function calling
|
||||||
:-> :fn :call-rev))
|
:-> :fn :call-rev
|
||||||
|
;; General purpose functions
|
||||||
|
:range :split :remove-at-indices :rev-map))
|
||||||
|
|
||||||
(in-package #:prick.macros)
|
(in-package #:prick)
|
||||||
|
|
||||||
(defun --transform-symbols-to-unary (form)
|
(defun --transform-symbols-to-unary (form)
|
||||||
(if (symbolp form)
|
(if (symbolp form)
|
||||||
@@ -57,11 +60,8 @@ unary functions i.e.
|
|||||||
(let ((x (c x)))
|
(let ((x (c x)))
|
||||||
x)))"
|
x)))"
|
||||||
`(let* ,(loop :for i :from 1
|
`(let* ,(loop :for i :from 1
|
||||||
:for f :in (cdr forms)
|
:for func :in (cdr forms)
|
||||||
:for canon-f := (if (symbolp f)
|
:collect (list placeholder (--transform-symbols-to-unary func)) :into xs
|
||||||
(list f placeholder)
|
|
||||||
f)
|
|
||||||
:collect `(,placeholder ,canon-f) :into xs
|
|
||||||
:finally (return (cons `(,placeholder ,(car forms)) xs)))
|
:finally (return (cons `(,placeholder ,(car forms)) xs)))
|
||||||
,placeholder))
|
,placeholder))
|
||||||
|
|
||||||
@@ -76,8 +76,7 @@ Includes transformer where symbols (after the first form) are considered unary
|
|||||||
functions i.e. (->> a b c) => (c (b a))"
|
functions i.e. (->> a b c) => (c (b a))"
|
||||||
(loop :with acc := (car forms)
|
(loop :with acc := (car forms)
|
||||||
:for func :in (cdr forms)
|
:for func :in (cdr forms)
|
||||||
:for canon-func := (--transform-symbols-to-unary func)
|
:do (setq acc (append (--transform-symbols-to-unary func) (list acc)))
|
||||||
:do (setq acc (append canon-func (list acc)))
|
|
||||||
:finally (return acc)))
|
:finally (return acc)))
|
||||||
|
|
||||||
(defmacro -<> (&rest forms)
|
(defmacro -<> (&rest forms)
|
||||||
@@ -91,7 +90,7 @@ Includes transformer where symbols (after the first form) are considered unary
|
|||||||
functions i.e. (-<> a b c) => (c (b a))"
|
functions i.e. (-<> a b c) => (c (b a))"
|
||||||
(loop :with acc = (car forms)
|
(loop :with acc = (car forms)
|
||||||
:for func :in (cdr forms)
|
:for func :in (cdr forms)
|
||||||
:for canon-func := (if (symbolp func) (list func) func)
|
:for canon-func := (--transform-symbols-to-unary func)
|
||||||
:do (push acc (cdr canon-func))
|
:do (push acc (cdr canon-func))
|
||||||
:do (setq acc canon-func)
|
:do (setq acc canon-func)
|
||||||
:finally (return acc)))
|
:finally (return acc)))
|
||||||
@@ -136,3 +135,50 @@ i.e. (call-rev f arg-1 ... arg-n) => (f arg-n ... arg-1).
|
|||||||
|
|
||||||
Interacts well with the threading macro family (`-->', `->>', `-<>')"
|
Interacts well with the threading macro family (`-->', `->>', `-<>')"
|
||||||
`(,func-name ,@(reverse arguments)))
|
`(,func-name ,@(reverse arguments)))
|
||||||
|
|
||||||
|
(fn range (&key (start 0) (end 0) (step 1))
|
||||||
|
(-> (&key (:start fixnum) (:end fixnum) (:step fixnum)) list)
|
||||||
|
"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)))
|
||||||
|
|
||||||
|
(fn split (n lst) (-> (fixnum sequence) (values sequence sequence))
|
||||||
|
"Return two sequences of `lst': lst[0..`n'] and lst[`n'..]."
|
||||||
|
(values (subseq lst 0 n)
|
||||||
|
(subseq lst n)))
|
||||||
|
|
||||||
|
(fn remove-at-indices (indices lst) (-> (list sequence) list)
|
||||||
|
"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)."
|
||||||
|
(loop :for i :from 0 :to (1- (length lst))
|
||||||
|
:for item :in (coerce lst 'list)
|
||||||
|
:if (not (member i indices))
|
||||||
|
:collect item))
|
||||||
|
|
||||||
|
(fn rev-map (indicator lst &key (key-eq #'eq))
|
||||||
|
(-> (function list &key (:key-eq function)) list)
|
||||||
|
"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)))
|
||||||
@@ -1,79 +0,0 @@
|
|||||||
;;; 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 <https://unlicense.org/>.
|
|
||||||
|
|
||||||
;;; 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 sequence lst))
|
|
||||||
(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)))
|
|
||||||
Reference in New Issue
Block a user