Permalink
Browse files

- added tests for the case and exclusive-cond syntax-error calls

    4.ms, root-experr-compile-0-f-f-f
- added print-extended-identifier parameter.  when #t, symbols like
  1+ and +++ print without escapes.
    priminfo.ss, print.ss,
    6.ms
  • Loading branch information...
1 parent 2004f91 commit 603019ea82afda1926462214576ef92df15e43c8 @dybvig dybvig committed Aug 23, 2016
View
@@ -298,4 +298,10 @@
7.ms
- fixed a bug in case and exclusive-cond syntax-error calls causing an
exception in syntax-error instead of the intended error message.
- s/syntax.ss
+ syntax.ss
+- added tests for the case and exclusive-cond syntax-error calls
+ 4.ms, root-experr-compile-0-f-f-f
+- added print-extended-identifier parameter. when #t, symbols like
+ 1+ and +++ print without escapes.
+ priminfo.ss, print.ss,
+ 6.ms
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
Binary file not shown.
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
Binary file not shown.
Binary file not shown.
View
@@ -393,6 +393,8 @@
)
(mat exclusive-cond
+ (error? ; invalid syntax
+ (exclusive-cond [a . b]))
(let ((a 'a))
(and (begin (set! a 3)
(exclusive-cond ((= a 4) #f) ((= a 3) #t) (else #f)))
@@ -464,6 +466,8 @@
)
(mat case
+ (error? ; invalid syntax
+ (case 3 [a . b]))
(eq? (case 'a [a 'yes] [b 'no]) 'yes)
(let ((a 'a))
(and
View
@@ -1085,6 +1085,16 @@
(pretty-print '#(1 2 3 3 3))
(pretty-print '#vfx(5 7 9 8 8 9 -1 -1)))))
"#5(1 2 3)\n#8vfx(5 7 9 8 8 9 -1)\n")
+ (equal? (parameterize ([print-extended-identifiers #f])
+ (with-output-to-string
+ (lambda ()
+ (for-each pretty-print '(1+ +++ .. |12| xyz aBc |-155| |.5e7| |.5e|)))))
+ "\\x31;+\n\\x2B;++\n\\x2E;.\n\\x31;2\nxyz\naBc\n\\x2D;155\n\\x2E;5e7\n\\x2E;5e\n")
+ (equal? (parameterize ([print-extended-identifiers #t])
+ (with-output-to-string
+ (lambda ()
+ (for-each pretty-print '(1+ +++ .. |12| xyz aBc |-155| |.5e7| |.5e|)))))
+ "1+\n+++\n..\n\\x31;2\nxyz\naBc\n\\x2D;155\n\\x2E;5e7\n.5e\n")
(equal? (parameterize ([print-gensym #f])
(format "~s" '(#3# #3=#{g0 fool})))
"(g0 g0)")
@@ -243,7 +243,9 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input
4.mo:Expected error in mat apply: "apply: (1 2 1 2 1 2 ...) is circular".
4.mo:Expected error in mat begin: "invalid syntax (begin)".
4.mo:Expected error in mat cond: "invalid syntax x".
+4.mo:Expected error in mat exclusive-cond: "invalid exclusive-cond clause (a . b)".
4.mo:Expected error in mat exclusive-cond: "invalid syntax x".
+4.mo:Expected error in mat case: "invalid case clause (a . b)".
4.mo:Expected error in mat r6rs:case: "invalid syntax (r6rs:case (quote a) (a (quote yes)) (b (quote no)))".
4.mo:Expected error in mat r6rs:case: "invalid syntax (case (quote a) (a (quote yes)) (b (quote no)))".
4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".
View
@@ -972,6 +972,7 @@
(pretty-standard-indent [sig [() -> (ufixnum)] [(ufixnum) -> (void)]] [flags])
(print-brackets [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
(print-char-name [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
+ (print-extended-identifiers [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
(print-gensym [sig [() -> (ptr)] [(ptr) -> (void)]] [flags unrestricted])
(print-graph [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
(print-length [sig [() -> (maybe-ufixnum)] [(maybe-ufixnum) -> (void)]] [flags])
View
@@ -1143,6 +1143,77 @@ floating point returns with (1 0 -1 ...).
[else (print-hex-char c p)]))
(s1 s p n (fx+ i 1))))
+ (define extended-identifier?
+ (let ()
+ (define-syntax state-machine
+ (lambda (x)
+ (syntax-case x ()
+ ((_k start-state (name def (test e) ...) ...)
+ (with-implicit (_k s i n) ; support num4 kludge
+ #'(let ()
+ (define name
+ (lambda (s i n)
+ (if (= i n)
+ def
+ (let ([g (string-ref s i)])
+ (state-machine-help (s i n) g (test e) ... ))))) ...
+ (lambda (string)
+ (start-state string 0 (string-length string)))))))))
+ (define-syntax state-machine-help
+ (syntax-rules (else to skip)
+ [(_ (s i n) c [test (skip to x)] more ...)
+ (state-machine-help (s i n) c [test (x s i n)] more ...)]
+ [(_ (s i n) c [test (to x)] more ...)
+ (state-machine-help (s i n) c [test (x s (fx+ i 1) n)] more ...)]
+ [(_ (s i n) c [else e]) e]
+ [(_ (s i n) c [test e] more ...)
+ (if (state-machine-test c test)
+ e
+ (state-machine-help (s i n)c more ...))]))
+ (define-syntax state-machine-test
+ (syntax-rules (-)
+ [(_ c (char1 - char2))
+ (char<=? char1 c char2)]
+ [(_ c (e1 e2 ...))
+ (or (state-machine-test c e1) (state-machine-test c e2) ...)]
+ [(_ c char)
+ (char=? c char)]))
+ (state-machine start
+ (start #f ; start state
+ [((#\a - #\z) (#\A - #\Z)) (to sym)]
+ [(#\- #\+) (to num1)]
+ [(#\* #\= #\> #\<) (to sym)]
+ [(#\0 - #\9) (to num4)]
+ [#\. (to num2)]
+ [(#\{ #\}) (to brace)]
+ [else (skip to sym)])
+ (num1 #t ; seen + or -
+ [(#\0 - #\9) (to num4)]
+ [#\. (to num3)]
+ [(#\i #\I) (to num5)]
+ [else (skip to sym)])
+ (num2 #f ; seen .
+ [(#\0 - #\9) (to num4)]
+ [else (skip to sym)])
+ (num3 #f ; seen +. or -.
+ [(#\0 - #\9) (to num4)]
+ [else (skip to sym)])
+ (num4 #f ; seen digit, +digit, -digit, or .digit
+ [else ; kludge
+ (if (number? ($str->num s n 10 #f #f)) ; grabbing private s and n
+ #f
+ (sym s i n))]) ; really (skip to sym)
+ (num5 #f ; bars: seen +i, -i, +I, or -I
+ [else (skip to sym)])
+ (sym #t ; safe symbol
+ [((#\a - #\z) (#\A - #\Z) #\- #\? (#\0 - #\9) #\* #\! #\= #\> #\< #\+ #\/)
+ (to sym)]
+ [((#\nul - #\space) #\( #\) #\[ #\] #\{ #\} #\" #\' #\` #\, #\; #\" #\\ #\|)
+ #f]
+ [else (to sym)])
+ (brace #t ; { or }
+ [else #f]))))
+
(define wrsymbol
(case-lambda
[(s p) (wrsymbol s p #f)]
@@ -1152,7 +1223,9 @@ floating point returns with (1 0 -1 ...).
(s1 s p n 0)
(if (fx= n 0)
(display-string "||" p)
- (s0 s p n))))])))
+ (if (and (print-extended-identifiers) (extended-identifier? s))
+ (display-string s p)
+ (s0 s p n)))))])))
(set! $write-pretty-quick
(lambda (x lev len env p)
@@ -1237,6 +1310,8 @@ floating point returns with (1 0 -1 ...).
(define print-vector-length ($make-thread-parameter #f (lambda (x) (and x #t))))
+(define print-extended-identifiers ($make-thread-parameter #f (lambda (x) (and x #t))))
+
(define print-precision
($make-thread-parameter
#f

1 comment on commit 603019e

@89himanshu-dwivedi

i am not understood
why am i doing ,,,,,,,,,,,,
please help me

Please sign in to comment.