yiyunliu/core-in-racket
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix indent

Browse source
This commit is contained in:
Yiyun Liu 2025-05-28 20:46:53 -04:00
parent a46cc06335
commit c17995f97d
1 changed files with 38 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

34
printer.rkt
View file

@ -1,10 +1,15 @@
#lang typed/racket
(require "ast.rkt")
(define-type IndentLevel Nonnegative-Integer)
(define-type IndentLevel Integer)
(define-type ISeq
(∪ Null String (List 'Indent ISeq) 'Newline (List '++ ISeq ISeq)))
(∪ Null
String
(List 'Hang IndentLevel ISeq)
'Newline
(List '++ ISeq ISeq)
(List 'Indent IndentLevel ISeq)))
(define-syntax iseq-append-with-sep
(syntax-rules ()
@ -68,18 +73,17 @@
"case"
(ppr-expr e)
"of")
(list 'Indent (list 'Indent
(iseq-append 'Newline (ppr-alts alts))))))
(list 'Hang -2
(iseq-append 'Newline (ppr-alts alts)))))
(: ppr-lets (-> Let CoreBinds CoreExpr ISeq))
(define (ppr-lets lt binds e)
(list 'Hang 0
(iseq-append
(symbol->string lt)
" "
(list 'Indent (list 'Indent (list 'Indent (list 'Indent (ppr-binds binds)))))
'Newline
"in "
(list 'Indent (list 'Indent (list 'Indent (ppr-expr e))))))
(list 'Hang 0 (ppr-binds binds))
(iseq-append 'Newline "in " (ppr-expr e)))))
(: ppr-expr (-> CoreExpr ISeq))
(define (ppr-expr a)
@ -99,15 +103,21 @@
(: iseq->string (-> IndentLevel ISeq String))
(define (iseq->string l a)
(letrec ([s (open-output-string)]
[go : (-> IndentLevel ISeq Void)
(let ([s (open-output-string)])
(port-count-lines! s)
(letrec ([go : (-> IndentLevel ISeq Void)
(λ (l i)
(match i
['() (void)]
[`(++ ,i0 ,i1) (begin
(go l i0)
(go l i1))]
[`(Indent ,i) (go (+ l 1) i)]
[`(Indent ,l0 ,i) (go (max (+ l l0) 0) i)]
[`(Hang ,l0 ,i)
(let-values ([(linum col-pos pos) (port-next-location s)])
(if (not (false? col-pos))
(go (max (+ col-pos l0) 0) i)
(error "impossible: line counting not enabled")))]
['Newline (display
(string-append
"\n"
@ -115,4 +125,4 @@
s)]
[(? string?) (display i s)]))])
(go l a)
(get-output-string s)))
(get-output-string s))))