Compare commits

..

12 Commits

Author SHA1 Message Date
903c0aaced chore: fix $PATH 2023-04-13 13:42:20 -07:00
3f27d70514 chore: upgrade install-nix-action 2023-04-13 13:40:08 -07:00
a3724362b6 chore: fiddle 2023-04-13 13:38:18 -07:00
6c2d96f0c6 chore: fiddle 2023-04-13 13:36:22 -07:00
4eab1df341 chore: fiddle 2023-04-13 13:35:15 -07:00
555b621974 chore: (bump) 2023-04-13 13:33:39 -07:00
46b1b66291 chore: (bump) 2023-04-13 13:33:25 -07:00
fde90ed5ff chore: (bump) 2023-04-13 13:30:56 -07:00
7309c59ca8 chore: try fixing github action 2023-04-13 13:29:59 -07:00
821ec9407b chore: (bump) 2023-04-13 09:34:54 -07:00
49358627c2 fix: remove spurious warning in DISJ 2023-04-13 09:29:51 -07:00
9c4d29543b feat: allow over to accept multiple functions and compose them 2023-04-13 09:29:22 -07:00
3 changed files with 41 additions and 5 deletions

View File

@ -22,7 +22,7 @@ jobs:
# Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
- uses: actions/checkout@v2
- uses: cachix/install-nix-action@v15
- uses: cachix/install-nix-action@v19
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@ -34,6 +34,15 @@ jobs:
cd
nix profile install nixpkgs\#sbcl
- name: setup lisp
run: |
set -x
nix profile list
export PATH="$HOME/.nix-profile/bin:$PATH"
echo $PATH
ls ~/.nix-profile/bin
sbcl --quit
command -v sbcl || exit 36
wget 'https://beta.quicklisp.org/quicklisp.lisp'
@ -47,6 +56,7 @@ jobs:
- name: run tests
run: |
export PATH="$HOME/.nix-profile/bin:$PATH"
cd "$GITHUB_WORKSPACE"
sbcl --disable-debugger --no-userinit \
--load "$HOME/quicklisp/setup.lisp" \

View File

@ -132,6 +132,7 @@
(defmacro disj (&rest fns)
(let ((dat (gensym "dat")))
`(lambda (,dat)
(declare (ignorable ,dat))
(or ,@(mapcar (lambda (fn)
`(funcall ,fn ,dat))
fns)))))
@ -291,10 +292,29 @@
seq
:initial-value ()))))
(defun over (fun &key (result-type 'list))
(let ((fun (functionalize fun)))
(lambda (seq)
(map result-type fun seq))))
(defun over (fun &rest funs)
(let* ((fun (functionalize fun))
(rt-pos (position :result-type funs))
(result-type (cond
((null rt-pos) 'list)
((>= (1+ rt-pos)
(length funs))
(error "invalid result-type"))
(t
(elt funs (1+ rt-pos)))))
(funs (if rt-pos
(append (mapcar #'functionalize
(subseq funs 0 rt-pos))
(mapcar #'functionalize
(subseq funs (+ rt-pos 2))))
(mapcar #'functionalize funs)))
(combined-fun (if funs
(apply #'alexandria:compose fun funs)
fun)))
(lambda (seq &rest seqs)
(if seqs
(apply #'map result-type combined-fun seq seqs)
(map result-type combined-fun seq)))))
(defun denest (&key (result-type 'list))
(lambda (seq)

View File

@ -250,6 +250,12 @@
(5am:is (equalp #(1 2 3)
(funcall (data-lens:over '1+ :result-type 'vector)
'(0 1 2))))
(5am:is (equalp #(2 3 4)
(funcall (data-lens:over '1+ :result-type 'vector '1+)
'(0 1 2))))
(5am:is (equalp #(2 3 4)
(funcall (data-lens:over '1+ '1+ :result-type 'vector)
'(0 1 2))))
(5am:is (equalp #(1 2 3)
(funcall (data-lens:over '1+ :result-type 'vector)
#(0 1 2)))))