add custom indenter

pull/2/head
Matthew Butterick 9 years ago
parent b3deb1ed02
commit 574bb06fb7

@ -23,4 +23,30 @@
(module reader syntax/module-reader (module reader syntax/module-reader
#:language 'br) #:language 'br
#:info my-get-info
(require racket/class)
(define (indenter t pos)
(define reserved-terms (map string->list '("with-pattern" "with-shared-id" "define-macro")))
(define sexp-start-pos (send t find-up-sexp pos))
(define paren-length 1)
(define sexp-name-start (send t skip-whitespace (+ paren-length (or sexp-start-pos 0)) 'forward #t))
(define sexp-name (for*/list ([p (in-naturals sexp-name-start)]
[c (in-value (send t get-character p))]
#:break (char-whitespace? c))
c))
(and (member sexp-name reserved-terms)
(let* ([paranum (send t position-paragraph sexp-name-start)]
[psp (send t paragraph-start-position paranum)]
[prev-indent (- sexp-name-start psp)])
(add1 prev-indent)))) ; #f will trigger default indentation
(define (my-get-info key default default-filter)
(case key
#;[(color-lexer)
(dynamic-require 'syntax-color/default-lexer 'default-lexer)]
[(drracket:indentation) indenter]
[else
(default-filter key default)])))

@ -1,18 +1,17 @@
#lang br #lang br
(define (read-syntax source-path input-port) (define (read-syntax src-path in-port)
(define src-strs (remove-blank-lines (port->lines input-port))) (define lines (remove-blank-lines (port->lines in-port)))
(define (make-datum str) (format-datum '(dispatch ~a) str)) (define (make-exec-datum line) (format-datum '(exec ~a) line))
(define src-exprs (map make-datum src-strs)) (define exec-exprs (map make-exec-datum lines))
(strip-context (strip-context (with-pattern ([(EXEC-EXPR ...) exec-exprs])
(with-pattern ([(SRC-EXPR ...) (map make-datum src-strs)])
#'(module stacker-mod br/demo/stacker #'(module stacker-mod br/demo/stacker
SRC-EXPR ...)))) EXEC-EXPR ...))))
(provide read-syntax) (provide read-syntax)
(define-macro (stacker-module-begin READER-LINE ...) (define-macro (stacker-module-begin SRC-LINE ...)
#'(#%module-begin #'(#%module-begin
READER-LINE ... SRC-LINE ...
(display (first stack)))) (display (first stack))))
(provide (rename-out [stacker-module-begin #%module-begin])) (provide (rename-out [stacker-module-begin #%module-begin]))
@ -20,10 +19,14 @@
(define (push num) (set! stack (cons num stack))) (define (push num) (set! stack (cons num stack)))
(provide push) (provide push)
(define-cases dispatch (define-cases exec
[(_ push num) (push num)] [(_ func num) (func num)]
[(_ op) (define op-result (op (first stack) (second stack))) [(_ op) (define result (op (first stack) (second stack)))
(set! stack (cons op-result (drop stack 2)))]) (set! stack (cons result (drop stack 2)))])
(provide dispatch) (provide exec)
(provide + * #%app #%datum #%top-interaction) (provide + * #%app #%datum #%top-interaction)
(module+ test
(require rackunit)
(check-equal? (with-output-to-string (λ () (dynamic-require "stacker-test.rkt" #f))) "36"))
Loading…
Cancel
Save