what am I doing wrong in this scheme stream implementation? - scheme

I'm trying to implement streams for an assignment, and I'm missing something important.
This stream-cons should be creating a pair which is a value and a promise for the cdr (to be evaluated later) ..
(define (str1) (stream-cons 1 2))
However, when then I call (stream-car str1) and it complains "contract violation expected: pair?"
I don't understand why str1 is not a valid pair -- what do I do to make this work?
Rob
#lang racket
(define-syntax delay
(syntax-rules () ((delay expr) (lambda () expr))))
(define (force delayed-obj)
(delayed-obj))
(define-syntax stream-cons
(syntax-rules() ((stream-cons x y)
(cons x (delay y)))))
(define (stream-car stream)
(car stream))
(define (stream-cdr stream)
(force (cdr stream)))
(define the-empty-stream '())
;;;
; TESTS
(define (str1) (stream-cons 1 2))
(stream-car str1)

Your line:
(define (str1) (stream-cons 1 2))
is defining a function called str1 and thus str1 is not a pair. It should read:
(define str1 (stream-cons 1 2))

Related

Why does this expression evaluate to 4 (call/cc)

Sorry this simple continuation example evaluates to 4, but I could not figure out why:
(call/cc
(lambda (k)
(* 5 (k 4))))
Chez Scheme 9.5.3
call/cc lets you get the advantages of continuation passing style without having to write it in continuation passing style. eg.
(define (cars lsts)
(define (cars lsts k)
(cond ((null? lsts) (k '()))
((null? (car lsts)) '())
(else (cars (cdr lsts)
(lambda (r)
(k (cons (caar lsts) r)))))))
(cars lsts values))
;; eg
(cars '()) ; ==> ()
(cars '((1) (2) (3))) ; ==> (1 2 3)
(cars '((1) (2) ())) ; ==> ()
Can be written like this:
(define (cars lsts)
(call/cc
(lambda (bail)
(define (cars lsts)
(cond ((null? lsts) '())
((null? (car lsts)) (bail '()))
(else (cons (caar lsts) (cars (cdr lsts))))))
(cars lsts))))
call/cc& looks like this in CPS:
(define (call/cc& proc k)
(define (exit& v ignored-k)
(k v))
(proc exit& k))
And your simple example can easily be rewritten to continuation passing style:
(call/cc& (lambda (k& real-k)
(k& 4 (lambda (res)
(*& 5 res real-k))))
display)
So looking at that the ignore-k gets ignored and 4 gets passed to the continuation of call/cc& which I have put display which then displays 4 in the repl.
I would explain you by writing a code with the same semantics by using CPS.
((lambda (k)
(k 4
(lambda (v)
(* 5 v))))
(lambda (result stack)
;; this continuation will drop the stack
result))
After you call the continuation K, you also call it using the remained stack, but the stack is dropped.
Had you took into account the remaining stack you would have had:
((lambda (k)
(k 4
(lambda (v)
(* 5 v))))
(lambda (result stack)
;; this continuation will consider the stacked computation
(stack result)))
and in this case the result would have been 20.
But in the semantics from your code, by calling the continuation, you dropped the stack, the not-finished computation.
The continuation will return with the value passed to it (k 4), so 4 is the return value.

Unusual Scheme `let` binding, what is `f`?

In "The Scheme Programming Language 4th Edition" section 3.3 Continuations the following example is given:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
I can confirm it works in chezscheme as written:
> (product '(1 2 3 4 5))
120
What is 'f' in the above let? Why is the given ls being assigned to itself? It doesn't seem to match what I understand about (let ...) as described in 4.4 local binding:
syntax: (let ((var expr) ...) body1 body2 ...)
If 'f' is being defined here I would expect it inside parenthesis/square brackets:
(let ([f some-value]) ...)
This is 'named let', and it's a syntactic convenience.
(let f ([x y] ...)
...
(f ...)
...)
is more-or-less equivalent to
(letrec ([f (λ (x ...)
...
(f ...)
...)])
(f y ...))
or, in suitable contexts, to a local define followed by a call:
(define (outer ...)
(let inner ([x y] ...)
...
(inner ...)
...))
is more-or-less equivalent to
(define (outer ...)
(define (inner x ...)
...
(inner ...)
...)
(inner y ...))
The nice thing about named let is that it puts the definition and the initial call of the local function in the same place.
Cavemen like me who use CL sometimes use macros like binding, below, to implement this (note this is not production code: all its error messages are obscure jokes):
(defmacro binding (name/bindings &body bindings/decls/forms)
;; let / named let
(typecase name/bindings
(list
`(let ,name/bindings ,#bindings/decls/forms))
(symbol
(unless (not (null bindings/decls/forms))
(error "a syntax"))
(destructuring-bind (bindings . decls/forms) bindings/decls/forms
(unless (listp bindings)
(error "another syntax"))
(unless (listp decls/forms)
(error "yet another syntax"))
(multiple-value-bind (args inits)
(loop for binding in bindings
do (unless (and (listp binding)
(= (length binding) 2)
(symbolp (first binding)))
(error "a more subtle syntax"))
collect (first binding) into args
collect (second binding) into inits
finally (return (values args inits)))
`(labels ((,name/bindings ,args
,#decls/forms))
(,name/bindings ,#inits)))))
(t
(error "yet a different syntax"))))
f is bound to a procedure that has the body of let as a body and ls as a parameter.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.16
Think of this procedure:
(define (sum lst)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc))))
(helper lst 0))
(sum '(1 2 3)) ; ==> 6
We can use named let instead of defining a local procedure and then use it like this:
(define (sum lst-arg)
(let helper ((lst lst-arg) (acc 0))
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc)))))
Those are the exact same code with the exception of some duplicate naming situations. lst-arg can have the same name lst and it is never the same as lst inside the let.
Named let is easy to grasp. call/ccusually takes some maturing. I didn't get call/cc before I started creating my own implementations.

SICP practise 3.51 Wrong type to apply: #<syntax-transformer cons-stream>

In practice 3.51 of the SICP, it defines a procedure "show", and use stream-map to create a stream:
(add-to-load-path ".")
(load "stream.scm")
(define (show x)
(display-line x)
x)
(define x0 (stream-enumerate-interval 0 3))
(display-stream x0) ;succ, no error
(stream-map show x0) ;all element printed, but interpreter report error at last
The other staff about streams in stream.scm:
#!/usr/bin/guile
!#
(define (stream-null? s)
(null? s))
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
(define (stream-map proc s)
(if (stream-null? s)
the-empty-stream
(cons-stream (proc (car s))
(stream-map proc (stream-cdr s)))))
(define (stream-for-each proc s)
(if (stream-null? s)
'done
(begin
(proc (stream-car s))
(stream-for-each proc (stream-cdr s)))))
(define (display-stream s)
(stream-for-each display-line s))
(define (display-line x)
(display x))
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define (stream-enumerate-interval low high)
(if (> low high)
the-empty-stream
(cons-stream
low
(stream-enumerate-interval (+ low 1) high))))
(define (stream-filter pred stream)
(cond
((stream-null? stream) the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred (stream-cdr stream))))
(else
(stream-filter pred (stream-cdr stream)))))
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b)))))
(define the-empty-stream '())
(define (stream-enumerate-interval low high)
(if (> low high)
the-empty-stream
(cons-stream low
(stream-enumerate-interval (+ low 1) high))))
The error is like this:
0123Backtrace:
8 (apply-smob/1 #<catch-closure 557e16ae8c20>)
In ice-9/boot-9.scm:
705:2 7 (call-with-prompt ("prompt") #<procedure 557e16aef6a0 …> …)
In ice-9/eval.scm:
619:8 6 (_ #(#(#<directory (guile-user) 557e16b9e140>)))
In ice-9/boot-9.scm:
2312:4 5 (save-module-excursion #<procedure 557e16b24330 at ice-…>)
3822:12 4 (_)
In stream.scm:
25:8 3 (stream-map #<procedure show (x)> (0 . #<promise (1 . …>))
25:8 2 (stream-map #<procedure show (x)> (1 . #<promise (2 . …>))
25:8 1 (stream-map #<procedure show (x)> (2 . #<promise (3 . …>))
In unknown file:
0 (_ 3 ())
I've no idea why display-stream succeed, but stream-map "show" is fail.
The code is the same as the sample in SICP. The scheme interpreter is 'guile'.
Any ideas? THX
The error disappeared when I moved
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b)))))
to the top of the file.
Apparently, in Guile it must be defined above its first use point in the file.
You didn't see the error with stream-enumerate-interval because it is defined twice - the last time below the definition of cons-stream.
Tested in https://ideone.com which uses "guile 2.0.13".

Macro that unrolls a 'for' loop in racket/scheme?

I'm trying to write a macro in racket/scheme that operates like a for loop across some arbitrary code such that the body of the loop is unrolled. For example, the following code
(macro-for ((i '(0 1 2 3))
(another-macro
(with i)
(some (nested i))
(arguments (in (it (a b c i))))))
should have the same result as if the code had been written as
(another-macro
(with 0)
(some (nested 0))
(arguments (in (it (a b c 0))))))
(another-macro
(with 1)
(some (nested 1))
(arguments (in (it (a b c 1))))))
(another-macro
(with 2)
(some (nested 2))
(arguments (in (it (a b c 2))))))
I've made an attempt of implementing it but I'm new to macros and they don't seem to work as I expect them to. Here's my attempt - which doesn't compile because match apparently is not allowed to be used within macros - but hopefully it conveys the idea I'm trying to achieve.
(module test racket
(require (for-syntax syntax/parse))
(begin-for-syntax
(define (my-for-replace search replace elem)
(if (list? elem)
(map (lambda (e) (my-for-replace search replace e)) elem)
(if (equal? elem search)
replace
elem))))
(define-syntax (my-for stx)
(syntax-case stx ()
((my-for args-stx body-stx)
(let ((args (syntax-e #'args-stx)))
(if (list? args)
(map (lambda (arg)
(match arg
((list #'var #'expr)
(my-for-replace #'var #'expr #'body))
(else
(raise-syntax-error #f
"my-for: bad variable clause"
stx
#'args))))
args)
(raise-syntax-error #f
"my-for: bad sequence binding clause"
stx
#'args))))))
(define-syntax (my-func stx)
(syntax-parse stx
((my-func body)
#'body)))
(my-for ((i '(0 1 2)))
(my-func (begin
(display i)
(newline))))
)
Here's how I would write that (if I were going to write something like that):
First, we need a helper function that substitutes in one syntax object wherever an identifier occurs in another syntax object. Note: never use syntax->datum on something that you intend to treat as an expression (or that contains expressions, or definitions, etc). Instead, recursively unwrap using syntax-e and after processing put it back together just like it was before:
(require (for-syntax racket/base))
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (syntax-substitute stx id replacement)
(let loop ([stx stx])
(cond [(and (identifier? stx) (bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Unwrapped data cases:
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; FIXME: also traverse vectors, etc?
[else stx]))))
Use bound-identifier=? when you're implementing a binding-like relationship, like substitution. (This is a rare case; usually free-identifier=? is the right comparison to use.)
Now the macro just interprets the for-clause, does the substitutions, and assembles the results. If you really want the list of terms to substitute to be a compile-time expression, use syntax-local-eval from racket/syntax.
(require (for-syntax racket/syntax))
(define-syntax (macro-for stx)
(syntax-case stx ()
[(_ ([i ct-sequence]) body)
(with-syntax ([(replaced-body ...)
(for/list ([replacement (syntax-local-eval #'ct-sequence)])
(syntax-substitute #'body #'i replacement))])
#'(begin replaced-body ...))]))
Here's an example use:
> (macro-for ([i '(1 2 3)]) (printf "The value of ~s is now ~s.\n" 'i i))
The value of 1 is now 1.
The value of 2 is now 2.
The value of 3 is now 3.
Notice that it replaces the occurrence of i under the quote, so you never see the symbol i in the output. Is that what you expect?
Disclaimer: This is not representative of typical Racket macros. It's generally a bad idea to go searching and replacing in unexpanded forms, and there are usually more idiomatic ways to achieve what you want.
If the for-loop is to be evaluated at compile-time, you can use the builtin for loop.
#lang racket/base
(require (for-syntax syntax/parse
racket/base)) ; for is in racket/base
(define-syntax (print-and-add stx)
(syntax-parse stx
[(_ (a ...))
; this runs at compile time
(for ([x (in-list (syntax->datum #'(a ...)))])
(displayln x))
; the macro expands to this:
#'(+ a ...)]))
(print-and-add (1 2 3 4 5))
Output:
1
2
3
4
5
15
UPDATE
Here is an updated version.
#lang racket
(require (for-syntax syntax/parse racket))
(define-syntax (macro-for stx)
(syntax-parse stx
[(_macro-for ((i (a ...))) body)
(define exprs (for/list ([x (syntax->list #'(a ...))])
#`(let-syntax ([i (λ (_) #'#,x)])
body)))
(with-syntax ([(expr ...) exprs])
#'(begin expr ...))]))
(macro-for ((i (1 2 3 4)))
(displayln i))
Output:
1
2
3
4
Ryan Culpepper's answer only supports use of one induction variable, so here's an extension which supports multiple induction variables:
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (instr-syntax-substitute stx id replacement index)
(let loop ([stx stx])
(cond [(and (identifier? stx)
(bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Special handling of (define-instruction id ...) case
[(and (pair? stx)
(syntax? (car stx))
(equal? (syntax-e (car stx)) 'define-instruction))
(let ((id-stx (car (cdr stx))))
(cons (loop (car stx))
(cons (datum->syntax id-stx
(string->symbol
(format "~a_~a"
(symbol->string
(syntax-e id-stx))
index))
id-stx
id-stx)
(loop (cdr (cdr stx))))))]
;; Unwrap list case
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; Do nothing
[else stx]))))
(begin-for-syntax
(define instr-iter-index 0)
(define (instr-iter-arg body arg argrest)
(let loop ([body body]
[arg arg]
[argrest argrest])
(let ([i (car (syntax-e arg))]
[ct-sequence (cadr (syntax-e arg))]
[replaced-bodies '()])
(for ([replacement (syntax-e ct-sequence)])
(let ([new-body (instr-syntax-substitute body
i
replacement
instr-iter-index)])
(if (null? argrest)
(begin
(set! replaced-bodies
(append replaced-bodies (list new-body)))
(set! instr-iter-index (+ instr-iter-index 1)))
(let* ([new-arg (car argrest)]
[new-argrest (cdr argrest)]
[new-bodies (loop new-body
new-arg
new-argrest)])
(set! replaced-bodies
(append replaced-bodies new-bodies))))))
replaced-bodies))))
(provide instr-for)
(define-syntax (instr-for stx)
(syntax-case stx ()
[(instr-for args body)
(with-syntax ([(replaced-body ...)
(let ([arg (car (syntax-e #'args))]
[argrest (cdr (syntax-e #'args))])
(instr-iter-arg #'body arg argrest))])
#'(begin replaced-body ...))]))

How is the sicp cons-stream implemented?

I'm working through the streams section of the scip and am stuck on how to define a stream.
The following is my code:
(define (memo-func function)
(let ((already-run? false)
(result false))
(lambda ()
(if (not already-run?)
(begin (set! result (function))
(set! already-run? true)
result)
result))))
(define (delay exp)
(memo-func (lambda () exp)))
(define (force function)
(function))
(define the-empty-stream '())
(define (stream-null? stream) (null? stream))
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define (cons-stream a b) (cons a (memo-func (lambda () b))))
If I define integers the way that the book descibes:
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
(define integers (integers-starting-from 1))
I get a message saying: Aborting!: maximum recursion depth exceeded.
I'm guessing that the delay function is not working but I don't know how to fix it. I am running the MIT scheme on my Mac.
update 1
So now with cons-stream as a macro, the integers can be defined.
But then I've got another error.
(define (stream-take n s)
(cond ((or (stream-null? s)
(= n 0)) the-empty-stream)
(else (cons-stream (stream-car s)
(stream-take (- n 1) (stream-cdr s))))))
(stream-take 10 integers)
;ERROR - Variable reference to a syntactic keyword: cons-stream
update 2
Please ignore update 1 above
cons-stream needs to be a macro in order for your sample code to work correctly. Otherwise the invocation of cons-stream will evaluate all its arguments eagerly.
Try this (not tested):
(define-syntax cons-stream
(syntax-rules ()
((cons-stream a b)
(cons a (memo-func (lambda () b))))))
P.S. Your delay needs to be a macro also, for similar reasons. Then after you fix delay, you can make your cons-stream use delay directly.
You cannot define delay as a function, since prior to calling it, Scheme will evaluate its argument - which is exactly what you're trying to postpone. SICP says this explicitly that delay should be a special form.

Resources