(module functional mzscheme (define (partiall fun val) #| (partiall fun val) partially applies fun to val, val fixing the left-most argument to fun |# (lambda args (apply fun (append args (list val))))) (define (partialr fun val) #| (partialr fun val) partially applies fun to val, val fixing the right most argument to fun |# (lambda args (apply fun (cons val args)))) (define (make-arg-list null-symbol curried-args partial-list) #| (make-arg-list null-symbol curried-args partial-list) constructs the argument list to be passed to a function which has been partially evaluated. PARTIAL-LIST is the list of arguments passed to the PARTIALX procedure where some elements are equal to NULL-SYMBOL, indicating that they should be replaced by CURRIED-ARGS in the same order. NULL-SYMBOL is either a symbol or false indicating which arguments in PARTIAL-LIST are provided by the partially applied function. CURRIED-ARGS are the arguments to put in the slots of PARTIAL-LIST see also: PARTIALX|# (let loop ((out '()) (rst-c-args curried-args) (rst-prt partial-list)) (cond ((null? rst-prt) (reverse out)) ((eq? (car rst-prt) null-symbol) (loop (cons (car rst-c-args) out) (cdr rst-c-args) (cdr rst-prt))) (else (loop (cons (car rst-prt) out) rst-c-args (cdr rst-prt)))))) (define (symbol-or-false? p) (or (symbol? p) (not p))) (define (partialx . args) #| (partialx fun arg-or#f ...) partially applies fun to the arguments, leaving "unfixed" arguments which are false. (partialx sym fun arg-or-sym ...) partially applies fun to the arguments leaving "unfixed" all the values equal to sim. Example: (map (partialx + 10 #f) (list 0 1 2 3 4)) -> (10 11 12 13 14) (map (partialx 'tail string-append "dogs" 'tail) (list " are awesome" "are not awesome")) -> ("dogs are awesome" "dogs are not awesome") For convenience, a nickname is provided via PLX, which is just this function. |# (cond ((procedure? (car args)) (apply partialx (cons #f args))) ((symbol-or-false? (car args)) (let ((nuller (car args)) (fun (cadr args)) (rest (cddr args))) (lambda lamargs (apply fun (make-arg-list nuller lamargs rest))))))) (define plx partialx) (define (fix f arg0 . args) #| (fix f arg0) Repeatedly applies f to arg (and subsequent results) until two successive results are equal by "eq?". (fix f arg0 predicate) like above but uses PREDICATE for equality. |# (cond ((= 0 (length args)) (fix-helper f arg0 eq?)) ((= 1 (length args)) (fix-helper f arg0 (car args))) (else (error "Fix expects at most 3 arguments")))) (define (fix-helper f arg0 pred) (let loop ((arg arg0)) (let ((argn (f arg))) (if (pred argn arg) argn (loop argn))))) (define (map-apply f list) #| (map-apply f list) equivalent to (map (plx apply f #f) list) |# (map (lambda (arguments) (apply f arguments)) list)) (provide partiall partialr partialx plx map-apply fix))