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

sync HtDP languages and test suite

Browse Source 
svn: r9424
This commit is contained in:
Matthew Flatt 2008-04-23 13:28:43 +00:00
parent 13c5e3812d
commit e5350bb22f
12 changed files with 89 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/lang/htdp-advanced.ss
View File

@ -51,6 +51,9 @@
;; [advanced-contract contract]
;; [advanced-define-data define-data]
)
check-expect
check-within
check-error
#%datum
#%top-interaction
empty true false)
@ -62,6 +65,4 @@
(all-from-except intermediate: lang/htdp-intermediate-lambda procedures
cons list* append)
(all-from advanced: lang/private/advanced-funs procedures))
(provide (all-from-out test-engine/scheme-tests))
)

6
collects/lang/htdp-beginner-abbr.ss
View File

@ -36,6 +36,9 @@
[intermediate-unquote unquote]
[intermediate-unquote-splicing unquote-splicing]
[beginner-module-begin #%module-begin])
check-expect
check-within
check-error
#%datum
#%top-interaction
empty true false)
@ -44,6 +47,5 @@
(provide-and-document
procedures
(all-from beginner: lang/htdp-beginner procedures))
(provide (all-from-out test-engine/scheme-tests))
)

5
collects/lang/htdp-beginner.ss
View File

@ -37,6 +37,9 @@
;; [beginner-contract contract]
;; [beginner-define-data define-data]
)
check-expect
check-within
check-error
#%datum
#%top-interaction
empty true false)
@ -92,6 +95,4 @@
in-rator-position-only
(all-from beginner: lang/private/beginner-funs procedures))
(provide (all-from-out test-engine/scheme-tests))
)

4
collects/lang/htdp-intermediate-lambda.ss
View File

@ -39,6 +39,9 @@
;; [intermediate-contract contract]
;; [intermediate-define-data define-data]
)
check-expect
check-within
check-error
#%datum
#%top-interaction
empty true false)
@ -47,5 +50,4 @@
(provide-and-document
procedures
(all-from intermediate: lang/htdp-intermediate procedures))
(provide (all-from-out test-engine/scheme-tests))
)

4
collects/lang/htdp-intermediate.ss
View File

@ -40,6 +40,9 @@
;; [intermediate-contract contract]
;; [intermediate-define-data define-data]
)
check-expect
check-within
check-error
#%datum
#%top-interaction
empty true false)
@ -48,5 +51,4 @@
(provide-and-document
procedures
(all-from beginner: lang/private/intermediate-funs procedures))
(provide (all-from-out test-engine/scheme-tests))
)

6
collects/lang/htdp-lib.scrbl
View File

