diff --git a/printer.rkt b/printer.rkt index 000765b..80052fb 100644 --- a/printer.rkt +++ b/printer.rkt @@ -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) - (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 + (iseq-append + (symbol->string lt) + " " + (list 'Hang 0 (ppr-binds binds)) + (iseq-append 'Newline "in " (ppr-expr e))))) (: ppr-expr (-> CoreExpr ISeq)) (define (ppr-expr a) @@ -99,20 +103,26 @@ (: iseq->string (-> IndentLevel ISeq String)) (define (iseq->string l a) - (letrec ([s (open-output-string)] - [go : (-> IndentLevel ISeq Void) - (λ (l i) - (match i - ['() (void)] - [`(++ ,i0 ,i1) (begin - (go l i0) - (go l i1))] - [`(Indent ,i) (go (+ l 1) i)] - ['Newline (display - (string-append - "\n" - (make-string l #\space)) - s)] - [(? string?) (display i s)]))]) - (go l a) - (get-output-string s))) + (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 ,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" + (make-string l #\space)) + s)] + [(? string?) (display i s)]))]) + (go l a) + (get-output-string s))))