revised 'for' and docs
svn: r6400 original commit: c59c7ebab760505fc3215b4c58a823617df0bb0d
This commit is contained in:
Matthew Flatt
parent
da1bfdad73
commit
72ee384f64
|
|
@ -46,16 +46,39 @@
|
|||
(if (flow? p)
|
||||
p
|
||||
(make-flow (list p))))))
|
||||
(append
|
||||
(if (string? (car val-list+outputs))
|
||||
(map
|
||||
(lambda (s)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemeerror"
|
||||
(italic s))))))))
|
||||
(let sloop ([s (car val-list+outputs)])
|
||||
(if (string=? "" (cdar val-list+outputs))
|
||||
null
|
||||
(list
|
||||
(list
|
||||
(make-flow
|
||||
(list
|
||||
(let ([s (regexp-split #rx"\n"
|
||||
(regexp-replace #rx"\n$"
|
||||
(cdar val-list+outputs)
|
||||
""))])
|
||||
(if (= 1 (length s))
|
||||
(make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemestdout" (car s))))
|
||||
(make-table
|
||||
#f
|
||||
(map (lambda (s)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemestdout" s)))))))
|
||||
s)))))))))
|
||||
(if (string? (caar val-list+outputs))
|
||||
;; Error result case:
|
||||
(map
|
||||
(lambda (s)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemeerror"
|
||||
(italic s))))))))
|
||||
(let sloop ([s (caar val-list+outputs)])
|
||||
(if ((string-length s) . > . maxlen)
|
||||
;; break the error message into multiple lines:
|
||||
(let loop ([pos (sub1 maxlen)])
|
||||
|
|
@ -67,43 +90,20 @@
|
|||
(sloop (substring s (add1 pos))))]
|
||||
[else (loop (sub1 pos))]))
|
||||
(list s))))
|
||||
(append
|
||||
(if (string=? "" (cdar val-list+outputs))
|
||||
;; Normal result case:
|
||||
(let ([val-list (caar val-list+outputs)])
|
||||
(if (equal? val-list (list (void)))
|
||||
null
|
||||
(list
|
||||
(list
|
||||
(make-flow
|
||||
(list
|
||||
(let ([s (regexp-split #rx"\n"
|
||||
(regexp-replace #rx"\n$"
|
||||
(cdar val-list+outputs)
|
||||
""))])
|
||||
(if (= 1 (length s))
|
||||
(make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemestdout" (car s))))
|
||||
(make-table
|
||||
#f
|
||||
(map (lambda (s)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemestdout" s)))))))
|
||||
s)))))))))
|
||||
(let ([val-list (caar val-list+outputs)])
|
||||
(if (equal? val-list (list (void)))
|
||||
null
|
||||
(map (lambda (v)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemeresult"
|
||||
(to-element/no-color v))))))))
|
||||
val-list)))))
|
||||
(loop (cdr expr-paras)
|
||||
(cdr val-list+outputs)
|
||||
#f))))))))
|
||||
(map (lambda (v)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(span-class "schemeresult"
|
||||
(to-element/no-color v))))))))
|
||||
val-list))))
|
||||
(loop (cdr expr-paras)
|
||||
(cdr val-list+outputs)
|
||||
#f)))))))
|
||||
|
||||
(define (do-eval s)
|
||||
(cond
|
||||
|
|
@ -121,7 +121,8 @@
|
|||
(let ([o (open-output-string)])
|
||||
(parameterize ([current-output-port o])
|
||||
(with-handlers ([exn? (lambda (e)
|
||||
(exn-message e))])
|
||||
(cons (exn-message e)
|
||||
(get-output-string o)))])
|
||||
(cons (let ([v (do-plain-eval s #t)])
|
||||
(copy-value v (make-hash-table)))
|
||||
(get-output-string o)))))]))
|
||||
|
|
|
|||
|
|
@ -43,10 +43,16 @@
|
|||
(define (to-element/id s)
|
||||
(make-element "schemesymbol" (list (to-element/no-color s))))
|
||||
|
||||
(define-code scheme to-element unsyntax (lambda (ctx s v) s))
|
||||
(define-code schemeresult to-element/result unsyntax (lambda (ctx s v) s))
|
||||
(define-code schemeid to-element/id unsyntax (lambda (ctx s v) s))
|
||||
(define-code schememodname to-element unsyntax (lambda (ctx s v) s))
|
||||
(define (keep-s-expr ctx s v) s)
|
||||
(define (add-sq-prop s name val)
|
||||
(if (eq? name 'paren-shape)
|
||||
(make-shaped-parens s val)
|
||||
s))
|
||||
|
||||
(define-code scheme to-element unsyntax keep-s-expr add-sq-prop)
|
||||
(define-code schemeresult to-element/result unsyntax keep-s-expr add-sq-prop)
|
||||
(define-code schemeid to-element/id unsyntax keep-s-expr add-sq-prop)
|
||||
(define-code schememodname to-element unsyntax keep-s-expr add-sq-prop)
|
||||
|
||||
(define (litchar . strs)
|
||||
(unless (andmap string? strs)
|
||||
|
|
|
|||
|
|
@ -13,7 +13,9 @@
|
|||
syntax-ize
|
||||
syntax-ize-hook
|
||||
current-keyword-list
|
||||
current-variable-list)
|
||||
current-variable-list
|
||||
|
||||
(struct shaped-parens (val shape)))
|
||||
|
||||
(define no-color "schemeplain")
|
||||
(define meta-color "schemeplain")
|
||||
|
|
@ -26,12 +28,13 @@
|
|||
(define opt-color "schemeopt")
|
||||
|
||||
(define current-keyword-list
|
||||
(make-parameter '(define let let* letrec require provide
|
||||
(make-parameter '(define let let* letrec require provide let-values
|
||||
lambda new send if cond begin else and or
|
||||
define-syntax syntax-rules define-struct
|
||||
quote quasiquote unquote unquote-splicing
|
||||
syntax quasisyntax unsyntax unsyntax-splicing
|
||||
fold-for list-for list-for* for)))
|
||||
for/fold for/list for*/list for for/and for/or for* for*/or for*/and for*/fold
|
||||
for-values for*/list-values for/first for/last)))
|
||||
(define current-variable-list
|
||||
(make-parameter null))
|
||||
|
||||
|
|
@ -301,6 +304,7 @@
|
|||
(string? (syntax-e c))
|
||||
(bytes? (syntax-e c))
|
||||
(char? (syntax-e c))
|
||||
(keyword? (syntax-e c))
|
||||
(boolean? (syntax-e c)))
|
||||
value-color]
|
||||
[(identifier? c)
|
||||
|
|
@ -336,13 +340,13 @@
|
|||
|
||||
(define-syntax (define-code stx)
|
||||
(syntax-case stx ()
|
||||
[(_ code typeset-code uncode d->s)
|
||||
[(_ code typeset-code uncode d->s stx-prop)
|
||||
(syntax/loc stx
|
||||
(define-syntax (code stx)
|
||||
(define (stx->loc-s-expr v)
|
||||
(cond
|
||||
[(syntax? v)
|
||||
(let ([mk `(d->s
|
||||
(let ([mk `(,#'d->s
|
||||
#f
|
||||
,(syntax-case v (uncode)
|
||||
[(uncode e) #'e]
|
||||
|
|
@ -354,7 +358,7 @@
|
|||
,(syntax-span v)))])
|
||||
(let ([prop (syntax-property v 'paren-shape)])
|
||||
(if prop
|
||||
`(syntax-property ,mk 'paren-shape ,prop)
|
||||
`(,#'stx-prop ,mk 'paren-shape ,prop)
|
||||
mk)))]
|
||||
[(pair? v) `(cons ,(stx->loc-s-expr (car v))
|
||||
,(stx->loc-s-expr (cdr v)))]
|
||||
|
|
@ -365,13 +369,13 @@
|
|||
[(null? v) 'null]
|
||||
[else `(quote ,v)]))
|
||||
(define (cvt s)
|
||||
(d->s #'here (stx->loc-s-expr s) #f))
|
||||
(datum->syntax-object #'here (stx->loc-s-expr s) #f))
|
||||
(syntax-case stx ()
|
||||
[(_ expr) #`(typeset-code #,(cvt #'expr))]
|
||||
[(_ expr (... ...))
|
||||
#`(typeset-code #,(cvt #'(code:line expr (... ...))))])))]
|
||||
[(_ code typeset-code uncode)
|
||||
#'(define-code code typeset-code uncode datum->syntax-object)]
|
||||
#'(define-code code typeset-code uncode datum->syntax-object syntax-property)]
|
||||
[(_ code typeset-code) #'(define-code code typeset-code unsyntax)]))
|
||||
|
||||
|
||||
|
|
@ -406,10 +410,16 @@
|
|||
(loop (cons (car r) r) (sub1 i)))))
|
||||
l))))
|
||||
|
||||
(define-struct shaped-parens (val shape))
|
||||
|
||||
(define (syntax-ize v col)
|
||||
(cond
|
||||
[((syntax-ize-hook) v col)
|
||||
=> (lambda (r) r)]
|
||||
[(shaped-parens? v)
|
||||
(syntax-property (syntax-ize (shaped-parens-val v) col)
|
||||
'paren-shape
|
||||
(shaped-parens-shape v))]
|
||||
[(and (list? v)
|
||||
(pair? v)
|
||||
(memq (car v) '(quote unquote unquote-splicing)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user