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

66
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)
(iseq-append (list 'Hang 0
(symbol->string lt) (iseq-append
" " (symbol->string lt)
(list 'Indent (list 'Indent (list 'Indent (list 'Indent (ppr-binds binds))))) " "
'Newline (list 'Hang 0 (ppr-binds binds))
"in " (iseq-append 'Newline "in " (ppr-expr e)))))
(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,20 +103,26 @@
(: 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)
(λ (l i) (letrec ([go : (-> IndentLevel ISeq Void)
(match i (λ (l i)
['() (void)] (match i
[`(++ ,i0 ,i1) (begin ['() (void)]
(go l i0) [`(++ ,i0 ,i1) (begin
(go l i1))] (go l i0)
[`(Indent ,i) (go (+ l 1) i)] (go l i1))]
['Newline (display [`(Indent ,l0 ,i) (go (max (+ l l0) 0) i)]
(string-append [`(Hang ,l0 ,i)
"\n" (let-values ([(linum col-pos pos) (port-next-location s)])
(make-string l #\space)) (if (not (false? col-pos))
s)] (go (max (+ col-pos l0) 0) i)
[(? string?) (display i s)]))]) (error "impossible: line counting not enabled")))]
(go l a) ['Newline (display
(get-output-string s))) (string-append
"\n"
(make-string l #\space))
s)]
[(? string?) (display i s)]))])
(go l a)
(get-output-string s))))