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

Correction to sync parsers, fix indenting, and inform of syntax errors

Browse Source 
svn: r7060
This commit is contained in:
Kathy Gray 2007-08-08 21:36:11 +00:00
parent b3821d8d82
commit afcb20810d
5 changed files with 37 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/combinator-parser/private-combinator/combinator.scm
View File

@ -440,10 +440,9 @@
#;(when (zero? used-toks)
(printf "compute-chance 0 case: ~a, ~a, ~a, ~a -> ~a~n"
sub-chance expected-length num-alts may-use
(* (/ 1 num-alts) (/ 1 expected-length) sub-chance)))
(* (/ 1 num-alts) sub-chance)))
(cond
[(and (zero? used-toks) (zero? may-use))
sub-chance #;(* (/ 1 expected-length) (/ 1 num-alts) sub-chance)]
#;[(zero? used-toks) (* (/ 1 num-alts) sub-chance)]
[(zero? used-toks) sub-chance #;probability-with-sub]
[else
#;(printf "compute-chance: args ~a ~a ~a ~a ~a ~a~n"

6
collects/profj/check.ss
View File

@ -1816,6 +1816,12 @@
(let ((var (lookup-var-in-env (id-string (local-access-name acc)) env)))
(unless (properties-usable? (var-type-properties var))
(unusable-var-error (string->symbol (var-type-var var)) (id-src (local-access-name acc))))
(when (and (eq? level 'beginner)
(not interact?)
(properties-field? (var-type-properties var)))
(beginner-field-access-error (string->symbol (var-type-var var))
(id-src (local-access-name acc))))
(unless interact?
(unless assign-left?
(unless (properties-parm? (var-type-properties var))

1
collects/profj/parser.ss
View File

@ -39,6 +39,7 @@
(define (error-builder parser old-parser lexed loc)
(if (new-parser?)
(lambda ()
(printf "Syntax error detected~n")
(let ([result (!!! (parser lexed loc))])
#;(printf "~a~n" result)
(if (list? result)

7
collects/profj/parsers/beginner-parser.ss
View File

@ -450,8 +450,11 @@
(make-check-expect #f (build-src 6) $2 $4 $6 (build-src 2 4))])
(Assignment
[(LeftHandSide AssignmentOperator CheckExpression)
(make-assignment #f (build-src 3) $1 $2 $3 (build-src 2 2))])
[(LeftHandSide AssignmentOperator #;CheckExpression IDENTIFIER)
(make-assignment #f (build-src 3) $1 $2 #;$3
(make-access #f (build-src 3 3)
(make-local-access
(make-id $3 (build-src 3 3)))) (build-src 2 2))])
(LeftHandSide
[(Name) (name->access $1)]

43
collects/profj/tool.ss
View File

@ -108,6 +108,7 @@
backward-match backward-containing-sexp
find-string position-paragraph paragraph-start-position
begin-edit-sequence end-edit-sequence
is-stopped? is-frozen?
skip-whitespace forward-match)
(define single-tab-stop 2)
@ -122,25 +123,27 @@
(define/private (get-indentation start-pos)
(letrec ([indent
(let* ([base-offset 0]
[curr-open (get-sexp-start start-pos)])
(cond
[(and (eq? (classify-position start-pos) 'comment)
(eq? (classify-position (add1 start-pos)) 'comment))
base-offset]
[(or (not curr-open) (= curr-open 0)) base-offset]
[else
(let ([previous-line (find-string eol 'backward start-pos 0 #f)])
(cond
[(not previous-line) (+ base-offset single-tab-stop)]
[else
(let* ([last-line-start (skip-whitespace previous-line 'forward #f)]
[last-line-indent (sub1 (- last-line-start previous-line))]
[old-open (get-sexp-start last-line-start)])
(cond
[(not old-open) last-line-indent]
[(and old-open (<= curr-open old-open)) last-line-indent]
[else (+ single-tab-stop last-line-indent)]))]))]))])
(if (or (is-stopped?) (is-frozen?))
0
(let* ([base-offset 0]
[curr-open (get-sexp-start start-pos)])
(cond
[(and (eq? (classify-position start-pos) 'comment)
(eq? (classify-position (add1 start-pos)) 'comment))
base-offset]
[(or (not curr-open) (= curr-open 0)) base-offset]
[else
(let ([previous-line (find-string eol 'backward start-pos 0 #f)])
(cond
[(not previous-line) (+ base-offset single-tab-stop)]
[else
(let* ([last-line-start (skip-whitespace previous-line 'forward #f)]
[last-line-indent (sub1 (- last-line-start previous-line))]
[old-open (get-sexp-start last-line-start)])
(cond
[(not old-open) last-line-indent]
[(and old-open (<= curr-open old-open)) last-line-indent]
[else (+ single-tab-stop last-line-indent)]))]))])))])
(build-string (max indent 0) (λ (x) #\space)))
#;(let ([to-insert 0])
(let loop ([pos start-pos])
@ -749,7 +752,7 @@
(examples (if (testcase-ext?)
(list (send execute-types get-test-classes) null)
(find-examples compilation-units))))
(printf "ProfJ compilation complete~n")
#;(printf "ProfJ compilation complete~n")
(let ((name-to-require #f)
(tests-run? #f))
(let loop ((mods (order compilation-units))