As a project to help me understand continuations in Racket, I decided to try and write a co-routine implementation without using mutable or global variables. Here is what I have so far, but it seems to end up in a deadlock of some kind. Am I missing something obvious?
#!/usr/bin/env racket
#lang racket
(define (make-proc-args args)
(let/cc cc
(cons cc args)))
(define (fork proc)
(let ([current (make-proc-args '())])
(proc current)))
(define (yield to args)
(let ([current (make-proc-args args)])
((car to) current)))
(define c
(fork
(lambda (p)
(let loop ([i 0]
[parent p])
(unless (> i 10)
(loop (+ i 1) (yield parent (list i))))))))
(let loop ([child c])
(println (car child))
(loop (yield child '())))
(define (make-proc-args args)
(let/cc cc
(cons cc args)))
This when called returns it's continuation as a object. If you look at this code:
(define (fork proc)
(let ([current (make-proc-args '())])
(proc current)))
The continuation of (make-proc-args '()) is the application of the let with current bound and proc called. In the context of:
(fork
(lambda (p)
(let loop ([i 0]
[parent p])
(unless (> i 10)
(loop (+ i 1) (yield parent (list i)))))))
It means (yield parent (list i)) will time travel back and call and (proc current) will be called again.. The let with start with i and 0.. But one would expect the continuation of the yield to be stored, right? Wrong!
(define (yield to args)
(let ([current (make-proc-args args)])
((car to) current)))
The continuation that is captured is ((car to) current) which happen to be the same again and again and again.
The easiest way to solve this is to make the continuation have not the calling of your stored continuation as it's own continuation. Thus you need to do something like this:
(define (fork proc)
(let/cc cc
(let ([current (cons cc '())])
(proc current))))
(define (yield to args)
(let/cc cc
(let ([current (cons cc args)])
((car to) current))))
Notice that in both of these the continuation is what happens when yield and fork returns naturally and not when the body of a let is finished.
Also know that continuations are delimited at top level so you should perhaps test with all code in a let block to catch bugs you might have since continuations behave differently at top level. The define is not allowed top level, but if you put it in a let you get #<void> as the last value as child because that is the value define forms make, not the pairs you expect.
(define (worker p)
(let loop ([i 0]
[parent p])
(unless (> i 10)
(loop (+ i 1) (yield parent i)))))
(let ((c (fork worker)))
(let loop ([child c])
(when (pair? child)
(println child)
(loop (yield child '())))))
This prints:
(#<continuation> . 0)
(#<continuation> . 1)
(#<continuation> . 2)
(#<continuation> . 3)
(#<continuation> . 4)
(#<continuation> . 5)
(#<continuation> . 6)
(#<continuation> . 7)
(#<continuation> . 8)
(#<continuation> . 9)
(#<continuation> . 10)
As a last tip. Perhaps you should make a struct for your continuation object or at least abstract?
Related
I'm continue learning Racket (well, in this case functional programming).
I have to implement this loop in a functional programming way:
At this moment I have this code:
#lang racket
(define EGS0
(lambda (PSET NSET CSET HSET)
(map (lambda (h)
(cond
[(not (andmap (lambda (p) (my-function h p)) PSET)) h]
[(not (ormap (lambda (n) (my-function h n)) NSET)) h]
) HSET))))
Instead of removing elements from HSET list, I'm creating a new one with the elements that I don't have to remove. This code is only a first approximation: in some cases this will add twice h but this is not my problem now.
CSET is an empty list and my-function returns #t or #f.
My problem comes with the last statement:
Then remove H from HSET and add H to CSET.
With map and I can get one list, but I don't know how to get two list. the only way I can think of is using set!, but if I use it, it is not going to be functional program.
Instead of map, I've thought to use a for loop, or maybe do two loops.
How can I get the two lists (the new list with the elements of HSET and the CSET list)?
UPDATE:
I'm adding some data to test the algorithm (someone needs extra help to understand the pseudocode).
(define my-function (lambda (x y) (and x y)))
(define hset '(1))
(define pset '(0))
(define nset '(1))
(egs pset nset '() hset)
It must returns: '(() (1)).
Notice that this problem is procedural in nature and is not as straightforward to write in a functional style; in this case writing an explicit loop is more natural than using map or filter.
Returning two values is easy, it can be managed by passing two accumulator parameters in the recursion and returning them at the end inside a list. Here's my implementation:
(define (egs pset nset cset hset)
(let loop ((input hset) (output '()) (cset cset))
(if (null? input)
; return modified cset and hset
(list cset output)
(let ((pset-match
(andmap (lambda (p) (my-function (car input) p)) pset))
(nset-match
(ormap (lambda (n) (my-function (car input) n)) nset)))
(cond ((not nset-match)
; if h does not match any members from nset
; remove h from hset, add h to cset
(loop (cdr input) output (cons (car input) cset)))
((not pset-match)
; if h does not match all members of pset
; remove h from hset, leave cset unmodified
(loop (cdr input) output cset))
(else
; otherwise don't remove h from hset, leave cset unmodified
(loop (cdr input) (cons (car input) output) cset)))))))
It works with the sample input:
(define my-function (lambda (x y) (and x y)))
(define hset '(1))
(define pset '(0))
(define nset '(1))
(egs pset nset '() hset)
=> '(() (1))
Is there a way in which I can make this work without using rest (I tried to put cdr lst wherever rest is but it gives me an error) plus how can I remove the if condition - (if (> N 0) - because all I want display to do is output the list - (list N E)?
(define (count lst)
(if (null? lst) '()
(let ((display (lambda (N E)
(if (> N 0) (list N E) (list N E)))))
(let loop ((rest (cdr lst))
(E (car lst))
(N 1))
(cond ((null? rest)
(list (display N E)))
((eq? E (car rest))
(loop (cdr rest) E (+ N 1)))
(else
(cons (display N E) (loop (cdr rest) (car rest) 1))))))))
Note that all procedures are just bound to variables in the global scope.
Example:
(let ((rest 5))
(rest '(1 2 3)))
In R6RS and later you should get an exception saying that the number 5 is not a procedure. The reason is that you have overridden the binding rest in this scope and shoudl use the variable rest as the binding to 5 and not try to call it as a procedure. In R5RS and earlier the result is undefined since it's not valid Scheme code but most implementations will perhaps have a similar error as R6RS is required to have.
You have done the same with display but this time display is a procedure that does something else than the global display. It's OK in R6RS but it's not ok in R5RS and earlier. An implementation is free to replace it with the global for all supported types. display supports all types and thus your code might not work in all implementations since it is invalid R5RS.
I am trying to find the other element in the nested list when querying the first one. Something like this. (findOther 'a '((a b) (b c) (a d)))--> b and d. I have done this so far: The problem is I only get b.
(defun findOther (elem L)
(cond (NIL (null L))
((eq elem (caar L)) (cdar L))
((findOther elem (cdr L)))))
First some comments on the original code:
(defun findOther (elem L)
(cond
;; NIL is always false, so you *never* end up using this
;; case. You probably want something like ((null l) '()),
;; NULL is still pretty common for this, but since you're
;; expecting a list, you could use the slighly more
;; descriptive ENDP.
(NIL (null L))
;; When you find an element, you immediately return its
;; counterpart, and don't collect it and continue on to
;; the rest of the list. It's also easier to read if
;; you use more descriptive names like FIRST and SECOND,
;; as in ((eq elem (first (first l))) (second (first l))).
;; It's worth noting that unless you have a specific reason
;; to use EQ, you might want to use EQL, which is the
;; default comparison in most CL functions.
((eq elem (caar L)) (cdar L))
;; Else, you continue to the rest of the list. In my
;; opinion, REST would be more decriptive than CDR here,
;; but recursing and returning the value *is* what you
;; want to do here.
((findOther elem (cdr L)))))
Taking some of those into consideration, we could do something like this:
(defun others (element list)
(cond
((endp list) '())
((eql element (first (first list)))
(list* (second (first list))
(others element (rest list))))
((others element (rest list)))))
All that said, the functions in the standard library
would make this much easier. E.g. using mapcan:
(defun others (element list)
(mapcan (lambda (sublist)
(when (eql (first sublist) element)
(rest sublist)))
list))
(others 'a '((a b) (b c) (a d)))
;=> (B D)
I am not sure if you are looking for pair of two elements or may be more elements in list as well. Just in case you have more elements and you want all of them as well and also of some of them are not really pairs,
(defun pair-of (elem lis)
(let ((temp nil))
(cond
((and (listp lis) (not (null lis)))
(mapcar
#'(lambda (x)
(cond
((and (listp x) (not (null x)) (eql elem (car x)))
(push (cdr x) temp))))
lis)))
(nreverse temp)))
USAGE:(pair-of 'a '((a b) (b c) (a d w) 1))
OUTPUT: ((B) (D W))
But in case you want them combined in one list,
(reduce #'append (pair-of 'a '((a s) (a 3 8) (2 5 1))):initial-value '())
=> (S 3 8)
I wish to replace the first occurrence of a symbol within pairs. For example:
take
(define n '((a . b) . (a . d)))
and i define a method context to replace the first instance (left most) of X with '()
replacing a should give me:
((() . b) a . d)
however i am stuck as my method replaces ALL instances and i am not sure how to add a check for this.
my code is as follows:
(define (context s sym)
(cond ((null? s) #f)
((atom? s)
(if (equal? s sym) '() s ))
(else (cons (context (car s) sym)
(context (cdr s) sym)))))
which gives : ((() . b) () . d)
any help? Thank you
The quickest way is to use a flag indicating whether the replacement has already been done, something along the lines of:
(define (context sxp sym)
(define done #f)
(let loop ((sxp sxp))
(cond (done sxp)
((pair? sxp) (cons (loop (car sxp)) (loop (cdr sxp))))
((eq? sym sxp) (set! done #t) '())
(else sxp))))
It's not very elegant to use set!, but the alternative would be to have the procedure return 2 values, and the resulting let-values code would be even worse in terms of readability IMO.
Also note that I didn't use atom? because it's not defined in standard Scheme; the usual way is to successively test null? then pair?, and handle the atom case in the else clause.
This is a bit more general (you can replace things other than symbols, and you can customize the test, and you can specify any particular number of instances to replace, not just one), and may be a little bit more complicated at first glance than what you're looking for, but here's a solution that works by internally using a continuation-passing style helper function. The main function, subst-n takes a new element, and old element, a tree, a test, and a count. It replaces the first count occurrences of new (as compared with test) with old (or all, if count is not a non-negative integer).
(define (subst-n new old tree test count)
(let substs ((tree tree)
(count count)
(k (lambda (tree count) tree)))
(cond
;; If count is a number and zero, we've replaced enough
;; and can just "return" this tree unchanged.
((and (number? count) (zero? count))
(k tree count))
;; If the tree is the old element, then "return" the new
;; element, with a decremented count (if count is a number).
((test old tree)
(k new (if (number? count) (- count 1) count)))
;; If tree is a pair, then recurse on the left side,
;; with a continuation that will recurse on the right
;; side, and then put the sides together.
((pair? tree)
(substs (car tree) count
(lambda (left count)
(substs (cdr tree) count
(lambda (right count)
(k (cons left right) count))))))
;; Otherwise, there's nothing to do but return this
;; tree with the unchanged count.
(else
(k tree count)))))
> (display (subst-n '() 'a '((a . b) . (a . d)) eq? 1))
((() . b) a . d)
> (display (subst-n '() 'a '((a . b) . (a . d)) eq? 2))
((() . b) () . d)
I am trying to use recursion to stack a basic block I created (y), x amount of times high.
(define stack-copies-of
(lambda (x y)
(cond
((= x 0) 0)
((> x 0) (stack y y)
I didn't go any further because well... I'm stumped. I want the stack of blocks to appear on the screen. Thank you!
First of all, you are not using recursion. stack-copies-of is not stack.
You need to look at basic list operations. Heres some that makes a list:
;; easiest version, looks most like the one you started with
(define (make-list num-elements)
(if (zero? num-elements)
'() ; the tail of the list is the empty list
(cons '* (make-list (- num-elements 1)))))
;; tail recursive version using auxillary procedure
(define (make-list num-elements)
;; we define a local auxillary procedure to do the work
(define (make-list-aux num-elements acc)
(if (zero? n)
acc ; return the produced list
(make-list-aux (- n 1)
(cons '* acc))))
;; fire it off
(make-list-aux num-elements '()))
;; exactly the same as the previous, but with a named let
(define (make-list num-elements)
;; a named let can be called by name as a procedure, creating a loop
(let make-list-aux ((num-elements num-elements)
(acc '()))
(if (zero? n)
acc
(make-list-aux (- n 1)
(cons '* acc)))))
(display (make-list 10)) ; print the result
I expect what you're after could be based on one of these except instead of '* you use your extra argument.
If your data structure is a stack you can define it and the related operations push, pop and one to display the stack.
(define stack '())
(define (push e)
(set! stack (cons e stack)))
(define (pop)
(let ((e (car stack)))
(set! stack (cdr stack))
e))
(define (display-stack)
(for-each
(lambda (e) (display e) (newline))
stack))
the following is the recursive function to stack n times an element
(define (stack-ntimes n e)
(when (> n 0)
(push e)
(stack-ntimes (- n 1) e)))