Call of non procedure <#unspecific> - scheme

I'm trying to convert sexps to xml, I have a recursive function that goes through a list representing an xml tag and its child tags, and then prints them to the standard output with correct indentation.
I'm using the chicken scheme compiler.
source:
(use srfi-13)
(use extras)
;Returns the length of a list
(define (len lst)
(define (len-help lst count)
(cond ((not (eq? lst '())) (len-help (cdr lst) (+ count 1)))
(else count)))
(len-help lst 0))
(define (const-l fil len)
;makes a constant list of symbol fil len times
(cond ((> len 0) (cons fil (const-l fil (- len 1))))
(else '())))
;makes a string out of a list of tag attribute strings
(define (make-attribute-string tag-atribs)
(cond ((eq? tag-atribs '()) "")
(else (string-join tag-atribs " "))))
(define (indent num)
(string-join (const-l " " num) ""))
;makes a tag structure from args
;tag-name is a symbol
;tag-attribs is a lis of tag attribute strings
;i.e.: '("att1='val1'" "att2='val2'")
(define (make-tag tag-label tag-atribs tag-elements)
`(,tag-label ,(make-attribute-string tag-atribs) ,tag-elements))
(define (tag-name tag)
(car tag))
(define (tag-atribs tag)
(cadr tag))
(define (tag-elems tag)
(caddr tag))
(define (print-tag tag close ind)
(cond ((eq? close #f) (printf "~A<~A ~A>" (indent ind) (tag-name tag) (tag-atribs tag)))
((eq? close #t) (printf "~A<~A/>" (indent ind)(tag-name tag)))))
(define (display-heir tag)
(define (recursive-display tag indent)
(print-tag tag #f indent)
(newline)
(cond ((not (eq? (tag-elems tag) '()))
(map (lambda (tg) (
(recursive-display tg (+ indent 1))))
(tag-elems tag))))
(print-tag tag #t indent)
(newline))
(recursive-display tag 0))
(define tg3 (make-tag 'Person '("name='Joe'" "age='5'" "sex='Male'") '()))
(define tg4 (make-tag 'Person '("name='Sally'" "age='1'" "sex='Female'") '()))
(define tg2 (make-tag 'children '() (list tg3 tg4)))
(define tg1 (make-tag 'Person '("name='Bob'" "age='21'" "sex='Male'") (list tg2)))
;this doesnt work, stops working after printing first element in innermost
;level of the heirarchy, should work like the next block with some additional
;newlines
(display-heir tg1)
;this displays the tags correctly
(print-tag tg1 #f 0)
(newline)
(print-tag tg2 #f 1)
(newline)
(print-tag tg3 #f 2)(print-tag tg3 #t 0)
(newline)
(print-tag tg4 #f 2)(print-tag tg4 #t 0)
(newline)
(print-tag tg2 #t 1)
(newline)
(print-tag tg1 #t 0)
I compiled it with normal settings csc xml.scm -o xml.exe
I get the following
C:\Users\jorda\Documents\iupprac\more>csc xml.scm
C:\Users\jorda\Documents\iupprac\more>xml
<Person name='Bob' age='21' sex='Male'>
<children >
<Person name='Joe' age='5' sex='Male'>
<Person/>
Error: call of non-procedure: #<unspecified>
Call history:
xml.scm:45: newline
xml.scm:46: tag-elems
xml.scm:50: print-tag
xml.scm:40: ##sys#check-output-port
xml.scm:40: indent
xml.scm:21: const-l
xml.scm:12: const-l
xml.scm:12: const-l
xml.scm:21: string-join
xml.scm:40: ##sys#print
xml.scm:40: ##sys#write-char-0
xml.scm:40: tag-name
xml.scm:40: ##sys#print
xml.scm:40: ##sys#print
xml.scm:51: newline
xml.scm:47: g105 <--
If you remove the (display-heir tg1) it gives the correct output with the code that follows after that line:
<Person name='Bob' age='21' sex='Male'>
<children >
<Person name='Joe' age='5' sex='Male'><Person/>
<Person name='Sally' age='1' sex='Female'><Person/>
<children/>
<Person/>

The problem here is the procedure that you pass to map:
(define (display-heir tag)
(define (recursive-display tag indent)
(print-tag tag #f indent)
(newline)
(cond ((not (eq? (tag-elems tag) '()))
(map (lambda (tg) (
(recursive-display tg (+ indent 1))))
(tag-elems tag))))
(print-tag tag #t indent)
(newline))
If you indent this correctly, you may spot the problem more easily:
(define (display-heir tag)
(define (recursive-display tag indent)
(print-tag tag #f indent)
(newline)
(cond ((not (eq? (tag-elems tag) '()))
(map (lambda (tg) (
(recursive-display tg (+ indent 1))))
(tag-elems tag))))
(print-tag tag #t indent)
(newline))
(recursive-display tag 0))
As you can (hopefully) see, the call to recursive-display is wrapped in an extra set of parentheses. This means it will try to call the result of recursive-display as a procedure (which it isn't, it's void or #<unspecified>)

Related

How might I use letrec in this function so that it does the same job as it does with named let?

I've read here that named let can be rewritten with letrec.
And so I proceeded to rewrite the following function with letrec:
(define (duplicate pos lst)
(let dup ([i 0] [lst lst])
(cond
[(= i pos) (cons (car lst) lst)]
[else (cons (car lst) (dup (+ i 1) (cdr lst)))])))
My attempt at this:
(define (duplicate pos lst)
(letrec ((dup (lambda ([i 0] [lst lst])
(cond
[(= i pos) (cons (car lst) lst)]
[else (cons (car lst) (dup (+ i 1) (cdr lst)))]))))))
Sadly, when I call it with (duplicate 1 (list "apple" "cheese burger!" "banana")) I get from Racket letrec: bad syntax (missing body). How might I rewrite duplicate with letrec?
As you can see in the documentation for letrec, it has these arguments:
(letrec ([id val-expr] ...) body ...+)
So, you have to add at least one body form after definitions.
I also replaced cond with if (you have only two branches of code), (+ ... 1) with add1 and improved indentation:
#lang racket
(define (duplicate pos lst)
(letrec ((dup (lambda ([i 0] [lst lst])
(if (= i pos)
(cons (car lst)
lst)
(cons (car lst)
(dup (add1 i) (cdr lst)))))))
(dup)))
Test:
> (duplicate 1 (list "apple" "cheese burger!" "banana"))
'("apple" "cheese burger!" "cheese burger!" "banana")
The named let is (more or less) a locally defined regular procedure that is called "behind the scenes".
The body of a named let is not the body of the equivalent "unnamed" let, but the body of that procedure;
(let f ([x init])
body)
can be rewritten as
(letrec ([f (lambda ([x init]) body)])
(f))
or, without using default arguments (which some would find clearer),
(letrec ([f (lambda (x) body)])
(f init))

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)")
>

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)

Scheme Formatting Help

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 '())

Resources