From 0372e02294ccef805e9bb71f9dcadbf2fc82c8d1 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Fri, 15 Jul 2011 12:20:11 -0400 Subject: [PATCH] documented error reporting functions (Cherry picked from 9193203, and slightly edited for conflicts due to code shuffling.) --- collects/htdp/error-reporting.scrbl | 134 +++++++++++++----- collects/htdp/error.rkt | 209 +++++++++++++++------------- collects/htdp/htdp.scrbl | 27 +++- 3 files changed, 237 insertions(+), 133 deletions(-) diff --git a/collects/htdp/error-reporting.scrbl b/collects/htdp/error-reporting.scrbl index 452e82cbf5..d553cc4bf3 100755 --- a/collects/htdp/error-reporting.scrbl +++ b/collects/htdp/error-reporting.scrbl @@ -1,49 +1,121 @@ #lang scribble/doc -@(require scribble/manual - (for-label htdp/error) - ) +@(require scribble/manual (for-label htdp/error 2htdp/image racket)) @title[#:tag "error-reporting"]{Error Reporting Functions} @defmodule[htdp/error] -To provide uniform error messages from the TeachPacks, this module -provides several functions: +To provide uniform error messages from teachpacks, this module provides several functions: -@defproc[(check-arg) void?]{ +@defproc[(check-arg [name (or/c symbol? string?)] + [chk boolean?] + [expected any/c] + [position (or/c (and/c positive? integer?) string?)] + [given any/c]) + void?]{ + Checks an flat-valued argument to function @scheme[name]. + Reports an error for function @scheme[name] + telling students what kind of data is @scheme[expected] at the @scheme[position]-th argument + and displaying what value was actually @scheme[given], + unless @scheme[chk] is @scheme[true].} + +@defproc[(check-arity [name (or/c symbol? string?)] + [arg# (or/c (and/c positive? integer?) string?)?] + [args list?]) + void?]{ + Checks the arity of a procedure-valued argument to function @scheme[name]. + Reports an error for function @scheme[name] + telling students that @scheme[(length args)] arguments were provided but + @scheme[arg#] were expected, unless @scheme[(= (length args) arg#)] + produces @scheme[true].} + +@defproc[(check-proc [name (or/c symbol? string?)] + [proc any/c] + [expected natural?] + [arg# (or/c (and/c positive? integer?) string?)] + [arg-err string?]) + void?]{ + Checks [the properties of] a procedure-valued argument to function @scheme[name]. + Reports an error for function @scheme[name] + telling students that a procedure was expected at position @scheme[arg#] + and that this procedure should be of arity @scheme[expected], + unless the @scheme[proc] is a function and has the @scheme[expected] arity. + The string @scheme[arg-err] is used to describe the higher-order argument.} + +@defproc[(check-result [name (or/c symbol? string?)] + [pred? (-> any/c boolean?)] + [kind (or/c symbol? string?)] + [returned any/c] ...+) + void?]{ + Checks the expected result of a procedure-valued argument. + If the result satisfies @scheme[pred?], it is returned. + Otherwise, the function reports an error for function @scheme[name] + telling students what @scheme[kind] of value is expected and what the + @scheme[returned] value is. NOTE: if there is more than one + @scheme[returned] value, the function uses the second value. (MF: I forgot + why.)} + + +@defproc[(check-list-list [name (or/c symbol? string?)] + [chk (or/c string? false/c)] + [pred? any/c] + [given any/c]) + void?]{ + Checks a list-of-lists-valued argument to function @scheme[name]. + Reports an error for function @scheme[name] if a list-of-lists contains + a value of the wrong kind---signaled via a string-valued @scheme[chk]. + The @scheme[given] value is the element that went wrong. Rarely used.} + +@defproc[(check-color [name (or/c symbol? string?)] + [arg# natural?] + [given any/c]) + void?]{ + Checks a color-valued argument to function @scheme[name]. + Deprecated. Use @scheme[image-color?] instead. } -@defproc[(check-arity) void?]{ +@defproc[(check-fun-res [f procedure?] + [pred? (-> any/c boolean?)] + [type (or/c symbol? string?)]) + void?]{ + Creates a callback from @scheme[f] and uses @scheme[check-result] to make + sure the result is a piece of data that satisfies @scheme[pred?], + described as @scheme[type]. } -@defproc[(check-proc) void?]{ - } +@defproc[(natural? [o any/c]) boolean?]{ + Determines whether the given value is a natural number.} -@defproc[(check-result) void?]{ - } - -@defproc[(check-list-list) void?]{ - } - -@defproc[(check-color) void?]{ - } - -@defproc[(check-fun-res) void?]{ - } - -@defproc[(check-dependencies) void?]{ - } - -@defproc[(natural?) void?]{ - } - -@defproc[(find-non) void?]{ - } +@defproc[(find-non [pred? (-> any/c boolean?)] [l list?]) (or/c any/c false/c)]{ + Find an element of @scheme[l] for which @scheme[(pred? l)] produces + @scheme[true]; otherwise return @scheme[false].} -@defproc[(tp-exn?) void?]{ +@defproc[(check-dependencies [name (or/c symbol? string?)] + [chk boolean?] + [fmt format-string?] + [arg any/c] ...) + void?]{ + Unless @scheme[chk] is @scheme[true], it raises an error called + @scheme[name] whose message is composed from @scheme[fmt] and the + @scheme[arg]s. } -@defproc[(number->ord) void?]{ +@defproc[(tp-error [name (or/c symbol? string?)] + [fmt format-string?] + [arg any/c] ...) + void?]{ + Signals an @racket[exn:fail:contract] from @scheme[fmt] and @scheme[arg] + for a function called @scheme[name].} + +@defproc[(tp-exn? [o any/c]) boolean?]{ + Determine whether the given object is a teachpack exception + MF: Guillaume seems to have deprecated these structures. } +@defproc[(number->ord [n natural?]) string?]{ + Convert a position number into a string, e.g., 1 into ``first'' and so + on.} + +MF: These library and its uses needs to be cleaned up. + diff --git a/collects/htdp/error.rkt b/collects/htdp/error.rkt index 21883517a1..3e589b01ed 100644 --- a/collects/htdp/error.rkt +++ b/collects/htdp/error.rkt @@ -1,82 +1,59 @@ -#lang scheme/base -(require scheme/class - lang/private/rewrite-error-message) +#lang racket/base -;; -------------------------------------------------------------------------- -(provide check-arg check-arity check-proc check-result - check-list-list check-color - check-fun-res check-dependencies +(require lang/private/rewrite-error-message) + +;; ----------------------------------------------------------------------------- +;; this module provides one-point functionality to report errors in teachpacks + +;; ----------------------------------------------------------------------------- +(provide check-arg + check-list-list + check-arity + check-proc + check-result + check-fun-res + check-color + check-dependencies natural? - find-non tp-exn? number->ord + number->ord + find-non + tp-exn? tp-error) -(define (natural? w) - (and (number? w) (integer? w) (>= w 0))) - -;; (_ -> Boolean) (listof X) -> (union X false) -(define (find-non pred? l) - (let ([r (filter (compose not pred?) l)]) - (if (null? r) #f (car r)))) - - -;(: check-fun-res (∀ (γ) (∀ (β α ...) (α ...α -> β)) (_ -γ-> boolean) _ -> γ)) -(define (check-fun-res f pred? type) - (lambda x - (define r (apply f x)) - (check-result (object-name f) pred? type r) - r)) - -;; check-dependencies : Symbol x Boolean x FormatString x Any* -> Void -(define (check-dependencies pname condition fmt . args) +;; check-arg : sym bool str (or/c str non-negative-integer) TST -> void +(define (check-arg pname condition expected arg-posn given) (unless condition - (tp-error pname (apply format fmt args)))) - -#| Tests ------------------------------------------------------------------ - (not (find-non list? '((1 2 3) (a b c)))) - (symbol? (find-non number? '(1 2 3 a))) - (symbol? (find-non list? '((1 2 3) a (b c)))) - |# - -(define-struct (tp-exn exn) ()) - -(define (tp-error name fmt . args) - (raise - (make-exn:fail:contract #; make-tp-exn - (string-append (format "~a: " name) (apply format fmt args)) - (current-continuation-marks)))) - -(define (number->ord i) - (if (= i 0) - "zeroth" - (case (modulo i 10) - [(0 4 5 6 7 8 9) (format "~ath" i)] - [(1) (format "~ast" i)] - [(2) (format "~and" i)] - [(3) (format "~ard" i)]))) - -;; spell-out : number-or-string -> string -(define (spell-out arg-posn) - (cond - [(string? arg-posn) arg-posn] - [(number? arg-posn) - (case arg-posn - [(1) "first"] - [(2) "second"] - [(3) "third"] - [(4) "fourth"] - [(5) "fifth"] - [(6) "sixth"] - [(7) "seventh"] - [(8) "eighth"] - [(9) "ninth"] - [(10) "tenth"] - [else (number->ord arg-posn)])])) + (tp-error pname "expects ~a as ~a argument, given ~e" + (add-article expected) + (spell-out arg-posn) + given))) ;; Symbol (union true String) String X -> void (define (check-list-list pname condition pred given) (when (string? condition) (tp-error pname (string-append condition (format "\nin ~e" given))))) +;; check-arity : sym num (list-of TST) -> void +(define (check-arity name arg# args) + (unless (= (length args) arg#) + (tp-error name (argcount-error-message arg# (length args))))) + +;; check-proc : sym (... *->* ...) num (union sym str) (union sym str) -> void +(define (check-proc name f exp-arity arg# arg-err) + (unless (procedure? f) + (tp-error name "expected a function as ~a argument; given ~e" arg# f)) + (let ([arity-of-f (procedure-arity f)]) + (unless (procedure-arity-includes? f exp-arity) + (tp-error name "expected function of ~a as ~a argument; given function of ~a " + arg-err arg# + (cond + [(number? arity-of-f) + (if (= arity-of-f 1) + (format "1 argument") + (format "~s arguments" arity-of-f))] + [(arity-at-least? arity-of-f) "variable number of arguments"] + [else (format "multiple arities (~s)" arity-of-f)]))))) + ;; Symbol (_ -> Boolean) String X X *-> X (define (check-result pname pred? expected given . other-given) (if (pred? given) @@ -111,33 +88,75 @@ "expected the name ~e to be a color, but did not recognize it" given)))) -;; check-arg : sym bool str (or/c str non-negative-integer) TST -> void -(define (check-arg pname condition expected arg-posn given) +;; (: check-fun-res (∀ (γ) (∀ (β α ...) (α ...α -> β)) (_ -γ-> boolean) _ -> γ)) +(define (check-fun-res f pred? type) + (lambda x + (check-result (object-name f) pred? type (apply f x)))) + +;; check-dependencies : Symbol x Boolean x FormatString x Any* -> Void +(define (check-dependencies pname condition fmt . args) (unless condition - (tp-error pname "expects a ~a as ~a argument, given ~e" - expected - (spell-out arg-posn) - given))) + (tp-error pname (apply format fmt args)))) -;; check-arity : sym num (list-of TST) -> void -(define (check-arity name arg# args) - (if (= (length args) arg#) - (void) - (tp-error name (argcount-error-message arg# (length args))))) +(define-struct (tp-exn exn) ()) -;; check-proc : -;; sym (... *->* ...) num (union sym str) (union sym str) -> void -(define (check-proc proc f exp-arity arg# arg-err) - (unless (procedure? f) - (tp-error proc "expected a function as ~a argument; given ~e" arg# f)) - (let ([arity-of-f (procedure-arity f)]) - (unless (procedure-arity-includes? f exp-arity) ; (and (number? arity-of-f) (>= arity-of-f exp-arity)) - (tp-error proc "expected function of ~a as ~a argument; given function of ~a " - arg-err arg# - (cond - [(number? arity-of-f) - (if (= arity-of-f 1) - (format "1 argument") - (format "~s arguments" arity-of-f))] - [(arity-at-least? arity-of-f) "variable number of arguments"] - [else (format "multiple arities (~s)" arity-of-f)]))))) +(define (tp-error name fmt . args) + (raise + (make-exn:fail:contract + (string-append (format "~a: " name) (apply format fmt args)) + (current-continuation-marks)))) + +(define (number->ord i) + (if (= i 0) + "zeroth" + (case (modulo i 10) + [(0 4 5 6 7 8 9) (format "~ath" i)] + [(1) (format "~ast" i)] + [(2) (format "~and" i)] + [(3) (format "~ard" i)]))) + +;; (_ -> Boolean) (listof X) -> (union X false) +;; (not (find-non list? '((1 2 3) (a b c)))) +;; (symbol? (find-non number? '(1 2 3 a))) +;; (symbol? (find-non list? '((1 2 3) a (b c)))) +(define (find-non pred? l) + (let ([r (filter (compose not pred?) l)]) + (if (null? r) #f (car r)))) + +(define (natural? w) + (and (number? w) (integer? w) (>= w 0))) + +;; add-article : anything -> string +;; (add-article 'color) should be "a color" +;; (add-article 'acronym) should be "an acronym" +(define (add-article thing) + (let ((s (format "~a" thing))) + (string-append + (if (starts-with-vowel? s) + "an " + "a ") + s))) + +;; starts-with-vowel? : string -> boolean +(define (starts-with-vowel? s) + (and + (not (string=? s "")) + (member (string-ref s 0) (list #\a #\e #\i #\o #\u)))) + +;; spell-out : number-or-string -> string +(define (spell-out arg-posn) + (cond + [(string? arg-posn) arg-posn] + [(number? arg-posn) + (case arg-posn + [(1) "first"] + [(2) "second"] + [(3) "third"] + [(4) "fourth"] + [(5) "fifth"] + [(6) "sixth"] + [(7) "seventh"] + [(8) "eighth"] + [(9) "ninth"] + [(10) "tenth"] + [else (number->ord arg-posn)])])) diff --git a/collects/htdp/htdp.scrbl b/collects/htdp/htdp.scrbl index fa1149e6a9..bc1bdb43e7 100644 --- a/collects/htdp/htdp.scrbl +++ b/collects/htdp/htdp.scrbl @@ -22,12 +22,26 @@ file from the filesystem.} Under the hood, HtDP Teachpacks and HtDP Libraries are implemented the same way, using normal Racket @secref[#:doc '(lib "scribblings/guide/guide.scrbl") "modules"]. -When implementing an extension intended for students, pay a special attention to -the error messages. The error messages of DrRacket's teaching languages go to -great length to ensure that students are never confronted with messages that -uses vocabulary or phrases the students has not learned yet. The teaching languages -also ensure that students cannot stumble by accident onto challenging or -confusing features intended for professional or for higher-level students. +When implementing such an extension for students, pay a special attention +to two aspects: +@itemlist[#:style 'ordered + +@item{@bold{choice of construct}: The teaching languages limit the +expressive power in comparison to plain Racket. One goal is to teach +``design subject to constraints,'' and the other one is to help restrict +the set of explanations for student errors. With regard to the first, we +consider it imperative that new teachpacks and libraries avoid features +intended for upper-level students or professionals.} + +@item{@bold{error messages}: The error messages from the teaching languages +go to great length to never confront students messages that uses vocabulary +or phrases outside of the scope of the chosen level. While teachpacks and +libraries can be used at all levels, they should ideally restrict the +vocabulary in error message to the lowest level language in which they are +to be used.} + +] + This manual describes library support for authors of HtDP Teachpacks, libraries, and customized teaching languages. Use the HtDP @@ -39,7 +53,6 @@ of DrRacket's teaching languages. @local-table-of-contents[#:style 'immediate-only] - @include-section["error-composition.scrbl"] @include-section["error-reporting.scrbl"]