luv

Workshop wiki

implementation.lisp

parinfer/implementation.lisp

system luv/parinfer · 36 definitions · on GitHub

A minimal Parinfer-like indentation repair pass.

Adapted from cl-mcp/src/parinfer.lisp: https://github.com/cl-ai-project/cl-mcp

Copyright 2025 cxxxr, Satoshi Imai

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.

defpackage#:sly-client.parinfer
:use#:cl
:export#:apply-indent-mode#:analyze-indent-mode#:indent-mode-candidate#:indent-mode-report#:indent-mode-report-candidate#:indent-mode-report-candidate-balanced-p#:indent-mode-report-candidate-changed-p#:indent-mode-report-source-balanced-p
in-package#:sly-client.parinfer
defstruct
state
:constructormake-state
stacknil:typelist
in-stringnil:typeboolean
escapenil:typeboolean
in-bar-symbolnil:typeboolean
symbol-escapenil:typeboolean
sharp-seennil:typeboolean
char-literalnil:typeboolean
block-comment-depth0:type
integer0
block-sharp-seennil:typeboolean
block-bar-seennil:typeboolean
token-buffernil:typelist
token-form
unmatched-closes0:type
integer0
defstruct
open-form
:constructormake-open-form
columnline&keyopen-columnroleheadelement-count
column0:type
integer0
line0:type
integer0
open-column0:type
integer0
role:ordinary:typesymbol
head
element-count0:type
integer0
defstruct
close-event
:constructormake-close-event
open-formcolumn
open-form
column0:type
integer0
defstructindent-mode-report
source-balanced-pnil:typeboolean
candidate"":typestring
candidate-balanced-pnil:typeboolean
candidate-changed-pnil:typeboolean
defparameter*binding-form-heads*'
"LET""LET*""FLET""LABELS""MACROLET""SYMBOL-MACROLET"
defparameter*clause-form-heads*'
"COND""CASE""CCASE""ECASE""TYPECASE""CTYPECASE""ETYPECASE"
defparameter*slot-list-form-heads*'
"DEFCLASS"
defunsplit-lines
text
if
zerop
lengthtext
nil
loopwithstart=0fornewline=
position#\Newlinetext:startstart
collect
subseqtextstartnewline
ifnewlinedo
setfstart
1+newline
anddo
when
=start
lengthtext
loop-finish
elsedo
loop-finish
defuncount-leading-space
line
loopforcharacteracrosslinewhile
membercharacter'
#\Space#\Tab
count1
defunempty-or-comment-line-p
line
let
trimmed
string-left-trim'
#\Space#\Tab
line
or
string=trimmed""
char=
chartrimmed0
#\;
defunblank-line-p
line
string=
string-left-trim'
#\Space#\Tab
line
""
defunleftmost-opening-line-p
line
and
plusp
lengthline
char=
charline0
#\(
defunnormalized-token
characters
string-upcase
coerce
nreversecharacters
'string
defunregister-form-element
form
whenform
incf
open-form-element-countform
defunfinish-token
state
when
state-token-bufferstate
let
form
state-token-formstate
token
normalized-token
state-token-bufferstate
whenform
when
=
open-form-element-countform
1
setf
open-form-headform
token
setf
state-token-bufferstate
nil
state-token-formstate
nil
defuntoken-character-p
character
not
membercharacter'
#\Space#\Tab#\Newline#\(#\)#\"#\;
defunbegin-or-continue-token
statecharacter
unless
state-token-bufferstate
setf
state-token-formstate
first
state-stackstate
pushcharacter
state-token-bufferstate
defunchild-role
parentchild-index
cond
andparent
member
open-form-headparent
*binding-form-heads*:test#'string=
=child-index2
:binding-list
andparent
eq
open-form-roleparent
:binding-list
:binding
andparent
member
open-form-headparent
*clause-form-heads*:test#'string=
>=child-index2
:clause
andparent
member
open-form-headparent
*slot-list-form-heads*:test#'string=
=child-index4
:slot-list
andparent
eq
open-form-roleparent
:slot-list
:slot
t:ordinary
defunopener-column-role-p
role
memberrole'
:binding-list:slot-list
defunrole-open-threshold
roleopen-column
caserole
:binding-list
max0
1-open-column
topen-column
defunmake-child-open-form
parentopen-columnline-number
let*
child-index
whenparent
open-form-element-countparent
role
child-roleparentchild-index
threshold
if
role-open-thresholdroleopen-column
1+open-column
make-open-formthresholdline-number:open-columnopen-column:rolerole
defunmaybe-lower-head-continuation-threshold
when
and
open-form-headform
=
open-form-element-countform
1
let
continuation-column
max0
1-
open-form-open-columnform
when
and
<=continuation-columnindentation
<continuation-column
open-form-columnform
setf
open-form-columnform
continuation-column
defundedent-closes
loopwhile
state-stackstate
forform=
first
state-stackstate
dowhile
>
open-form-columnform
indentation
do
pop
state-stackstate
count1
defunappend-closes-to-previous-line
processed-linescount
when
and
pluspcount
processed-lines
let
target
find-if-not#'blank-line-pprocessed-lines
whentarget
setf
car
membertargetprocessed-lines:test#'eq
concatenate'stringtarget
make-stringcount:initial-element#\)
processed-lines
defunlast-code-character-index
line
loopforindexdownfrom
1-
lengthline
to0unless
member
charlineindex
'
#\Space#\Tab
do
returnindex
defuntrailing-close-count
line
loopwithindex=while
andindex
>=index0
char=
charlineindex
#\)
count1do
decfindex
defunremove-one-trailing-close
line
let
if
andindex
char=
charlineindex
#\)
concatenate'string
subseqline0index
subseqline
1+index
line
defuntail-events
eventscount
lastevents
mincount
lengthevents
defundefer-pending-trail-closes
stateprocessed-linespending-eventsindentationprevious-indentation
loopwhile
andpending-eventsprevious-indentation
>indentationprevious-indentation
<=
open-form-column
close-event-open-form
firstpending-events
indentation
do
progn
push
close-event-open-form
firstpending-events
state-stackstate
whenprocessed-lines
setf
firstprocessed-lines
remove-one-trailing-close
firstprocessed-lines
poppending-events
pending-events
defunprocess-line
linestate&optional
line-number0
let
close-events
values
with-output-to-string
output
loopforcharacteracrosslineforcolumnfrom0do
cond
plusp
state-block-comment-depthstate
write-charcharacteroutput
cond
and
state-block-sharp-seenstate
char=character#\|
incf
state-block-comment-depthstate
setf
state-block-sharp-seenstate
nil
state-block-bar-seenstate
nil
and
state-block-bar-seenstate
char=character#\#
decf
state-block-comment-depthstate
setf
state-block-sharp-seenstate
nil
state-block-bar-seenstate
nil
t
setf
state-block-sharp-seenstate
char=character#\#
state-block-bar-seenstate
char=character#\|
state-char-literalstate
write-charcharacteroutput
setf
state-char-literalstate
nil
and
state-sharp-seenstate
char=character#\\
write-charcharacteroutput
setf
state-sharp-seenstate
nil
state-char-literalstate
t
state-sharp-seenstate
setf
state-sharp-seenstate
nil
cond
char=character#\"
write-charcharacteroutput
setf
state-in-stringstate
not
state-in-stringstate
char=character#\|
write-charcharacteroutput
setf
state-block-comment-depthstate
1
char=character#\;
write-charcharacteroutput
char=character#\(
write-charcharacteroutput
push
make-child-open-form
first
state-stackstate
columnline-number
state-stackstate
char=character#\)
if
state-stackstate
let
open-form
pop
state-stackstate
push
make-close-eventopen-formcolumn
close-events
write-charcharacteroutput
incf
state-unmatched-closesstate
t
write-charcharacteroutput
state-symbol-escapestate
write-charcharacteroutput
setf
state-symbol-escapestate
nil
state-in-bar-symbolstate
write-charcharacteroutput
cond
char=character#\\
setf
state-symbol-escapestate
t
char=character#\|
setf
state-in-bar-symbolstate
nil
state-escapestate
write-charcharacteroutput
setf
state-escapestate
nil
and
state-in-stringstate
char=character#\\
write-charcharacteroutput
setf
state-escapestate
t
char=character#\"
unless
state-in-stringstate
write-charcharacteroutput
setf
state-in-stringstate
not
state-in-stringstate
and
not
state-in-stringstate
char=character#\|
write-charcharacteroutput
setf
state-in-bar-symbolstate
t
and
not
state-in-stringstate
char=character#\\
write-charcharacteroutput
setf
state-symbol-escapestate
t
and
not
state-in-stringstate
char=character#\#
write-charcharacteroutput
setf
state-sharp-seenstate
t
and
not
state-in-stringstate
char=character#\;
write-stringlineoutput:startcolumn
loop-finish
and
not
state-in-stringstate
membercharacter'
#\Space#\Tab
write-charcharacteroutput
and
not
state-in-stringstate
char=character#\(
write-charcharacteroutput
push
make-child-open-form
first
state-stackstate
columnline-number
state-stackstate
and
not
state-in-stringstate
char=character#\)
if
state-stackstate
let
open-form
pop
state-stackstate
push
make-close-eventopen-formcolumn
close-events
write-charcharacteroutput
incf
state-unmatched-closesstate
and
not
state-in-stringstate
write-charcharacteroutput
t
write-charcharacteroutput
unless
or
state-in-bar-symbolstate
state-symbol-escapestate
setf
state-escapestate
nil
state-sharp-seenstate
nil
state-char-literalstate
nil
state-block-sharp-seenstate
nil
state-block-bar-seenstate
nil
nreverseclose-events
defunappend-remaining-closes
stateprocessed-lines
append-closes-to-previous-lineprocessed-lines
length
state-stackstate
defunsource-balanced-p
text

