From: Niklas Ulvinge <[EMAIL PROTECTED]>
Date: 2008/7/2
Subject: Fresh ideas from a beginner
To: readable-discuss@lists.sourceforge.net
Hello
I've seen that this list has been a little inactive lately,
but it doesn't matter. Here's an implementation of
both a i-expression pretty printer (idisplay), and an
i-expression reader (iread). Currently I do not escape
characters, and that's the only thing my code can't
handle as far as I can see.
My pretty printer also prints much more beautiful code
than the others I've tried.
I don't know how well this conforms to the standard,
(or the scheme standard, for that matter) but it looks
like it should work very well.
I also don't know how good it is to write code with it
but that is going to change, as my next project will
be written with only iexpr.
Well, here's the code:
(define (flatten l)
(if (not (list? l))
(list l)
(if (null? l)
'()
(append (flatten (car l))
(flatten (cdr l))))))
(define (idisplay l)
(define group "group ")
(define (indent i)
(make-string i #\space))
(define (len l)
(if (null? l)
0
(+ (string-length (car l))
(len (cdr l)))))
(define (make-single l)
(define (remove-multiple-newlines l)
(if (null? (cdr l))
'()
(if (equal? (car l) "\n")
(if (equal? (cadr l) "\n")
(remove-multiple-newlines (cdr l))
(cons "\n"
(remove-multiple-newlines (cdr l))))
(cons (car l)
(remove-multiple-newlines (cdr l))))))
(apply string-append (remove-multiple-newlines l)))
(define (parse l i)
(write (list i l)) (newline)
(flatten
(cond ((list? l) (parse-list l i))
((symbol? l) (list (symbol->string l)))
((number? l) (list (number->string l)))
((null? l) "'()")
((string? l) (list "\"" l "\""))
((pair? l) (list "(" (parse (car l)) " . " (parse (cdr l)) ")"))
(else "undef"))))
(define (parse-list l i)
(if (list? (car l))
(list group
(parse (car l) (+ i (string-length group)))
(map (lambda(k)
(list "\n"
(indent (+ i (string-length group)))
(parse k (+ i (string-length group)))))
(cdr l)))
(let* ((first (parse (car l) i))
(len (len first)))
(list (if (null? (cdr l))
(list group first)
(list first
(indent 1)
(parse (cadr l) (+ i len 1))
(map (lambda(k)
(list "\n"
(indent (+ i len 1))
(parse k (+ i len 1))))
(cddr l))))
"\n"))))
(make-single (parse l 0)))
*********************************** iread ***********************************
(define (iread port)
(define lparen #\()
(define rparen #\))
(define peek '())
(define indent 0)
(define (get)
(let ((ret peek))
(if (equal? ret #\newline)
(set! indent 0)
(set! indent (+ 1 indent)))
(if (eof-object? (peek-char port))
(set! peek '())
(begin
(set! peek (read-char port))))
ret))
(define (tokenise)
(define (read-token)
(define (loop)
(if (or (null? peek)
(char-whitespace? peek)
(equal? #\; peek)
(equal? lparen peek))
'()
(cons (get)
(loop))))
(list->string (loop)))
(define (read-comment)
(if (equal? peek #\newline)
(read-whitespace)
(begin (get)
(read-comment))))
(define (read-whitespace)
(if (equal? peek #\;) ; ; IS preceded by whitespace
(read-comment)
(if (and (not (null? peek))
(char-whitespace? peek))
(begin (get)
(read-whitespace)))))
(define (read-string)
(define (loop)
(if (null? peek)
'()
(if (equal? peek #\")
(cons (get)
'())
(cons (get)
(loop)))))
(list->string (cons (get) ;becouse of the first #\"
(loop))))
(define (read-sexpr)
(define (loop n-open-parens)
(cond ((null? peek) '())
((equal? peek lparen) (cons (get)
(loop (+ n-open-parens 1))))
((equal? peek rparen) (if (= 1 n-open-parens)
(cons (get) ;exit loop
'())
(cons (get)
(loop (- n-open-parens 1)))))
(else (cons (get)
(loop n-open-parens)))))
(list->string (loop 0)))
(read-whitespace)
(cons indent
(if (equal? peek lparen)
(read-sexpr)
(if (equal? peek #\")
(read-string)
(read-token)))))
(define peekt '())
(define (gett)
(let ((ret peekt))
(set! peekt (tokenise))
(if (equal? (cdr peekt) "")
(set! peekt '(-1 . ())))
ret))
(define (tokens->list i)
(define (head i)
(let ((first (cdr (gett))))
(if (equal? "group" first)
(body (car peekt))
(if (< i (car peekt)) ;we have childs
(append (list first)
(body (car peekt)))
first))))
(define (body i)
(if (= i (car peekt))
(cons (head i)
(body i))
'()))
(body i))
(define (to-string l)
(define (loop l)
(if (list? l)
(append (list "(")
(map loop l)
(list ") "))
(list l " ")))
(apply string-append (flatten (loop l))))
(set! peek (peek-char port))
(gett)
(call-with-input-string (to-string (tokens->list 0))
read))
(define input1 "
define fac x
if = x
0
1
* x
fac - x
1
fac 4
")
(define input2 "
z a
b c
(+ 1 d)
group e f
g ;test
group h
i
\"hello\"
quote j
")
(define fac '(define (fac x)
(if (= x 0)
1
(* x
(fac (- x 1))))))
(define (iexecute port)
(map (lambda(e) (write e) (newline) (write (eval e)) (newline))
(iread port)))
(display input1) (newline)
(iexecute (open-input-string input1)) (newline)
************************************ EOF ************************************
Please excuse my poor coding style, I've only been
programming in scheme for about a month.
Another thing I found out is that the (a) special case
for a list with only one item in it isn't necessary,
it can be solved with group a instead....
Niklas Ulvinge aka IDK
wishes everybody happy
programming and bliss.
-------------------------------------------------------------------------
Sponsored by: SourceForge.net Community Choice Awards: VOTE NOW!
Studies have shown that voting for your favorite open source project,
along with a healthy diet, reduces your potential for chronic lameness
and boredom. Vote Now at http://www.sourceforge.net/community/cca08
_______________________________________________
Readable-discuss mailing list
Readable-discuss@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/readable-discuss
