Paste #0IlalBrxVH7KHjW83ayu at spacepaste

#!/home/arne/wisp/wisp-multiline.sh
; !#
;; This file might need to be licensed permissively for inclusion in
;; an SRFI. Only change it, if you agree to this possible relicensing
;; of your contribution to this file. I will not accept changes here
;; which do not allow that.
; we need to be able to replace end-of-line characters in brackets and strings
;; TODO: Check whether I can offload the string processing to the
;; read-function. That’s a source of endless complications. Required:
;; A kind of unrolling step which appends the string-representation of
;; the read strings back into the code. I would have to process a list
;; of strings instead of one big string. Or rather, each line would be
;; a list of strings.
;; bootstrap via python3 wisp.py wisp-guile.w > 1 && guile 1 wisp-guile.w > 2 && guile 2 wisp-guile.w > 3 && diff 2 3
;;
;; -Author: Arne Babenhauserheide
;; Copyright (C) Arne Babenhauserheide (2013--2015). All Rights Reserved.
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use, copy,
;; modify, merge, publish, distribute, sublicense, and/or sell copies
;; of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(define-module (wisp)
#:export (wisp2lisp wisp-chunkreader))
(use-modules
((srfi srfi-1))
((ice-9 regex)))
(define (endsinunevenbackslashes text ); comment
(if (= 0 (string-length text))
#f
(let counter
((last (string-take-right text 1))
(rest (string-append " " (string-drop-right text 1)))
(count 0))
(cond
((= 0 (string-length rest )); end clause: read all
(odd? count))
; end clause: no \
((not (equal? last (string #\\)))
(odd? count))
(else
(counter (string-take-right rest 1) (string-drop-right rest 1) (+ 1 count)))))))
(define (nostringandbracketbreaks inport)
"Replace all linebreaks inside strings and brackets with placeholders."
(let ((expressions (list (nostringandbracketbreaksreader inport))))
(while (not (eof-object? (peek-char inport)))
(set! expressions (append expressions (list (nostringandbracketbreaksreader inport)))))
(string-join expressions "\n")))
(define (nostringandbracketbreaksreader inport)
"Read one wisp-expression from the inport.
Ends with three consecutive linebreaks or eof."
; Replace end of line characters in brackets and strings
; FIXME: Breaks if the string is shorter than 2 chars
; FIXME: Breaks if the text begins with a comment.
(let*
((lastchar (read-char inport))
(nextchar (read-char inport))
(text (if (eof-object? lastchar) "" (string lastchar)))
(incomment #f)
(incommentfirstchar #f ); first char of a comment
(instring #f)
(inbrackets 0)
(incharform 0 )); #\<something>
(while
(not
(or (eof-object? nextchar)
(and
(or (char=? nextchar #\newline ) (char=? nextchar #\return ) )
(or (char=? lastchar #\newline ) (char=? lastchar #\return ) )
(string-suffix? "\n\n" text )))); text includes lastchar
; incommentfirstchar is only valid for exactly one char
(when incommentfirstchar (set! incommentfirstchar #f ))
; but add incommentfirstchar if we just started the text
(when (equal? text ";" ); initial comment
(set! incommentfirstchar #f)
(set! incomment #t)
(set! text (string-append text "\\REALCOMMENTHERE")))
; already started char forms win over everything, so process them first.
; already started means: after the #\
; FIXME: Fails to capture #t and #f which can kill line splitting if it happens inside brackets
(when (= incharform 1)
(when (not (and (char=? lastchar #\# ) (or (char=? #\f nextchar) (char=? #\t nextchar))))
; format #t "1: set incharform 0: lastchar ~a nextchar ~a instring ~a incomment ~a incharform ~a" lastchar nextchar instring incomment incharform
; newline
(set! incharform 0)))
(when (>= incharform 2)
(if (or (char=? nextchar #\space) (char=?
nextchar #\newline ) (char=? nextchar #\return ) )
(begin
; format #t "2: set incharform 0: lastchar ~a nextchar ~a instring ~a incomment ~a incharform ~a" lastchar nextchar instring incomment incharform
; newline
(set! incharform 0))
; else
(set! incharform (+ incharform 1))))
; check if we switch to a string: last char is space, linebreak or in a string, not in a charform, not in a comment
(when
(and
(char=? nextchar #\")
(not incomment)
(< incharform 1)
(or
(and
instring ; when I’m in a string, I can get out
(or
(not (char=? lastchar #\\ )); if the last char is not a backslash (escaped quote)
; or the last char is a backslash preceded by an uneven number of backslashes (so the backslash is actually an escaped backslash)
(and (char=? lastchar #\\)
; if all backslashes before the lastchar are paired, the final quote is escaped.
(not (endsinunevenbackslashes text)))))
(char=? lastchar #\space ); when the last char was a space, I can get into a string
(char=? lastchar #\newline ); same for newline chars
(char=? lastchar #\return )
(and (not instring ); outside of strings, brackets are pseudo-whitespace, too
(or
(char=? lastchar #\( )
(char=? lastchar #\))
(char=? lastchar #\[ )
(char=? lastchar #\])
; TODO: Only match for braces {} if curly infix is enabled
(char=? lastchar #\{ )
(char=? lastchar #\})))))
(set! instring (not instring)))
; check if we switch to a comment
(when
(and
; FIXME: this should be
; char=? nextchar #\;
(equal? ";" (string nextchar))
(not incomment)
(not instring)
(< incharform 2))
(set! incomment #t)
(set! incommentfirstchar #t)
; this also closes any potential charform
(set! incharform 0))
(when
(and incomment
(or
(char=? nextchar #\return)
(char=? nextchar #\newline)))
(set! incomment #f))
; check for the beginning of a charform
(when
(and
(not instring)
(not incomment)
(char=? lastchar #\space)
(char=? nextchar #\#))
(set! incharform 1))
; check whether a charform is continued
(when
(and
(= incharform 1)
(char=? lastchar #\#)
(char=? nextchar #\\))
(set! incharform 2))
; check for brackets
; FIXME: This only fixes a single linebreak inside parens, but if a second occurs on the same line it breaks. I do not know why. Maybe something with having lastchar as linebreak.
(when (not (or instring incomment))
(when
(and
(not (string-suffix? text "#"))
(not (char=? #\\ lastchar))
(not (endsinunevenbackslashes (string-drop-right text (min 1 (string-length text))))))
; TODO: Only match for braces {} if curly infix is enabled
; FIXME: Catch wrong ordering of parens/brackets/braces like ({)}
(when (or (equal? "[" (string nextchar)) (equal? "(" (string nextchar)) (equal? "{" (string nextchar)))
(set! inbrackets (+ inbrackets 1)))
(when (or (equal? "}" (string nextchar)) (equal? ")" (string nextchar)) (equal? "]" (string nextchar)))
(set! inbrackets (- inbrackets 1)))))
(if (or instring (> inbrackets 0))
(if (char=? nextchar #\newline)
; we have to actually construct the escape
; sequence here to be able to parse ourselves.
(set! text (string-append text (string-append "\\LINE_" "BREAK_N")))
(if (char=? nextchar #\return)
(set! text (string-append text (string-append "\\LINE_" "BREAK_R")))
; else
(set! text (string-append text (string nextchar)))))
; mark the start of a comment, so we do not have to
; repeat the string matching in later code. We include
; the comment character!
; not (instring or inbrackets) = neither instring nor inbrackets
(if incommentfirstchar
(set! text (string-append text ( string nextchar ) "\\REALCOMMENTHERE"))
; when not in brackets or string or starting a
; comment: just append the char
(set! text (string-append text (string nextchar)))))
(set! lastchar nextchar)
(set! nextchar (read-char inport)))
; return the text
text))
; As next part we have split a text into a list of lines which we can process one by one.
(define (splitlines inport )
(let
((lines '())
(nextchar (read-char inport))
(nextline ""))
(while (not (eof-object? nextchar))
(if (not (or (char=? nextchar #\return ) (char=? nextchar #\newline )))
(set! nextline (string-append nextline (string nextchar)))
(begin
(set! lines (append lines (list nextline)))
(set! nextline "")))
(set! nextchar (read-char inport)))
(append lines (list nextline))))
(define (line-indent line)
(list-ref line 0))
(define (line-content line)
(list-ref line 1))
(define (line-comment line)
(list-ref line 2))
(define (line-continues? line)
"Check whether the line is a continuation of a previous line (should not start with a bracket)."
(if (equal? #f (line-content line))
#f ; this is the EOF line. It does not continue (to ensure that the last brackets get closed)
(string-prefix? ". " (line-content line))))
(define (line-empty-code? line)
"Check whether the code-part of the line is empty: contains only whitespace and/or comment."
(equal? "" (line-content line)))
(define (line-only-colon? line)
"Check whether the line content consists only of a colon and whitespace."
(equal? ":" (string-trim-right (line-content line))))
(define (line-only-prefix? line prefix)
"Check whether the line content consists only of a given prefix and whitespace."
(equal? prefix (string-trim-right (line-content line))))
(define (line-merge-comment line)
"Merge comment and content into the content. Return the new line."
(let
((indent (line-indent line))
(content (line-content line))
(comment (line-comment line)))
(if (equal? "" comment)
line ; no change needed
(list indent (string-append content ";" comment)
""))))
; skip the leading indentation
(define (skipindent inport)
(let skipper
((inunderbars #t)
(indent 0)
(nextchar (read-char inport)))
; when the file ends, do not do anything else
(if (not (eof-object? nextchar ))
; skip underbars
(if inunderbars
(if (char=? nextchar #\_ ); still in underbars?
(skipper
#t ; still in underbars?
(+ indent 1)
(read-char inport))
; else, reevaluate without inunderbars
(skipper #f indent nextchar))
; else: skip remaining spaces
(if (char=? nextchar #\space)
(skipper
#f
(+ indent 1)
(read-char inport))
(begin
(unread-char nextchar inport)
indent)))
indent)))
; Now we have to split a single line into indentation, content and comment.
(define (splitindent inport)
(let
((indent (skipindent inport)))
(let
((nextchar (read-char inport))
(inindent #t ); it always begins in indent
(incomment #f ); but not in a comment
(commentstart #f)
(commentstartidentifier "\\REALCOMMENTHERE")
(commentstartidentifierlength 16)
(commentidentifierindex 0)
(content "")
(comment ""))
(while (not (eof-object? nextchar))
(write (eof-object? nextchar))
; check whether we leave the content
; FIXME: (wisp.py) the reader cuts the ; here, when I write it as this:
; when : and ( not incomment ) : char=? nextchar #\;
; FIXME: THIS mistreats #\; as comment! (shown 4 lines after this comment…)
(when
(and
(not incomment)
; FIXME: this should be but would break
; char=? nextchar #\;
(equal? ";" (string nextchar))
(not (string-suffix? ( string #\# #\\ ) content)))
(set! commentstart #t)
(set! comment (string-append comment (string nextchar)))
(set! nextchar (read-char inport))
(continue))
; check whether we stay in the commentcheck
(when (and commentstart (char=? nextchar (string-ref commentstartidentifier commentidentifierindex)))
(set! commentidentifierindex (+ commentidentifierindex 1))
(set! comment (string-append comment (string nextchar)))
(when (= commentidentifierindex commentstartidentifierlength)
(set! commentstart #f)
(set! incomment #t)
; reset used variables
(set! commentidentifierindex 0)
(set! comment ""))
(set! nextchar (read-char inport))
(continue))
; if we cannot complete the commentcheck, we did not start a real comment. Append it to the content
(when (and commentstart (not (char=? nextchar (string-ref commentstartidentifier commentidentifierindex))))
(set! commentstart #f)
(set! content (string-append content comment (string nextchar)))
(set! comment "")
(set! commentidentifierindex 0)
(set! nextchar (read-char inport))
(continue))
; if we are in the comment, just append to the comment
(when incomment
(set! comment (string-append comment (string nextchar)))
(set! nextchar (read-char inport))
(continue))
; if nothing else is true, we are in the content
(set! content (string-append content (string nextchar)))
(set! nextchar (read-char inport)))
(when commentstart
(set! content (string-append content comment))
(set! comment ""))
; return the indentation, the content and the comment
(list indent content comment))))
; Now use the function to split a list of lines
(define (linestoindented lines)
(let splitter
((unprocessed lines)
(processed '()))
(if (equal? unprocessed '())
processed
; else: let-recursion
(splitter
(list-tail unprocessed 1)
(append processed
(list
(call-with-input-string
(list-ref unprocessed 0)
splitindent)))))))
(define (read-whole-file filename)
(let ((origfile (open-file filename "r")))
(let reader
((text "")
(nextchar (read-char origfile)))
(if (eof-object? nextchar)
text
(reader
(string-append text (string nextchar))
(read-char origfile))))))
(define (wisp2lisp-add-inline-colon-brackets line)
"Add inline colon brackets to a wisp-line (indent,content,comment).
A line with only a colon and whitespace gets no additional parens!
Also unescape \\: to :.
"
; if the line only consists of a colon and whitespace, do not change it.
(if (line-only-colon? line)
line
(let ((content (line-content line)))
; replace final " :" by a function call. There we are by definition of the line-splitting not in a string.
(when (string-suffix? " :" content)
(set! content (string-append (string-drop-right content 1) "()")))
; process the content in reverse direction, so we can detect ' : and turn it into '(
; let linebracketizer ( ( instring #f ) ( inbrackets 0 ) ( bracketstoadd 0 ) ( unprocessed content ) ( processed "" ) )
(let linebracketizer (( instring #f ) ( inbrackets 0 ) ( bracketstoadd 0 ) ( unprocessed content ) ( processed "" ) )
(if (< (string-length unprocessed) 2)
; if unprocessed is < 2 chars, it cannot contain ": ". We are done.
(list
(line-indent line)
(string-append unprocessed processed (xsubstring ")" 0 bracketstoadd))
(line-comment line))
; else
(let
((lastletter (string-take-right unprocessed 1))
(lastupto3 (string-take-right unprocessed (min 3 (string-length unprocessed))))
(lastupto4 (string-take-right unprocessed (min 4 (string-length unprocessed))))
(lastupto6 (string-take-right unprocessed (min 6 (string-length unprocessed)))))
; check if we’re in a string
(when
(or
(and
(not instring)
(equal? "\"" lastletter)
(not (equal? "#\\\"" lastupto3)))
(and
instring
(equal? "\"" lastletter)
(not (endsinunevenbackslashes (string-drop-right unprocessed 1)))))
(set! instring (not instring)))
(when (not instring)
(when
(or
; TODO: Only match for braces {} if curly infix is enabled
; FIXME: Catch wrong ordering of parens/brackets/braces like ({)}
(and (equal? "{" lastletter) (not (equal? "#\\{" lastupto3)))
(and (equal? "[" lastletter) (not (equal? "#\\[" lastupto3)))
(and (equal? "(" lastletter) (not (equal? "#\\(" lastupto3))))
(set! inbrackets (- inbrackets 1)))
(when
(or
(and (equal? ")" lastletter) (not (equal? "#\\)" lastupto3)))
(and (equal? "]" lastletter) (not (equal? "#\\]" lastupto3)))
(and (equal? "}" lastletter) (not (equal? "#\\}" lastupto3))))
(set! inbrackets (+ 1 inbrackets )))); remember that we're going backwards!
; error handling: inbrackets must never be smaller than 0 - due to the line splitting.
(when (< inbrackets 0)
(throw 'more-inline-brackets-closed-than-opened inbrackets line))
; when we’re in a string or in brackets , just skip to the next char
(cond
((or instring (> inbrackets 0))
(linebracketizer instring inbrackets bracketstoadd
(string-drop-right unprocessed 1)
(string-append lastletter processed)))
; else check for " : ": That adds a new inline bracket
; support : at the beginning of a line, too.
((or (equal? " : " lastupto3) (equal? ": " lastupto3))
; replace the last 2 chars with "(" and note
; that we need an additional closing bracket
; at the end.
(linebracketizer instring inbrackets (+ 1 bracketstoadd )
(string-append (string-drop-right unprocessed 2) )
(string-append "(" processed)))
; turn " ' (" into " '(", do not modify unprocessed, except to shorten it!
; same for ` , #' #` #, #,@,
((and (string-prefix? "(" processed) (equal? " ' " lastupto3))
; leave out the second space
(linebracketizer instring inbrackets bracketstoadd
(string-append (string-drop-right unprocessed 2) "'")
processed))
((and (string-prefix? "(" processed) (equal? " , " lastupto3))
; leave out the second space
(linebracketizer instring inbrackets bracketstoadd
(string-append (string-drop-right unprocessed 2) ",")
processed))
((and (string-prefix? "(" processed) (equal? " ` " lastupto3))
; leave out the second space
(linebracketizer instring inbrackets bracketstoadd
(string-append (string-drop-right unprocessed 2) "`")
processed))
((and (string-prefix? "(" processed) (equal? " #` " lastupto4))
; leave out the second space
(linebracketizer instring inbrackets bracketstoadd
(string-append (string-drop-right unprocessed 3) "#`")
processed))
((and (string-prefix? "(" processed) (equal? " #' " lastupto4))
; leave out the second space
(linebracketizer instring inbrackets bracketstoadd
(string-append (string-drop-right unprocessed 3) "#'")
processed))
((and (string-prefix? "(" processed) (equal? " #, " lastupto4))
; leave out the second space
(linebracketizer instring inbrackets bracketstoadd
(string-append (string-drop-right unprocessed 3) "#,")
processed))
((and (string-prefix? "(" processed) (equal? " #,@, " lastupto6))
; leave out the second space
(linebracketizer instring inbrackets bracketstoadd
(string-append (string-drop-right unprocessed 5) "#,@,")
processed))
(else ; just go on
(linebracketizer instring inbrackets bracketstoadd
(string-drop-right unprocessed 1)
(string-append lastletter processed))))))))))
(define (last-indent levels)
"Retrieve the indentation of the last line: Simply the highest level."
(list-ref levels 0))
(define (line-add-starting-bracket line)
"Add a starting bracket to the line, if it is no continuation line (it is more indented than the previous).
If line starts with one of ' , ` #` #' #, #,@, then turn it into '(... instead of ('...
If line is indented and only contains : and optional whitespace, remove the :.
The line *must* have a whitespace after the prefix, except if the prefix is the only non-whitespace on the line."
; if the line only contains a colon, we just replace its content with an opening paren.
(if (line-only-colon? line ); FIXME: Check for this somewhere else.
(list
(line-indent line)
(string-append "(" (string-drop (line-content line) 1 )); keep whitespace
(line-comment line))
(let loop ((paren-prefixes (list "' " ", " "` " "#` " "#' " "#, " "#,@, ")))
; first check whether we are done checking
(if (null-list? paren-prefixes)
; construct the line structure: '(indentation-depth content comment)
(list
(line-indent line)
(string-append
"("
(line-content line))
(line-comment line))
; otherwise check all possible prefixes
(let*
((prefix (car paren-prefixes))
(prefix-no-space (string-drop-right prefix 1)))
(cond
((string-prefix? prefix (line-content line))
(list
(line-indent line)
(string-append
prefix-no-space "("
(string-drop (line-content line) (string-length prefix)))
(line-comment line)))
((line-only-prefix? line prefix-no-space)
(list
(line-indent line)
(string-append
(string-drop-right prefix 1) "("
(string-drop (line-content line) (string-length prefix-no-space)))
(line-comment line)))
(else
(loop (cdr paren-prefixes)))))))))
(define (line-add-closing-brackets line number)
"Add a closing bracket to the line."
(list
(line-indent line)
(string-append
(line-content line)
(xsubstring ")" 0 number))
(line-comment line)))
(define (line-indent-brackets-to-close line-indent levels line-continues prev-continues)
"Find the number of brackets to close to reduce the levels to the line-indent."
; adjust the levels until the highest indentation level is equal
; to the indentation of the next line. Then check for
; continuation.
(let closer ((bracketstoclose 0) (rest levels))
(let ((highest-level (list-ref rest 0)))
; finish-condition
(if (= line-indent highest-level)
(if prev-continues
bracketstoclose
(+ 1 bracketstoclose))
(if (> line-indent highest-level)
(closer (- bracketstoclose 1) (append (list line-indent) rest ))
(closer (+ bracketstoclose 1) (list-tail rest 1)))))))
(define (line-indent-brackets-to-open line-indent levels line-continues prev-continues)
"Find the number of brackets to open to fit the line-indent and continuation marker."
(if line-continues
0
1))
(define (line-indent-levels-adjust levels next-indent)
"Add or remove levels so the highest remaining level matches next-indent."
(let adjuster ((lev levels))
(let ((highest-level (list-ref lev 0)))
(if (= next-indent highest-level)
lev
(if (> next-indent highest-level)
(append (list next-indent) lev)
(adjuster (list-tail lev 1)))))))
(define (line-drop-continuation-dot line)
(let ((content (line-content line)))
(list
(line-indent line)
(if (line-continues? line)
(string-drop content 2)
content)
(line-comment line ))))
(define (wisp2lisp-parse lisp prev lines)
"Parse the body of the wisp-code."
(set! prev (wisp2lisp-add-inline-colon-brackets prev )); prev already is a code-line.
(if (not (or (line-continues? prev) (line-empty-code? prev)))
(set! prev (line-add-starting-bracket prev)))
(set! lines (map-in-order wisp2lisp-add-inline-colon-brackets lines))
(let bracketizer ((levels '(0)) (pre prev) (unprocessed lines) (processed lisp) (whitespace '()))
; levels is the list of levels, with the lowest to the right. i.e: '(12 8 4 0)
; once we processed everything, we pass the bracketizer pre as f one last time
(if (equal? #f (line-content pre))
processed
(let ((next (if (equal? unprocessed '()) (list 0 #f #f) (list-ref unprocessed 0 )))); this is the break condition for the next loop!
(if (line-empty-code? next ); empty lines get silently added, but otherwise ignored
(bracketizer levels pre
(list-tail unprocessed 1)
processed
(append whitespace (list next)))
; firstoff add the next indent to the levels, so we only work on the levels, prev-continues, next-continues and next-indent
; if pre was a continuation, the real levels are 1 lower than the counted levels
(let*
((next-indent (line-indent next))
(pre-indent (line-indent pre))
(pre-continues (line-continues? pre))
(next-continues (line-continues? next))
(final-line (equal? #f (line-content next)))
(bracketstocloseprev (if (line-empty-code? pre) 0 (line-indent-brackets-to-close next-indent levels next-continues pre-continues)))
(bracketstoopennext (line-indent-brackets-to-open next-indent levels next-continues pre-continues))
(newnext (if final-line next (if (> bracketstoopennext 0) (line-add-starting-bracket next) next)))
(newpre (line-drop-continuation-dot (line-add-closing-brackets pre bracketstocloseprev)))
(newlevels (line-indent-levels-adjust levels next-indent)))
(bracketizer newlevels newnext
(if final-line unprocessed (list-tail unprocessed 1))
(append processed (list newpre) whitespace)
(list))))))))
(define (wisp2lisp-initial-comments lisp prev lines)
"Keep all starting comments: do not start them with a bracket."
(let skip-initial-comments ((lisp lisp) (prev prev) (lines lines))
(if (= 0 (length lines )); file only contained comments, maybe including the hashbang
(list lisp prev lines)
(if (line-empty-code? prev)
(skip-initial-comments (append lisp (list prev))
(list-ref lines 0) (list-tail lines 1))
(list lisp prev lines)))))
(define (wisp2lisp-hashbang lisp prev unprocessed)
"Parse a potential initial hashbang line."
(if
(and
(equal? lisp '() ); really the first line
(equal? 0 (line-indent prev))
(string-prefix? "#!" (line-content prev)))
(wisp2lisp-hashbang (append lisp (list (line-merge-comment prev)))
(list-ref unprocessed 0) (list-tail unprocessed 1))
(list lisp prev unprocessed)))
(define (wisp2lisp-lines lines)
"Parse indentation in the lines to add the correct brackets."
(if (equal? lines '())
'()
(let
((lisp '() ); the processed lines
(prev (list-ref lines 0 )); the last line
(unprocessed (list-tail lines 1 ))); obvious :)
(let*
((hashbanged (wisp2lisp-hashbang lisp prev unprocessed))
(deinitialized (apply wisp2lisp-initial-comments hashbanged))
(parsed (apply wisp2lisp-parse deinitialized)))
parsed))))
(define (line-unescape-underscore-and-colon line)
"Unescape underscores at the beginning of the line and colon."
(let loop
((processed "")
(unprocessed (line-content line)))
(if (equal? "" unprocessed)
(list
(line-indent line)
processed
(line-comment line))
(let
((next (string (string-ref unprocessed 0))))
(if (equal? "" processed )
(cond
; get rid of \_
((string-prefix? "(\\_" unprocessed)
(loop processed (string-append "(" (string-drop unprocessed 2))))
; get rid of \:
((string-prefix? "(\\:" unprocessed)
(loop processed (string-append "(" (string-drop unprocessed 2))))
; get rid of . \:
((string-prefix? "\\:" unprocessed)
(loop processed (string-drop unprocessed 1)))
(else
(loop
(string-append processed next)
(string-drop unprocessed 1))))
(cond
((string-prefix? " \\:" unprocessed)
(loop
(string-append processed " :" )
(string-drop unprocessed 3)))
((string-prefix? "(\\:" unprocessed)
(loop
(string-append processed "(:" )
(string-drop unprocessed 3)))
(else
(loop
(string-append processed next)
(string-drop unprocessed 1)))))))))
(define (unescape-underscore-and-colon lines)
"Unescape underscores at the beginning of each line and colon."
(let loop
((processed '())
(unprocessed lines))
(if (equal? unprocessed '())
processed
(let ((current (car unprocessed)))
(loop
(append processed (list (line-unescape-underscore-and-colon current)))
(cdr unprocessed))))))
(define* (string-replace-substring s substr replacement #:optional (start 0) (end (string-length s)))
"Replace every instance of substring in s by replacement."
(let ((substr-length (string-length substr)))
(if (zero? substr-length)
(error "string-replace-substring: empty substr")
(let loop
((start start)
(pieces (list (substring s 0 start))))
(let ((idx (string-contains s substr start end)))
(if idx
(loop (+ idx substr-length)
(cons* replacement
(substring s start idx)
pieces))
(string-concatenate-reverse
(cons (substring s start)
pieces))))))))
(define (unescape-linebreaks text)
"unescape linebreaks"
(string-replace-substring
; we have to construct the placeholders here to avoid unescaping them when we parse ourselves…
(string-replace-substring text (string-append "\\LINE_" "BREAK_N") (string #\newline))
(string-append "\\LINE_" "BREAK_R")
(string #\return )))
(define (unescape-comments text)
"unescape comments"
(string-replace-substring text
; we have to construct the placeholders here to avoid unescaping them when we parse ourselves…
(string-append ";" "\\REALCOMMENTHERE")
";"))
(define (wisp-chunkreader inport)
"Read one wisp-expression from inport, without escaping of fake newlines but with correct detection of real new lines.
Realized by reading with newline and comment escaping and unescaping both again after reading."
(unescape-comments
(unescape-linebreaks
(nostringandbracketbreaksreader inport))))
(define (join-lisp-lines lisp-lines)
(let join ((joined "") (unprocessed lisp-lines))
(if (not (equal? unprocessed '()))
(let*
((next (list-ref unprocessed 0))
(nextstring
(string-append
(xsubstring " " 0 (line-indent next))
; here we re-add all necessary linebreakswe get rid
(unescape-linebreaks (line-content next))
(if (equal? "" (line-comment next ))
""
(string-append ";" (line-comment next)))
"\n")))
(join (string-append joined nextstring) (list-tail unprocessed 1)))
joined)))
(define (wisp2lisp text )
(let*
((nobreaks (call-with-input-string text nostringandbracketbreaks))
(textlines (call-with-input-string nobreaks splitlines))
(lines (linestoindented textlines))
(lisp-lines (wisp2lisp-lines lines))
(clean-lines (unescape-underscore-and-colon lisp-lines)))
(join-lisp-lines clean-lines)))
; first step: Be able to mirror a file to stdout
(if (< 1 (length (command-line)))
(let*
((filename (list-ref ( command-line ) 1))
(text (read-whole-file filename))
; Lines consist of lines with indent, content and comment. See
; line-indent, line-content, line-comment and the other
; line-functions for details.
; textlines : split-wisp-lines text
; lines : linestoindented textlines
(lisp (wisp2lisp text)))
(display lisp)
(newline))
#f)

spacepaste

Paste details