From dbe82ab7d797f5ac025ad5847c5284abd7ea28a6 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Mon, 6 Aug 2007 15:17:19 +0000 Subject: [PATCH] Correction to default probability calculation. More tweaking of the profj grammars svn: r7032 --- .../private-combinator/combinator.scm | 32 +++++++++---------- collects/profj/comb-parsers/parser-units.scm | 10 +++++- 2 files changed, 25 insertions(+), 17 deletions(-) diff --git a/collects/combinator-parser/private-combinator/combinator.scm b/collects/combinator-parser/private-combinator/combinator.scm index 60e1fc4855..01c95fa07b 100644 --- a/collects/combinator-parser/private-combinator/combinator.scm +++ b/collects/combinator-parser/private-combinator/combinator.scm @@ -391,14 +391,12 @@ #;(when (pair? look-back) (printf "look-back is a pair~n")) #;(when (res? look-back) - (printf "lookbac is a res, ~a~n" (fail-type? (res-possible-error look-back)))) + (printf "lookback is a res, ~a~n" (fail-type? (res-possible-error look-back)))) (let* ([seq-fail-maker (lambda (fail) (let-values ([(kind expected found) (get-fail-info fail)]) (make-sequence-fail - (cond - [(= 0 used) (fail-type-chance fail)] - [else (compute-chance len seen-len used alts (fail-type-chance fail))]) + (compute-chance len seen-len used alts (fail-type-chance fail)) (fail-type-src fail) name used (+ used (fail-type-may-use fail) next-used) @@ -419,18 +417,20 @@ seq-fail))))])))) (define (compute-chance expected-length seen-length used-toks num-alts sub-chance) - (let* ([revised-expectation (+ (- used-toks seen-length) expected-length)] - [probability-with-sub (* (/ (add1 used-toks) revised-expectation) (/ 1 num-alts))] - [probability-without-sub (* (/ used-toks revised-expectation) (/ 1 num-alts))] - [expected-sub probability-with-sub] - [expected-no-sub probability-without-sub] - [probability (/ (* expected-sub sub-chance) (+ (* expected-sub sub-chance) - (* expected-no-sub (- 1 sub-chance))))]) - #;(printf "compute-chance: args ~a ~a ~a ~a ~a~n" - expected-length seen-length used-toks num-alts sub-chance) - #;(printf "compute-chance: intermediate values: ~a ~a ~a ~a ~a~n" - revised-expectation probability-with-sub probability-without-sub expected-sub expected-no-sub) - probability)) + (if (zero? used-toks) + (* (* (/ 1 expected-length) (/ 1 num-alts)) sub-chance) + (let* ([revised-expectation (+ (- used-toks seen-length) expected-length)] + [probability-with-sub (* (/ (add1 used-toks) revised-expectation) (/ 1 num-alts))] + [probability-without-sub (* (/ used-toks revised-expectation) (/ 1 num-alts))] + [expected-sub probability-with-sub] + [expected-no-sub probability-without-sub] + [probability (/ (* expected-sub sub-chance) (+ (* expected-sub sub-chance) + (* expected-no-sub (- 1 sub-chance))))]) + #;(printf "compute-chance: args ~a ~a ~a ~a ~a~n" + expected-length seen-length used-toks num-alts sub-chance) + #;(printf "compute-chance: intermediate values: ~a ~a ~a ~a ~a~n" + revised-expectation probability-with-sub probability-without-sub expected-sub expected-no-sub) + probability))) ;greedy-repeat: (list 'a) -> result -> (list 'a) -> result (define (repeat-greedy sub) diff --git a/collects/profj/comb-parsers/parser-units.scm b/collects/profj/comb-parsers/parser-units.scm index afa7247adc..9d2a3f4c5b 100644 --- a/collects/profj/comb-parsers/parser-units.scm +++ b/collects/profj/comb-parsers/parser-units.scm @@ -777,7 +777,15 @@ (repeat-greedy (choose (class interface) "class or interface")))) (define interact - (choose (field (statement-c #t) expression) "interactive program")) + (choose (field + (if-s (block #t) #f) + (return-s #t) + (assignment + (choose (identifier + (sequence (unique-base (repeat unique-end) field-access-end) id)) + "assignee") EQUAL) + (block #t) + expression) "interactive program")) )