Is it possible to reimplement "apply" in Scheme? - scheme

If I encounter a primitive procedure, do I always use the underlying scheme apply?
Assuming I do so, how would I re-implement apply for the scheme interpreter to interpret itself?
(define apply-1
(lambda (proc args)
(cond ((primitive? proc)
(apply proc args)) <-- How would I reimplement this
((eq? (car proc) 'closure)
(eval (cadr (cadr proc))
(bind (car (cdr proc)) args (caddr proc))))
(else error))))

Primitive-apply is the glue between how a primitive in your interpreter is implemented with the underlying implementation. Using hosts apply to apply primitives that are indeed procedures in the host system is a trick. You cannot make a host apply but you can make a interpreter primitive-apply differently that does less or supports other ways to package primitives. Eg.
;; define representations for primitives
(define prim-cons (list 'cons)) ; system unique
(define prim-car (list 'car))
...
;; define primitive?
(define (primitive? proc)
(or (eq? proc prim-cons)
(eq? proc prim-car)
...))
;; define primitive apply
(define (primitive-apply proc args)
(cond ((eq? proc prim-cons) args)
((eq? proc prim-car) (caar args))
...))
;; boot environment
(define primitive-environment
(list (cons #t prim-true)
(cons #f prim-false)
(cons '() prim-null)
(cons 'cons prim-cons)
(cond 'car prim-car)
...))
The fact is using apply is just a simplification since the actual primitive procedure is the resolved object. It doesn't always have to be like that. Imagine we try to optimize it a little:
;; define representations for primitives
(define prim-cons (list 'cons)) ; system unique
(define prim-car (list 'car))
;; make a list of primitives and their implementation
(define primitives
(list (cons prim-cons values)
(cons prim-car caar)))
;; define primitive?
(define (primitive? proc)
(assq proc primitives))
;; make apply-primitive
(define (apply-primitive proc args)
((cdr (primitive? proc)) args))
Still lot of boilerplate.. Why not move the whole primitive-list into the environment.
;; make tags
(define *primitive* (list 'primitive))
(define *constant* (list 'constant))
;; make a list of primitives and their implementation
(define boot-env
(list (list* 'cons *primitive* values)
(list* 'cons *primitive* caar)
...
(list* #f *constant* #f)
(list* #t *constant* #t)))
;; verify type
(define (is-type? x type)
(and (pair? proc)
(eq? (car proc) type)))
;; define primitive?
(define (primitive? proc)
(is-type proc *primitive*))
(define (constant? x)
(is-type x *constant*))
;; make apply-primitive
(define (apply-primitive proc args)
((cdr proc) args))
Now. For compound procedures we just have similar tag. eval itself become very small since you can even have *special-form* in your environment that does something similar making your eval just a case analysis between the types of values you eval and not special cases.
One of my thought about apply was that I wanted my apply to be the one called when you call the procedure apply from the interpreter. You can make use of apply, but apply actually needs to be handled by apply as well. You'll meet the same weird thing when you try to apply eval too.

Related

General memoization in Scheme

i have been assigned homework to make a general memoization procedure in scheme, so far it works on procedures that take one argument, but fail on what it seems to be the last argument when provided with more than 1. It also fails to memoize procedures that take no arguments.
Any help would be greatly appreciated.
(define mem
(lambda (mem-it func)
(let ((table (make-table) )(func-store func))
(cond
((equal? mem-it 'memoize)
(lambda args
(if (null? args)
func
(let ((prev (lookup args table)))
(or prev
(let ((result (apply func args)))
(insert! args result table)
result))))))
((equal? mem-it 'unmemoize)
(func-store))
(else (display "No Such command"))))))
This is what i have so far
(define (test-proc . args)
(display "computing test-proc of ")
(display args)
(newline)
(if (null? args)
0
(+ (expt (- 42 (car args)) 2)
(apply test-proc (cdr args)))))
And here is the test procedure provided
The error occurs when i try to run the following test
(set! test-proc (mem 'memoize test-proc))
(test-proc 40 41 42 43 44)
Here are the other procedures used
(define (make-table)
(list '*table*))
(define (lookup key table)
(let ((record (assoc key (cdr table))))
(and record (cdr record))))
(define (insert! key value table)
(let ((record (assoc key (cdr table))))
(if record
(set-cdr! record value)
(set-cdr! table
(cons (cons key value) (cdr table))))))
Your memoizarion procedure has a feature where it returns the implementation procedure when no arguments are passed:
((mem 'memoize test-proc)) ; ==> test-proc
The base case of your test procedure will never hit because of this feature thus for (test-proc 1) you can substitute it with the expression (+ 1681 test-proc) which will signal an error since test-proc is not a number.
It's better to use unique magic values:
(define +GET-PROC+ (list "get-proc"))
(test-proc +GET-PROC+) ; ==> original-test-proc
Since we are making a list it's is eq? that data only. In R6RS you can refrain from exporting so that code that uses memoization doesn't really have access to mess with it. All lists that look like it eg ("get-proc") won't be eq? so it can be used as an argument without getting the original procedure.
Since you are not using a standard hash procedure from (rnrs hashtables) or SRFI-69 it's not possible for me to check it but since you are using a list as key your hashtable must use equal? as test. This is often a source of frustration when using hash tables in most lisps.

Scheme Argument Checker Error-handling

I'm fairly new to Scheme programming and was wondering how I can add some error checkers in this program. I would like it to check if the user types in more than one parameter and if the user does I would like it to say that its an error.
(define (thirds lst)
(cond ((or (null? lst) (null? (cdr lst))) lst)
((null? (cddr lst)) (list (car lst)))
(else (cons (car lst)
(thirds (cdddr lst))))))
The Scheme interpreter should check this automatically. You only need to do your own checking of the number of arguments if you define the procedure to take spread arguments, i.e.
(define (thirds . args)
...)
You would normally only do this if the procedure takes a variable number of arguments. For procedures with static arguments, just list them in the definition and let the interpreter do the checking for you.
If you really want to detect this yourself, you can do:
(define (thirds . args)
(if (= (length args) 1)
(let ((lst (car args)))
(cond ... ; all the rest of your code
))
(display "Oh that's an error")))
So, using your definition of thirds in #!racket (the language) and trying to use it like this:
(thirds '(a b c) '(d e f))
thirds: arity mismatch;
the expected number of arguments does not match the given number
expected: 1
given: 2
arguments...:
'(a b c)
'(d e f)
context...:
/usr/share/racket/collects/racket/private/misc.rkt:87:7
As you can see all computation stops since I have given a one argument procedure two arguments. It's a contract violation and it throws an exception.
It's perfectly possible to make handlers:
(with-handlers ([exn:fail:contract?
(λ (e) (displayln "got a contract error"))])
(thirds '(1 2 3) '(4 5 6)))
; prints "got a contract error"

How to implement call-with-values to match the values example in R5RS

R5RS says...
Values might be defined as follows:
(define (values . things)
(call-with-current-continuation
(lambda (cont) (apply cont things))))
It doesn’t, however, say how call-with-values might be implemented if values were implemented this way. So, if values is implemented this way, how would call-with-values be implemented?
(This came up because I was trying to get some code that used call-with-values to work with TinyScheme, which doesn’t support it. I managed by faking values and call-with-values with lists, but—when I saw this in R5RS—I wanted to know if this might be a better workaround.)
Kent Dybvig defines call/cc, values and call-with-values thusly:
(define call/cc call/cc)
(define values #f)
(define call-with-values #f)
(let ((magic (cons 'multiple 'values)))
(define magic?
(lambda (x)
(and (pair? x) (eq? (car x) magic))))
(set! call/cc
(let ((primitive-call/cc call/cc))
(lambda (p)
(primitive-call/cc
(lambda (k)
(p (lambda args
(k (apply values args)))))))))
(set! values
(lambda args
(if (and (not (null? args)) (null? (cdr args)))
(car args)
(cons magic args))))
(set! call-with-values
(lambda (producer consumer)
(let ((x (producer)))
(if (magic? x)
(apply consumer (cdr x))
(consumer x))))))
The short answer is: You can't
The nifty implementation of values does not change the fact that there is no way to implement the other procedures if you don't have any of them to poke at the values. If you had one way to peek then you could implement the others with that.
(+ (values 4 5))
(apply + (values 4 5))
Doesn't work and that's why you need those other primitives.
When that said. There is no difference between returning more values and returning lists with values since the difference is optimization. You could make a macro that treats both of them as a binding and then the way you use them would be the same. The difference in performance is some pointer jumping and some consing which is reasonable fast for any lisp implementation. Heres a minimalistic implementation that will work given your code is correct:
(define values list)
(define (call-with-values producer consumer)
(apply consumer (producer)))

Scheme evaluation order standard

I've got a program I'm writing for a class to substitute the left-most occurrence of a variable with a new variable. (It actually allows you to provide an equivalence relation yourself, as well). The thing is, in Chez Scheme 8.2, this substitutes the right-most occurrence, if the left most is inside a list. We use a server running some version of scheme (I'm not sure which version), and on the server it substitutes, correctly, the left-most occurrence. Below is the code:
(define subst-leftmost
(lambda (new old ls proc)
(let ([keep-going? #t])
(letrec ([helper
(lambda (ls)
(cond [(null? ls) ls]
[(or (pair? (car ls)) (null? (car ls)))
(cons (helper (car ls)) (helper (cdr ls)))]
[(and keep-going? (proc old (car ls)))
(set! keep-going? #f) (cons new (cdr ls))]
[else (cons (car ls) (helper (cdr ls)))]))]) (helper ls))))
This is called like so: (subst-leftmost 'x 'a '(d b c (a) b a) eq?) which should produce the output (d b c (x) b a), and does on the server. In Chez scheme, however, it produces (d b c (a) b x). I think the difference is due to the line
[(or (pair? (car ls)) (null? (car ls)))
(cons (helper (car ls)) (helper (cdr ls)))]
evaluating the helper of the car and the helper of the cdr in a not-set order.
My question is this: Which version of scheme is following the standard, and how can I modify my code so that it works correctly in both versions?
(I've already talked to my professor about this. He's going to address the class about it on Monday, once he can think about it some, but I'm curious. I also already got the full points for the assignment, so don't worry about the ethics of helping me, in that regard.)
There isn't any, sorry. Here's the relevant legalese. Use LETs or LET* if you need to evaluate sub-expressions in a particular order.
Scheme guarantees no specific order (as Cirno has said). If your code has no side-effects, this doesn't matter.
However, your code is side-effecting (because of the set! to an outside variable), so, you have some choices:
Use Racket (which is committed to using left-to-right order, last time I talked to a Racket dev)
Structure your code to remove side-effects, so that your helper function doesn't change any variable or state outside it
Use appropriate lets to ensure the ordering you need (as Cirno suggested); in particular, change (cons (helper (car ls)) (helper (cdr ls))) to:
(let ((depth-first (helper (car ls))))
(cons depth-first (helper (cdr ls))))

Using AND with the apply function in Scheme

Why doesn't the following work?
(apply and (list #t #t #f))
While the following works just fine.
(apply + (list 1 3 2))
This seems to be the case in both R5RS and R6RS?
and isn't a normal function because it will only evaluate as few arguments as it needs, to know whether the result is true or false. For example, if the first argument is false, then no matter what the other arguments are, the result has to be false so it won't evaluate the other arguments. If and were a normal function, all of its arguments would be evaluated first, so and was made a special keyword which is why it cannot be passed as a variable.
(define and-l (lambda x
(if (null? x)
#t
(if (car x) (apply and-l (cdr x)) #f))))
pleas notice that this is lambda variadic!
apply example (and-l #t #t #f)
or you can use it via apply procedure(as was asked)
for example (apply and-l (list #t #t #f))
both options are ok...
and is actually a macro, whose definition is outlined in R5RS chapter 4. The notation "library syntax" on that page really means it is implemented as a macro.
Section 7.3, Derived expression types gives a possible definition of the and macro:
(define-syntax and
(syntax-rules ()
((and) #t)
((and test) test)
((and test1 test2 ...)
(if test1 (and test2 ...) #f))))
Given this defintion, it is not possible to use and as a function argument to apply.
In the Scheme dialect MIT/GNU Scheme, you can use the function boolean/and instead of the special form and.
(apply boolean/and (list #t #t #f)) ;Value: #f
Also, for the record, I couldn’t find any equivalent function in Guile Scheme’s procedure index.
(Other answers have already explained why the special form and won’t work, and shown how to write your own replacement function if there isn’t already such a function in your dialect.)
If you REALLY wanted to have a function pointer to a function that does and, and you don't mind behavior different than the "real" and, then this would work:
(define and-l (lambda (a b) (and a b)))
Which you can apply like this:
(apply and-l (list #t #f))
The two caveats are:
All of the args get evaluated, in violation of the definition of and, which should have shortcutting behavior.
Only two arguments are allowed.
I've stumbled across the same problem and found an elegant solution in Racket.
Since the problem is that "and" is a macro and not a function in order to prevent the evaluation of all its arguments, I've read a little on "lazy racket" and found that "and" is a function in that language. So I came up with the following solution where I just import the lazy and as "lazy-and":
#lang racket
(require (only-in lazy [and lazy-and]))
(define (mm)
(map number? '(1 2 3)))
(printf "~a -> ~a\n" (mm) (apply lazy-and (mm)))
which yields
(#t #t #t) -> #t
try this:
(define list-and (lambda (args) (and (car args) (list-and (cdr args)))))
then you can use apply to list-and!
You could also use
(define (andApply lBoo)
(if (not (car lBoo)) #f
(if (= 1(length lBoo)) (car lBoo)
(andApply (cdr lBoo)))))
I also bump into this problem playing with PLT-Scheme 372, I have digged into the behavior of and-syntax, and figure out the follow code which works just as if one would intuitively expect (apply and lst) to return, but I haven't done exaustive test.
(define (list-and lst)
(cond
((null? lst) '())
((not (pair? lst)) (and lst))
((eq? (length lst) 1) (car lst))
(else
(and (car lst)
(list-and (cdr lst))))
)
)
Welcome to DrScheme, version 372 [3m].
Language: Textual (MzScheme, includes R5RS).
> (eq? (and '()) (list-and '()))
#t
> (eq? (and '#f) (list-and (list '#f)))
#t
> (eq? (and 'a) (list-and (list 'a)))
#t
> (eq? (and 'a 'b) (list-and (list 'a 'b)))
#t
> (eq? (and 'a 'b '()) (list-and (list 'a 'b '())))
#t
> (eq? (and 'a 'b '#t) (list-and (list 'a 'b '#t)))
#t
> (eq? (and 'a 'b '#f) (list-and (list 'a 'b '#f)))
#t
I've also figured out another mind-trapping workaround. I call it mind-trapping because at first I don't know how to turn it into a function... Here it is (only a demo of my intuitive idea):
Welcome to DrScheme, version 372 [3m].
Language: Textual (MzScheme, includes R5RS).
> (eval (cons 'and (list ''#f ''#f ''#t)))
#f
> (eval (cons 'and (list ''a ''b ''c)))
c
But later I asked a question and got the answer here: Is it possible to generate (quote (quote var)) or ''var dynamically? . With this answer one can easily turn the above idea into a function.
(define (my-quote lst)
(map (lambda (x) `'',x) lst))
(cons 'and (my-quote (list 'a 'b 'c)))
=> '(and ''a ''b ''c)

Resources