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

Removing tool and using new repl submit

Browse Source 
original commit: ee8477ca137c333508a43f4e039e63082d0b64c1
This commit is contained in:
Jay McCarthy 2010-06-24 15:10:24 -06:00
parent aaa66de05a
commit 83e858254f
3 changed files with 62 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/datalog/lang/reader.rkt
View File

@ -6,11 +6,12 @@
#:read-syntax (lambda ([source-name #f] [in (current-input-port)])
(let ([ast (parse-program in)])
(list `(#%module-begin ,@ast))))
#:whole-body-readers? #t
#:whole-body-readers? #t
#:info (lambda (key defval default)
; XXX Should have comment character key
; XXX repl submit
; XXX Should have different comment character key
(case key
[(drracket:submit-predicate)
(dynamic-require `datalog/tool/submit 'repl-submit?)]
[(color-lexer)
(dynamic-require `datalog/tool/syntax-color 'get-syntax-token)]
[else (default key defval)]))

54
collects/datalog/tool/submit.rkt Normal file
View File

@ -0,0 +1,54 @@
#lang racket/base
(define (delimiter-pair? x y)
(and (char=? x #\() (char=? y #\))))
(define (repl-submit? ip has-white-space?)
(let loop ([blank? #t]
[string-char #f]
[delimiter-stack null]
[closed? #f])
(let ([c (read-char ip)])
(if (eof-object? c)
(and closed?
(not blank?)
(not string-char)
(null? delimiter-stack))
(case c
[(#\. #\? #\~)
(if string-char
(loop #f string-char delimiter-stack #f)
(loop #f #f delimiter-stack #t))]
[(#\()
(if string-char
(loop #f string-char delimiter-stack #f)
(loop #f #f (cons c delimiter-stack) #f))]
[(#\))
(cond
[string-char
(loop #f string-char delimiter-stack #f)]
[(and (pair? delimiter-stack)
(delimiter-pair? (car delimiter-stack) c))
(loop #f #f (cdr delimiter-stack) #f)]
[else
(loop #f #f delimiter-stack #f)])]
[(#\")
(cond
[(and string-char (char=? c string-char))
(loop #f #f delimiter-stack #f)]
[string-char
(loop #f string-char delimiter-stack #f)]
[else
(loop #f c delimiter-stack #f)])]
[(#\\)
(if string-char
(begin (read-char ip)
(loop #f string-char delimiter-stack #f))
(loop #f string-char delimiter-stack #f))]
[else
(loop (and blank? (char-whitespace? c))
string-char
delimiter-stack
closed?)])))))
(provide repl-submit?)

8
collects/datalog/tool/syntax-color.rkt
View File

@ -1,4 +1,4 @@
#lang racket
#lang racket/base
(require parser-tools/lex
(prefix-in : parser-tools/lex-sre)
"../private/lex.rkt")
@ -26,11 +26,11 @@
[comment-re
(syn-val lexeme 'comment #f start-pos end-pos)]
[variable-re
(syn-val lexeme 'identifier #f start-pos end-pos)]
(syn-val lexeme 'symbol #f start-pos end-pos)]
[identifier-re
(syn-val lexeme 'keyword #f start-pos end-pos)]
(syn-val lexeme 'identifier #f start-pos end-pos)]
[(:or #\) #\() (syn-val lexeme 'parenthesis #f start-pos end-pos)]
[(:or #\= #\? #\~ #\. #\, ":-") (syn-val lexeme 'default #f start-pos end-pos)]
[(:or #\= #\? #\~ #\. #\, ":-") (syn-val lexeme 'parenthesis #f start-pos end-pos)]
[(eof) (syn-val lexeme 'eof #f start-pos end-pos)]
[#\" ((colorize-string start-pos) input-port)]
[any-char (syn-val lexeme 'error #f start-pos end-pos)]))