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