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 #lang typed/racket
(require "ast.rkt") (require "ast.rkt")
(define-type IndentLevel Nonnegative-Integer) (define-type IndentLevel Integer)
(define-type ISeq (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 (define-syntax iseq-append-with-sep
(syntax-rules () (syntax-rules ()
@ -68,18 +73,17 @@
"case" "case"
(ppr-expr e) (ppr-expr e)
"of") "of")
(list 'Indent (list 'Indent (list 'Hang -2
(iseq-append 'Newline (ppr-alts alts)))))) (iseq-append 'Newline (ppr-alts alts)))))
(: ppr-lets (-> Let CoreBinds CoreExpr ISeq)) (: ppr-lets (-> Let CoreBinds CoreExpr ISeq))
(define (ppr-lets lt binds e) (define (ppr-lets lt binds e)
(list 'Hang 0
(iseq-append (iseq-append
(symbol->string lt) (symbol->string lt)
" " " "
(list 'Indent (list 'Indent (list 'Indent (list 'Indent (ppr-binds binds))))) (list 'Hang 0 (ppr-binds binds))
'Newline (iseq-append 'Newline "in " (ppr-expr e)))))
"in "
(list 'Indent (list 'Indent (list 'Indent (ppr-expr e))))))
(: ppr-expr (-> CoreExpr ISeq)) (: ppr-expr (-> CoreExpr ISeq))
(define (ppr-expr a) (define (ppr-expr a)
@ -99,15 +103,21 @@
(: iseq->string (-> IndentLevel ISeq String)) (: iseq->string (-> IndentLevel ISeq String))
(define (iseq->string l a) (define (iseq->string l a)
(letrec ([s (open-output-string)] (let ([s (open-output-string)])
[go : (-> IndentLevel ISeq Void) (port-count-lines! s)
(letrec ([go : (-> IndentLevel ISeq Void)
(λ (l i) (λ (l i)
(match i (match i
['() (void)] ['() (void)]
[`(++ ,i0 ,i1) (begin [`(++ ,i0 ,i1) (begin
(go l i0) (go l i0)
(go l i1))] (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 ['Newline (display
(string-append (string-append
"\n" "\n"
@ -115,4 +125,4 @@
s)] s)]
[(? string?) (display i s)]))]) [(? string?) (display i s)]))])
(go l a) (go l a)
(get-output-string s))) (get-output-string s))))