link the #lang in codeblocks

This makes the codeblock form output a (hash-lang) element for the
#lang, which is consistent with racketblock
This commit is contained in:
AlexKnauth 2015-09-06 11:13:16 -04:00 committed by Matthew Flatt
parent f33e8c0746
commit 5d15699944

View File

@ -102,12 +102,12 @@
;; (listof string) boolean boolean -> tokens string
;; tokens is a
;; (cons metadata (listof (list T natural natural natural)))
;; (listof (list T natural natural natural))
;; T being a symbol returned as a token type from the languages lexer
;; OR a function created by get-tokens
;; the first number being the start position
;; the second being the end position
;; the third 0 if T is a symbol, and 1 if its a function
;; the third 0 if T is a symbol, and 1 or greater if its a function or element
;; the tokens are sorted by the start end end positions
(define (get-tokens strs context expand)
(let* ([xstr (apply string-append strs)]
@ -193,6 +193,13 @@
(map loop (syntax->list #'(form ...))))]
[else null]))]
[has-hash-lang? (regexp-match? #rx"^#lang " bstr)]
[hash-lang (if has-hash-lang?
(list (list (hash-lang)
0
5
1)
(list 'white-space 5 6 0))
null)]
[language (if has-hash-lang?
(let ([m (regexp-match #rx"^#lang ([-0-9a-zA-Z/._+]+)" bstr)])
(if m
@ -206,6 +213,7 @@
null)]
[tokens (sort (append ids
mods
hash-lang
language
(filter (lambda (x) (not (eq? (car x) 'symbol)))
(if has-hash-lang?
@ -322,10 +330,10 @@
(define (tokens strs)
(define-values (toks _) (get-tokens strs #f #f))
(for/list ([tok (rest toks)])
(for/list ([tok (in-list toks)])
(match tok
[(list _ start end 1)
(list 'function start end 1)]
[(list _ start end (or 1 2 3))
(list 'function start end 1)] ; this looses information
[_ tok])))
(define (make-test-result lst)
@ -337,11 +345,14 @@
(values
(cons (list (first p) count next r) result)
next)))
(cons `(function 6 12 1) (reverse res)))
(list* `(function 0 5 1) `(white-space 5 6 0) `(function 6 12 1) `(function 6 12 1)
(reverse res)))
(test
(tokens (list "#lang racket\n1"))
=> `((function 6 12 1) (white-space 12 13 0) (constant 13 14 0))
=> `((function 0 5 1) (white-space 5 6 0) ;"#lang "
(function 6 12 1) (function 6 12 1) (white-space 12 13 0) ;"racket\n"
(constant 13 14 0)) ; "1"
(tokens (list "#lang racket\n" "(+ 1 2)"))
=> (make-test-result
'((white-space 1)