From fa683982b7e1a3055ccafd1f822ea4d45befa7eb Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 24 May 2025 07:35:09 +0200 Subject: [PATCH] rapply stuff OK, with rcall and rcurry --- decons.lisp | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/decons.lisp b/decons.lisp index acaeb61..259053f 100644 --- a/decons.lisp +++ b/decons.lisp @@ -8,6 +8,7 @@ #:scalar-p #:tensor #:at #:rapply #:line + #:lg- )) (in-package :decons) @@ -35,7 +36,7 @@ v (remainder (- v d) d))) -;;;; library stuff +;;;; tensor stuff (defgeneric scalar-p (x) (:method (x) t) @@ -60,32 +61,29 @@ (:method (op (a number) (b number)) (funcall op a b))) -;;;; rapply and other recursive stuff +;;;; rapply - recursive application of an operation -(defun rapply (op &rest args) - (if (null (cdr args)) - (rcall op (car args)) - ;(apply #'rapply (lambda (x) (funcall op (car args) x)) (cdr args)) - ;(apply #'rapply (rlambda op (car args)) (cdr args)) - ;(funcall op (car args) (apply #'rapply op (cdr args))) - (rcall2 op (car args) (apply #'rapply op (cdr args))) - )) +(defun rapply (op arg1 &optional arg2) + (if arg2 + (rcall (rcurry op arg1) arg2) + (rcall op arg1))) (defgeneric rcall (op arg) (:method (op arg) (funcall op arg)) (:method (op (arg list)) (mapcar (lambda (i) (rcall op i)) arg))) -(defgeneric rcall2 (op arg1 arg2) - (:method (op arg1 arg2) - (rcall (lambda (j) (funcall op arg1 j)) arg2)) - (:method (op (arg1 list) arg2) - (mapcar (lambda (i) (rcall (lambda (j) (funcall op i j)) arg2)) arg1))) - -(defgeneric rlambda (op arg) +(defgeneric rcurry (op arg) (:method (op arg) (lambda (j) (funcall op arg j))) (:method (op (arg list)) - (lambda (j) (mapcar (lambda (i) (funcall op i j)) arg)))) + (lambda (j) (mapcar (lambda (i) (rapply op i j)) arg)))) + +;;;; logging (printing) functions for debugging purposes + +(defun lg- (&rest args) + (let ((r (apply #'- args))) + (format t "~&(- ~a) = ~a~%" args r) + r)) ;;;; parameterized functions