suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

avoid allocation for 'paren' structs

Browse Source
This commit is contained in:
Robby Findler 2012-04-03 16:17:46 -05:00
parent f37ff698b4
commit 404b4da138
1 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/syntax-color/paren-tree.rkt
View File

@ -1,5 +1,6 @@
(module paren-tree mzscheme
(require mzlib/class
mzlib/list
"token-tree.rkt")
(provide paren-tree%)
@ -46,6 +47,27 @@
(define tree (new token-tree%))
(define invalid-tree (new token-tree%))
(define common-parens
(list (make-paren '|(| 1)
(make-paren '|)| 1)
(make-paren '|]| 1)
(make-paren '|[| 1)
(make-paren '|}| 1)
(make-paren '|{| 1)))
(define false-zero-paren (make-paren #f 0))
(define (build-paren type len)
(cond
[(eq? len 1)
(or (ormap (λ (cp) (and (equal? (paren-type cp) type)
cp))
common-parens)
(make-paren type len))]
[(and (eq? length 0) (eq? type #f))
false-zero-paren]
[else
(make-paren type len)]))
(define/private (split tree pos)
(send tree search! pos)
(let ((token-start (send tree get-root-start-position)))
@ -60,7 +82,7 @@
(send first add-to-root-length (- pos first-end))
(insert-first! next (new token-tree%
(length (- first-end pos))
(data (make-paren #f 0))))
(data (build-paren #f 0))))
(values first next)))))))
;; split-tree: natural-number -> void
@ -100,7 +122,7 @@
; Big performance increase using the -spec version.
;(insert-last! tree (new token-tree% (length length) (data (cons type length))))
(insert-last-spec! tree length
(make-paren type (if type length 0))))
(build-paren type (if type length 0))))
(else
(send tree search-max!)
(send tree add-to-root-length length))))