Return true when text has no paren balance problem this pass can repair.

let
state
make-state
loopforlineinforline-numberfrom1do
process-linelinestateline-number
and
null
state-stackstate
zerop
state-unmatched-closesstate
zerop
state-block-comment-depthstate
not
state-in-stringstate
not
state-escapestate
not
state-in-bar-symbolstate
not
state-symbol-escapestate
not
state-sharp-seenstate
not
state-char-literalstate
not
state-block-sharp-seenstate
not
state-block-bar-seenstate
defunindent-mode-candidate
text

Return the indentation-driven repair candidate for text.

Open forms close when indentation decreases or at EOF. Unmatched closing parentheses are dropped. Parentheses in strings, line comments, and character literals and block comments are ignored. This is the speculative Parinfer candidate, not necessarily a safe edit.

let
ends-with-newline
and
plusp
lengthtext
char=
chartext
1-
lengthtext
#\Newline
state
make-state
processed-linesnil
pending-trail-eventsnil
pending-trail-indentationnil
blank-boundary-seen-pnil
loopforlineinforline-numberfrom1do
cond
and
not
state-in-stringstate
not
state-in-bar-symbolstate
zerop
state-block-comment-depthstate
setfblank-boundary-seen-pt
pushlineprocessed-lines
t
let
line-started-in-string-p
state-in-stringstate
line-started-in-bar-symbol-p
state-in-bar-symbolstate
line-started-in-block-comment-p
plusp
state-block-comment-depthstate
unless
orline-started-in-string-pline-started-in-bar-symbol-pline-started-in-block-comment-p
when
andblank-boundary-seen-p
append-closes-to-previous-lineprocessed-lines
length
state-stackstate
setf
state-stackstate
nil
pending-trail-eventsnilpending-trail-indentationnil
setfpending-trail-events
defer-pending-trail-closesstateprocessed-linespending-trail-eventspending-trail-indentation
setfblank-boundary-seen-pnil
multiple-value-bind
processed-lineclose-events
process-linelinestateline-number
pushprocessed-lineprocessed-lines
if
orline-started-in-string-pline-started-in-bar-symbol-pline-started-in-block-comment-p
setfpending-trail-eventsnilpending-trail-indentationnil
setfpending-trail-events
reverse
pending-trail-indentation
append-remaining-closesstateprocessed-lines
let
result
formatnil"~{~A~^~%~}"
nreverseprocessed-lines
ifends-with-newline
concatenate'stringresult
string#\Newline
result
defunanalyze-indent-mode
text

Analyze text and return an indent-mode-report.

The report separates source balance from the indentation-driven candidate so callers can surface reader-balanced indentation conflicts without treating them as safe rewrites.

let*
candidate-changed-p
not
string=textcandidate
candidate-balanced-p
make-indent-mode-report:source-balanced-psource-balanced-p:candidatecandidate:candidate-balanced-pcandidate-balanced-p:candidate-changed-pcandidate-changed-p
defunapply-indent-mode
text

Repair text only when it has a validated paren-balance problem.

Balanced source is returned unchanged, even when indentation suggests a different tree. Use analyze-indent-mode or indent-mode-candidate to inspect those suspicious-but-balanced cases.

let
if
and
not
indent-mode-report-source-balanced-preport
indent-mode-report-candidate-balanced-preport
indent-mode-report-candidatereport
text