honu-module -> honu; misc doc and slideshow tweaks

svn: r10230

collects/honu-module/doc.txt

@@ -1,157 +0,0 @@
-
->>> FOR NOW, THIS IS AN EXPERIMENTAL TOY <<<
-    > Everything is subject to change. <
-
-Honu is a "gradual-ly typed" language. That is, it's statically typed,
-but any expression can have type `obj', and an expresion of type `obj'
-is implicitly coreced to any other type by inserting run-time checks
-(with delayed checks for higher-order values, as in a contract
-system).
-
-Every identifier binding has a declared type --- it's `obj' if an
-optional <type> is omitted --- and every function has a declared
-return type. Types for expressions are inferred in the obvious
-way. [TODO: explain "obvious".]
-
-The syntax is much like Java, but also slightly influenced by
-Javascript, since functions are first-class values. Honu support
-higher-order parametric polymorphism, for which it uses the Java
-"generic" terminology.
-
-There no no classes/records, yet. That's the next step.
-
-
-Write a Honu program as
-
- #honu
-
- <stmt|defn|impexp>
- ...
-
-and run it like a `(module ...)' program.
-
-Each <stmt> as a top-level <stmt|defn> is implicitly wrapped to print
-the result of the <stmt> (if the result is not void).
-
-The following grammar is a lie, because Honu is extensible in a way
-that doesn't fit BNFs. But it's (intended as) an accurate picture of
-the initial grammar before any extensions.
-
-Types:
-
- <type> := obj                   // anything
-        |  bool
-        |  int                   // exact integer
-        |  string                // character string
-        |  (<type>* -> <type>)   // procedure
-        |  (<id>* >-> <type>)    // generic
-        |  <id>                  // if bound as generic argument
-
-Definitions:
-
-  <defn> := var [<type>] <id> = <expr>;   // <type> defaults to `obj'
-         |  const [<type>] <id> = <expr>; // prohibits assignment
-         |  <type> <id> = <expr>;
-         |  <type> id(<arg>,*) { <stmt|defn>* }
-         |  < <id>,* > <type> id(<arg>,*) { <stmt|defn>* }
-
-   <arg> := <id>        // same as `obj <id>'
-         |  <type> <id>
-
-The <defn> form is a generic-procedure definition.
-
-Expressions:
-
-  <expr> := <literal>
-         | <expr> <binop> <expr>
-         |  <unpreop> <expr>
-         |  <expr> <unpostop>
-         |  (<expr>)
-         |  { <stmt|defn>* }
-         |  (type)<expr>         // cast
-         |  <expr>(<expr>,*)     // procedure call
-         |  <expr> [ <expr> ]    // array access (eventually)
-         |  <expr> < <type>,* >  // generic instantiation
-         |  [type] function(<arg>,*) { <stmt|defn>* } // anon function
-         |  < <id>,* > [type] function(<arg>,*) { <stmt|defn>* }
-
-  <literal> := <number>
-            |  <string>
-            |  true  | false
-
-  <binop> := + | - | * | / | %
-          | == | < | > | >= | <= | = 
-          | && | ||
-          |  ? | :    // see note below
-
-  Operators have the same precedence as in Java
-
-  Note: `<expr> ? <expr> : <expr>' is currently parsed as
-        `(<expr> ? (<expr> : <expr>))', where `?' looks for 
-        `:' in its second argument.
-
-Statements:
-
-  <stmt|defn> := <stmt> 
-              | <defn>          // in non-tail positions, only
-
-  <stmt> := <expr> ;
-         |  if (<expr>) <branch>
-         |  if (<expr>) <branch> else <branch>
-         |  return <stmt>        // in tail positions, only
-         |  time <expr> ;
-
-  <branch> := { <stmt>* }
-           |  <stmt>
-
-Imports and exports:
-
- <stmt|defn|impexp> := <stmt|defn>
-                    |  provide <id>,* ;
-
-------------------------------------------------------------------------
-
-About Honu Parsing and Typechecking
------------------------------------
-
-A Honu program is first parsed by using the MzScheme reader, which
-goes into H-expression mode due to the leading #honu. This read phase
-tokenizes and groups based on parens, braces, brackets, and (under
-certain circumstances) angle brackets. See the MzScheme manual for
-details.
-
-The program is then parsed, expanded (including translation to
-Scheme), and type-checked all at once. Thus, the parsing of a term can
-depend on the type assigned by the context.
-
-Parsing proceeds by taking the first thing in the reader's output and
-checking whether it has a binding as a Honu transformer. For example
-`int' will have a binding to a transformer that expands the next bit
-of the stream to a variable or function definition. This transformer
-check is performed when the stream starts with an identifier or a
-parenthesized group (<h-expr> ...) includes only one operator
-identifier; in the latter case, the operator is used for looking up a
-transformer. For example, `(int -> int)' starts a definition because
-`->' is bound to a transformer.
-
-A transformer takes the current stream and a context object; it
-returns a Scheme expression and the unconsumed part of the stream. The
-Scheme expression is likely to contain unparsed H-expression
-representations in a `honu-unparsed-block' form, which is bound to a
-Scheme macro in the usual way to continue parsing later.
-
-A context object can be anything. The base Honu grammar implies
-several kinds of contexts, each with its own record type (described
-later). A transformer should expand only in contexts that it
-recognizes, and it should raise a syntax error when given any context
-that it doesn't recognize. A transformer might expand differently in
-different contexts. For example, `int' expands to a definition in a
-block context (e.g., at the top level), but to a type description in a
-type context (e.g., in a procedure's formal argument list).
-
-When the start of the stream offers no other guidance, it is parsed as
-an expression. The expression-parsing rules are essentially hardwired
-to the Java grammar rules. (In the future, programmers will likely
-have control over precedence, at least.)
-
-[to be continued]

collects/honu/lang/reader.ss

@@ -0,0 +1,16 @@
+
+(module reader scheme/base
+  (require (only-in syntax/module-reader wrap-read-all))
+  (provide (rename-out [*read read]
+                       [*read-syntax read-syntax]))
+  
+  (define (*read in modpath line col pos)
+    (wrap in read-honu modpath #f line col pos))
+  
+  (define (*read-syntax src in modpath line col pos)
+    (wrap in (lambda (in)
+               (read-honu-syntax src in))
+          modpath src line col pos))
+
+  (define (wrap port read modpath src line col pos)
+    (wrap-read-all 'honu port read modpath src line col pos)))

collects/honu/main.ss

@@ -1,4 +1,4 @@
-(module honu-module "private/mzscheme.ss"
+(module main "private/mzscheme.ss"
 
   (require-for-syntax syntax/stx
 		      "private/ops.ss"
@@ -767,7 +767,7 @@
                                          (define-syntax arg-id (make-honu-type #'arg-pred-id stx-car #'arg-name-id #f)) ...
                                          (honu-unparsed-type-predicate #,>->-stx next-pred res-type-name . #,result-stx)
                                          (let ([v ((generic-val v) safe? arg-pred-id ... arg-name-id ...)])
-                                           (check #f #f res-type-name next-pred v)))))
+                                           (check* #f #f res-type-name next-pred v)))))
                            ;; Not a generic
                            (values #f #f)))
                    ;; generics always protect themselves, for now:
@@ -927,17 +927,17 @@
   (define (check proc who type-name pred val)
     (let-values ([(tst new-val) (pred val)])
       (unless tst
-	(raise
+        (raise
-	 (make-exn:fail:contract
+         (make-exn:fail:contract
-	  (format "~a: expected `~a' value for ~a, got something else: ~e"
+          (format "~a: expected `~a' value for ~a, got something else: ~e"
                   (or proc (if (eq? who #t) #f who) "procedure")
                   type-name
                   (cond [(eq? who #t) "result"]
                         [else (if proc
-                                (format "`~a' argument" who)
+                                  (format "`~a' argument" who)
-                                (if who "initialization" "argument"))])
+                                  (if who "initialization" "argument"))])
                   val)
-	  (current-continuation-marks))))
+          (current-continuation-marks))))
       new-val))
 
   (define-syntax as-protected
@@ -1017,7 +1017,7 @@
                             v))
                     ;; Need a run-time check:
                     (with-syntax ([val v])
-                      #'(check proc who type-name-expr pred val))))]
+                      #'(check* proc who type-name-expr pred val))))]
 	   [(if test-expr then-expr else-expr)
             (if (eq? #t (syntax-e #'type-name))
                 ;; Context guarantees correct use, but we have to manage any
@@ -1086,7 +1086,13 @@
                     v
                     ;; Run-time check:
                     (with-syntax ([val v])
-                      #'(check proc who type-name-expr pred val))))]))]))
+                      #'(check* proc who type-name-expr pred val))))]))]))
+
+  (define-syntax check*
+    (syntax-rules ()
+      [(_ proc who type-name #f val) val]
+      [(_ proc who type-name pred val)
+       (check proc who type-name pred val)]))
 
   (define-syntax (honu-app stx)
     (syntax-case stx ()
@@ -1099,9 +1105,13 @@
             (if (= (length (syntax->list #'(arg-type ...)))
                    (length (syntax->list #'(b ...))))
                 ;; Some run-time checks maybe needed on some arguments:
-                #'(honu-typed (pack-a-expr (check-expr-type #f #f arg-type arg-type-name arg-pred b) ...) 
+                (with-syntax ([app
-                              orig-expr
+                               (syntax/loc stx
-                              result-type result-protect-id)
+                                 (pack-a-expr (check-expr-type #f #f arg-type arg-type-name arg-pred b) ...))])
+                  (syntax/loc stx
+                    (honu-typed app
+                                orig-expr
+                                result-type result-protect-id)))
                 (raise-syntax-error #f
                                     (format (string-append 
                                              "static type mismatch: "
@@ -1114,7 +1124,8 @@
             ;; There will be a run-time check to make sure that a is the
             ;;  right kind of function, etc., and it will take care of the
             ;;  argument checks itself.
-            #'(#%app (honu-typed pack-a-expr orig-a-expr a-type a-protect-id) b ...)]
+            (syntax/loc stx
+              (#%app (honu-typed pack-a-expr orig-a-expr a-type a-protect-id) b ...))]
            [_else
             (type-mismatch #'orig-a-expr #'a-type #'(-> (.... #f) (.... #f #f)))]))]))
 
@@ -1178,11 +1189,14 @@
 		    [(set! id rhs)
 		     (if const?
 			 (raise-syntax-error #f "cannot assign to constant" #'id)
-			 #'(set! gen-id (check-expr-type 'set! id type-name type-name-expr pred-id rhs)))]
+			 (syntax/loc stx
+                           (set! gen-id (check-expr-type 'set! id type-name type-name-expr pred-id rhs))))]
 		    [(id arg (... ...))
-		     #'(honu-app (honu-typed gen-id id type-name protect-id) arg (... ...))]
+		     (syntax/loc stx
+                       (honu-app (honu-typed gen-id id type-name protect-id) arg (... ...)))]
 		    [id
-		     #'(honu-typed gen-id id type-name protect-id)]))))))]))
+                     (syntax/loc stx
+                       (honu-typed gen-id id type-name protect-id))]))))))]))
 
   (define-for-syntax (make-typed-procedure gen-id result-spec arg-spec protect-id)
     (with-syntax ([((arg arg-type arg-type-name arg-pred-id) ...) arg-spec]

collects/lang/private/contracts/contracts-module-begin.ss

@@ -251,7 +251,9 @@
 		  [(define-values-for-syntax . _)
 		   #`(begin #,e2 (frm e1s e3s def-ids))]
 		  [(begin b1 ...)
-		   #`(frm e1s (b1 ... . e3s) def-ids)]
+		   (syntax-track-origin #`(frm e1s (b1 ... . e3s) def-ids)
+                                        e2
+                                        (car (syntax-e e2)))]
 		  [(define-values (id ...) . _)
 		   #`(frm (#,e2 . e1s) e3s (id ... . def-ids))]
 		  [_

collects/lang/private/teach.ss

@@ -459,10 +459,13 @@
                                     stx 
                                     (define name
                                       #,(stepper-syntax-property
-                                         #`(lambda arg-seq 
+                                         (syntax-track-origin
-                                             #,(stepper-syntax-property #`make-lambda-generative 
+                                          #`(lambda arg-seq 
-                                                                       'stepper-skip-completely #t) 
+                                              #,(stepper-syntax-property #`make-lambda-generative 
-                                             lexpr ...)
+                                                                         'stepper-skip-completely #t) 
+                                              lexpr ...)
+                                          lam
+                                          (syntax-local-introduce (car (syntax-e lam))))
                                          'stepper-define-type
                                          'lambda-define))))))])
                   (check-definition-new

collects/lazy/lazy.scrbl

@@ -1,6 +1,5 @@
 #lang scribble/doc
-@(require (for-label scheme/base
+@(require (for-label (except-in lazy delay force promise?)
-                     scheme/contract
                      (only-in lazy/force
                               ! !! !!!
                               !list !!list
@@ -17,6 +16,32 @@
      (define scheme-promise? (scheme promise?))))
   (def-scheme scheme-force scheme-delay scheme-promise?))
 
+@(define-syntax-rule (deflazy mod def id)
+   (begin
+     (def-mz-req mod id mz-id)
+     @def[id]{Lazy variant of @|mz-id|.}))
+
+@(define-syntax-rule (def-mz-req mod id in-mz-id)
+   (begin
+     (define-syntax-rule (intro mz-id)
+       (begin
+         (require (for-label (only-in mod id)))
+         (define mz-id (scheme id))))
+     (intro in-mz-id)))
+
+@(define-syntax-rule (defprocthing* mod id ...)
+   (begin
+    (deflazy mod defprocthing id)
+    ...))
+
+@(define-syntax-rule (defprocthing id . rest)
+   (defthing id procedure? . rest))
+
+@(define-syntax-rule (defidform* mod id ...)
+   (begin
+    (deflazy mod defidform id)
+    ...))
+
 @; ----------------------------------------
 
 @(require scribble/manual)
@@ -31,7 +56,7 @@ can be used to write lazy code. To write lazy code, simply use
 
 @schememod[
 lazy
-... lazy code here...]
+... #, @elem{lazy code here}...]
 
 Function applications are delayed, and promises are automatically
 forced. The language provides bindings that are equivalent to most of
@@ -61,11 +86,60 @@ change (or be dropped) in the future.
 
 There are a few additional bindings, the important ones are special
 forms that force strict behaviour---there are several of these that
-are useful in forcing different parts of a value in different ways.
+are useful in forcing different parts of a value in different ways, as
+described in @secref["forcing"].
 
 @; ----------------------------------------
 
-@section{Forcing Values}
+@section{Lazy Forms and Functions}
+
+@defidform*[mzscheme
+lambda
+define
+]
+
+@defidform*[scheme
+let
+let*
+letrec
+parameterize
+define-values
+let-values
+let*-values
+letrec-values
+if
+set!
+begin begin0 when unless
+cond case
+]
+
+@defprocthing*[scheme
+   values make-struct-type
+   cons list list* vector box
+   and or
+   set-mcar! set-mcdr! vector-set! set-box!
+   error printf fprintf display write print
+   eq? eqv? equal?
+   list? length list-ref list-tail append map for-each andmap ormap
+   member memq memv assoc assq assv reverse
+   caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar
+   caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr
+   cddaar cddadr cdddar cddddr
+   first second third fourth fifth sixth seventh eighth rest cons? empty empty?
+   foldl foldr last-pair remove remq remv remove* remq* remv* memf assf filter
+   sort
+   true false boolean=? symbol=? compose build-list
+   take
+]
+
+@defprocthing[identity]{Lazy identity function.}
+
+@defprocthing[cycle]{Creates a lazy infinite list given a list of
+elements to repeat in order.}
+
+@; ----------------------------------------
+
+@section[#:tag "forcing"]{Forcing Values}
 
 @defmodule[lazy/force]
 

collects/scribblings/reference/filesystem.scrbl

@@ -264,8 +264,8 @@ Returns the file or directory's last modification date as
 platform-specific seconds (see also @secref["time"]) when
 @scheme[secs-n] is not provided or is @scheme[#f]. (For FAT
 filesystems under Windows, directories do not have modification
-dates. Therefore, the creation date is returned for a directory (but
+dates. Therefore, the creation date is returned for a directory, but
-the modification date is returned for a file).)
+the modification date is returned for a file.)
 
 If @scheme[secs-n] is provided and not @scheme[#f], the access and
 modification times of @scheme[path] are set to the given time.

collects/scribblings/reference/syntax.scrbl

@@ -248,8 +248,8 @@ pre-defined forms are as follows.
  @defsubform[(only-in require-spec id-maybe-renamed ...)]{
   Like @scheme[require-spec], but constrained to those exports for
   which the identifiers to bind match @scheme[id-maybe-renamed]: as
-  @scheme[id] or as @scheme[orig-id] in @scheme[[orig-id bind-id]]. If
+  @scheme[_id] or as @scheme[_orig-id] in @scheme[[_orig-id _bind-id]]. If
-  the @scheme[id] of @scheme[orig-id] of any @scheme[id-maybe-renamed]
+  the @scheme[_id] or @scheme[_orig-id] of any @scheme[id-maybe-renamed]
   is not in the set that @scheme[require-spec] describes, a syntax
   error is reported.}
 

collects/scribblings/slideshow/picts.scrbl

@@ -681,7 +681,7 @@ library provides functions for creating and placing cartoon-speech
 balloons.}
 
 @defproc[(wrap-balloon [pict pict?]
-                       [spike one-of/c ('n 's 'e 'w 'ne 'se 'sw 'nw)]
+                       [spike (one-of/c ('n 's 'e 'w 'ne 'se 'sw 'nw))]
                        [dx real?]
                        [dy real?]
                        [color (or/c string? (is-a?/c color%)) balloon-color]
@@ -810,8 +810,8 @@ follows:
 }}
 
 @defproc[(face* [eyebrow-kind (one-of/c 'none 'normal 'worried 'angry)]
-                [mouth-kind (one-of/c 'plain 'narrow 'medium 'large 'huge
+                [mouth-kind (one-of/c 'plain 'smaller 'narrow 'medium 'large 
-                                      'grimace 'oh 'tongue)]
+                                      'huge 'grimace 'oh 'tongue)]
                 [frown? any/c]
                 [color (or/c string (is-a?/c color%))]
                 [eye-inset real?]
@@ -832,7 +832,7 @@ Returns a pict for a face:
 
  @item{@scheme[eyebrow-kind] determines the eyebrow shape.}
 
- @item{@scheme[mouth-kind] determines the mouth shape, sombined with
+ @item{@scheme[mouth-kind] determines the mouth shape, combined with
        @scheme[frown?].}
 
  @item{@scheme[frown?] determines whether the mouth is up or down.}

collects/setup/setup-unit.ss

@@ -99,7 +99,11 @@
   (define (record-error cc desc go fail-k)
     (with-handlers ([exn:fail?
                      (lambda (x)
-                       (fprintf (current-error-port) "~a\n" (exn->string x))
+                       (if (verbose)
+                           ((error-display-handler)
+                            (format "~a\n" (exn->string x))
+                            x)
+                           (fprintf (current-error-port) "~a\n" (exn->string x)))
                        (set! errors (cons (list cc desc x) errors))
                        (fail-k))])
       (go)))

collects/texpict/face.ss

@@ -107,15 +107,16 @@
                    (* sw 2/3) (+ (if flip? 0 i) (* h 2/3))
                    (- (* pi (- 5/4 (if flip? 1 0))) da) (+ (* pi (- 7/4 (if flip? 1 0))) da)))
                 
-                (define (plain-smile flip? tongue?)
+                (define (plain-smile flip? tongue? narrow?)
 		  (send dc set-brush no-brush)
 		  (series dc 
                           (if mouth-shading? 3 0)
                           (make-object color% "black")
                           face-edge-color
                           (lambda (i)
-                            (smile w h i 0 #f 0 flip?)
+                            (let ([da (if narrow? (* pi -1/8) 0)])
-                            (smile w h (+ 1 (- i)) 0 #f 0 flip?)) 
+                              (smile w h i da #f 0 flip?)
+                              (smile w h (+ 1 (- i)) da #f 0 flip?)))
                           #t #f)
 		  (when tongue?
 		    (let ([path (new dc-path%)]
@@ -243,7 +244,12 @@
                 
                 (define (medium-grimace flip?)
                   (grimace
-                   (* 1.2 w) (* h 0.9) (- (* 0.1 pi))
+                   (* 1.2 w) (* h 0.9) (- (* 0.1 pi)) 
+                   flip?))
+                
+                (define (narrow-grimace flip?)
+                  (grimace
+                   (* 1.2 w) (* h 0.9) (- (* 0.1 pi)) 15
                    flip?))
                 
                 (define (large-smile flip?)
@@ -327,14 +333,15 @@
 		  [(angry) (angry-eyebrows eyebrow-dy)]
 		  [(none) (void)])
 		(case mouth-kind
-		  [(plain) (plain-smile frown? #f)]
+		  [(plain) (plain-smile frown? #f #f)]
+		  [(smaller) (plain-smile frown? #f #t)]
                   [(narrow) (narrow-smile frown?)]
 		  [(medium) (medium-smile frown?)]
 		  [(large) (large-smile frown?)]
 		  [(huge) (largest-smile frown?)]
 		  [(grimace) (medium-grimace frown?)]
                   [(oh) (oh)]
-		  [(tongue) (plain-smile frown? #t)])
+		  [(tongue) (plain-smile frown? #t #f)])
                 
                 (send dc set-brush old-brush)
                 (send dc set-pen old-pen))