Simplest example of backwards continuations in Scheme without explicit mutation - haskell

I've written a small Scheme interpreter in C#, and realised that the way I had implemented it, it was very easy to add support for proper continuations.
So I added them... but want to "prove" that they way that I've added them is correct.
My Scheme interpreter however has no support for "mutating" state - everything is immutable.
So it was pretty easy to write a unit test to expose "upwards" continuations:
AssertEqual(Eval("(call/cc (lambda (k) (+ 56 (k 3))))"), 3);
However, I also want to write a unit test that demonstrates that if the continuation "escapes" then that still works too:
AssertEqual(Eval("(call/cc (lambda (k) k))", <some continuation>);
But of course, the above would just test that "I got a continuation"... not that it's actually a valid continuation.
All of the examples I can find, however, always end up using "set!" to demonstrate the escaped continuation.
What's the simplest Scheme example that demonstrates proper support for backwards continuations without relying on mutation?
Are backwards continuations any use without mutation? I am beginning to suspect that they are not, because you could only use it to execute the exact same calculation again... which is meaningless if there are no side-effects. Is this why Haskell does not have continuations?

I don't know if this is the simplest, but here's an example of using backwards continuations without any call to set! or similar:
(apply
(lambda (k i) (if (> i 5) i (k (list k (* 2 i)))))
(call/cc (lambda (k) (list k 1))))
This should evaluate to 8.
Slightly more interesting is:
(apply
(lambda (k i n) (if (= i 0) n (k (list k (- i 1) (* i n)))))
(call/cc (lambda (k) (list k 6 1))))
which computes 6! (that is, it should evaluate to 720).
You can even do the same thing with let*:
(let* ((ka (call/cc (lambda (k) `(,k 1)))) (k (car ka)) (a (cadr ka)))
(if (< a 5) (k `(,k ,(* 2 a))) a))
(Man, stackoverflow's syntax highlighting fails massively on scheme.)

I think you're right -- without mutation, backwards continuations do nothing that forward continuations can't.

Here's the best I've come up with:
AssertEqual(Eval("((call/cc (lambda (k) k)) (lambda (x) 5))", 5);
Not amazing, but it is a backwards continuation which I then "call" with the actual function I wish to invoke, a function that returns the number 5.
Ah and I've also come up with this as a good unit test case:
AssertEqual(Eval("((call/cc call/cc) (lambda (x) 5))", 5);
I agree with Jacob B - I don't think it's that useful without mutable state... but would be still be interested in a counter-example.

Functional Threads:
You can use a recursive loop to update state without mutation. including the state of the next continuation to be called. Now this is more complicated than the other examples given, but all you really need is the thread-1 and main loop. The other thread and "update" function are there to show that continuations can be used for more than a trivial example. Additionally, for this example to work you need an implementation with the named let. This can be translated into an equivalent form made with define statements.
Example:
(let* ((update (lambda (data) data)) ;is identity to keep simple for example
(thread-1
(lambda (cc) ;cc is the calling continuation
(let loop ((cc cc)(state 0))
(printf "--doing stuff state:~A~N" state)
(loop (call/cc cc)(+ state 1))))) ;this is where the exit hapens
(thread-2
(lambda (data) ;returns the procedure to be used as
(lambda (cc) ;thread with data bound
(let loop ((cc cc)(data data)(state 0))
(printf "--doing other stuff state:~A~N" state)
(loop (call/cc cc)(update data)(+ state 1)))))))
(let main ((cur thread-1)(idle (thread-2 '()))(state 0))
(printf "doing main stuff state:~A~N" state)
(if (< state 6)
(main (call/cc idle) cur (+ state 1)))))
Which outputs
doing main stuff state:0
--doing other stuff state:0
doing main stuff state:1
--doing stuff state:0
doing main stuff state:2
--doing other stuff state:1
doing main stuff state:3
--doing stuff state:1
doing main stuff state:4
--doing other stuff state:2
doing main stuff state:5
--doing stuff state:2
doing main stuff state:6

Related

Recursively reading a file in Racket

I am struggling to understand how to read a file line by line with racket, while passing each line to a recursive function.
According to the manual, the idiomatic way of doing this is something like the following example:
(with-input-from-file "manylines.txt"
(lambda ()
(for ([l (in-lines)])
(op l))))
What if my function op is a recursive function that needs to do some complicated operations depending on the line just read from file and also on the history of the recursion?
For example, I could have a function like this:
(define (op l s)
;; l is a string, s is a list
(cond ((predicate? l)
(op (next-line-from-file) (cons (function-yes l) s)))
(else
(op (next-line-from-file) (append (function-no l) s)))))
I am not sure how to use this function within the framework described by the manual.
Here next-line-from-file is a construct I made up to make it clear that I would like to keep reading the file.
I think I could do what I want by introducing side effects, for example:
(with-input-from-file "manylines.txt"
(lambda ()
(let ((s '()))
(for ([l (in-lines)])
(if (predicate? l)
(let ((prefix (function-yes l)))
(set-cdr! s s)
(set-car! s prefix))
(let ((prefix (function-no l)))
(set-cdr! prefix s)
(set-car! s prefix)))))))
I actually did not try to run this code, so I'm not sure it would work.
Anyway I would bet that this common task can be solved without introducing side effects, but how?
Two approaches that Racket supports rather well are to turn the port into something which is essentially a generator of lines, or into a stream. You can then pass these things around as arguments to whatever function you are using in order to successively read lines from the file.
The underlying thing in both of these is that ports are sequences, (in-lines p) returns another sequence which consists of the lines from p, and then you can turn these into generators or streams.
Here's a function which will cat a file (just read its lines in other words) using a generator:
(define (cat/generator f)
(call-with-input-file f
(λ (p)
(let-values ([(more? next) (sequence-generate (in-lines p))])
(let loop ([carry-on? (more?)])
(when carry-on?
(displayln (next))
(loop (more?))))))))
Here call-with-input-file deals with opening the file and calling its second argument with a suitable port. in-lines makes a sequence of lines from the port, and sequence-generate then takes any sequence and returns two thunks: one tells you if the sequence is exhausted, and one returns the next thing in it if it isn't. The remainder of the function just uses these functions to print the lines of the file.
Here's an equivalent function which does it using a stream:
(define (cat/stream f)
(call-with-input-file f
(λ (p)
(let loop ([s (sequence->stream (in-lines p))])
(unless (stream-empty? s)
(displayln (stream-first s))
(loop (stream-rest s)))))))
Here the trick is that sequence->stream returns a stream corresponding to a sequence, and then stream-empty? will tell you if you're at the end of the stream, and if it's not empty, then stream-first returns the first element (conceptually the car) while stream-rest returns a stream of all the other elements.
The second one of these is nicer I think.
One nice thing is that lists are streams so you can write functions which use the stream-* functions, test them on lists, and then use them on any other kind of stream, which means any other kind of sequence, and the functions will never know.
I recently implement something similar, except in my case the predicate depended on the following line, not the preceding one. In any case, I found it simplest to discard in-lines and use read-line recursively. Since the predicate depended on unread input, I used peek-string to look ahead in the input stream.
If you really want to use in-lines, you might like to experiment with sequence-fold:
(sequence-fold your-procedure '() (in-lines))
Notice this uses an accumulator, which you could use to check the previous results from your procedure. However, if you're building a list, you generally want to build it backwards using cons, so the most recent element is at the head of the list and can be accessed in constant time. Once you're done, reverse the list.

How to do looping in lisp?

Just started learning and coding lisp,
I'm trying to create a program that will continuously accept a number and stops only if and only if the last input number is twice the previous number.
Here's my code
----------
(let((a 0)
(b 0)
(count 0))
(loop
(= a b))
(princ"Enter Number: ")
(defvar a(read))
(format t "~% a = ~d" a)
(setq count (1+ count))
(while
(!= b(* a 2) || <= count 1)
(princ "Program Terminated Normally")
)
Thank you
a bit feedback
(let ((a 0)
(b 0)
(count 0))
(loop
(= a b)) ; here the LOOP is already over.
; You have a closing parenthesis
; -> you need better formatting
(princ"Enter Number: ")
(defvar a(read))
(format t "~% a = ~d" a)
(setq count (1+ count))
(while
(!= b(* a 2) || <= count 1)
(princ "Program Terminated Normally")
)
some improved formatting:
(let ((a 0)
(b 0)
(count 0))
(loop
(= a b)) ; LOOP ends here, that's not a good idea
(princ "Enter Number: ")
(defvar a(read)) ; DEFVAR is the wrong construct,
; you want to SETQ an already defined variable
(format t "~% a = ~d" a)
(setq count (1+ count))
(while ; WHILE does not exist as an operator
(!= b(* a 2) || <= count 1) ; This expression is not valid Lisp
(princ "Program Terminated Normally")
)
You may need to learn a bit more Lisp operators, before you really can write such loops. You also may want to use Lisp interactively and try out things, instead of trying to write code into an editor and never get feedback from a Lisp...
Here's an answer which definitely is not how you would do this in real life, but if you understand what it does you will understand one of the two big important things about Lisps.
(If you understand why the equivalent program would not work reliably in Scheme you'll also understand one of the important things about writing safe programs! Fortunately this is Common Lisp, not Scheme, so it's OK here.)
First of all let's write a little helper function to read integers. This is just fiddly detail: it's not important.
(defun read-integer (&key (prompt "Integer: ")
(stream *query-io*))
;; Read an integer. This is just fiddly details
(format stream "~&~A" prompt)
(values (parse-integer (read-line stream))))
OK, now here's a slightly odd function called mu (which stands for 'mutant U'):
(defun mu (f &rest args)
(apply f f args))
And now here is our program:
(defun read-integers-until-double-last ()
(mu (lambda (c getter current next factor)
(if (= next (* current factor))
(values current next)
(mu c getter next (funcall getter) factor)))
#'read-integer
(read-integer)
(read-integer)
2))
And here it is working:
> (read-integers-until-double-last)
Integer: 0
Integer: 4
Integer: 3
Integer: -2
Integer: -4
-2
-4
For extra mysteriosity you can essentially expand out the calls to mu here, which makes it either more clear or less clear: I'm not quite sure which:
(defun read-integers-until-double-last ()
((lambda (c)
(funcall c c
#'read-integer
(read-integer)
(read-integer)
2))
(lambda (c getter current next factor)
(if (= next (* current factor))
(values current next)
(funcall c c getter next (funcall getter) factor)))))
Again, this is not how you do it in real life, but if you understand what this does and how it does it you will understand quite an important thing about Lisps and their theoretical underpinnings. This is not all (not even most) of the interesting things about them, but it is a thing worth understanding, I think.

The inner `try` interation in `fixed-point`

I am reading the fix-point of SICP:
#+begin_src emacs-lisp :session sicp :lexical t
(defvar tolerance 0.00001)
(defun fixed-point(f first-guess)
(defun close-enoughp(v1 v2)
(< (abs (- v1 v2)) tolerance))
(defun try(guess) ;;
(let ((next (funcall f guess)))
(if (close-enoughp guess next)
next
(try next))))
(try first-guess))
(fixed-point #'cos 1.0)
#+end_src
#+RESULTS:
: 0.7390822985224024
From the above case, I learned that one nature of while is the abstract concept "try"
#+begin_src ipython :session sicp :results output pySrc/sicp_fixedpoint2.py
import math
def fixed_point(f, guess):
while True:
nex = f(guess)
if abs(guess-nex) < 0.0001:
return nex
else:
guess = nex #local assignment is nature of lambda
print(fixed_point(math.cos, 1))
#+end_src
#+RESULTS:
: 0.7390547907469174
So I could write iteration in python just with the effective functional abstraction thinking.
When reflect on try, more than "try is a while in iteration", what it teach me?
It could be reframed without try, but return return fixed_point(f, nex) directly.
#+begin_src ipython :session sicp :results output :tangle pySrc/sicp_fixedpoint.py
import math
tolerance = 0.00001
def fixed_point(f, guess):
def good_enoughp(a, b):
return abs(a-b) < tolerance
nex = f(guess)
if good_enoughp(guess, nex):
return nex
else:
return fixed_point(f, nex)
print(fixed_point(math.cos, 1))
#+end_src
#+RESULTS:
: 0.7390822985224024
So why SICP introduced try here, I guess efficiency might not be the author's key consideration.
Test with elisp
#+begin_src emacs-lisp :session sicp :lexical t
(defvar tolerance 0.00001)
(defun fixed-point(f guess)
(defun close-enoughp(v1 v2) ;
(< (abs (- v1 v2)) tolerance))
(let ((next (funcall f guess)))
(if (close-enoughp guess next)
next
(fixed-point f next)))
)
;;(trace-function #'fixed-point)
(fixed-point #'cos 1.0)
#+end_src
#+RESULTS:
: 0.7390822985224024
It works as expected.
It seems that return fixed-point f next is a bit cleaner than a inner iteration with try.
What's the consideration of SICP here, what was intended to teach?
It's the opposite: it's cleaner and more efficient with try because it doesn't need to redefine the good-enough-p.
(also, you're not supposed to use recursion in Python).
The version with try is better than the version which calls the top function, fixed-point, because fixed-point contains inner definitions, of the functions good-enough-p and try. A simple-minded compiler would compile it so that on each call it actually makes those definitions anew, again and again, on each call. With try there's no such concern as it is already inside the fixed-point's inner environment where good-enough-p is already defined, and so try can just run.
(correction/clarification: the above treats your code as if it were Scheme, with internal defines instead of the Common Lisp with defuns as you show. SICP is Scheme, after all. In Common Lisp / ELisp there's not even a question -- the internal defuns will always be performed, on each call to the enclosing function, just (re)defining the same functions at the top level over and over again.)
Incidentally, I like your Python loop translation, it is a verbatim translation of the Scheme's tail-recursive loop, one to one.
Your while translation is exactly what a Scheme compiler is supposed to be doing given the first tail-recursive Scheme code in your question. The two are exactly the same, down to the "horrible while True ... with an escape" which, personally, I quite like for its immediacy and clarity. Meaning, I don't need to keep track of which value gets assigned to what variable and which variable gets returned in the end -- instead, a value is just returned, just like it is in Scheme.
The natural way to write something like this in Python is something like this, I think:
tolerance = 0.00001
def fixed_point(f, first_guess):
guess = first_guess
next_guess = f(guess)
def close_enough(a, b):
return (abs(a - b) < tolerance)
while not close_enough(guess, next_guess):
guess = next_guess
next_guess = f(guess)
return next_guess
This:
uses a while loop rather than recursion in the way that is natural in Python;
doesn't use some horrible while True ... with an escape which is just confusing.
(In fact, since function-call in Python is generally very slow, it is probably more natural to open-code the call to close_enough and remove the local function altogether.)
But this is imperative code: it's full of assignment (the first two 'assignments' are really bindings of variables as Python doesn't distinguish the two syntactically, but the later assignments really are assignments). We want to express this in a way which doesn't have assignment. We also want to replace it by something which does not use any looping constructs or expresses those looping constructs in terms of function calls.
We can do this in two ways:
we can treat the top-level function as the thing we call recursively;
we can define some local function through which we recurse.
Which of these we do is really a choice, and in this case it probably makes little difference. However there are often significant advantages to the second approach: in general the top-level function (the function that is in some interface we might be exposing to people) may have all sorts of extra arguments, some of which may have default values and so on, which we really don't want to have to keep passing through the later calls to it; the top-level function may also just not have an appropriate argument signature at all because the iterative steps may be iterating over some set of values which are derived from the arguments to the top-level function.
So, it's generally better to express the iteration in terms of a local function although it may not always be so.
Here is a recursive version in Python which takes the chance to also make the signature of the top-level function sightly richer. Note that this approach would be terrible style in Python since Python does not do anything special with tail calls. The code is also littered with returns because Python is not an expression language (don't believe people who say 'Python is like Lisp': it's not):
default_tolerance = 0.00001
def fixed_point(f, first_guess, tolerance=default_tolerance):
guess = first_guess
next_guess = f(guess)
def close_enough(a, b):
return (abs(a - b) < tolerance)
def step(guess, next_guess):
if close_enough(guess, next_guess):
return next_guess
else:
return step(next_guess, f(next_guess))
return step(first_guess, f(first_guess))
Well, in Scheme this is much more natural: here is the same function written in Scheme (in fact, in Racket):
(define default-tolerance 0.00001)
(define (fixed-point f initial-guess #:tolerance (tolerance default-tolerance))
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(define (try guess next)
(if (close-enough? guess next)
next
(try next (f next))))
(try initial-guess (f initial-guess)))
The only thing that is annoying about this is that we have to kick-off the iteration after defining try. Well, we could avoid even that with a macro:
(define-syntax-rule (iterate name ((var val) ...) form ...)
(begin
(define (name var ...)
form ...)
(name val ...)))
And now we can write the function as:
(define (fixed-point f initial-guess #:tolerance (tolerance default-tolerance))
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(iterate try ((guess initial-guess) (next (f initial-guess)))
(if (close-enough? guess next)
next
(try next (f next)))))
Well, in fact we don't need to write this iterate macro: it's so useful in Scheme that it already exists as a special version of let called 'named let':
(define (fixed-point f initial-guess #:tolerance (tolerance default-tolerance))
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(let try ((guess initial-guess) (next (f initial-guess)))
(if (close-enough? guess next)
next
(try next (f next)))))
And with any of these versions:
> (fixed-point cos 0)
0.7390822985224023
> (fixed-point cos 0 #:tolerance 0.1)
0.7013687736227565
Finally a meta-comment: I don't understand why you seem to be trying to learn Scheme using Emacs Lisp. The two languages are not alike at all: if you want to learn Scheme, use Scheme: there are probably hundreds of Scheme systems out there, almost all of which are free.
Scheme permits redefinition of top-level symbols, such as fixed-point; even the function f could redefine it! Compilers (and interpreters) need to take this into consideration, and check for a redefinition every call of fixed-point. On the other hand, try is not visible outside the definition of fixed-point, so f cannot redefine it. So, the compiler (or interpreter) can turn this tail recursive function into a loop.

Do I need a lock to access an immutable datastructure in multithreading context?

I have an immutable datastructure that is a functional hashmap (see fash.scm) that is shared among several threads.
Imagine a thread wants to change the global hashmap to a new version. Do I need a lock to change the value? If that's is the case, I assume I also need to lock the value to read it, isn't it?
It seems to me it boils down to whether setting a value in Scheme is an atomic operation or not. According to this answer for C language, you must
acquire a lock for both read and write access of pointer.
If it matters I am using guile 2.2.3 and bigloo 4.3.
It all depends on what you want to do. In general, if the value can be guaranteed to be read (e.g. always a number), then it's okay not to lock when the value is read. For example,
(import (rnrs) (srfi :18))
(define count 0)
(define t
(thread-start!
(make-thread
(lambda ()
(let loop ()
(display count) (newline)
(thread-sleep! 0.1)
(loop))))))
(do ((i 0 (+ i 1))) ((= i 10))
(set! count (+ count 1))
(thread-sleep! 0.1))
This is pretty much safe to read. However if the value is, say a vector of length 1, then you may want to lock if the other threads may change the value to #f or a vector of length 0. For example:
(import (rnrs) (srfi :18))
(define count (vector 1))
(define t
(thread-start!
(make-thread
(lambda ()
(let loop ()
(display (vector-ref count 0)) (newline)
(thread-sleep! 0.1)
(loop))))))
(do ((i 0 (+ i 1))) ((= i 10))
(vector-set! count 0 (+ (vector-ref count 0) i))
(thread-sleep! 0.1))
(set! count #f) ;; if this happens, the you may want to lock on reader thread
I haven't check how fash is implemented, but as long as entries are not updated to unexpected values, I would think it's okay not to lock.

How to exhaust a channel's values and then return the result (ClojureScript)?

Suppose that channel chan has the values "1" and "2" on queue.
Goal: Make a function which takes chan and returns the vector [1 2]. Note that I am totally fine if this function has to block for some time before its value is returned.
Attempt:
(defn chan->vector
[chan]
(let [a (atom true) v []]
(while (not-nil? #a)
(go
(reset! a (<! chan))
(into v #a)
(reset! a (<! chan))
)
) v
)
)
Result: My REPL freezes and eventually spits out a huge error. I have come to realize that this is because the (go ...) block is asynchronous, and so immediately returns. Thus the atom іn my (while ...) loop is never given a chance to be set to nil and the loop can never terminate.
So how do I accomplish the desired result? In case it's relevant, I'm using ClojureScript and targetting nodejs.
you should use alts! from core.async to fulfill this task
(https://clojure.github.io/core.async/#clojure.core.async/alts!):
(def x (chan 10))
(go (>! x 1)
(>! x 2)
(>! x 3))
(defn read-all [from-chan]
(<!! (go-loop [res []]
(let [[v _] (alts! [from-chan] :default :complete)]
(if (= v :complete)
res
(recur (conj res v)))))))
(read-all x)
;; output: [1 2 3]
(read-all x)
;; output: []
(go (>! x 10)
(>! x 20)
(>! x 30)
(>! x 40))
(read-all x)
;; output: [10 20 30 40]
inside the go-loop this (a/alts! [from-chan] :default :complete) tries to read any value from channel, and in case there are no value available at once it emits the default value, so you will see you should break the loop and return accumulated values.
update: as the blocking read (<!!) is absent in cljs, you can rewrite it the following way:
(defn read-all [from-chan]
(go-loop [res []]
(let [[v _] (alts! [from-chan] :default :complete)]
(if (= v :complete)
res
(recur (conj res v)))))))
so it will return the channel, and then just read one value from there:
(go (let [res (<! (read-all x))]
(println res)
;; do something else
))
You can use clojure.core.async/reduce:
;; demo setup
(def ch (async/chan 2))
(async/>!! ch :foo)
(async/>!! ch :bar)
;; background thread to print reduction result
(async/thread
(prn (async/<!! (async/reduce conj [] ch))))
;; closing the channel…
(async/close! ch)
;; …terminates the reduction and the result gets printed out:
;; [:foo :bar]
clojure.core.async/reduce returns a channel that will produce a value if and when the original channel closes. Internally it uses a go block and will release control in between taking elements from the original channel.
If you want to produce a value after a certain amount of time passes whether or not the original channel closes, you can either wrap the original channel in a pass-through channel that will close itself after a timeout passes or you can use a custom approach to the reduction step (perhaps the approach suggested by #leetwinski).
Use into
Returns a channel containing the single (collection) result of the
items taken from the channel conjoined to the supplied collection. ch
must close before into produces a result.
Something like this should work (it should print the events from events-chan given events-chan closes when it is done publishing events):
(go
(println (<! (into [] events-chan))))
The source channel needs to end (close), otherwise you can't put all events into a collection.
Edit:
Re-read your question, and it is not very clear what you want to accomplish. Whatever you want to do, chan->vector needs to return a channel so that whoever calls it can wait for the result. In fact, chan->vector is exactly into:
; chan->vector ch:Chan<Event> -> Chan<Vector[Event]>
(defn chan->vector [ch]
(into [] ch))
(go
(let [events (<! (chan->vector events-chan))]
(println events) ; Do whatever with the events vector
))
As I mentioned above, if the events chan never closes, then you have to do more thinking about how to consume the events. There is no magic solution. Do you want to batch the events by time intervals? By number of events? By a combination of those?
In summary, as mentioned above, chan->vector is into.
While possible in Clojure and many other languages, what you want to do is not possible in ClojureScript.
You want a function that blocks while listening to a channel. However, ClojureScript's version of core.async doesn't include the blocking operators. Why? Because ClojureScript doesn't block.
I couldn't find a reliable source to back that last sentence. There seems to be a lot of confusion around this topic on the web. However, I'm pretty sure of what I'm saying because ClojureScript ultimately becomes JavaScript, and that's how JavaScript works.
Indeed, JavaScript never blocks, neither on the browser nor in Node.js. Why? As far as I understand, it uses a single thread, so if it were to block, the user would be unable to do anything in the browser.
So it's impossible to do what you want. This is by design, because it could have disastrous UX effects. ClojureScript channels are like JavaScript events; in the same way you don't want an event listener to block the user interface while waiting for an event to happen, you also shouldn't want a channel to block while waiting for new values.
Instead, try using a callback function that gets called whenever a new value is delivered.

Resources