#!/home/arne/wisp/wisp-multiline.sh
; !#
;; Scheme-only implementation of a wisp-preprocessor which output a
;; scheme Tree IL to feed to a scheme interpreter instead of a
;; preprocessed file.
;; Plan:
;; read reads the first expression from a string. It ignores comments,
;; so we have to treat these specially. Our wisp-reader only needs to
;; worry about whitespace.
;;
;; So we can skip all the string and bracket linebreak escaping and
;; directly create a list of codelines with indentation. For this we
;; then simply reuse the appropriate function from the generic wisp
;; preprocessor.
use-modules : srfi srfi-1
;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...)
define : line-indent line
car line
define : line-code line
cdr line
define : line-continues? line
let : : readdot : call-with-input-string "." read
equal? readdot : car : line-code line
define : line-only-colon? line
and
equal? ":" : car : line-code line
null? : cdr : line-code line
define : line-empty-code? line
null? : line-code line
define : line-empty? line
and
= 0 : line-indent line
line-empty-code? line
define : line-strip-continuation line
if : line-continues? line
list
line-indent line
cdr : line-code line
. line
define : indent-level-reduction indentation-levels level select-fun
. "Reduce the INDENTATION-LEVELS to the given LEVEL and return the value selected by SELECT-FUN"
let loop
: newlevels indentation-levels
diff 0
cond
: = level : car newlevels
select-fun : list diff indentation-levels
: < level : car newlevels
loop
cdr newlevels
1- diff
else
throw 'wisp-syntax-error "Level ~A not found in the indentation-levels ~A."
define : indent-level-difference indentation-levels level
. "Find how many indentation levels need to be popped off to find the given level."
indent-level-reduction indentation-levels level
lambda : x ; get the count
car x
define : indent-reduce-to-level indentation-levels level
. "Find how many indentation levels need to be popped off to find the given level."
indent-level-reduction indentation-levels level
lambda : x ; get the levels
car : cdr x
define : wisp-scheme-read-chunk-lines port
let loop
: indent-and-symbols : list ; '((5 "(foobar)" "\"yobble\"")(3 "#t"))
inindent #t
inunderscoreindent : equal? #\_ : peek-char port
incomment #f
currentindent 0
currentsymbols '()
emptylines 0
let : : next-char : peek-char port
cond
: eof-object? next-char
append indent-and-symbols : list : append (list currentindent) currentsymbols
: <= 2 emptylines
. indent-and-symbols
: and inindent : equal? #\space next-char
read-char port ; remove char
loop
. indent-and-symbols
. #t ; inindent
. #f ; inunderscoreindent
. #f ; incomment
1+ currentindent
. currentsymbols
. emptylines
: and inunderscoreindent : equal? #\_ next-char
read-char port ; remove char
loop
. indent-and-symbols
. #t ; inindent
. #t ; inunderscoreindent
. #f ; incomment
1+ currentindent
. currentsymbols
. emptylines
; any char but whitespace *after* underscoreindent is
; an error. This is stricter than the current wisp
; syntax definition. TODO: Fix the definition. Better
; start too strict.
: and inunderscoreindent : not : equal? #\space next-char
throw 'wisp-syntax-error "initial underscores without following whitespace at beginning of the line after" : last indent-and-symbols
: or (equal? #\newline next-char) (equal? #\return next-char)
read-char port ; remove the newline
; TODO: Check whether when or if should be preferred here. guile 1.8 only has if.
if : and (equal? #\newline next-char) : equal? #\return : peek-char port
read-char port ; remove a full \n\r. Damn special cases...
let* ; distinguish pure whitespace lines and lines
; with comment by giving the former zero
; indent. Lines with a comment at zero indent
; get indent -1 for the same reason - meaning
; not actually empty.
:
indent
cond
incomment
if : = 0 currentindent ; specialcase
. -1
. currentindent
: not : null? currentsymbols ; pure whitespace
. currentindent
else
. 0
parsedline : append (list indent) currentsymbols
; TODO: If the line is empty, . Either do it here and do not add it, just
; increment the empty line counter, or strip it later. Replace indent
; -1 by indent 0 afterwards.
loop
append indent-and-symbols : list parsedline
. #t ; inindent
equal? #\_ : peek-char port
. #f ; incomment
. 0
. '()
if : line-empty? parsedline
1+ emptylines
. 0
: equal? #t incomment
read-char port ; remove one comment character
loop
. indent-and-symbols
. #f ; inindent
. #f ; inunderscoreindent
. #t ; incomment
. currentindent
. currentsymbols
. emptylines
: equal? #\space next-char ; remove whitespace when not in indent
read-char port ; remove char
loop
. indent-and-symbols
. #f ; inindent
. #f ; inunderscoreindent
. #f ; incomment
. currentindent
. currentsymbols
. emptylines
; | cludge to appease the former wisp parser
; | which had a prblem with the literal comment
; v char.
: equal? (string-ref ";" 0) next-char
loop
. indent-and-symbols
. #f ; inindent
. #f ; inunderscoreindent
. #t ; incomment
. currentindent
. currentsymbols
. emptylines
else ; use the reader
loop
. indent-and-symbols
. #f ; inindent
. #f ; inunderscoreindent
. #f ; incomment
. currentindent
; this also takes care of the hashbang and leading comments.
append currentsymbols : list : read port
. emptylines
define : line-append-n-parens n line
. "Append N parens at the end of the line"
let loop : (rest n) (l line)
cond
: = 0 rest
. l
else
loop (1- rest) (append l '(")"))
define : line-prepend-n-parens n line
. "Prepend N parens at the beginning of the line, but after the indentation-marker"
let loop : (rest n) (l line)
cond
: = 0 rest
. l
else
loop
1- rest
append
list : car l
. '("(")
cdr l
; TODO: process inline colons
define : wisp-indentation-to-parens lines
. "Add parentheses to lines and remove the indentation markers"
let loop
: processed '()
current-line : car lines
unprocessed : cdr lines
indentation-levels '(0)
cond
; the recursion end-condition
: and (null? current-line) (null? unprocessed) (not (null? indentation-levels))
throw 'wisp-programming-error "The current-line is null but there are indentation-levels: Something returned a broken line as new current-line."
: and (not (null? current-line)) (null? indentation-levels)
throw 'wisp-programming-error "The indentation-levels are null but the current-line is null: Something killed the indentation-levels."
; the recursion end-condition
: and (null? current-line) (null? unprocessed)
. processed
; now care for the last step
: null? unprocessed
; current is the last line
cond
: line-continues? current-line
loop
append processed
list
line-append-n-parens
1- : length indentation-levels
line-strip-continuation current-line
. '() ; current-line empty: required end condition 1
. '() ; unprocessed empty: required end condition 2
. '() ; indentation-levels: There is nothing more to process
else
loop
append processed
list
line-prepend-n-parens 1
line-append-n-parens
length indentation-levels
line-strip-continuation current-line
. '() ; current-line empty: required end condition 1
. '() ; unprocessed empty: required end condition 2
. '() ; indentation-levels: There is nothing more to process
else ; now we come to the line-comparisons and indentation-counting.
let*
: next-line : car unprocessed
cond
: line-empty-code? current-line
; We cannot process indentation without
; code. Just switch to the next line. This should
; only happen at the start of the recursion.
loop
. processed
. next-line
cdr unprocessed
. indentation-levels
: line-empty-code? next-line
loop
. processed
. current-line
cdr unprocessed
. indentation-levels
: = (line-indent current-line) (line-indent next-line)
let
: parens-to-add : if (line-continues? current-line) 0 1
loop
append processed
list
line-prepend-n-parens parens-to-add
line-append-n-parens parens-to-add
line-strip-continuation current-line
. next-line
cdr unprocessed
. indentation-levels
: < (line-indent current-line) (line-indent next-line)
if : line-continues? current-line
; this is a syntax error.
throw 'wisp-syntax-error "Line with deeper indentation follows after a continuation line: current: ~A, next: ~A."
. current-line next-line
loop
append processed
list
line-prepend-n-parens 1
line-strip-continuation current-line
. next-line
cdr unprocessed
; we need to add an indentation level for the next-line.
cons (line-indent next-line) indentation-levels
: > (line-indent current-line) (line-indent next-line)
; first we need to find out how many indentation levels we need to pop.
let*
: newlevels : indent-reduce-to-level indentation-levels : line-indent next-line
level-difference : indent-level-difference indentation-levels : line-indent next-line
parens-to-prepend
if : line-continues? current-line
. 1
. 0
parens-to-append
if : line-continues? current-line
. level-difference
1+ level-difference
loop
append processed
list
line-prepend-n-parens parens-to-prepend
line-append-n-parens parens-to-append
line-strip-continuation current-line
. next-line
cdr unprocessed
. newlevels
else
throw 'wisp-not-implemented
format #f "Need to implement further line comparison: current: ~A, next: ~A, processed: ~A."
. current-line next-line processed
define : wisp-scheme-read-chunk port
. "Read and parse one chunk of wisp-code"
; TODO: process inline colons.
wisp-indentation-to-parens : wisp-scheme-read-chunk-lines port
define : wisp-scheme-read-all port
. "Read all chunks from the given port"
let loop
: tokens '()
cond
: eof-object? : peek-char port
; TODO: Join as string.
. tokens
else
loop
append tokens : wisp-scheme-read-chunk port
define : wisp-scheme-read-file path
call-with-input-file path wisp-scheme-read-all
define : wisp-scheme-read-file-chunk path
call-with-input-file path wisp-scheme-read-chunk
define : wisp-scheme-read-string str
call-with-input-string str wisp-scheme-read-all
display
wisp-scheme-read-string " foo ; bar\n ; nop \n\n; nup\n; nup \n \n\n\n foo : moo \"\n\" \n___ . goo . hoo"
newline
display : wisp-scheme-read-file-chunk "wisp-scheme.w"
newline
; This correctly throws an error.
; display
; wisp-scheme-read-string " foo \n___. goo . hoo"
; newline