Scheme Formatting Help - scheme

I've been working on a project for school that takes functions from a class file and turns them into object/classes. The assignment is all about object oriented programming in scheme.
My problem however is that my code doesn't format right.
The output it gives me whenever I give it a file to pass in wraps the methods of the class in a list, making it so that the class never really gets declared. I can't for the life of me figure out how to get the parenthesis wrapping the method list to remove.
I would really appreciate any help.
Below is the output, the class file and the code,.
(define pointInstance
(let ((myx 1) (myy 2))
(lambda msg
(cond
(((eq? (car msg) getx) myx)
((eq? (car msg) gety) myy)
((eq? (car msg) setx) (set! myx x))
((eq? (car msg) show) (begin (display "[") (display myx) (display ",") (display myy) (display "]"))))))))
If you look at just after the cond you'll see how all those eq statements are contained in a list. I can't get this to work right unless they're not wrapped by that top level list.
;;;; PART1 --- A super-easy set of classes. Just models points and lines. Tests all of >the
;; basics of class behavior without touching on anything particularly complex.
(class pointInstance (parent:) (constructor_args:)
(ivars: (myx 1) (myy 2))
(methods:
(getx () myx)
(gety () myy)
(setx (x) (set! myx x))
(show () (begin (display "[") (display myx) (display ",") (display myy) (display "]")))
))
(require (lib "trace.ss"))
;; Continue reading until you hit the end of the file, all the while
;; building a list with the contents
(define load-file
(lambda (port)
(let ((rec (read port)))
(if (eof-object? rec)
'()
(cons rec (load-file port))))))
;; Open a port based on a file name using open-input-file
(define (load fname)
(let ((fport (open-input-file fname)))
(load-file fport)))
;(define lis (load "C:\\Users\\Logan\\Desktop\\simpletest.txt"))
;(define lis (load "C:\\Users\\Logan\\Desktop\\complextest.txt"))
(define lis (load "C:\\Users\\Logan\\Desktop\\pointinstance.txt"))
;(display (cdaddr (cdddar lis)))
(define makeMethodList
(lambda (listToMake retList)
;(display listToMake)
(cond
[(null? listToMake)
retList
;(display "The list passed in to parse was null")
]
[else
(makeMethodList (cdr listToMake) (append retList (list (getMethodLine listToMake))))
]
)
))
;(trace makeMethodList)
;this works provided you just pass in the function line
(define getMethodLine
(lambda (functionList)
`((eq? (car msg) ,(caar functionList)) ,(caddar functionList))))
(define load-classes
(lambda paramList
(cond
[(null? paramList) (display "Your parameters are null, man.")]
[(null? (car paramList))(display "Done creating class definitions.")]
[(not (null? (car paramList)))
(begin
(let* ((className (cadaar paramList))
(classInstanceVars (cdaddr (cddaar paramList)))
(classMethodList (cdr (cadddr (cddaar paramList))))
(desiredMethodList (makeMethodList classMethodList '()))
)
;(display "Classname: ")
;(display className)
;(newline)(newline)
;(display "Class Instance Vars: ")
;(display classInstanceVars)
;(newline)(newline)
;(display "Class Method List: ")
;(display classMethodList)
;(newline)
;(display "Desired Method List: ")
;(display desiredMethodList))
;(newline)(newline)
;----------------------------------------------------
;do not delete the below code!`
`(define ,className
(let ,classInstanceVars
(lambda msg
;return the function list here
(cond ,(makeMethodList classMethodList '())))
))
;---------------------------------------------------
))]
)
))
(load-classes lis)
;(load-classes lis)
;(load-classes-helper lis)
;(load-classes "simpletest.txt")
;(load-classes "complextest.txt")
;method list
;(display (cdr (cadddr (cddaar <class>))))

You have too many opening parenthesis in the 1st clause of the cond.
IE:
(((eq? (car msg) getx) myx)
^
Updated:
Are you looking for this?
(cond ,#(makeMethodList classMethodList '())
^^
Or you can do:
(cond . ,(makeMethodList classMethodList '())

Related

Why do I get "application: not a procedure" with this for loop in Racket?

The following code reads a csv file and based on its content generates a Prolog program:
#!/usr/bin/env racket
#lang racket/base
(define (overwrite-s-to-f fname s); Will create fname and write overwriting the previous content.
(with-output-to-file #:exists 'truncate fname (lambda () (displayln s))))
(define (c-o-a-line-to-f fname s); Will append a string to fname or create it if does not exist. Appends a new line.
(with-output-to-file #:exists 'append fname (lambda () (displayln s))));
(define fname "women.csv")
(define pl-fname "females-by-Racket.pl")
(require racket/file)
(define content (file->lines fname))
(define disc-line (string-append ":-discontiguous(" (string-replace (car content) "Name," "") ").\n"))
(overwrite-s-to-f pl-fname disc-line)
(define list-of-verbs (string-split (string-replace (car content) "Name," "") ","))
(require racket/string racket/system)
(for ((row content));content is a list of strings
(let ((list-of-cs (string-split row ",")))
(when (equal? (car (cdr list-of-cs)) "+")
(displayln row)(let ((cmd (string-append "awesome("(car list-of-cs)").")))(c-o-a-line-to-f pl-fname cmd)(displayln cmd)))
(when (equal? (car (cdr (cdr list-of-cs))) "+")(displayln row)(let ((cmd (string-append "and_intelligent("(car list-of-cs)").")))
(c-o-a-line-to-f pl-fname cmd)(displayln cmd))))); TODO: when for each columns 2-last of women.csv
The content of women.csv:
Name,awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts
adriana_chechik,+,,,+,?,+,+,,-,,,,,
alysa_gap,+,,,,?,+,+,,-,,,,,
anna_de_ville,+,,,,,+,+,,+,-,+,-,-,
aurora_jolie,+,+,,,,,,,+,+,+,,+,
autumn_falls,,,,,,,,,+,+,-,+,+,
casey_calvert,+,,,,,,,,+,+,+,,,
dahlia_sky,+,,,,,,+,,,,,,,
dominica_lito,+,,,,,,+,,,,,,,
ella_knox,,,,,,,,,+,+,+,,+,
isabella_clark,+,,,,,,+,,,,,,,
jade_kush,,,,,,,,,+,+,,,+,
juelz_ventura,+,,,,,+,,,-,-,,,-,+
kapri_styles,,,,,,,,,+,,+,,,
kristina_milan,,,,,,,,,+,+,,,+,
kylie_sinner,+,+,,,,,,,+,,,,-,
leigh_raven,+,,,,,+,,,+,+,,,,
maserati,,,,,,,,,+,+,,,+,
miosotis,,,,,,,,,+,+,,,+,
scarlett_bloom,,,,,,,,,+,+,+,,-,
sheena_shaw,,,,,,,,,-,,+,,-,
sofia_rose,,,,,,,,,+,,,,+,
teanna_trump,+,,,,,,,,+,,+,,,
veronica_avluv,+,,,,,,+,,,,,,,
yudi_pineda,+,,,,,,,,+,+,,,,
females-by-Racket.pl is to look like so:
:-discontiguous(awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts).
awesome(adriana_chechik).
awesome(alysa_gap).
awesome(anna_de_ville).
awesome(aurora_jolie).
and_intelligent(aurora_jolie).
awesome(casey_calvert).
awesome(dahlia_sky).
awesome(dominica_lito).
awesome(isabella_clark).
awesome(juelz_ventura).
awesome(kylie_sinner).
and_intelligent(kylie_sinner).
awesome(leigh_raven).
awesome(teanna_trump).
awesome(veronica_avluv).
awesome(yudi_pineda).
but with more predicates (up to n-1 for each woman where n is the number of columns in women.csv)
The names of the columns or the numbers thereof in women.csv are likely to be frequently changed.
That is partly why I wish to avoid manually coding for every when. The other concerns are the sheer amount of the lines to code (15 whens for each column) and the risk of error/typo.
Is it doable to loop through every cell in list-of-cs in such way that it is taken from list-of-verbs?
I've tried this but to no avail (the comment show the error message that I got):
(for ((row content))
(let ((list-of-cs (cdr (string-split row ","))))
(for ((cell list-of-cs))
; application: not a procedure; expected a procedure
; that can be applied to arguments
(set! list-of-verbs (cdr (list-of-verbs)))
(let ((verb (car list-of-verbs)))
(when (equal? cell "+")
(displayln row)
(let ((cmd (string-append verb "(" (car row) ").")))
(c-o-a-line-to-f pl-fname cmd)))
))))
named let is a useful form to be familiar with:
#lang scheme
(define (csv->attributes rows) ;; ListOfString -> ListOfString
;; produce "column-header(row-name)" for "+" entries in csv (see example)
(let ([fields (string-split (car rows) ",")])
(let next-row ([rows (cdr rows)] [result (list)])
(cond
[(null? rows) (reverse result) ]
[else
(let* ([cells (string-split (car rows) ",")]
[name (car cells)])
(let next-cell ([cells (cdr cells)] [fields (cdr fields)] [result result])
(cond
[(null? cells) (next-row (cdr rows) result) ]
[else (next-cell
(cdr cells) (cdr fields)
(if (string=? (car cells) "+")
(cons (string-append (car fields) "(" name ")") result)
result)) ]))) ]))))
(define trio '("Name,fast,slow,sidles"
"Achilles,+,,"
"Tortoise,,+,"
"Crab,,+,+"))
Welcome to DrRacket, version 8.5 [cs].
Language: scheme, with debugging.
> (csv->attributes trio)
("fast(Achilles)" "slow(Tortoise)" "slow(Crab)" "sidles(Crab)")
>

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.

scheme - display won't print on screen in a recursive function

I have the function getBoundedVars which uses the function boundsInLambda. In the end of it all the box bBox should contain all bounded variables in the expression exp.
I'm trying to debug this function and in order to do so I want to print the parameters of boundsInLambda every time the function is being activated but for some reason the values won't show up on the screen.
If I put the display operation in getBoundedVars it will print it but those are just the values in the first iteration.
If I run the following :
(getBoundedVars (lambda-simple (x) (lambda-simple (y) (const x))) bx)
when bx is an empty box,
'1 will be printed but the print commands in boundsInLambda will not
here's the code:
(define getBoundedVars
(lambda (exp bBox)
(if (atom? exp)
0 ;; don't put in box
(if (lambda? (car exp))
(begin
(display 1)
(newline)
(let ((pBox (make-pBox exp))
(lBox (box '()))
(bodyExp (make-body exp))
)
(boundsInLambda bodyExp lBox pBox bBox)))
(begin
(getBoundedVars (car exp) bBox)
(getBoundedVars (cdr exp) bBox))))))
(define boundsInLambda
(lambda (bodyExp lastBox paramBox boundsBox)
(newline)
(display `(bodyExp: ,bodyExp))
(newline)
(display `(lastBox: ,lastBox))
(newline)
(display `(paramBox: ,paramBox))
(newline)
(display `(boundsBox: ,boundsBox))
(newline)
(if (and (not (null? bodyExp))
(list bodyExp)
(equal? (car bodyExp) 'seq)
)
(map boundsInLambda (cadr bodyExp))
(let* ( (lists* (filter (lambda (el) (and (not (null? el)) (list? el) (not (equal? (car el) 'const)))) bodyExp))
(lists (map (lambda (el) (if (equal? (car el) 'set) (cddr el) el)) lists*))
(bounds (filter (lambda (el) (and (member el (unbox lastBox)) (not (member el (unbox paramBox))))) bodyExp))
(listsLeft? (> (length lists) 0))
(anyBounds? (> (length bounds) 0))
)
(if anyBounds?
(begin
(set-box! boundsBox (append (unbox boundsBox) bounds))))
(if listsLeft?
(map
(lambda (lst)
(if (lambda? (car lst))
(let* ((newBodyExp (make-body lst))
(newParamBox (make-pBox exp))
(newLastBox (box (append (unbox lastBox) (unbox paramBox))))
)
(boundsInLambda newBodyExp newLastBox newParamBox boundsBox))
(boundsInLambda lst lastBox paramBox boundsBox)))
lists)
0))
)))
(define make-pBox
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-simple)
(box (cadr lamExp))
(if (equal? (car lamExp) 'lambda-opt)
(box (cadr lamExp))
(box '())))))
(define make-body
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-opt)
(cdddr lamExp)
(cddr lamExp))))
any help would be very much appreciated.

Display elements in list with for-each

I have 1 big list of smaller 3-element-lists that look like:
( ("001" "Bob" 80) ("002" "Sam" 85) ("003" "Aaron" 94) etc . . .)
I'm trying to create something like:
No.1: ID=001, Name=’’Bob’’, Grade=80
No.2: ID=002, Name=’’Sam’’, Grade=85
No.3: ID=003, Name=’’Aaron’’, Grade=94
I only have access to display and for-each (no "for" or "printf" functions)
I've been trying to create a for-each function that takes the list and:
pseudo-code:
for-each list in list
display "ID=(car list)"
display "Name ="(cadr list)" "
etc
Any help would be greatly appreciated!
So, your interpreter doesn't have printf after all? that's a shame. We can get the desired output by hand, it's a bit cumbersome but this should work on most Scheme interpreters, notice that an extra procedure is required for keeping track of the index:
(define lst
'(("001" "Bob" 80) ("002" "Sam" 85) ("003" "Aaron" 94)))
(define (add-index lst)
(let loop ((lst lst) (idx 1))
(if (null? lst)
'()
(cons (cons idx (car lst))
(loop (cdr lst) (+ idx 1))))))
(for-each (lambda (e)
(display "No.")
(display (car e))
(display ": ID=")
(display (cadr e))
(display ", Name=’’")
(display (caddr e))
(display "’’, Grade=")
(display (cadddr e))
(newline))
(add-index lst))
It prints the desired result:
No.1: ID=001, Name=’’Bob’’, Grade=80
No.2: ID=002, Name=’’Sam’’, Grade=85
No.3: ID=003, Name=’’Aaron’’, Grade=94
Here's another version. It avoids construction of a temporary list.
(define lst
'(("001" "Bob" 80) ("002" "Sam" 85) ("003" "Aaron" 94)))
(define (print-list lst)
(define (display-one-item item index)
(display "No.")
(display index)
(display ": ID=")
(display (car item))
(display ", Name=’’")
(display (cadr item))
(display "’’, Grade=")
(display (caddr item))
(newline))
(define (helper in index)
(if (not (null? in))
(begin
(display-one-item (car in) index)
(helper (cdr in) (+ index 1))
)))
(helper lst 0))
(print-list lst)

Improperly placed closed parenthesis in scheme function

I have the following scheme function:
(define get-ivars
(λ (ivars num)
(cond ((null? ivars) '())
(else
(append (list (car ivars) `(nth args ,num)) (list (get-ivars (cdr ivars) (+ num 1))))))))
That returns the following in a specific instance:
(x (nth args 1) (y (nth args 2) ()))
The problem is, I need it to return:
((x (nth args1)) (y (nth args 2)) ())
-the two closing parenthesis at the end should be after the (nth statements.
How would I go about getting this to work properly?
get-ivars caller:
(define gen-classes
(λ (classes)
(cond ((null? classes) '())
(else
(let* ((class (car classes)))
(eval
`(define ,(cadr class)
(λ (args)
(let (
,(get-ivars (cdr (cadddr class)) 1)
)
(eval
(let* ,(cdar (cddddr class))
(λ (method . args)
,(get-methods (cdadr (cddddr class)))
))))))))))))
That second (list ...) in your else clause is what's screwing you up. It's nesting each successive call deeper and deeper. The recursion will naturally create the list; you don't need to wrap it again.
Try:
(define get-ivars
(λ (ivars num)
(if (null? ivars) '()
(cons (list (car ivars) `(nth args ,num))
(get-ivars (cdr ivars) (+ num 1))))))
Regarding the get-ivars caller code, the parentheses surrounding the unquoted call to get-ivars are what's giving you the trouble you mention in the comments. With them, this code:
`(define ClassName
(lambda (args)
(let (,(get-ivars '(iVar1 iVar2 iVar3) 1))
;; your method-getting code
)))
Gives you this:
(define ClassName
(lambda (args)
(let (((iVar1 (nth args 1))
(iVar2 (nth args 2))
(iVar3 (nth args 3))))
;; method-getting code
)))
Which, as you can see, gives you an extra set of parentheses around the assignments in the let.
So you want to do this:
`(define ClassName
(lambda (args)
(let ,(get-ivars '(iVar1 iVar2 iVar3) 1)
;; your method-getting code
)))
get-ivars is returning a list of lists, which is exactly what you want for the assignments in the let, so you don't need to wrap or (as I had it earlier) splice it. Just use the unquote on its own, and the result is:
(define ClassName
(lambda (args)
(let ((iVar1 (nth args 1))
(iVar2 (nth args 2))
(iVar3 (nth args 3)))
;; method-getting code
)))
Which should do the trick.
Incidentally, I found it helpful to leave off the eval when I was playing around with this; one can then visually inspect the result to make sure its syntax is okay.
I haven't tried this, but I think this would work:
(define (get-ivars ivars num)
(if (null? ivars)
'()
(list (list (car ivars) `(nth args ,num))
(get-ivars (cdr ivars) (1+ num)))))

Resources