About "Frames as Repository of Local State" - functional-programming

SICP, Exercise 3.10 in section 3.2.3 shows the following as an alternative to a previously defined make-withdraw:
(define (make-withdraw initial-amount)
(let ((balance initial-amount))
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))))
and prescribes that we
Use the environment model to analyze this alternate version of make-withdraw, drawing figures like the ones above to illustrate the interactions
(define W1 (make-withdraw 100))
(W1 50)
(define W2 (make-withdraw 100))
However, before the above request, the text recalls that (let ((<var> <exp>)) <body>) is syntactic sugar for ((lambda (<var>) <body>) <exp>).
Now I guess that suggestion means that I should analize actually this version of make-withdraw:
(define (make-withdraw initial-amount)
((lambda (balance)
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
initial-amount))
or, even better (based on The procedure definition syntax is just syntactic sugar for an underlying implicit lambda expression, from section 3.2.1):
(define make-withdraw
(lambda (initial-amount)
((lambda (balance)
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
initial-amount)))
And here I see 3 lambda procedures, whereas in both this and this solutions (unofficial; I don't know of official solutions) only two procedures are shown. For instance, this is the latter solution:
; After (define W1 (make-withdraw 100))
global env
------------------
| |<--- env: global env
| | parameters: initial-amount
| make-withdraw: ----> body:
| | ((lambda (balance)
| | (lambda (amount)
| | (if (>= balance amount)
| | (begin (set! balance (- balance amount))
| | balance)
| | "Insufficient funds"))) initial-amount)
| |
| | E1
| | -----------------------
| |<----| initial-amount: 100 |
| | -----------------------
| | /\
| | E2 |
| | ----------------
| | | balance: 100 |
| | ----------------
| | /\
| | |
| | env: E2
| | parameters: amount
| W1: ---------------> body:
| | (if (>= balance amount)
| | (begin (set! balance (- balance amount))
| | balance)
| | "Insufficient funds")
------------------
whereas I would have imagined that a procedure with parameters: balance and body: (lambda (amount) …) was drawn as well, as that's the (temporary?) lambda that's run in E2 (with balance bound to initial-amount, not to 100, which is in turn bound to 100 in E1) to generate the procedure that's ultimately bound to W1.
Am I correct? If not, can you explain why?

When (make-withdraw 100) is called it constructs an environment with initial-amount bound to 100 (this is E1 in the diagram). It then immediately calls another function in this environment: that function constructs a child environment in which balance is bound to 100, which is E2 in the diagram, and returns a third function defined in that environment, which is thus the return value of make-withdraw.
So W1 is now bound to that third function, whose environment is E2. The second function, which constructed E2, has been called and has returned its value (the third function): it's no longer in the picture.
That's why it's not there any more.
I'm not sure if it helps, but it might be useful to think of the environment picture if make-withdraw didn't exist at all as its really just spurious noise at the point W1 has been defined (obviously not in real life, where you might want to make several accounts!):
(define W1 ((λ (initial-amount)
;; this function was `make-withdraw`
((λ (balance)
;; this function was `let`
(λ (amount)
;; this is what W1 will end up being
(if (>= balance amount)
(begin
(set! balance (- balance amount))
balance)
"Insufficient funds")))
initial-amount))
100))

Related

Dtrace from Touretzky

I am trying to learn lisp with the book "Common LISP a Gentle Introduction to Symbolic Computation" written by Touretzky. There is a utility in the book, Dtrace(I use dtrace.generic). Example of using dtrace:
(defun add-to-end (x y)
(append x (list y)))
(defun repeat-first (phrase)
(add-to-end phrase (first phrase)))
> (dtrace add-to-end repeat-first)
(ADD-TO-END REPEAT-FIRST)
> (repeat-first ’(for whom the bell tolls))
----Enter REPEAT-FIRST
| PHRASE = (FOR WHOM THE BELL TOLLS)
| ----Enter ADD-TO-END
| | X = (FOR WHOM THE BELL TOLLS)
| | Y = FOR
| \--ADD-TO-END returned
| (FOR WHOM THE BELL TOLLS FOR)
\--REPEAT-FIRST returned
(FOR WHOM THE BELL TOLLS FOR)
(FOR WHOM THE BELL TOLLS FOR)
Unfortunately in Clozure (on Win7) the result is:
? (repeat-first '(for whom the bell tolls))
----Enter REPEAT-FIRST
| Arg-1 = (FOR WHOM THE BELL TOLLS)
| ----Enter ADD-TO-END
| | Arg-1 = (FOR WHOM THE BELL TOLLS)
| | Arg-2 = FOR
| \--ADD-TO-END returned (FOR WHOM THE BELL TOLLS FOR)
\--REPEAT-FIRST returned (FOR WHOM THE BELL TOLLS FOR)
(FOR WHOM THE BELL TOLLS FOR)
Function argument names are lost. It should depend on the fetch-arglist function. Based on this answer, I wrote fetch-arglist as:
(defun fetch-arglist (x) (arglist x))
In fact:
? (arglist #'add-to-end)
(X Y)
:ANALYSIS
Unfortunately, the result is the same. Is there a way, in Clozure, to make the argument names of functions appear in dtrace?
Update:
Solution is (in dtrace.generic):
(defun fetch-arglist (x) (ccl:arglist x))
Update2:
dtrace prints strange results as:
((CCC (? AAA . #1=(0)) (? BBB . #1#)))
While trace of Clozure prints correctly:
((CCC (? AAA 0) (? BBB 0)))
Update3(and hopefully last):
Solution due to Vsevolod Dyomkin:
(defparameter *dtrace-print-circle* nil)
*print-circle* shows common substructure:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((l '((a b c) (d e f))))
(list l (copy-list l)))
;=> ((#1=(A B C) #2=(D E F)) (#1# #2#))

How to go count all of the atoms in a list (or a list of nested lists) when you use recursion

I am creating a recursive function that counts the number of atoms inside a list. It should be able to count the atoms of lists that are nested.
For example: (a (b c) e d) or (a (b c (g e)) e d), it should count b and c separately or b, c, e, and d separately and not as a whole.
This is the function that I have created:
(defun count-atoms (mylist)
(cond
((null mylist) 0)
((listp (car mylist)) (count-atoms (car mylist)))
((atom (car mylist)) (+ 1 (count-atoms (rest mylist))))
)
)
The output I get is 3 but it should be 5 (based from (a (b c) e d)). I am guessing that the function stops the moment it reaches c. How do i make the function not stop at c and make it go back to the outermost list.
Here's a way we can reason about the problem -
If the input is null, return zero
'( )
^
| 0 atoms
(inductive) Otherwise the input has at least one element. If car is a list, call count-elements on car and cdr. Add the two results together and return.
'( a b c d ... )
^ ^
| | count atoms in cdr <-
| \
| count atoms in sublist <------\_ add together
(inductive) Otherwise the input has at least one element that is not a list. Call count-elements on cdr. Add one to the result and return.
'( a b c d ... )
^ ^
| | count atoms in cdr <-
| \
| one atom <-----------------\_ add together
Do you see where your program differs?
Your mistake is that you are ignoring the tail in the second clause.
(defun count-atoms (tree)
"Count atoms in all leaves of the tree, ignoring terminating NIL."
(if tree
(+ (if (atom (car tree))
1
(count-atoms (car tree)))
(count-atoms (cdr tree)))
0))
now
(count-atoms '(a (b c) e d))
==> 5
(count-atoms '(a (b c (g e)) e d))
==> 7
(count-atoms '(a (b c (g e)) nil e d))
==> 8

BNF accepting a list( infinite amount of vars) and append(infinite amount of lists) but not append(symbol)?

I am trying to write a BNF that contains a List and append func':
The list is supposed to get as many symbols, lists or numbers as wanted:
Therefore I wrote something like this:
<LIST> ::= <SNS>
| <APPEND>
| (list <SNS>)
| (list <LIST>)
| (list <SNS> <LIST>)
The append is supposed to get as many lists as possible therefore I wrote something like:
<APPEND>::=
<LIST>
| (append <LIST>)
| (append <LIST> <APPEND>)
The language accepts also symbols numbers or null therefore I wrote:
<SNS> ::= <null>
| <num>
| '<sym>
My problem is that part of the requests on this BNF is that it should not accept (append <num>).
The way I fixed this is to do:
<LIST> ::= <null> //this is a list therefore (append null) is good
| <APPEND> // also is a list
| <LIST>
| (list <SNS>)
| (list <LIST>)
| (list <SNS> <LIST>)
<APPEND>::= (append <LIST>)
| <LIST>
| (append <LIST> <APPEND>)
The problem is that the BNF also tells me that I need to take in for an example: (list 1 33 `g).
How can I create a BNF that takes in both restrictions? What is the idea behind the fix?
Well I added a helper expression that basically is a flow of (symbols numbers or null).
Instead of making the base of expression as I made that the func` list gets as input this flow of input.
Old expression:
<LIST> ::= <null> //this is a list therefore (append null) is good
| <APPEND> // also is a list
| <LIST>
| (list <SNS>)
| (list <LIST>)
| (list <SNS> <LIST>)
<APPEND>::= (append <LIST>)
| <LIST>
| (append <LIST> <APPEND>)
BNF - with new expression
<LIST> ::= <null>
| <CONS>
| <APPEND>
| (list <SNS_FLOW>) ; this is what will get (list 1 2 ...)
| (list <LIST>)
| (list <SNS_FLOW> <LIST>) ; so I can accept: (list 'a (list ...))
| (list <LIST> <SNS_FLOW>) ; so I can accept: (list (list ...) 'a)
<APPEND>::= (append <LIST>)
| <LIST>
| (append <LIST> <APPEND>)
<SNS_FLOW>::= <SNS> ; this is the new expression
| <SNS><SNS_FLOW>

Recursion overflow using trampolining

I'm trying to test the following factorisation function but it's blowing up for large primes:
(defn divides? [N n]
(zero? (mod N n)))
(defn f-reduce [n f & {:keys [expt] :or {expt 0}}]
(if (divides? n f) (f-reduce (/ n f) f :expt (inc expt))
(if (zero? expt) [n []] [n [f expt]])))
(defn _factors [n f known-fs]
(let [[m fs] (f-reduce n f)]
(if (> f (Math/sqrt m))
(cond (and (empty? fs) (= m 1)) known-fs
(empty? fs) (concat known-fs [m 1])
(= m 1) (concat known-fs [f (last fs)])
true (concat known-fs [m (last fs)]))
#(_factors m (+ 2 f) (concat known-fs fs))))))
(defn factors
"returns the prime factors of n in form: p_0 expt_0 p_1 expt_1 ... p_m expt_m,
where p_i denotes ith prime factor, and expt_i denotes exponent of p_i"
[n]
(let [[m fs] (f-reduce n 2)]
(trampoline (_factors m 3 fs))))
which at each recursive step attempts to reduce a number n to some product p^k m.
As I understand, trampoline is meant to solve problem by returning a function which trampoline then calls (getting back another function) and so on, the stack picture looking something like:
|fn 1| --> |fn 2| -- ... --> |fn n|
as opposed to the non-tail recursive
|fn 1| --> |fn 1|fn 2| -- .. --> |fn 1|fn 2| ... |fn n-k| BOOM|
But for an input to factors being 12424242427 I get:
java.lang.StackOverflowError: null
at clojure.lang.LazySeq.seq (LazySeq.java:49)
clojure.lang.RT.seq (RT.java:507)
clojure.core/seq (core.clj:137)
clojure.core$concat$fn__4215.invoke (core.clj:691)
clojure.lang.LazySeq.sval (LazySeq.java:40)
clojure.lang.LazySeq.seq (LazySeq.java:49)
clojure.lang.RT.seq (RT.java:507)
clojure.core/seq (core.clj:137)
clojure.core$concat$fn__4215.invoke (core.clj:691)
clojure.lang.LazySeq.sval (LazySeq.java:40)
clojure.lang.LazySeq.seq (LazySeq.java:49)
clojure.lang.RT.seq (RT.java:507)
clojure.core/seq (core.clj:137)
clojure.core$concat$fn__4215.invoke (core.clj:691)
clojure.lang.LazySeq.sval (LazySeq.java:40)
clojure.lang.LazySeq.seq (LazySeq.java:49)
clojure.lang.RT.seq (RT.java:507)
clojure.core/seq (core.clj:137)
clojure.core$concat$fn__4215.invoke (core.clj:691)
clojure.lang.LazySeq.sval (LazySeq.java:40)
clojure.lang.LazySeq.seq (LazySeq.java:49)
What am I missing? (I know this algorithm isn't perfect, improving that is one entirely for me)
Damn ... it was lazy old concat!! if you look at the stack trace most of the work pertains to some lazy sequence (and of course concat). Googling this I came up with
http://stuartsierra.com/2015/04/26/clojure-donts-concat
and then changing my concat to into fixed the issue

Recursive Scheme Function Value Error

I am writing a small hangman game in scheme and am getting a very weird issue that almost seems like a language specific one.
In my game I have a variable that holds the number of mistakes allowed and on each recursive call of my game loop, I "let" the value to a new one if it needs to be changed. Here is some code to help visualize how I run the game loop.
guessed_list - a list of string characters containing old guesses and one new guess (ex. '("a" "x" "b") where "a" is the new guess)
game_word - '("a" "b" "c")
display_word - a list of string characters containing letters I have matched and hyphens for those I haven't up to this iteration of my game loop (ex '("" "b" "") where "a" from the guessed_list is going to be evaluated this loop iteration)
mistakes_left - The number of mistakes I have before my game should end because of wrong guessed. Initially this starts at 6, but in my current example should be 5 because 1 letter, "x", was guessed incorrectly.
;; Game Loop.
(define (game-loop guessed_list display_word mistakes_left)
(let ((n_mistakes_left
(- mistakes_left (if (contains? game_word (car guessed_list))
0 1))))
(if (= n_mistakes_left 0)
(display n_mistakes_left);; End game output
(let ((display_word (fill-in-guess (list (car guessed_list))
game_word display_word))
(guessed_list (sort guessed_list string<?)))
(display "You have guessed: ")
(display-list guessed_list ", ")
(display "\n\n")
(draw-hangman n_mistakes_left)
(display "\n\nWord: ")
(display-list display_word " ")
(cond ((contains? display_word "_")
(display "\n\nEnter a letter to guess: ")
(game-loop (append (list (symbol->string (read))) guessed_list)
display_word n_mistakes_left))
(else (display "\n\nYou Won!")))))))
I can post my helper methods contains?, fill-in-guess, display-list, draw-hangman if necessary, but all of them work as they should and do not change values of my mistakes_left variable for their functionality.
The problem I am running into is my mistakes_left variable starts out at 6 and passes through fine on the first call of game-loop, but on subsequent calls, gets smaller even when guessing a correct value. I have taken every piece individually, tested it and mistakes_left comes out with the right value until I recurse.
I suspect it has to do with the recurse and "let"ing my variable, but I would like a difinitive answer if anyone could or point out the most likely simple error I am missing!
EDIT:
Here is the rest of the code to test, I still get the issue. I think append worked because it appends the second list to the first, so in that sense cons and append gave me the same input.
(define zero_wrong "
|---------
| |
|
|
|
|
|
|
|
|_______________")
(define one_wrong "
|---------
| |
___
| |. .|
---
|
|
|
|
|
|
|_______________")
(define two_wrong "
|---------
| |
___
| |. .|
---
| |
|
| |
|
|
|
|
|
|_______________")
(define three_wrong "
|---------
| |
___
| |. .|
---
| |
|----
| |
|
|
|
|
|
|_______________")
(define four_wrong "
|---------
| |
___
| |. .|
---
| |
----|----
| |
|
|
|
|
|
|_______________")
(define five_wrong "|---------
| |
___
| |. .|
---
| |
----|----
| |
|
| \\
\\
|
|
|
|_______________")
(define six_wrong "|---------
| |
___
| |x x|
---
| |
----|----
| |
|
| / \\
/ \\
|
|
|
|_______________")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Read list value at x.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (get-str-at x str_lst)
(cond ((equal? x 0)
(car str_lst))
(else
(get-str-at (- x 1) (cdr str_lst))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Car operation for strings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-car str)
(substring str 0 1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cdr operation for strings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-cdr str)
(substring str 1 (string-length str))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Converts a string into a
;; list of character strings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-to-char-string-list str)
(cond
((equal? (string-cdr str) "")
(list str)
)
(
(append (list (string-car str)) (string-to-char-string-list (string-cdr str)))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests if a list contains a spefified object.
;;
;; Method code from:
;; http://stackoverflow.com/questions/1869116/scheme-built-in-to-check-list-containment
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (contains? list item)
(if (empty? list)
#f
(or (eq? (first list) item)
(contains? (rest list) item)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Displays a list with the
;; given separater.
;;
;; Base code from:
;; ftp://ftp.cs.utexas.edu/pub/garbage/cs345/schintro-v13/schintro_99.html
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (display-list a_list separater)
(if (null? a_list)
(display "")
(begin
(display (car a_list))
(if (null? (cdr a_list))
(display "")
(display separater))
(display-list (cdr a_list) separater)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Gets the Xth word in the
;; provided file.
;;
;; Does not check for eof
;; condition, so x must be
;; within range of the file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (get-word x file)
(cond
((= 1 x)
(read file))
(else
(read file)
(get-word (- x 1) file)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Returns a list of blanks
;; equal to the number of
;; letters in provided word.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (init-display-word game_word)
(cond
((null? game_word)
(list))
(else
(append (init-display-word (cdr game_word)) '("_"))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fills in the blank spaces
;; in the display word with
;; the letter that matches
;; those positions in the
;; game word.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (fill-in-guess letter game_word display_word)
(cond
((null? game_word)
(list)
)
(else
(cond
((equal? letter (list (car game_word)))
(append letter (fill-in-guess letter (cdr game_word) (cdr display_word)))
)
(else
(append (list (car display_word)) (fill-in-guess letter (cdr game_word) (cdr display_word)))
)
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Draws the hanging man.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (draw-hangman guesses_left)
(cond ((equal? guesses_left 6)
(display zero_wrong))
(else (cond ((equal? guesses_left 5)
(display one_wrong))
(else (cond ((equal? guesses_left 4)
(display two_wrong))
(else (cond ((equal? guesses_left 3)
(display three_wrong))
(else (cond ((equal? guesses_left 2)
(display four_wrong))
(else (cond ((equal? guesses_left 1)
(display five_wrong))
(else (display six_wrong))
)))))))))))
)
I have made several modifications to your code. I have marked my changes with comments above the function, explaining them. You problem was that you sorted guessed_list. There is no need to do so. I have tested it and it works. Keep in mind, that if you call game-loop with an empty list of guesses it will error. To fix that you need to test if guessed_list is null, and also return 0 for the subtraction. I will leave that to you.
Also in many places in your code, you had nested conds That is not necessary. Read here: cond
(define game_word '("a" "b" "c"))
(define zero_wrong "
|---------
| |
|
|
|
|
|
|
|
|_______________")
(define one_wrong "
|---------
| |
___
| |. .|
---
|
|
|
|
|
|
|_______________")
(define two_wrong "
|---------
| |
___
| |. .|
---
| |
|
| |
|
|
|
|
|
|_______________")
(define three_wrong "
|---------
| |
___
| |. .|
---
| |
|----
| |
|
|
|
|
|
|_______________")
(define four_wrong "
|---------
| |
___
| |. .|
---
| |
----|----
| |
|
|
|
|
|
|_______________")
(define five_wrong "|---------
| |
___
| |. .|
---
| |
----|----
| |
|
| \\
\\
|
|
|
|_______________")
(define six_wrong "|---------
| |
___
| |x x|
---
| |
----|----
| |
|
| / \\
/ \\
|
|
|
|_______________")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Read list value at x.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (get-str-at x str_lst)
(cond ((equal? x 0)
(car str_lst))
(else
(get-str-at (- x 1) (cdr str_lst)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Car operation for strings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-car str)
(substring str 0 1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cdr operation for strings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; *** This is enough.
(define (string-cdr str)
(substring str 1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Converts a string into a
;; list of character strings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-to-char-string-list str)
(cond
((equal? (string-cdr str) "")
(list str))
((append (list (string-car str)) (string-to-char-string-list (string-cdr str))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests if a list contains a spefified object.
;;
;; Method code from:
;; http://stackoverflow.com/questions/1869116/scheme-built-in-to-check-list-containment
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (contains? list item)
(if (empty? list)
#f
(or (string=? (first list) item)
(contains? (rest list) item))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Displays a list with the
;; given separater.
;;
;; Base code from:
;; ftp://ftp.cs.utexas.edu/pub/garbage/cs345/schintro-v13/schintro_99.html
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (display-list a_list separater)
(if (null? a_list)
(display "")
(begin
(display (car a_list))
(if (null? (cdr a_list))
(display "")
(display separater))
(display-list (cdr a_list) separater))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Gets the Xth word in the
;; provided file.
;;
;; Does not check for eof
;; condition, so x must be
;; within range of the file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (get-word x file)
(cond
((= 1 x)
(read file))
(else
(read file)
(get-word (- x 1) file))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Returns a list of blanks
;; equal to the number of
;; letters in provided word.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (init-display-word game_word)
(cond
((null? game_word)
(list))
(else
(append (init-display-word (cdr game_word)) '("_")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fills in the blank spaces
;; in the display word with
;; the letter that matches
;; those positions in the
;; game word.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; No need for append here. Just use cons when adding to the start of the list.
; No need to nest conds
(define (fill-in-guess letter game_word display_word)
(cond
((null? game_word)
'())
((equal? letter (car game_word))
(cons letter (fill-in-guess letter (cdr game_word) (cdr display_word))))
(else
(cons (car display_word)
(fill-in-guess letter (cdr game_word) (cdr display_word))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Draws the hanging man.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; You used cond as an if/else statement. You can have multiple clauses in a cond.
; You only need one final else cluase.
(define (draw-hangman guesses_left)
(cond ((equal? guesses_left 6)
(display zero_wrong))
((equal? guesses_left 5)
(display one_wrong))
((equal? guesses_left 4)
(display two_wrong))
((equal? guesses_left 3)
(display three_wrong))
((equal? guesses_left 2)
(display four_wrong))
((equal? guesses_left 1)
(display five_wrong))
(else (display six_wrong))))
; Don't sort the guessed-list.
; You had display when guess left was 0. Not draw_hagman
(define (game-loop guessed_list display_word mistakes_left)
(let ((n_mistakes_left
(- mistakes_left (if (contains? game_word (car guessed_list))
0 1))))
(if (= n_mistakes_left 0)
(draw-hangman n_mistakes_left);; End game output
(let ((display_word (fill-in-guess (car guessed_list)
game_word display_word)))
(display "You have guessed: ")
(display-list guessed_list ", ")
(display "\n\n")
(draw-hangman n_mistakes_left)
(display "\n\nWord: ")
(display-list display_word " ")
(cond ((contains? display_word "_")
(display "\n\nEnter a letter to guess: ")
(game-loop (cons (symbol->string (read)) guessed_list)
display_word n_mistakes_left))
(else (display "\n\nYou Won!")))))))
I generalize the question to not focus on the hangman aspect of it. There was an immediate answer to the problem and comments further explained the reasoning for the error. You can find all of that information in this post: Scheme Recursion Loop Incorrect Values and Variable Binding.

Resources