@ -43,9 +43,9 @@ Intermediate Student language for @|htdp|; see
@; ------------------------------------------------------------
@section{@italic{HtDP} Intermediate Student with Lambda}
@defmodule[lang/htdp-intermediate-lam]
@defmodule[lang/htdp-intermediate-lambda]
The @schememodname[lang/htdp-intermediate-lam] module provides the
The @schememodname[lang/htdp-intermediate-lambda] module provides the
Intermediate Student with Lambda language for @|htdp|; see
@htdp-ref["intermediate-lam"].
@ -138,7 +138,7 @@ they can be syntactically restricted to application positions.
]]
}
@defform[(provide-higher-order-procedure id (arg ...))]{
@defform[(provide-higher-order-primitive id (arg ...))]{
Like @scheme[define-higher-order-primitive], but the function
@scheme[id] is exported as the primitive operator named

104
collects/lang/private/teach.ss
View File

@ -604,55 +604,61 @@
(define (intermediate-pre-lambda/proc stx)
(beginner-lambda/proc stx))
(define (check-defined-lambda lam)
(syntax-case lam (intermediate-pre-lambda)
[(intermediate-pre-lambda arg-seq lexpr ...)
(syntax-case (syntax arg-seq) () [(arg ...) #t][_else #f])
(let ([args (syntax->list (syntax arg-seq))])
(for-each (lambda (arg)
(unless (identifier/non-kw? arg)
(teach-syntax-error
'lambda
lam
arg
"expected a name for a function argument, but found ~a"
(something-else/kw arg))))
args)
(when (null? args)
(teach-syntax-error
'lambda
lam
(syntax arg-seq)
"expected at least one argument name in the sequence after `lambda', but found none"))
(let ([dup (check-duplicate-identifier args)])
(when dup
(teach-syntax-error
'lambda
lam
dup
"found an argument name that was used more than once: ~a"
(syntax-e dup))))
(check-single-result-expr (syntax->list (syntax (lexpr ...)))
#f
lam
args)
'ok)]
;; Bad lambda because bad args:
[(intermediate-pre-lambda args . _)
(teach-syntax-error
'lambda
lam
(syntax args)
"expected a sequence of function arguments after `lambda', but found ~a"
(something-else (syntax args)))]
;; Bad lambda, no args:
[(intermediate-pre-lambda)
(teach-syntax-error
'lambda
lam
(syntax args)
"expected a sequence of function arguments after `lambda', but nothing's there")]
[_else 'ok]))
(define (check-defined-lambda rhs)
(syntax-case rhs ()
[(lam . _)
(and (identifier? #'lam)
(or (module-identifier=? #'lam #'beginner-lambda)
(module-identifier=? #'lam #'intermediate-pre-lambda)))
(syntax-case rhs ()
[(lam arg-seq lexpr ...)
(syntax-case (syntax arg-seq) () [(arg ...) #t][_else #f])
(let ([args (syntax->list (syntax arg-seq))])
(for-each (lambda (arg)
(unless (identifier/non-kw? arg)
(teach-syntax-error
'lambda
rhs
arg
"expected a name for a function argument, but found ~a"
(something-else/kw arg))))
args)
(when (null? args)
(teach-syntax-error
'lambda
rhs
(syntax arg-seq)
"expected at least one argument name in the sequence after `lambda', but found none"))
(let ([dup (check-duplicate-identifier args)])
(when dup
(teach-syntax-error
'lambda
rhs
dup
"found an argument name that was used more than once: ~a"
(syntax-e dup))))
(check-single-result-expr (syntax->list (syntax (lexpr ...)))
#f
rhs
args)
'ok)]
;; Bad lambda because bad args:
[(lam args . _)
(teach-syntax-error
'lambda
rhs
(syntax args)
"expected a sequence of function arguments after `lambda', but found ~a"
(something-else (syntax args)))]
;; Bad lambda, no args:
[(lam)
(teach-syntax-error
'lambda
rhs
(syntax args)
"expected a sequence of function arguments after `lambda', but nothing's there")]
[_else 'ok])]
[_else 'ok]))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define-struct (beginner)

5
collects/lang/run-teaching-program.ss
View File

@ -4,7 +4,8 @@
"debugger-language-interface.ss"
stepper/private/shared
scheme/class
scheme/contract)
scheme/contract
test-engine/scheme-tests)
(provide/contract
[expand-teaching-program (->* (input-port?
@ -58,7 +59,7 @@
,@(map (λ (x) `(require ,x)) teachpacks)
,@body-exps
,@(if enable-testing?
(if (null? body-exps) '() '((run-tests) (display-results)))
(if (null? body-exps) '() `((,#'run-tests) (,#'display-results)))
'()))))
rep)))]
[(require)

2
collects/scribblings/start/manuals.ss
View File

@ -31,7 +31,7 @@
(make-sec 'net-library
"Network Libraries")
(make-sec 'parsing-library
"GUI and Graphics Libraries")
"Parsing Libraries")
(make-sec 'tool-library
"Tool Libraries")
(make-sec 'foreign

2
collects/tests/mzscheme/beg-adv.ss
View File

@ -218,7 +218,7 @@
(htdp-teachpack-pop)
;; Check require
(htdp-top (require mzlib/unit))
(htdp-top (require (lib "unit.ss" "mzlib")))
(htdp-test #f unit? 12)
(htdp-top-pop 1)

6
collects/tests/mzscheme/htdp-test.ss
View File

@ -134,9 +134,13 @@
(define test (namespace-variable-value 'test))
(provide test))
(define (print-eval stx)
(printf "~s\n" (syntax->datum stx))
(eval stx))
(define (do-htdp-test stx stx-err? exn?)
(let ([name (gensym 'm)])
((if stx-err? syntax-test eval)
((if stx-err? syntax-test print-eval)
#`(module #,name 'helper
test
#,current-htdp-lang #%module-begin

5
doc/release-notes/mzscheme/MzScheme_4.txt
View File

@ -145,6 +145,11 @@ but we start with an enumeration of changes:
- UTF-8 decoding for ports uses #\uFFFD instead of #\? as the
replacement character for bad encodings.
- Inside PLT Scheme: the `mzscheme' module is no longer built into
the exectable. When embedding PLT Scheme in a larger application,
use `mzc --c-mods' to convert a set of modules into embeddable C
code (as a static byte array containing bytecode).
======================================================================
Porting Advice
======================================================================