From 289e076893976f542504316d369764ae44de2c13 Mon Sep 17 00:00:00 2001 From: John Clements Date: Sat, 11 Mar 2006 00:21:19 +0000 Subject: [PATCH] added preliminary acl2 support svn: r2414 --- collects/stepper/private/annotate.ss | 31 +- collects/stepper/private/model.ss | 475 ++++++++++++++------------- collects/stepper/stepper-tool.ss | 19 +- 3 files changed, 277 insertions(+), 248 deletions(-) diff --git a/collects/stepper/private/annotate.ss b/collects/stepper/private/annotate.ss index 12fe04608a..0dc95f0f8b 100644 --- a/collects/stepper/private/annotate.ss +++ b/collects/stepper/private/annotate.ss @@ -27,6 +27,7 @@ (list?) (any/c)) ; procedure for runtime break boolean? ; track-inferred-name? + string? ; language-level-name : not a nice way to abstract. syntax?)] ; results #;[top-level-rewrite (-> syntax? syntax?)]) @@ -106,7 +107,7 @@ [let-bound-bindings null] [cond-test (lx #f)]) (if (or (syntax-property stx 'stepper-skip-completely) - (syntax-property stx '.stepper-define-struct-hint)) + (syntax-property stx 'stepper-define-struct-hint)) stx (let* ([recur-regular (lambda (stx) @@ -258,7 +259,7 @@ ; c) a boolean indicating whether to store inferred names. ; - (define (annotate main-exp break track-inferred-names?) + (define (annotate main-exp break track-inferred-names? language-level-name) #;(define _ (fprintf (current-error-port) "input to annotate: ~v\n" (syntax-object->datum main-exp))) (define binding-indexer @@ -1059,7 +1060,25 @@ (lambda () . rest2) (lambda () . rest3))) exp] - [else (error `annotate/top-level "unexpected top-level expression: ~a\n" (syntax-object->datum exp))]))) + [else (begin + (fprintf (current-error-port) "~v\n" (syntax-object->datum exp)) + (error `annotate/top-level "unexpected top-level expression: ~a\n" (syntax-object->datum exp)))]))) + + (define/contract annotate/top-level/acl2 + (syntax? . -> . syntax?) + (lambda (exp) + (syntax-case exp (begin define-values #%app) + [(begin contract-thingy + (begin body (begin))) + #`(begin contract-thingy (begin #,(annotate/module-top-level #`body) (begin)))] + [else (annotate/module-top-level exp)] + + #;[else (begin + (fprintf (current-error-port) "~v\n" (syntax-object->datum exp)) + (error `annotate/top-level "unexpected top-level expression: ~a\n" (syntax-object->datum exp)))]))) + + + (define/contract annotate/module-top-level (syntax? . -> . syntax?) @@ -1111,6 +1130,10 @@ ; body of local #;(printf "input: ~a\n" exp) - (let* ([annotated-exp (annotate/top-level main-exp)]) + (let* ([annotated-exp (cond + [(string=? language-level-name "ACL2 Beginner (beta 8)") + (annotate/top-level/acl2 main-exp)] + [else + (annotate/top-level main-exp)])]) #;(printf "annotated: \n~a\n" (syntax-object->datum annotated-exp)) annotated-exp))) diff --git a/collects/stepper/private/model.ss b/collects/stepper/private/model.ss index 1995380bb5..541fd85345 100644 --- a/collects/stepper/private/model.ss +++ b/collects/stepper/private/model.ss @@ -56,251 +56,252 @@ (step-result? . -> . void?) ; receive-result (or/c render-settings? false/c) ; render-settings boolean? ; track-inferred-names? + string? ; language-level-name . -> . void?)]) ; go starts a stepper instance ; see provide stmt for contract - (define (go program-expander receive-result render-settings track-inferred-names?) + (define (go program-expander receive-result render-settings track-inferred-names? language-level-name) - (local + + + ;; finished-exps: (listof (list/c syntax-object? (or/c number? false?)( -> any))) + ;; because of mutation, these cannot be fixed renderings, but must be re-rendered at each step. + (define finished-exps null) + (define/contract add-to-finished + ((-> syntax?) (or/c (listof natural-number/c) false/c) (-> any) . -> . void?) + (lambda (exp-thunk lifting-indices getter) + (set! finished-exps (append finished-exps (list (list exp-thunk lifting-indices getter)))))) + + ;; the "held" variables are used to store the "before" step. + (define held-exp-list no-sexp) + (define held-step-was-app? #f) + (define held-finished-list null) + + (define basic-eval (current-eval)) + + ;; highlight-mutated-expressions : + ;; ((listof (list/c syntax? syntax?)) (listof (list/c syntax? syntax?)) . -> . (list/c (listof syntax?) (listof syntax?))) + ;; highlights changes occurring due to mutation. This function accepts the left-hand-side + ;; expressions and the right-hand-side expressions, and matches them against each other + ;; to see which ones have changed due to mutation, and highlights these. + ;; POSSIBLE RESEARCH POINT: if, say, (list 3 4) is mutated to (list 4 5), should the 4 & 5 be + ;; highlighted individually or should the list as a whole be highlighted. Is either one "wrong?" + ;; equivalences between reduction semantics? + ;; + ;; 2005-11-14: punting. just highlight the whole damn thing if there are any differences. + ;; in fact, just test for eq?-ness. + + #;(define (highlight-mutated-expressions lefts rights) + (if (or (null? lefts) (null? rights)) + (list lefts rights) + (let ([left-car (car lefts)] + [right-car (car rights)]) + (if (eq? (syntax-property left-car 'user-source) + (syntax-property right-car 'user-source)) + (let ([highlights-added (highlight-mutated-expression left-car right-car)] + [rest (highlight-mutated-expressions (cdr lefts) (cdr rights))]) + (cons (cons (car highlights-added) (car rest)) + (cons (cadr highlights-added) (cadr rest)))))))) + + ;; highlight-mutated-expression: syntax? syntax? -> syntax? + ;; given two expressions, highlight 'em both if they differ at all. + + ;; notes: wanted to use simple "eq?" test... but this will fail when a being-stepped definition (e.g. + ;; in a let) turns into a permanent one. We pay a terrible price for the lifting thing. And, for the fact + ;; that the highlighting follows from the reductions but can't obviously be deduced from them. + + #;(define (highlight-mutated-expression left right) + (cond + ;; if either one is already highlighted, leave them alone. + [(or (syntax-property left 'stepper-highlight) + (syntax-property right 'stepper-highlight)) + (list left right)] + + ;; first pass: highlight if not eq?. Should be broken for local-bound things + ;; as they pass into permanence. + [(eq? left right) + (list left right)] + + [else (list (syntax-property left 'stepper-highlight) + (syntax-property right 'stepper-highlight))])) + + ;; REDIVIDE MAKES NO SENSE IN THE NEW INTERFACE. THIS WILL BE DELETED AFTER BEING PARTED OUT. + ; redivide takes a list of sexps and divides them into the 'before', 'during', and 'after' lists, + ; where the before and after sets are maximal-length lists where none of the s-expressions contain + ; a highlight-placeholder + ; (->* ((listof syntax)) (list/c syntax syntax syntax)) + #;(define (redivide exprs) + (letrec ([contains-highlight + (lambda (expr) + (or (syntax-property expr 'stepper-highlight) + (syntax-case expr () + [(a . rest) (or (contains-highlight #`a) (contains-highlight #`rest))] + [else #f])))]) + (let* ([list-length (length exprs)] + [split-point-a (- list-length (length (or (memf contains-highlight exprs) null)))] + [split-point-b (length (or (memf contains-highlight (reverse exprs)) null))]) + (if (<= split-point-b split-point-a) + (error 'redivide-exprs "s-expressions did not contain the highlight-placeholder: ~v" (map syntax-object->hilite-datum exprs)) + (values (sublist 0 split-point-a exprs) ; before + (sublist split-point-a split-point-b exprs) ; during + (sublist split-point-b list-length exprs)))))) ; after + + + ; (redivide `(3 4 (+ (define ,highlight-placeholder) 13) 5 6)) + ; (values `(3 4) `((+ (define ,highlight-placeholder) 13)) `(5 6)) + ; + ; (redivide `(,highlight-placeholder 5 6)) + ; (values `() `(,highlight-placeholder) `(5 6)) + ; + ; (redivide `(4 5 ,highlight-placeholder ,highlight-placeholder)) + ; (values `(4 5) `(,highlight-placeholder ,highlight-placeholder) `()) + ; + ; (printf "will be errors:~n") + ; (equal? (redivide `(1 2 3 4)) + ; error-value) + ; + ; (redivide `(1 2 ,highlight-placeholder 3 ,highlight-placeholder 4 5)) + ; (values `(1 2) `(,highlight-placeholder 3 ,highlight-placeholder) `(4 5)) + + (define (>>> x) + (fprintf (current-output-port) ">>> ~v\n" x) + x) + + (define break + (opt-lambda (mark-set break-kind [returned-value-list #f]) - (;; finished-exps: (listof (list/c syntax-object? (or/c number? false?)( -> any))) - ;; because of mutation, these cannot be fixed renderings, but must be re-rendered at each step. - (define finished-exps null) - (define/contract add-to-finished - ((-> syntax?) (or/c (listof natural-number/c) false/c) (-> any) . -> . void?) - (lambda (exp-thunk lifting-indices getter) - (set! finished-exps (append finished-exps (list (list exp-thunk lifting-indices getter)))))) - - ;; the "held" variables are used to store the "before" step. - (define held-exp-list no-sexp) - (define held-step-was-app? #f) - (define held-finished-list null) - - (define basic-eval (current-eval)) - - ;; highlight-mutated-expressions : - ;; ((listof (list/c syntax? syntax?)) (listof (list/c syntax? syntax?)) . -> . (list/c (listof syntax?) (listof syntax?))) - ;; highlights changes occurring due to mutation. This function accepts the left-hand-side - ;; expressions and the right-hand-side expressions, and matches them against each other - ;; to see which ones have changed due to mutation, and highlights these. - ;; POSSIBLE RESEARCH POINT: if, say, (list 3 4) is mutated to (list 4 5), should the 4 & 5 be - ;; highlighted individually or should the list as a whole be highlighted. Is either one "wrong?" - ;; equivalences between reduction semantics? - ;; - ;; 2005-11-14: punting. just highlight the whole damn thing if there are any differences. - ;; in fact, just test for eq?-ness. - - #;(define (highlight-mutated-expressions lefts rights) - (if (or (null? lefts) (null? rights)) - (list lefts rights) - (let ([left-car (car lefts)] - [right-car (car rights)]) - (if (eq? (syntax-property left-car 'user-source) - (syntax-property right-car 'user-source)) - (let ([highlights-added (highlight-mutated-expression left-car right-car)] - [rest (highlight-mutated-expressions (cdr lefts) (cdr rights))]) - (cons (cons (car highlights-added) (car rest)) - (cons (cadr highlights-added) (cadr rest)))))))) - - ;; highlight-mutated-expression: syntax? syntax? -> syntax? - ;; given two expressions, highlight 'em both if they differ at all. - - ;; notes: wanted to use simple "eq?" test... but this will fail when a being-stepped definition (e.g. - ;; in a let) turns into a permanent one. We pay a terrible price for the lifting thing. And, for the fact - ;; that the highlighting follows from the reductions but can't obviously be deduced from them. - - #;(define (highlight-mutated-expression left right) - (cond - ;; if either one is already highlighted, leave them alone. - [(or (syntax-property left 'stepper-highlight) - (syntax-property right 'stepper-highlight)) - (list left right)] - - ;; first pass: highlight if not eq?. Should be broken for local-bound things - ;; as they pass into permanence. - [(eq? left right) - (list left right)] - - [else (list (syntax-property left 'stepper-highlight) - (syntax-property right 'stepper-highlight))])) - - ;; REDIVIDE MAKES NO SENSE IN THE NEW INTERFACE. THIS WILL BE DELETED AFTER BEING PARTED OUT. - ; redivide takes a list of sexps and divides them into the 'before', 'during', and 'after' lists, - ; where the before and after sets are maximal-length lists where none of the s-expressions contain - ; a highlight-placeholder - ; (->* ((listof syntax)) (list/c syntax syntax syntax)) - #;(define (redivide exprs) - (letrec ([contains-highlight - (lambda (expr) - (or (syntax-property expr 'stepper-highlight) - (syntax-case expr () - [(a . rest) (or (contains-highlight #`a) (contains-highlight #`rest))] - [else #f])))]) - (let* ([list-length (length exprs)] - [split-point-a (- list-length (length (or (memf contains-highlight exprs) null)))] - [split-point-b (length (or (memf contains-highlight (reverse exprs)) null))]) - (if (<= split-point-b split-point-a) - (error 'redivide-exprs "s-expressions did not contain the highlight-placeholder: ~v" (map syntax-object->hilite-datum exprs)) - (values (sublist 0 split-point-a exprs) ; before - (sublist split-point-a split-point-b exprs) ; during - (sublist split-point-b list-length exprs)))))) ; after - - - ; (redivide `(3 4 (+ (define ,highlight-placeholder) 13) 5 6)) - ; (values `(3 4) `((+ (define ,highlight-placeholder) 13)) `(5 6)) - ; - ; (redivide `(,highlight-placeholder 5 6)) - ; (values `() `(,highlight-placeholder) `(5 6)) - ; - ; (redivide `(4 5 ,highlight-placeholder ,highlight-placeholder)) - ; (values `(4 5) `(,highlight-placeholder ,highlight-placeholder) `()) - ; - ; (printf "will be errors:~n") - ; (equal? (redivide `(1 2 3 4)) - ; error-value) - ; - ; (redivide `(1 2 ,highlight-placeholder 3 ,highlight-placeholder 4 5)) - ; (values `(1 2) `(,highlight-placeholder 3 ,highlight-placeholder) `(4 5)) - - (define (>>> x) - (fprintf (current-output-port) ">>> ~v\n" x) - x) - - (define break - (opt-lambda (mark-set break-kind [returned-value-list #f]) - - - (let* ([mark-list (and mark-set (extract-mark-list mark-set))]) - - (define (reconstruct-all-completed) - (map (match-lambda - [`(,source-thunk ,lifting-indices ,getter) - (match (r:reconstruct-completed (source-thunk) lifting-indices getter render-settings) - [#(exp #f) (first-of-one (unwind-no-highlight exp))] - [#(exp #t) exp])]) - finished-exps)) - - ;; TO BE SCRAPPED - #;(define (double-redivide finished-exps new-exprs-before new-exprs-after) - (let*-values ([(before current after) (redivide new-exprs-before)] - [(before-2 current-2 after-2) (redivide new-exprs-after)]) - (unless (equal? (map syntax-object->hilite-datum before) - (map syntax-object->hilite-datum before-2)) - (error 'double-redivide "reconstructed before defs are not equal.")) - (unless (equal? (map syntax-object->hilite-datum after) - (map syntax-object->hilite-datum after-2)) - (error 'double-redivide "reconstructed after defs are not equal.")) - (values (append finished-exps before) current current-2 after))) - - #;(printf "break called with break-kind: ~a ..." break-kind) - (if (r:skip-step? break-kind mark-list render-settings) - (begin - #;(printf " but it was skipped!\n") - (when (or (eq? break-kind 'normal-break) - (eq? break-kind 'nomal-break/values)) ;; not sure about this... - (set! held-exp-list skipped-step))) - - (begin - #;(printf "and it wasn't skipped.\n") - (case break-kind - [(normal-break normal-break/values) - (begin - (when (and (eq? break-kind 'normal-break) returned-value-list) - (error 'break "broken invariant: normal-break can't have returned values")) - (set! held-finished-list (reconstruct-all-completed)) - (set! held-exp-list (unwind (r:reconstruct-left-side mark-list returned-value-list render-settings) #f)) - (set! held-step-was-app? (r:step-was-app? mark-list)))] - - [(result-exp-break result-value-break) - (if (eq? held-exp-list skipped-step) - ; don't render if before step was a skipped-step - (set! held-exp-list no-sexp) - - (let* ([new-finished-list (reconstruct-all-completed)] - [reconstructed (unwind (r:reconstruct-right-side mark-list returned-value-list render-settings) #f)] - [result - (if (eq? held-exp-list no-sexp) - ;; in this case, there was no "before" step, due to - ;; unannotated code. In this case, we make the - ;; optimistic guess that none of the finished expressions - ;; were mutated. It would be somewhat painful to do a better - ;; job, and the stepper makes no guarantees in this case. - (make-before-after-result - (list #`(... ...)) - (append new-finished-list reconstructed) - 'normal) - - (let*-values - ([(step-kind) (if (and held-step-was-app? - (eq? break-kind 'result-exp-break)) - 'user-application - 'normal)] - [(left-exps right-exps) - ;; write this later: - #;(identify-changed (append held-finished-list held-exps) (append new-finished-list reconstructed)) - (values (append held-finished-list held-exp-list) - (append new-finished-list reconstructed))]) - - (make-before-after-result left-exps right-exps step-kind)))]) - (set! held-exp-list no-sexp) - (receive-result result)))] - - [(double-break) - ;; a double-break occurs at the beginning of a let's evaluation. - (when (not (eq? held-exp-list no-sexp)) - (error 'break-reconstruction - "held-exp-list not empty when a double-break occurred")) - (let* ([new-finished-list (reconstruct-all-completed)] - [reconstruct-result (r:reconstruct-double-break mark-list render-settings)] - [left-side (unwind (car reconstruct-result) #f)] - [right-side (unwind (cadr reconstruct-result) #t)]) - ;; add highlighting code as for other cases... - (receive-result (make-before-after-result (append new-finished-list left-side) - (append new-finished-list right-side) - 'normal)))] - - - [(expr-finished-break) - (unless (not mark-list) - (error 'break "expected no mark-list with expr-finished-break")) - ;; in an expr-finished-break, the returned-vals hold (listof (list/c source lifting-index getter)) - ;; this will now include define-struct breaks, for which the source is the source and the getter - ;; causes an error. - (for-each (lambda (source/index/getter) - (apply add-to-finished source/index/getter)) - returned-value-list)] - - [else (error 'break "unknown label on break")])))))) - - - - - (define (step-through-expression expanded expand-next-expression) - (let* ([annotated (a:annotate expanded break track-inferred-names?)]) - (eval-syntax annotated) - (expand-next-expression))) - - (define (err-display-handler message exn) - (if (not (eq? held-exp-list no-sexp)) + + (let* ([mark-list (and mark-set (extract-mark-list mark-set))]) + + (define (reconstruct-all-completed) + (map (match-lambda + [`(,source-thunk ,lifting-indices ,getter) + (match (r:reconstruct-completed (source-thunk) lifting-indices getter render-settings) + [#(exp #f) (first-of-one (unwind-no-highlight exp))] + [#(exp #t) exp])]) + finished-exps)) + + ;; TO BE SCRAPPED + #;(define (double-redivide finished-exps new-exprs-before new-exprs-after) + (let*-values ([(before current after) (redivide new-exprs-before)] + [(before-2 current-2 after-2) (redivide new-exprs-after)]) + (unless (equal? (map syntax-object->hilite-datum before) + (map syntax-object->hilite-datum before-2)) + (error 'double-redivide "reconstructed before defs are not equal.")) + (unless (equal? (map syntax-object->hilite-datum after) + (map syntax-object->hilite-datum after-2)) + (error 'double-redivide "reconstructed after defs are not equal.")) + (values (append finished-exps before) current current-2 after))) + + #;(printf "break called with break-kind: ~a ..." break-kind) + (if (r:skip-step? break-kind mark-list render-settings) + (begin + #;(printf " but it was skipped!\n") + (when (or (eq? break-kind 'normal-break) + (eq? break-kind 'nomal-break/values)) ;; not sure about this... + (set! held-exp-list skipped-step))) + + (begin + #;(printf "and it wasn't skipped.\n") + (case break-kind + [(normal-break normal-break/values) (begin - (receive-result (make-before-error-result (append held-finished-list held-exp-list) - message)) - (set! held-exp-list no-sexp)) - (receive-result (make-error-result message))))) - - (program-expander - (lambda () - ; swap these to allow errors to escape (e.g., when debugging) - (error-display-handler err-display-handler) - #;(void) - ) - (lambda (expanded continue-thunk) ; iter - (if (eof-object? expanded) - (begin - (receive-result (make-finished-stepping))) - (step-through-expression expanded continue-thunk)))))) + (when (and (eq? break-kind 'normal-break) returned-value-list) + (error 'break "broken invariant: normal-break can't have returned values")) + (set! held-finished-list (reconstruct-all-completed)) + (set! held-exp-list (unwind (r:reconstruct-left-side mark-list returned-value-list render-settings) #f)) + (set! held-step-was-app? (r:step-was-app? mark-list)))] + + [(result-exp-break result-value-break) + (if (eq? held-exp-list skipped-step) + ; don't render if before step was a skipped-step + (set! held-exp-list no-sexp) + + (let* ([new-finished-list (reconstruct-all-completed)] + [reconstructed (unwind (r:reconstruct-right-side mark-list returned-value-list render-settings) #f)] + [result + (if (eq? held-exp-list no-sexp) + ;; in this case, there was no "before" step, due to + ;; unannotated code. In this case, we make the + ;; optimistic guess that none of the finished expressions + ;; were mutated. It would be somewhat painful to do a better + ;; job, and the stepper makes no guarantees in this case. + (make-before-after-result + (list #`(... ...)) + (append new-finished-list reconstructed) + 'normal) + + (let*-values + ([(step-kind) (if (and held-step-was-app? + (eq? break-kind 'result-exp-break)) + 'user-application + 'normal)] + [(left-exps right-exps) + ;; write this later: + #;(identify-changed (append held-finished-list held-exps) (append new-finished-list reconstructed)) + (values (append held-finished-list held-exp-list) + (append new-finished-list reconstructed))]) + + (make-before-after-result left-exps right-exps step-kind)))]) + (set! held-exp-list no-sexp) + (receive-result result)))] + + [(double-break) + ;; a double-break occurs at the beginning of a let's evaluation. + (when (not (eq? held-exp-list no-sexp)) + (error 'break-reconstruction + "held-exp-list not empty when a double-break occurred")) + (let* ([new-finished-list (reconstruct-all-completed)] + [reconstruct-result (r:reconstruct-double-break mark-list render-settings)] + [left-side (unwind (car reconstruct-result) #f)] + [right-side (unwind (cadr reconstruct-result) #t)]) + ;; add highlighting code as for other cases... + (receive-result (make-before-after-result (append new-finished-list left-side) + (append new-finished-list right-side) + 'normal)))] + + + [(expr-finished-break) + (unless (not mark-list) + (error 'break "expected no mark-list with expr-finished-break")) + ;; in an expr-finished-break, the returned-vals hold (listof (list/c source lifting-index getter)) + ;; this will now include define-struct breaks, for which the source is the source and the getter + ;; causes an error. + (for-each (lambda (source/index/getter) + (apply add-to-finished source/index/getter)) + returned-value-list)] + + [else (error 'break "unknown label on break")])))))) + + + + + (define (step-through-expression expanded expand-next-expression) + (let* ([annotated (a:annotate expanded break track-inferred-names? language-level-name)]) + (eval-syntax annotated) + (expand-next-expression))) + + (define (err-display-handler message exn) + (if (not (eq? held-exp-list no-sexp)) + (begin + (receive-result (make-before-error-result (append held-finished-list held-exp-list) + message)) + (set! held-exp-list no-sexp)) + (receive-result (make-error-result message)))) + + (program-expander + (lambda () + ; swap these to allow errors to escape (e.g., when debugging) + (error-display-handler err-display-handler) + #;(void) + ) + (lambda (expanded continue-thunk) ; iter + (if (eof-object? expanded) + (begin + (receive-result (make-finished-stepping))) + (step-through-expression expanded continue-thunk))))) (define (first-of-one x) diff --git a/collects/stepper/stepper-tool.ss b/collects/stepper/stepper-tool.ss index ae6f96f53a..73e1b84187 100644 --- a/collects/stepper/stepper-tool.ss +++ b/collects/stepper/stepper-tool.ss @@ -146,6 +146,7 @@ (drscheme:language-configuration:language-settings-language language-settings)) (define language-level-name (car (last-pair (send language get-language-position)))) + ;; VALUE CONVERSION CODE: @@ -190,12 +191,15 @@ ;; render-to-sexp : TST -> sexp (define (render-to-sexp val) - (parameterize ([current-print-convert-hook (make-print-convert-hook simple-settings)]) - (set-print-settings - language - simple-settings - (lambda () - (simple-module-based-language-convert-value val simple-settings))))) + (cond + [(string=? language-level-name "ACL2 Beginner (beta 8)") + (simple-module-based-language-convert-value val simple-settings)] + [else (parameterize ([current-print-convert-hook (make-print-convert-hook simple-settings)]) + (set-print-settings + language + simple-settings + (lambda () + (simple-module-based-language-convert-value val simple-settings))))])) (define (>>> x) (fprintf (current-error-port) ">>> ~v\n" x) @@ -433,7 +437,8 @@ (model:go program-expander-prime receive-result (get-render-settings render-to-string render-to-sexp #t) (not (member language-level-name (list (string-constant intermediate-student/lambda) - (string-constant advanced-student))))) + (string-constant advanced-student)))) + language-level-name) (send s-frame show #t) s-frame)