From afcb20810dbe6658d45ec5f0bf3cc54f67ed4c63 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Wed, 8 Aug 2007 21:36:11 +0000 Subject: [PATCH] Correction to sync parsers, fix indenting, and inform of syntax errors svn: r7060 --- .../private-combinator/combinator.scm | 5 +-- collects/profj/check.ss | 6 +++ collects/profj/parser.ss | 1 + collects/profj/parsers/beginner-parser.ss | 7 ++- collects/profj/tool.ss | 43 ++++++++++--------- 5 files changed, 37 insertions(+), 25 deletions(-) diff --git a/collects/combinator-parser/private-combinator/combinator.scm b/collects/combinator-parser/private-combinator/combinator.scm index 6319f36c75..4fe99083f9 100644 --- a/collects/combinator-parser/private-combinator/combinator.scm +++ b/collects/combinator-parser/private-combinator/combinator.scm @@ -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" diff --git a/collects/profj/check.ss b/collects/profj/check.ss index 40bfabc88e..d8752459dc 100644 --- a/collects/profj/check.ss +++ b/collects/profj/check.ss @@ -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)) diff --git a/collects/profj/parser.ss b/collects/profj/parser.ss index 1dc2d3579d..f68ad00020 100644 --- a/collects/profj/parser.ss +++ b/collects/profj/parser.ss @@ -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) diff --git a/collects/profj/parsers/beginner-parser.ss b/collects/profj/parsers/beginner-parser.ss index 4b24e6bbf7..23b3ec14b7 100644 --- a/collects/profj/parsers/beginner-parser.ss +++ b/collects/profj/parsers/beginner-parser.ss @@ -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)] diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index d67a791356..3d19fccb46 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -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))