Skip to content

Commit

Permalink
Improve support for # in Racket lexer (#1472)
Browse files Browse the repository at this point in the history
The # character can be used in Racket in multiline comments as well as
in boolean constants. Currently, the Racket lexer does not at correctly
lex multiline comments, expression comments or full-word boolean
constants.

This commit adds support for those constructs. It also removes
extraneous code from the visual sample.
  • Loading branch information
pyrmont committed Apr 2, 2020
1 parent 96315eb commit c4bd736
Show file tree
Hide file tree
Showing 2 changed files with 53 additions and 236 deletions.
25 changes: 24 additions & 1 deletion lib/rouge/lexers/racket.rb
Expand Up @@ -488,6 +488,9 @@ def self.builtins
state :root do
# comments
rule %r/;.*$/, Comment::Single
rule %r/#!.*/, Comment::Single
rule %r/#\|/, Comment::Multiline, :block_comment
rule %r/#;/, Comment::Multiline, :sexp_comment
rule %r/\s+/m, Text

rule %r/[+-]inf[.][f0]/, Num::Float
Expand All @@ -510,7 +513,7 @@ def self.builtins
rule %r/['`]#{id}/i, Str::Symbol
rule %r/#\\([()\/'"._!\$%& ?=+-]{1}|[a-z0-9]+)/i,
Str::Char
rule %r/#t|#f/, Name::Constant
rule %r/#t(rue)?|#f(alse)?/i, Name::Constant
rule %r/(?:'|#|`|,@|,|\.)/, Operator

rule %r/(['#])(\s*)(\()/m do
Expand All @@ -524,6 +527,26 @@ def self.builtins
rule id, Name::Variable
end

state :block_comment do
rule %r/[^|#]+/, Comment::Multiline
rule %r/\|#/, Comment::Multiline, :pop!
rule %r/#\|/, Comment::Multiline, :block_comment
rule %r/[|#]/, Comment::Multiline
end

state :sexp_comment do
rule %r/[({\[]/, Comment::Multiline, :sexp_comment_inner
rule %r/"(?:\\"|[^"])*?"/, Comment::Multiline, :pop!
rule %r/[^\s]+/, Comment::Multiline, :pop!
rule(//) { pop! }
end

state :sexp_comment_inner do
rule %r/[^(){}\[\]]+/, Comment::Multiline
rule %r/[)}\]]/, Comment::Multiline, :pop!
rule %r/[({\[]/, Comment::Multiline, :sexp_comment_inner
end

state :command do
rule id, Name::Function do |m|
if self.class.keywords.include? m[0]
Expand Down
264 changes: 29 additions & 235 deletions spec/visual/samples/racket
Expand Up @@ -2,10 +2,28 @@

;; Single-line comment

#| Multi-line comment on one line |#
#| Block comment on one line |#

#| Multi-line comment on
two lines |#
#|Block comment.
(define x 3)
is not highlighted as the commented text.
|#

#|
Block comment.
(define x 3)
is not highlighted as the commented text.
|#

#| a |# 1 ; reads equal to 1
#| #| a |# 1 |# 2 ; reads equal to 2

#;1 2 ; reads equal to 2
#;(define x 1) (define x 2) ; reads equal to (define x 2)
#;(define x (f a b)) (define x 2) ; reads equal to (define x 2)

#!/bin/sh ; reads equal to nothing
#! /bin/sh ; reads equal to nothing

'symbol
`symbol
Expand All @@ -23,6 +41,7 @@

(define (1-crazy-identifier-疯狂的标识符-τρελό-αναγνωριστικό x)
(add1 x))

(check-equal? (1-crazy-identifier-疯狂的标识符-τρελό-αναγνωριστικό 1) 2)

(require xml net/url
Expand Down Expand Up @@ -91,236 +110,11 @@
(λ (query)
`(html (body "Hello, World!"))))

;; ----------------------------------------

(define (build-request-page label next-url hidden)
`(html
(head (title "Enter a Number to Add"))
(body ([bgcolor "white"])
(form ([action ,next-url] [method "get"])
,label
(input ([type "text"] [name "number"]
[value ""]))
(input ([type "hidden"] [name "hidden"]
[value ,hidden]))
(input ([type "submit"] [name "enter"]
[value "Enter"]))))))

(define (many query)
;; Create a page containing the form:
(build-request-page "Number of greetings:" "/reply" ""))

(define (reply query)
;; Extract and use the form results:
(define n (string->number (cdr (assq 'number query))))
`(html (body ,@(for/list ([i (in-range n)])
" hello"))))

(hash-set! dispatch-table "many" many)
(hash-set! dispatch-table "reply" reply)

;; ----------------------------------------
;; Old, awkward version:

(define (sum query)
(build-request-page "First number:" "/one" ""))

(define (one query)
(build-request-page "Second number:"
"/two"
(cdr (assq 'number query))))

(define (two query)
(let ([n (string->number (cdr (assq 'hidden query)))]
[m (string->number (cdr (assq 'number query)))])
`(html (body "The sum is " ,(number->string (+ m n))))))

(hash-set! dispatch-table "sum" sum)
(hash-set! dispatch-table "one" one)
(hash-set! dispatch-table "two" two)

;; ----------------------------------------

;; Helper to grab a computation and generate a handler for it:

(define (send/suspend mk-page)
(let/cc k
(define tag (format "k~a" (current-inexact-milliseconds)))
(hash-set! dispatch-table tag k)
(abort (mk-page (string-append "/" tag)))))

;; Helper to run the number-getting page via `send/suspend':

(define (get-number label)
(define query
;; Generate a URL for the current computation:
(send/suspend
;; Receive the computation-as-URL here:
(λ (k-url)
;; Generate the query-page result for this connection.
;; Send the query result to the saved-computation URL:
(build-request-page label k-url ""))))
;; We arrive here later, in a new connection
(string->number (cdr (assq 'number query))))

;; ----------------------------------------

;; New direct-style servlet:

(define (sum2 query)
(define m (get-number "First number:"))
(define n (get-number "Second number:"))
`(html (body "The sum is " ,(number->string (+ m n)))))

(hash-set! dispatch-table "sum2" sum2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#lang web-server/insta

(require web-server/formlets
"model-3.rkt")

; start: request -> doesn't return
; Consumes a request and produces a page that displays
; all of the web content.
(define (start request)
(render-blog-page
(initialize-blog!
(build-path (current-directory)
"the-blog-data.sqlite"))
request))

; new-post-formlet : formlet (values string? string?)
; A formlet for requesting a title and body of a post
(define new-post-formlet
(formlet
(#%# ,{input-string . => . title}
,{input-string . => . body})
(values title body)))

; render-blog-page: blog request -> doesn't return
; Produces an HTML page of the content of the
; blog.
(define (render-blog-page a-blog request)
(local [(define (response-generator embed/url)
(response/xexpr
`(html (head (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts a-blog embed/url)
(form ([action
,(embed/url insert-post-handler)])
,@(formlet-display new-post-formlet)
(input ([type "submit"])))))))

(define (insert-post-handler request)
(define-values (title body)
(formlet-process new-post-formlet request))
(blog-insert-post! a-blog title body)
(render-blog-page a-blog (redirect/get)))]

(send/suspend/dispatch response-generator)))

; new-comment-formlet : formlet string
; A formlet for requesting a comment
(define new-comment-formlet
input-string)

; render-post-detail-page: post request -> doesn't return
; Consumes a post and produces a detail page of the post.
; The user will be able to either insert new comments
; or go back to render-blog-page.
(define (render-post-detail-page a-blog a-post request)
(local [(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ([action
,(embed/url insert-comment-handler)])
,@(formlet-display new-comment-formlet)
(input ([type "submit"])))
(a ([href ,(embed/url back-handler)])
"Back to the blog")))))

(define (insert-comment-handler request)
(render-confirm-add-comment-page
a-blog
(formlet-process new-comment-formlet request)
a-post
request))

(define (back-handler request)
(render-blog-page a-blog request))]

(send/suspend/dispatch response-generator)))

; render-confirm-add-comment-page :
; blog comment post request -> doesn't return
; Consumes a comment that we intend to add to a post, as well
; as the request. If the user follows through, adds a comment
; and goes back to the display page. Otherwise, goes back to
; the detail page of the post.
(define (render-confirm-add-comment-page a-blog a-comment
a-post request)
(local [(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Add a Comment"))
(body
(h1 "Add a Comment")
"The comment: " (div (p ,a-comment))
"will be added to "
(div ,(post-title a-post))

(p (a ([href ,(embed/url yes-handler)])
"Yes, add the comment."))
(p (a ([href ,(embed/url cancel-handler)])
"No, I changed my mind!"))))))

(define (yes-handler request)
(post-insert-comment! a-blog a-post a-comment)
(render-post-detail-page a-blog a-post (redirect/get)))

(define (cancel-handler request)
(render-post-detail-page a-blog a-post request))]

(send/suspend/dispatch response-generator)))

; render-post: post (handler -> string) -> xexpr
; Consumes a post, produces an xexpr fragment of the post.
; The fragment contains a link to show a detailed view of the post.
(define (render-post a-blog a-post embed/url)
(local [(define (view-post-handler request)
(render-post-detail-page a-blog a-post request))]
`(div ([class "post"])
(a ([href ,(embed/url view-post-handler)])
,(post-title a-post))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)"))))

; render-posts: blog (handler -> string) -> xexpr
; Consumes a embed/url, produces an xexpr fragment
; of all its posts.
(define (render-posts a-blog embed/url)
(local [(define (render-post/embed/url a-post)
(render-post a-blog a-post embed/url))]
`(div ([class "posts"])
,@(map render-post/embed/url (blog-posts a-blog)))))

; render-as-itemized-list: (listof xexpr) -> xexpr
; Consumes a list of items, and produces a rendering as
; an unorderered list.
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))

; render-as-item: xexpr -> xexpr
; Consumes an xexpr, and produces a rendering
; as a list item.
(define (render-as-item a-fragment)
`(li ,a-fragment))
;; Highlight booleans
(define ht #true)
(define ht #t)
(define ht #T)
(define hf #false)
(define hf #f)
(define hf #F)

0 comments on commit c4bd736

Please sign in to comment.