cco/decons
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

rapply basically working

Browse source
This commit is contained in:
Helmut Merz 2025-05-23 10:24:29 +02:00
parent d3417cf94a
commit 2ce2ca18f6
2 changed files with 11 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
decons.lisp
View file

@ -63,13 +63,17 @@
;;;; rapply and other recursive stuff ;;;; rapply and other recursive stuff
(defun rapply (op &rest args) (defun rapply (op &rest args)
(rcall op (car args))) (if (null (cadr args))
(rcall op (car args))
(apply #'rapply (lambda (x) (funcall op (car args) x)) (cdr args))
))
(defgeneric rcall (op arg) (defgeneric rcall (op arg)
(:method (op a) (funcall op a)) (:method (op arg) (funcall op arg))
) (:method (op (arg list))
(mapcar (lambda (x) (rcall op x)) arg)))
;;;; parameterized functions ;;;; parameterized functions
(defun line (x) (defun line (x)
#'(lambda (theta) (traverse #'+ (cadr theta) (traverse #'* (car theta) x)))) #'(lambda (theta) (rapply #'+ (cadr theta) (rapply #'* (car theta) x))))

3
test-decons.lisp
View file

@ -38,6 +38,9 @@
(deftest test-rapply () (deftest test-rapply ()
(== (decons:rapply #'1+ 7) 8) (== (decons:rapply #'1+ 7) 8)
(== (decons:rapply #'1+ '(2 3)) '(3 4))
(== (decons:rapply #'+ 2 3) 5)
(== (decons:rapply #'+ 3 '(4 5)) '(7 8))
) )
(deftest test-line () (deftest test-line ()