Scheme: Return a function?

Question

I'm trying to create a function that mimics the "adda" behavior of car and cdr which I can pass any string of 'a's and 'd's. The idea is to return a function which then executes on the list that follows. A call to this function might look like:

((cxr "dd") '(1 2 3))

I've incrementally built up to where I think it should be working, first by creating a letrec that returns the correct string of car and cdr. Then moved the body of the letrec to the body of a lambda inside a define.

(define (cxr cmdString)  ;named function to call
    (lambda (X)          ;beginning of un-named function to return
        (                   
            (cond
                ;if the string passed in is empty, return the arguments to the second function
                ((= 0 (string-length cmdString)) 'X)

                ;if its an 'a', add a call to car to the list and call the function again with a shorter command string.
                ((char=? #\a (string-ref cmdString 0)) (list (quote car) (cxr (substring cmdString 1 (string-length cmdString))))) 

                ;if its a 'd', add a call to cdr to the list and call the function again with a shorter command string.
                ((char=? #\d (string-ref cmdString 0)) (list (quote cdr) (cxr (substring cmdString 1 (string-length cmdString))))) 
            )
        )
    )
)

((cxr "a") '(1 2 3)) ;call the function

Using Repl.it, I get an awful error message that makes no sense to me. I've finagled it a bit to get it to work a different way, but I want to know what I'm doing wrong.

Letrec I built from, returns the correct string of car and cdr:

(letrec
    (
        (cxr
            (lambda (cmdString)
                (cond
                    ((= 0 (string-length cmdString)) 'X)
                    ((char=? #\a (string-ref cmdString 0)) (list (quote car) (cxr (substring cmdString 1 (string-length cmdString)))))
                    ((char=? #\d (string-ref cmdString 0)) (list (quote cdr) (cxr (substring cmdString 1 (string-length cmdString)))))
                )
            )   
        )
    )
(cxr "daa") ;can change "daa" to any combination of 'd's and 'a's.
)

Finagled version that has the behavior I'm seeking, not very well tested (and kind of ugly):

(define (cxr X)
(list 'lambda '(X) 
    (letrec
        (
            (computecxr
                (lambda (cmdString)
                    (cond
                        ((= 0 (string-length cmdString)) 'X)
                        ((char=? #\a (string-ref cmdString 0)) (list 'car (computecxr (substring cmdString 1 (string-length cmdString)))))
                        ((char=? #\d (string-ref cmdString 0)) (list 'cdr (computecxr (substring cmdString 1 (string-length cmdString)))))
                    )
                )   
            )
        )
        (computecxr X)
    )
)
)

(print (cxr "a"))
((eval (cxr "dd")) '(1 2 3))

Any advice would be helpful. Thank you.

EDIT: Alexis, I don't see the correlation between my question, and the other. I'm not using an if in my program, nor is that the error I'm getting. Could you please explain why you think it's a duplicate?

Answer 1

Ok. Let's take the first attempt in your question, and clean it up a little, with proper indentation and normal ) placement:

(define (cxr cmdString) ; named function to call
  (lambda (X)           ; beginning of un-named function to return
    ((cond
       ; if the string passed in is empty, return the arguments to the second function
       [(= 0 (string-length cmdString)) 'X]

       ; if its an 'a', add a call to car to the list and call the function again with a shorter command string.
       [(char=? #\a (string-ref cmdString 0))
        (list (quote car) (cxr (substring cmdString 1 (string-length cmdString))))]

       ; if its a 'd', add a call to cdr to the list and call the function again with a shorter command string.
       [(char=? #\d (string-ref cmdString 0))
        (list (quote cdr) (cxr (substring cmdString 1 (string-length cmdString))))]))))

((cxr "a") '(1 2 3)) ; call the function

Now it's slightly easier to see the problems. The first problem is a simple paren error, where you wrapped the body of the lambda in a set of parentheses that shouldn't be there. Keep in mind that in scheme, parentheses normally mean a function call. That's why you were getting the application: not a procedure error. Now with that fixed:

(define (cxr cmdString) ; named function to call
  (lambda (X)           ; beginning of un-named function to return
    (cond
      ; if the string passed in is empty, return the arguments to the second function
      [(= 0 (string-length cmdString)) 'X]

      ; if its an 'a', add a call to car to the list and call the function again with a shorter command string.
      [(char=? #\a (string-ref cmdString 0))
       (list (quote car) (cxr (substring cmdString 1 (string-length cmdString))))]

      ; if its a 'd', add a call to cdr to the list and call the function again with a shorter command string.
      [(char=? #\d (string-ref cmdString 0))
       (list (quote cdr) (cxr (substring cmdString 1 (string-length cmdString))))])))

((cxr "a") '(1 2 3)) ; call the function

The code gives the result:

'(car #<procedure>)

It's returning a list with two elements, equivalent to (list 'car #<procedure>). That's probably not what you meant. I'm guessing you wanted it to return the car of the list '(1 2 3), which is 1. So first, write that in a comment:

;; cxr : CmdString -> (ConsTree -> Any)
;; Given a command string containing 'a' and 'd' characters, returns
;; a function that gets the corrosponding element in the cons tree.
;; For example, (cxr "a") should return a function equivalent to car,
;; (cxr "d") should return a function equivalent to cdr, and
;; (cxr "add") should return a function equivalent to caddr.

So now that we've documented what (cxr ...) returns, we can do something with it. We can use it properly in the recursive case. It returns a function that accepts a cons tree, so we can apply it to X, which is our cons tree: ((cxr ...) X). That returns the sub-piece of X corresponding to the rest of the string, which is (cddr X) for the "add" case. So then all you need is to apply car or cdr to that:

; 'a' case
(car ((cxr ...) X))
; 'd' case
(cdr ((cxr ...) X))

In context:

(define (cxr cmdString) ; named function to call
  (lambda (X)           ; beginning of un-named function to return
    (cond
      ; if the string passed in is empty, return the arguments to the second function
      [(= 0 (string-length cmdString)) 'X]

      ; if its an 'a', call car on a recursive call using the rest of the command string.
      [(char=? #\a (string-ref cmdString 0))
       (car ((cxr (substring cmdString 1 (string-length cmdString))) X))]

      ; if its a 'd', call cdr on a recursive call using the rest of the command string.
      [(char=? #\d (string-ref cmdString 0))
       (cdr ((cxr (substring cmdString 1 (string-length cmdString))) X))])))

((cxr "a") '(1 2 3)) ; call the function

Now this gives this error:

car: contract violation
  expected: pair?
  given: 'X

Where did the 'X come from? The base case. We need to fix the base case as well, but that's easy, just use X instead of 'X:

;; cxr : CmdString -> (ConsTree -> Any)
;; Given a command string containing "a" and "d" characters, returns
;; a function that gets the corrosponding element in the cons tree.
;; For example, (cxr "a") should return a function equivalent to car,
;; (cxr "d") should return a function equivalent to cdr, and
;; (cxr "add") should return a function equivalent to caddr.
(define (cxr cmdString) ; named function to call
  (lambda (X)           ; beginning of un-named function to return
    (cond
      ; if the string passed in is empty, return the argument to the second function
      [(= 0 (string-length cmdString)) X]

      ; if its an 'a', call car on a recursive call using the rest of the command string.
      [(char=? #\a (string-ref cmdString 0))
       (car ((cxr (substring cmdString 1 (string-length cmdString))) X))]

      ; if its a 'd', call cdr on a recursive call using the rest of the command string.
      [(char=? #\d (string-ref cmdString 0))
       (cdr ((cxr (substring cmdString 1 (string-length cmdString))) X))])))

Testing it:

> ((cxr "a") '(1 2 3))
1
> ((cxr "d") '(1 2 3))
'(2 3)
> ((cxr "add") '(1 2 3))
3
> ((cxr "adda") '((1 2 3) 4))
3

Update

In the spirit of @Sylwester's compose answer, you can translate this code to use compose instead of (lambda (X) ...), while keeping some of the same structure from your original code:

;; cxr : CmdString -> (ConsTree -> Any)
;; Given a command string containing "a" and "d" characters, returns
;; a function that gets the corrosponding element in the cons tree.
;; For example, (cxr "a") should return a function equivalent to car,
;; (cxr "d") should return a function equivalent to cdr, and
;; (cxr "add") should return a function equivalent to caddr.
(define (cxr cmdString)
  (cond
    ; if the string passed in is empty, return the identity function.
    [(= 0 (string-length cmdString)) identity]

    ; if its an 'a', compose car with a recursive call using the rest of the command string.
    [(char=? #\a (string-ref cmdString 0))
     (compose car (cxr (substring cmdString 1 (string-length cmdString))))]

    ; if its a 'd', compose cdr with a recursive call using the rest of the command string.
    [(char=? #\d (string-ref cmdString 0))
     (compose cdr (cxr (substring cmdString 1 (string-length cmdString))))]))

If you look at the structure, this isn't too different from what you wrote originally. It doesn't have the lambda because it builds up the function using compose, it returns the identity function for the base case instead of the symbol 'X, and for the recursive cases it uses compose where you used list and quote.

Answer 2

The original accessors are not magically generated but usually global bindings that are compositions.

However it is possible to do this. A common procedure called compose is usually something that chains procedures together and that is what is happening here. With compose it's very simple to make cxr and without using eval. A compiler has little chance to optimize code that use eval and there are security issues if somehow the evaled code has elements from user input.

#!r6rs
(import (rnrs)
        (only (srfi :1) fold)
        (only (srfi :13) string-fold-right))

(define compose
  (let* ((apply-1
          (lambda (proc value)
            (proc value)))
         (gen
          (lambda (procs)
            (let ((initial (car procs))
                  (additional (cdr procs)))
              (lambda args
                (fold apply-1
                      (apply initial args)
                      additional))))))
    (lambda procs
      (cond ((null? procs) values)
            ((null? (cdr procs)) (car procs))
            (else (gen (reverse procs)))))))

(define (cxr receipt)
  (define (add-proc char acc)
    (cons (if (eqv? char #\a) car cdr) acc))

  (apply compose
         (string-fold-right add-proc
                            '()
                            receipt)))

;; test
(define test '(1 2 3 4 5 6))
(define my-caddr (cxr "add"))
(define compose-caddr (compose car cdr cdr))

(caddr test)         ; ==> 3
(my-caddr test)      ; ==> 3
(compose-caddr test) ; ==> 3

Answer 3

In your code, a part from syntax errors due to the wrong use of parenthesis, you are trying to build a list, using quote and list, which then must be evaluated to get the result.

But if you want to explore functional programming, you should avoid to think of functions in terms of concrete data structures, like lists. Instead, you should start to think to them as values of the language, exactly like integers and strings, for instance as functions returned by other functions, or expressions that are applied to other expressions since they evaluate to a function.

Here is a possible solution to your problem, written as high-level function, tested with DrRacket:

(define (cxr cmd-string)
  (if (= 0 (string-length cmd-string))
      (lambda (x) x) 
      (let* ((first-char (string-ref cmd-string 0))
             (f (if (char=? first-char #\a) car cdr)))
        (lambda (x) (f ((cxr (substring cmd-string 1 (string-length cmd-string))) x))))))

((cxr "add") '(1 2 3)) ;  => 3

The first test checks if the string is empty, and in this case returns the identity function (that is, the function the returns its argument).

Otherwise, the first character of the string is bound to first-char, then the corresponding function is bound to f (note that car and cdr are the two primitive functions), and finally the value returned is a new function, with a parameter x, that apply f to the result of applying to x the function resulting from the recursive call of cxr.

Added

To see the difference between the functional approach and the "build-a-list-representing-a-function" one, and in particular the different use of the recursion, compare the above function with the following:

(define (mk-cxr cmd-string)
  (define (mk-body string)
    (if (= 0 (string-length string))
        '(x)
        (let* ((first-char (string-ref string 0))
               (operation (if (char=? first-char #\a) 'car 'cdr)))
          (list (cons operation (mk-body (substring string 1 (string-length string))))))))       
  (cons 'lambda (cons '(x) (mk-body cmd-string))))

(mk-cxr "add")   ;  => (lambda (x) (car (cdr (cdr x))))