Initial commit.

.gitmodules

@@ -0,0 +1,8 @@
+[submodule "graph/lib/doc/bracket"]
+	path = graph/lib/doc/bracket
+	url = https://github.com/soegaard/bracket
+	branch = master
+[submodule "graph/lib/doc/MathJax"]
+	path = graph/lib/doc/MathJax
+	url = https://github.com/mathjax/MathJax.git
+	branch = master

graph/.gitignore

@@ -0,0 +1,6 @@
+*.css
+*.js
+*.html
+/docs/
+*~
+compiled

graph/Makefile

@@ -0,0 +1,15 @@
+.PHONY: all
+all: make/make
+	make/make
+
+make/make: make/make.rkt make/lib.rkt
+	raco exe make/make.rkt
+
+.PHONY: clean
+clean:
+	rm -fr make/make docs coverage
+	find \( -path ./lib/doc/bracket -prune -and -false \) -or -name compiled -print0 | xargs -0 rm -rf
+
+.PHONY: build-dep
+build-dep:
+	raco pkg install --deps search-auto --update-deps --skip-installed alexis-util cover

graph/README

@@ -0,0 +1,262 @@
+How to build this project
+=========================
+
+To install the build dependencies of this project on a clean Ubuntu 14.04
+machine, you need to install a recent version of racket. First, you need to
+install a recent version of racket (as of the time of writing, version
+20151017-6b93b18 has a bug that prevents normal execution of the graph library,
+but the slightly older version 6.2.900.11 works fine). Then run the following
+commands after doing a cd into the directory containing this README file:
+
+   sudo apt-get install git
+   git submodule init
+   git submodule update
+   make build-dep
+
+To build the project, simply run `make`:
+
+   make
+
+List of files
+=============
+
+Graph library
+-------------
+
+* graph/graph.lp2.rkt
+
+  Implements a graph construction library. The user specifies a series of
+  transformations from a root input value to a result node, and can safely call
+  other transformations, without risking to run into an infinite loop.
+
+  The make-graph-constructor takes the types of the result nodes, and the
+  transformations, and creates a graph-construction routine that detects cycles,
+  and prevents infinite recursion.
+
+  For now, in the result, calls to other transformations are replaced by link
+  requests, but later versions will allow seamless access to the target result
+  node.
+
+  The make-graph-constructor macro can be used like this:
+
+      (define make-g
+        (make-graph-constructor
+         ([ma (fav String) (faa ma) (fab mb)]
+          [mb (fbv String) (fba ma)])
+         [transform-a (s String) : ma
+      		(ma s
+      		    (transform-a s)
+      		    (transform-b "b"))]
+         [transform-b (s String) : mb
+      		(mb s
+      		    (transform-a s))]))
+      
+  Then, when the resulting graph constructor is called:
+
+      (make-g "root-arg")
+
+  We get the following graph as a result:
+
+      (ma "root-arg" <link-request1> <link-request2>)
+      ^                   |               |
+      `-------------------'        ,------'
+                                   v
+                                   (mb "b" <link-request3>)
+                                   ^            |
+      ,--------------------------- | -----------'
+      v                            |
+      (ma "b" <link-request4> <link-request5>)
+      ^            |
+      `------------'
+
+* graph/type-system.scrbl
+  
+  Documentation about the type system implemented by graph/graph2.lp2.rkt,
+  graph/variant.lp2.rkt, graph/structure.lp2.rkt.
+
+* graph/variant.lp2.rkt
+  
+  Implements tagged unions, similar to those in caml, F#, or the unions in C if
+  a tag field is added, with a distinct tag value for each type in the union.
+
+* graph/structure.lp2.rkt
+  
+  Implements structures with anonymous access: accessing the field “b” of a
+  structure instance i can be written: (get i b), independently of the structure
+  type of the instance. Traditionnally, if one creates two structs in Racket,
+  using:
+  
+      (struct s1 ([a : Number] [b : String]))
+      (struct s2 ([b : String] [c : Boolean]))
+  
+  then, to access the “b” field from an instance “i” of “s1”, one has to write
+  “(s1-b i)”, whereas to access the field “b” from an instance “j” of “s2”, one
+  has to write “(s2-b j)”. The fact that we need to know the type of an instance
+  to access one of its fields is impractical when one needs to work with a large
+  number of structs which share some field names.
+
+  Inheritance could solve this problem, but Racket only has single inheritance
+  for structs, not multiple inheritance.
+  
+  With the syntax offered by this library, one can write (get i b) for the first
+  case and (get j b), therefore allowing more flexible use of structures
+  containing similar fields.
+  
+* graph/equatable.rkt
+  
+  Provides a struct in typed/racket with customizable equality, hashing and
+  printing. This is similar to overriding .equals(), .hashCode() and .toString()
+  in Java.
+
+  Untyped racket provides these features out of the box, but they are not
+  normally available in typed/racket.
+
+* graph/dotlang.rkt
+  
+  Small programming language extension that allows writing “instance.f.g.h”
+  instead of “(get (get (get instance f) g) h)”.
+
+* graph/remember.rkt
+
+  This utility module is used by graph/structure.lp2.rkt to memoize structure
+  descriptiors. When the “structure” macro defined in graph/structure.lp2.rkt
+  encounters an unknown list of field names, it adds it to the file
+  graph/remember.rkt. The memoized descriptors are used to know all possible
+  structs that can contain a field with the desired name when aceesing it with
+  “(get instance field-name)”. The “get” macro can then dispatch on these types,
+  and retrieve the field's value using the right accessor (for example
+  “(s123-field-name instance)”).
+
+* graph/list-lang.rkt
+
+  Tiny programming language extension that allows constructing a list with the
+  contents of all trailing lines in the file. This is used by graph/remember.rkt
+  to easily add elements to the list of memoized structure descriptors, by just
+  appending to the end of the file.
+
+Type-expander
+-------------
+
+* type-expander/type-expander.lp2.rkt
+  
+  This library extends the type system to allow type-expander macros, much in
+  the same way that “(match …)” allows match-expanders. For example, one can
+  write the “(Repeat t n)” type-expander, which expands to a list of “n”
+  elements of type “t”:
+
+      (define-type-expander (Repeat stx)
+               (syntax-case stx ()
+                 [(_ t n)
+                  #`(List #,@(map (λ (x) #'t)
+                                  (range (syntax->datum #'n))))]))
+
+  It can then be used in places where a regular type is expected:
+
+      (: count-five-more (→ Number (Repeat Number 5)))
+      (define (count-five-more x)
+        (list (+ x 1) (+ x 2) (+ x 3) (+ x 4) (+ x 5)))
+      
+      (count-five-more 3)
+      ;; => '(4 5 6 7 8)
+
+      (ann (count-five-more 15) (Repeat Number 5))
+      ;; => '(16 17 18 19 20)
+
+  This will be used by the graph library in graph/graph.lp2.rkt to allow
+  expressing graph types anonymously:
+
+     (: x-to-string (→ (graph (a [x Number] [b b])
+                              (b [a a] [y Boolean]))
+                       (graph (a [x String] [b b])
+                              (b [a a] [y Boolean]))))
+     (define (x-to-string g) …)
+
+* type-expander/multi-id.lp2.rkt
+  
+  This library allows easy definition of an identifier with multiple semantics:
+  the same identifier can be used as a constructor function, match expander,
+  type, type-expander, expanded type (i.e. a type containing type-expanders,
+  that has been expanded once), regular mutable or immutable variable, and with
+  a custom write procedure.
+
+  It allows defining a new type with its constructor and match expander with
+  very little boilerplate code.
+
+Library functions and utilities
+-------------------------------
+
+* lib/eval-get-values.rkt
+
+  Wrapper for the racket “eval” function that allows evaluation of code with
+  multiple return values in typed/racket.
+
+* lib/lib.rkt
+  
+  Utilities that complement racket and typed/racket's standard libraries.
+
+* lib/low.rkt
+
+  Lower-level utilities that complement racket and typed/racket's standard
+  libraries.
+
+* lib/low-untyped.rkt
+  
+  Wrapper around lib/low.rkt that allows using it from a untyped racket file.
+
+* lib/untyped/ids.rkt
+  
+  Some untyped racket utilities to manipulate identifiers inside macros.
+
+* lib/untyped/for-star-list-star.rkt
+
+  A utility macro similar to for*/list to iterate over collections and return a
+  list of results, but which can return nested lists instead of just a flat one.
+
+* lib/untyped.rkt
+
+  Aggregates lib/low-untyped.rkt, lib/untyped/ids.rkt and
+  lib/untyped/for-star-list-star.rkt.
+
+* lib/test-framework.rkt
+  
+  Some wrappers and utilities that allow easier use of the rackunit test
+  framework from typed/racket files.
+
+* lib/syntax/quasitemplate.rkt
+
+  Extension of the syntax/parse/experimental/template library, that allows using
+  “unsyntax” and “unsyntax-splicing” inside a “quasitemplate”, just like in the
+  normal “quasisyntax”.
+
+* lib/path.rkt
+
+  Filesystem path manipulation utilities.
+
+* lib/doc.rkt
+
+  Enhancements and utilities for documentation and literate programming files
+  using scribble and scribble/lp2.
+
+* lib/doc/math.rkt
+
+  Allows typesetting mathematical formulas in documentation and literate
+  programming files using scribble and scribble/lp2.
+
+* lib/doc/template.lp2.rkt
+
+  Example document using the features in lib/doc.rkt and lib/doc/math.rkt.
+
+* lib/doc/example.lp2.rkt
+
+  Other example document using the features in lib/doc.rkt and lib/doc/math.rkt.
+
+Makefile
+--------
+
+* make/make.rkt
+  This program acts like a Makefile, it is used to compile the rest of
+  the code.
+
+* make/lib.rkt
+  Function definitions for the "unix make"-like tool, used by
+  make/make.rkt

graph/graph/dotlang.rkt

@@ -0,0 +1,26 @@
+#lang typed/racket
+
+(module dotlang racket
+  (require typed/racket)
+  (provide (except-out (all-from-out typed/racket) #%top)
+           (rename-out [new-#%top #%top]))
+  
+  (require (for-syntax racket/string))
+  
+  (define-syntax-rule (dot . xyz)
+    '(dot . xyz))
+  
+  (define-syntax (new-#%top stx)
+    (syntax-case stx ()
+      [(_  . x)
+       (let ([components (string-split (symbol->string (syntax->datum #'x))
+                                       ".")])
+         (if (> (length components) 1)
+             #`(dot . #,components)
+             #'(#%top . x)))])))
+
+(module test (submod ".." dotlang)
+  (require typed/rackunit)
+  (let ((foo.bar 42))
+    (check-equal? foo.bar 42))
+  (check-equal? foo.bar '(dot "foo" "bar")))

graph/graph/equatable.rkt

@@ -0,0 +1,49 @@
+#lang racket
+
+(module untyped racket
+  (provide (struct-out untyped-object))
+  
+  (define-struct untyped-object ()
+    #:transparent
+    ;#:property prop:procedure (λ (self . rest) (apply (untyped-object-proc self) rest))
+    #:methods gen:custom-write
+    [(define write-proc (λ (self port mode) (((vector-ref (struct->vector self) 1) 'write-proc) port mode)))]
+    #:methods gen:equal+hash
+    [(define equal-proc (λ (x y recursive-equal?) (((vector-ref (struct->vector x) 1) 'equal-proc) y recursive-equal?)))
+     (define hash-proc (λ (x recursive-equal-hash-code?) (((vector-ref (struct->vector x) 1) 'hash-proc) recursive-equal-hash-code?)))
+     (define hash2-proc (λ (x recursive-equal-secondary-hash-code?) (((vector-ref (struct->vector x) 1) 'hash2-proc) recursive-equal-secondary-hash-code?)))]))
+
+
+(module typed typed/racket
+  (require/typed (submod ".." untyped)
+                 [#:struct untyped-object ()])
+  
+  (define-type Field-Present (Vector Any))
+
+  (: field-present (→ Any Field-Present))
+  (define (field-present x) (vector x))
+
+  (: field-present-get-value (→ Field-Present Any))
+  (define (field-present-get-value fp) (vector-ref fp 0))
+  
+  (struct (T) Equatable untyped-object
+    ([f : (case→ [→ 'value T] ;; Sadly, we can't extend a case→ described by T, so we have to chain two calls to access any field.
+                 ;; TODO: we could just directly accept the other parameters
+                 [→ 'write-proc (→ Output-Port (U #t #f 0 1) Any)]
+                 [→ 'equal-proc (→ (U Equatable Any) (→ Any Any Boolean) Boolean)]
+                 [→ 'hash-proc (→ (→ Any Fixnum) Fixnum)]
+                 [→ 'hash2-proc (→ (→ Any Fixnum) Fixnum)]
+                 [→ 'reflect (→ (U Index Symbol) (U Field-Present #f))])])
+    #:transparent)
+
+  (: Equatable-value (∀ (T) (→ (Equatable T) T)))
+  (define (Equatable-value e) ((Equatable-f e) 'value))
+  
+  (provide (struct-out Equatable)
+           Equatable-value
+           Field-Present
+           field-present
+           field-present-get-value))
+
+(require 'typed)
+(provide (all-from-out 'typed))

graph/graph/graph.lp2.rkt

@@ -0,0 +1,885 @@
+#lang scribble/lp2
+@(require "../lib/doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Graph implementation}
+
+This module provides (a simplified form of) recursive algebraic data structures,
+with the ability to handle the structure as a collection of nodes, and process
+them all in a way similar to what @tc[map] provides. Traditionally, immutable
+data structures can't form cycles, but can easily be traversed to reach all
+nodes. Conversely, traversing a cyclic data structure (based on lazy evaluation
+or thunks) is difficult if at all possible.
+
+More formally, this module offers fold operations on heterogeneous, richly typed
+graphs.
+
+@(table-of-contents)
+
+@section{Notes on complex transform result types}
+
+We wish at one point to support complex result types for the transforms, instead
+of only allowing a single node type.
+
+We have to impose a constraint: do not have a cycle inside the transform's
+result that doesn't go through a node, since we break cycles by replacing nodes
+with a promise. The safest way to satisfy that constraint is to enforce the
+absence of loops at the type level.
+
+We would then inline the called transform's results, breaking the cycles by
+replacing nodes with a thunk that returns the desired node. That thunk will be
+wrapped into a Promise that calls it, so that typed/racket's occurrence typing
+is happy, but we don't rely on the memoization semantics.
+
+@subsection{Compile-time handling of complex transform result types}
+
+During macro-expansion, we generate procedures that process nodes found in
+transforms' results, by inlining the results of called transforms. If we find a
+@tc[transform/link-request] type in some place we don't know how to rewrite
+(like a function type, for example), we throw an error. Similarly, if we
+encounter a cycle in the type that does not go through a node type, we throw an
+error.
+
+These procedures will help generate code to make a facade node from the
+incomplete one. When inlining results from called transforms, they will request
+other incomplete nodes from the database.
+
+@subsection{Two-step graph creation}
+
+Writing a graph-generation macro that allows complex return types for transforms
+seems difficult, and it would be easier to write a simple graph-generation
+macro, that only accepts transforms with return a single node type. We could
+build on top of that a more flexible macro, that would first generate a graph
+where each transform's result is wrapped in an ad-hoc single-field node. Then,
+we would automatically generate a second graph transformation that produces the
+desired nodes from that graph.
+
+Example: transform @tc[t1] takes a list of numbers as input, and produces a list
+of either calls to transform @tc[t2] or nodes @tc[ni] as output. The @tc[t2]
+transform generates a pair of nodes @tc[(ni [x Number])] and
+@tc[(nj [y String])].
+
+The user would describe the graph like this:
+
+@chunk[<example-1674389-2>
+       (make-graph ([root (Listof (U ni (Pairof ni nj)))]
+                    [ni [x Number]]
+                    [nj [y String]])
+                   [(t1 [ln : (Listof Number)] : (Listof (U ni t2))
+                        (map (λ (x) (if (even? x)
+                                        (t2 x)
+                                        (ni x)))
+                             ln))]
+                   [(t2 [n : Number] : (Pairof ni nj)
+                        (cons (ni n) (nj (format "~a" n))))])]
+
+In the above, the result type of @tc[t1] has to be @tc[(Listof (U ni t2))]
+instead of @tc[(Listof (U ni (Pairof ni nj)))], because otherwise we can't
+easily automatically infer that @tc[(Pairof ni nj)] was actually @tc[t2],
+without looking at the body of the transform. In a more advanced version, we
+could substitute every @tc[result-type] found in another transform's
+@tc[result-type] by @tc[(U result-type transform/link-request)], however that
+would likely produce spurious cycles that do not go through a node, so it's
+probably best to make things explicit, and let the user write @tc[U].
+
+@chunk[<example-1674389>
+       (graph ([r-t1 [result (Listof (U ni t2))]]
+               [r-t2 [result (Pairof ni nj)]])
+              [(t1 [ln : (Listof Number)] : r-t1
+                   (r-t1 (map (λ (x) (if (even? x)
+                                         (t2 x)
+                                         (ni x)))
+                              ln)))]
+              [(t2 [n : Number] : r-t2
+                   (r-t2 (cons (ni n)
+                               (nj (format "~a" n)))))])]
+
+Then use this graph transform:
+
+@chunk[<example-1674389-2>
+       (make-graph ([root [result (Listof (Pairof ni nj))]]
+                    [ni [x Number]]
+                    [nj [y String]])
+                   [(r-t1→root [t1 : r-t1]) : root
+                    (root (map (λ (v)
+                                 (match v
+                                   [(? list?) (r-t2-result v)]
+                                   [(ni _) v]))
+                               (r-t1-result t1)))])]
+
+@subsection{Many to one transforms}
+
+This example covers one to many transforms. What about many to one transforms?
+The macro we are building allows generating graphs, but does not care about the
+input. In the case were transforming a graph of @tc[house]s, @tc[street]s and a
+@tc[city], and we want to condense all the @tc[house]s on one side of each
+@tc[street] to a @tc[suburb], we would write a transform @tc[t1] for@tc[street]
+which passes the whole list of @tc[house]s to a transform @tc[t2]. The @tc[t2]
+transform would create a @tc[suburb] from those, without calling a transform for
+each @tc[house].
+
+@subsection{Implicit rule names}
+
+In order to allow implicit rule names, when there's only one rule with the
+desired result node, we can use the node's name as the transform name. We should
+think about naming conflicts: when calling @tc[n], should it insert a link
+request for the transform, or should it create an incomplete node?
+
+@subsection[#:tag "complex-transforms-return-type-conclusion"]{Conclusion}
+
+With this approach, we can write the graph creation macro with the guaranty
+that the result of a transform always is exactly one node type. More complex
+transform result types can be decomposed into to two passes.
+
+A downside is that we can't inspect the result of a call to another transform,
+since it's not actually calling it, and we're only getting an opaque link
+request back. We couldn't call the other transform anyway, because it could half
+of the time return a value immediately, and half of the time call us back (with
+the same arguments), causing an infinite loop. For that, we could declare some
+#:helper transforms, that get called immediately (but if they run into an
+infinite loop it's not our fault).
+
+@section{Comparison with @racket[make-placeholder] and
+ @racket[make-reader-graph]}
+
+Comparison of this approach with @tc[make-placeholder] and
+@tc[make-reader-graph]:
+
+@itemlist[
+ @item{They don't guarantee at compile-time that you'll fill in all
+  placeholders. We could use @racket[make-placeholder] and
+  @racket[make-reader-graph] wrapped inside a macro that makes sure that all
+  placeholders are filled (same approach as we have).}
+ @item{I don't think you can iterate over all the nodes or over the nodes of a
+  specific type, and @racket[make-placeholder] isn't typed (yet) anyway I
+  guess).}]
+
+@section{Constructor}
+
+Here is an overview of the architecture of the graph constructor:
+
+@itemlist[
+ @item{We first save the parameter types in the old context, because we later
+  shadow the node names, and the parameters should refer to the old types.
+  Depending on how we write the rest, this might not be necessary though, since
+  it is possible we need to write @racket[(og node)] to refer to nodes types
+  from the old graph @racket[og].}
+ @item{We then define the node names as constructors for incomplete types —
+  which means that they can contain link requests for the results other
+  transforms}
+ @item{We define data structures representing link requests. Each link request
+  encapsulates a thunk that performs the transform's work when called, as well
+  as the name of the transform and its arguments, used to detect when we have
+  two identical link requests (which can be due to cycles in the resulting
+  graph, for example).}
+ @item{We then define the transforms as procedures that return a link request.}]
+
+@chunk[<make-graph-constructor>
+       (define-syntax/parse
+         (make-graph-constructor ([node (field:id field-type:expr) ...] ...)
+                                 [transform:id (param:id param-type:expr) ...
+                                  (~literal :) result-type:id
+                                  body ...]
+                                 ...)
+         <stx-transform/link-request>
+         <stx-make-graph-database>
+         <stx-node/incomplete>
+         <stx-param-type/old>
+         <stx-transform/result-node/extract-link-requests>
+         <stx-transform/link-request→incomplete>
+         #`(let ()
+              <param-type/old>
+              (let ()
+                <define-incomplete-types>
+                <define-make-link-requests>
+                <transform/link-request→incomplete>
+                <define-transforms>
+                <make-graph-database>
+                make-graph-database)))]
+
+@chunk[<test-make-graph-constructor>
+       (define make-g (make-graph-constructor
+                       ([ma (fav String) (faa ma) (fab mb)]
+                        [mb (fbv String) (fba ma)])
+                       [transform-a (s String) : ma
+                        (ma s
+                            (transform-a s)
+                            (transform-b "b"))]
+                       [transform-b (s String) : mb
+                        (mb s
+                            (transform-a s))]))
+       (make-g "root-arg")]
+
+@subsection{Saving parameter types in old context}
+
+@chunk[<stx-param-type/old>
+       (define/with-syntax ((param-type/old ...) ...)
+         (stx-map (λ (ps)
+                    (with-syntax ([(t sps ...) ps])
+                      (format-temp-ids "~a/~a/memorized-type" #'t #'(sps ...))))
+                  #'((transform param ...) ...)))]
+
+@chunk[<param-type/old>
+       (define-type param-type/old param-type)
+       ...
+       ...]
+
+@subsection{Incomplete nodes}
+
+When a transform returns an object, it is incomplete (it potentially contains
+link requests instead of actual references to the nodes).
+
+We prepare some template variables. The first is the name of the tagged variant
+representing an incomplete node:
+
+@chunk[<stx-node/incomplete>
+       (define/with-syntax (node/incomplete ...)
+         (format-temp-ids "~a/incomplete" #'(node ...)))]
+
+Then, we build a reverse map, which from a node type obtains all the transforms
+returning that node type. More specifically, we are interested in the
+transform's link request type.
+
+@chunk[<stx-node/incomplete>
+       (define/with-syntax ((node/link-request-types ...) ...)
+         (for/list ([x (in-syntax #'(node ...))])
+           (multiassoc-syntax x
+                              #'([result-type . transform/link-request] ...))))]
+
+The third template variable we define maps transforms to the incomplete type for
+their returned node.
+
+@chunk[<stx-node/incomplete>
+       (define/with-syntax (transform/result-node/incomplete ...)
+         (for/list ([x (in-syntax #'(result-type ...))])
+           (assoc-syntax x #'([node . node/incomplete] ...))))]
+
+@CHUNK[<define-incomplete-types>
+       (define-type node (U node/link-request-types ...)
+         #:omit-define-syntaxes)
+       ...
+       (define-tagged node/incomplete [field field-type] ...)
+       ...
+       (define-multi-id node
+         #:match-expander-id node/incomplete
+         #:call-id node/incomplete)
+       ...]
+
+@subsection{Link requests for nodes}
+
+When a transform wants to produce a reference to the result of another transform
+of some data, it generates instead a link request, which encapsulates the
+desired transform and arguments, without actually performing it.
+
+@chunk[<stx-transform/link-request>
+       (define/with-syntax (transform/link-request ...)
+         (format-temp-ids "~a/link-request" #'(transform ...)))]
+
+Due to an issue with @tc[typed/racket] (@tc[struct]s aren't properly declared
+inside a @tc[let]), we need to pre-declare the @tc[transform/link-request]
+@tc[struct]. Since the call to make-graph could itself be inside a @tc[let], we
+need to pre-declare it in this file, instead of declaring it at the top of the
+macro.
+
+We're making the structure transparent for easier debugging, but at the time of
+writing this, it needs not be.
+
+@chunk[<pre-declare-transform/link-request>
+       (struct (TKey)
+         transform/link-request-pre-declared
+         ([key : TKey])
+         #:transparent)]
+
+@chunk[<define-make-link-requests>
+       (define-type transform/link-request
+         (transform/link-request-pre-declared
+          (List 'transform
+                param-type/old ...)))
+       ...]
+
+@subsection{Transforms}
+
+@chunk[<stx-transform/link-request→incomplete>
+       (define/with-syntax (transform/link-request→incomplete ...)
+         (format-temp-ids "~a/link-request→incomplete" #'(transform ...)))]
+
+@chunk[<transform/link-request→incomplete>
+       (begin
+         (: transform/link-request→incomplete
+            (→ param-type/old ... transform/result-node/incomplete))
+         (define (transform/link-request→incomplete param ...)
+           body ...))
+       ...]
+
+@chunk[<define-transforms>
+       (begin
+         (: transform
+            (→ param-type/old ...  transform/link-request))
+         (define (transform param ...)
+           ((inst transform/link-request-pre-declared
+                  (List 'transform
+                        param-type/old ...))
+            (list 'transform param ...))))
+       ...]
+
+@section{Queue}
+
+@chunk[<stx-make-graph-database>
+       (define/with-syntax (root-transform . _) #'(transform ...))
+       (define/with-syntax ((root-transform/param-type ...) . _)
+         #'((param-type ...) ...))
+       (define/with-syntax ((root-transform/param ...) . _)
+         #'((param ...) ...))
+       (define/with-syntax (transform/transformed ...)
+         (format-temp-ids "~a/transformed" #'(transform ...)))
+       (define/with-syntax (root-transform/link-request . _)
+         #'(transform/link-request ...))
+       (define/with-syntax recursive-call
+         #'(process-queue pending-requests
+                          processed-requests
+                          transform/transformed ...))
+       (define/with-syntax (node/extract-link-requests ...)
+         (format-temp-ids "~a/extract-link-requests" #'(node ...)))
+       <fold-type-clauses>
+       <fold-type-stx>
+       <stx-extract-link-requests>]
+
+To build the graph database, we take the parameters for the root transform, and
+return lists incomplete nodes (one for each transform).
+
+The parameters for the root transform, addition to the transform's name, form
+the first link request. To fulfil this link request and the ones found later,
+we call the desired transform which returns an incomplete node. We extract any
+link requests found in that incomplete node, and queue them. The incomplete node
+itself is added to the appropriate list, to be returned once the queue has been
+fully processed.
+
+@CHUNK[<make-graph-database>
+       (: make-graph-database
+          (→ root-transform/param-type ...
+             (List (Listof transform/result-node/incomplete) ...)))]
+
+The @tc[make-graph-database] function consists mainly in the process-queue
+function, which takes a queue for each transform, and a list of
+already-processed incomplete nodes for each transform, and returns these lists,
+once all queues are empty.
+
+@CHUNK[<make-graph-database>
+       (define (make-graph-database root-transform/param ...)
+         (: process-queue (→ (Setof (U transform/link-request ...))
+                             (Setof (U transform/link-request ...))
+                             (Listof transform/result-node/incomplete)
+                             ...
+                             (List (Listof transform/result-node/incomplete)
+                                   ...)))
+         (define (process-queue pending-requests
+                                processed-requests
+                                transform/transformed
+                                ...)
+           <define-extract-link-requests> ;; TODO: Can probably be moved out.
+           <process-queue-body>)
+         
+         <process-queue-initial-call>)]
+
+The @tc[process-queue] function is initially called with empty lists for all
+queues and all result lists, except for the root transform's queue, which
+contains the initial link request.
+
+@CHUNK[<process-queue-initial-call>
+       (process-queue (set (root-transform root-transform/param ...))
+                      (set)
+                      (begin 'transform/transformed '())
+                      ...)]
+
+Process-queue is a standard queue handler using sets.
+
+@CHUNK[<process-queue-body>
+       (if (set-empty? pending-requests)
+           (list transform/transformed ...)
+           (let* ([request (set-first pending-requests)]
+                  [pending-requests (set-rest pending-requests)]
+                  [processed-requests (set-add processed-requests request)]
+                  [tag (car (transform/link-request-pre-declared-key request))])
+             <process-queue-body-tags>))]
+
+To process each link request, we first match on its type, and once we found it,
+we call the result thunk, extract any link requests contained within, and add
+those to the queue.
+
+@CHUNK[<process-queue-body-tags>
+       (cond
+         [(eq? tag 'transform)
+          (let* ([transformed
+                  : transform/result-node/incomplete
+                  (apply transform/link-request→incomplete
+                         (cdr (transform/link-request-pre-declared-key request)))]
+                 [transform/transformed
+                  (cons transformed transform/transformed)]
+                 [extracted
+                  (list->set
+                   (transform/result-node/extract-link-requests transformed))]
+                 [pending-requests
+                  (set-union pending-requests
+                             (set-subtract extracted processed-requests))])
+            recursive-call)]
+         ...)]
+
+@subsection{TODO}
+
+We need to traverse the @tc[transformed] node (which is an incomplete node),
+and find the link requests within. These link requests will be added to the
+corresponding @tc[pending-requests] queue. Below is the body of a for-syntax
+function that transforms a type with link-requests into the @tc[match] patterns
+that will be used at run-time to traverse the incomplete node. In most cases,
+there is only one pattern, but the @tc[U] requires one for each possibility.
+
+When we encounter a link request, we prepend it to the corresponding queue.
+For the type @tc[(List Number n/link-request)], the function will look like
+this:
+
+@chunk[<fold-type-match-example>
+       (match transformed
+         [(list a b)
+          (match a [a2 a2])
+          (match b [(and t
+                         (transform/link-request-pre-declared
+                          (cons 'transform1 _)))
+                    (set! pending-requests
+                          (cons t pending-requests))])])]
+
+@subsubsection{Match clauses}
+
+We first transform the type into the different match clauses. For that, we
+define the @tc[fold-type-clauses] function, which takes the identifier to
+destructure at run-time, and its type. The function returns a list of clauses.
+
+@chunk[<fold-type-clauses>
+       (define (fold-type-clauses val t)
+         (syntax-parse t
+           <fold-type-clauses-body>))]
+
+When a link request is found in the type, we produce the corresponding match
+clause, which body prepends the request to the queue of pending requests. For
+now we use @racket[set!] to prepend the request, but it would be cleaner to use
+recursion. We wouldn't even need to flatten the pending-requests list, because
+it could be a tree instead of a flat list, since we only need to add to it and
+later pop elements.
+
+TODO: we currently ignore potential hiding of identifiers due to type variables
+bound by Rec, for example. This is a case where having a fold-type function
+provided by the type-expander library would be interesting.
+
+@CHUNK[<fold-type-clauses-body>
+       [x:id
+        #:when (ormap (curry free-identifier=? #'x)
+                      (syntax->list #'(node/incomplete ...)))
+        (define/with-syntax (this-field-type ...)
+          (assoc-syntax #'x #'((node/incomplete field-type ...) ...)))
+        
+        (define/with-syntax (tmp ...)
+          (generate-temporaries #'(this-field-type ...)))
+        #`([(x tmp ...)
+            (append #,@(stx-map fold-type
+                                #'(tmp ...)
+                                #'(this-field-type ...)))])]]
+
+@CHUNK[<fold-type-clauses-body>
+       [x:id
+        #:when (ormap (curry free-identifier=? #'x)
+                      (syntax->list #'(node ...)))
+        #`([(and t (transform/link-request-pre-declared (cons 'transform _)))
+            (cons (ann t transform/link-request) '())]
+           ...)]]
+
+We handle fixed-length lists by calling @tc[fold-type] on each element type.
+
+@CHUNK[<fold-type-clauses-body>
+       [((~literal List) a ...)
+        (define/with-syntax (tmp ...) (generate-temporaries #'(a ...)))
+        #`([(list tmp ...)
+            (append #,@(stx-map fold-type #'(tmp ...) #'(a ...)))])]]
+
+We iterate variable-length lists at run-time.
+
+@CHUNK[<fold-type-clauses-body>
+       [((~literal Listof) a)
+        #`([(list tmp (... ...))
+            (append-map (λ (tmp1) #,(fold-type #'tmp1 #'a))
+                        tmp)])]]
+
+Pairs and vectors are handled similarly:
+
+@CHUNK[<fold-type-clauses-body>
+       [((~literal Pairof) a b)
+        #`([(cons tmpa tmpb)
+            (list #,(fold-type #'tmpa #'a)
+                  #,(fold-type #'tmpb #'b))])]]
+
+@CHUNK[<fold-type-clauses-body>
+       [((~literal Vectorof) a)
+        #'([(vector tmp (... ...))
+            (append-map (λ (tmp1) #,(fold-type #'tmp1 #'a))
+                        tmp)])]]
+
+For unions, we return several clauses, obtained via a recursive call to
+@tc[fold-type-clauses].
+
+@CHUNK[<fold-type-clauses-body>
+       [((~literal U) a ...)
+        #`(#,@(stx-map fold-type-clauses val #'(a ...)))]]
+
+We handle other cases by leaving them as-is, but we still check that they don't
+contain a reference to a node type, because we would otherwise leave the
+link-request there.
+
+And the fourth maps transforms to the link-requests extraction procedure for
+their returned node.
+
+@chunk[<stx-transform/result-node/extract-link-requests>
+       (define/with-syntax (transform/result-node/extract-link-requests ...)
+         (for/list ([x (in-syntax #'(result-type ...))])
+           (assoc-syntax x #'([node . node/extract-link-requests] ...))))]
+
+The last case is when we encounter an unknown type. We assume that it does not
+contain any link-requests and therefore return an empty list.
+
+@CHUNK[<fold-type-clauses-body>
+       [x:id
+        #`([_ '()])]]
+
+@subsubsection{Folding the type: extracting link requests}
+
+The for-syntax function @tc[fold-type] generates code that uses @tc[match] to
+extract the @tc[link-request]s from an incomplete node (or part of it) with type
+@tc[t]. The match clauses are those returned by @tc[fold-type-clauses] defined
+above.
+
+@CHUNK[<fold-type-stx>
+       (define (fold-type val t)
+         #`(begin
+             (match #,val #,@(fold-type-clauses val t))))]
+
+@subsubsection{Fold function for each incomplete node}
+
+For each node type, we wish to declare a function that extracts link requests
+from the incomplete type. We should work on the expanded type.
+
+@chunk[<stx-extract-link-requests>
+       (define-template-metafunction (fold-type-tmpl stx)
+         (syntax-case stx () [(_ val t) (fold-type #'val #'t)]))]
+@CHUNK[<define-extract-link-requests>
+       #,@(for/list ([name (in-syntax #'(node/extract-link-requests ...))]
+                     [val-type (in-syntax #'(node/incomplete ...))]
+                     [field-types (in-syntax #'((field-type ...) ...))])
+            #`(define (#,name [val : #,val-type])
+                : (Listof (U transform/link-request ...))
+                #,(fold-type #'val val-type)))]
+
+@subsubsection{TODO}
+
+Later, we will replace link requests with thunks returning the desired node,
+wrapped in a promise in order to please occurrence typing. Below is the body of
+the for-syntax function that transforms a type with link-requests into a type
+with actual nodes. It's probably not useful, because we obtain the same result
+with scopes.
+
+@CHUNK[<fold-type-cases>
+       [x:id
+        #:when
+        (ormap (curry free-identifier=? #'x)
+               (syntax->list #'(node/link-request ...)))
+        #`(Promise (→ #,(assoc-syntax #'x #'((node/link-request . node) ...))))]
+       [((~literal List) a ...) #`(List #,@(stx-map fold-type #'(a ...)))]
+       [((~literal Listof) a) #`(Listof #,@(stx-map fold-type #'(a ...)))]
+       [((~literal Pairof) a b) #`(Pairof #,(fold-type #'a) #,(fold-type #'b))]
+       [((~literal Vectorof) a) #'(Vectorof #,(fold-type #'a))]
+       [((~literal U) a ...) #'(U #,(stx-map fold-type #'(a ...)))]]
+
+@section{@racket[incomplete] type-expander}
+
+We define a @tc[type-expander] @tc[(incomplete n)] that returns the incomplete
+node type for the node type @tc[n]. This type-expander allows the user to refer
+to the incomplete type of the node in the body of a transform, if annotations
+are needed for a value containing such a node.
+
+@chunk[<outermost-incomplete>
+       (define-type-expander (incomplete stx)
+         (syntax-case stx ()
+           [(_ n)
+            (raise-syntax-error
+             'incomplete
+             (format "Type doesn't have an incomplete counterpart: ~a"
+                     (syntax->datum #'n))
+             #'n)]))]
+
+@chunk[<save-outer-incomplete>
+       (define-type-expander (outer-incomplete stx)
+         (syntax-case stx () [(_ n) #'(incomplete n)]))]
+
+@chunk[<incomplete>
+       (let ()
+         <save-outer-incomplete>
+         (let ()
+           (define-type node
+             (tagged node [field (Promise field-type)] ...))
+           ...
+           
+           (define-type node/incomplete
+             ;; TODO: substitute link-requests here
+             (tagged node [field (Promise field-type)] ...))
+           
+           (define-type-expander (incomplete stx)
+             (syntax-parse stx ()
+               [(_ (~litral node))  #'node/incomplete]
+               [_ #'(outer-incomplete n)]))
+           <body>))]
+
+@section{Transforming @racket[incomplete] nodes into complete ones}
+
+@subsection{Initial version}
+
+We will start with a very simple traversal function, that will just substitute
+link requests immediately in the fields of a node.
+
+@chunk[<substitute-link-requests>
+       (define (substitute-link-requests v)
+         (match v
+           [(node/incomplete field ...)
+            (node <link-request→promise> ...)]
+           ...))]
+
+@chunk[<link-request→promise>
+       (match field
+         [(transform/link-request key _) (transform/key→promise key)] ;; TODO
+         ...)]
+
+@chunk[<transform/key→promise>
+       ]
+
+@subsection{More complex attempt}
+
+We know for sure that all references to future nodes are actually incomplete
+ones, but we have no guarantee about the contents of the fields of a node. Since
+they may contain a mix of link requests and primitives (via a @tc[U] type for
+example), and may contain lists of nodes etc. we need to traverse them at
+run-time, in order to find and replace references to link requests.
+
+However, if we were to write this as a simple recursive function, we wouldn't be
+able to express its type without knowing anything about the node's type:
+
+@chunk[<attempt-at-typing-traverse>
+       (case→ (→ node/link-request node) ...
+              (→ (Pairof may-contain-link-request
+                         may-contain-link-request)
+                 (Pairof doesnt-contain-link-request
+                         doesnt-contain-link-request)))]
+
+Writing the @tc[may-contain-link-request] and @tc[doesnt-contain-link-request]
+as functions, while expressing the contraint that the output is the same type as
+the input — except for the link requests that turned into nodes, would be
+impossible in typed/racket. I suppose that with GADTs one could write such a
+type.
+
+Instead, we will, during macro-expansion, traverse the type, and generate
+conversion procedures accordingly.
+
+@chunk[<fold-type-cases2>
+       [(~literal node/link-request) #''link-request]
+       ...
+       [((~literal List) a ...) #'(List #,@(stx-map fold-type #'(a ...)))]
+       [((~literal Listof) a) #''Listof]
+       [((~literal Pairof) a) #''Pairof]
+       [((~literal Vectorof) a) #''Vectorof]
+       [((~literal U) a ...) #''U]]
+
+@chunk[<traverse-list-type>
+       (→ (List a ...) (List replaced-a ...))]
+
+@chunk[<traverse-list-code>
+       [(list? v) (map traverse-list v)]
+       [(pair? v) (cons (traverse-list (car v))
+                        (traverse-list (cdr v)))]
+       [(vector? v) ]]
+
+@subsection{Unions}
+
+Unions are difficult to handle: At one extreme, we confuse two different types
+like @tc[(Listof Number)] and @tc[(Listof String)], by using just the @tc[list?]
+predicate. On the other end of the spectrum, we try to distinguish them with
+@tc[typed/racket]'s @tc[make-predicate], which doesn't work in all cases.
+
+Handling this in the best way possible is out of the scope of this project, so
+we will just add special cases as-needed.
+
+@subsection{Unhandled}
+
+We currently don't handle structure types, prefab structures, hash tables,
+syntax objects and lots of other types.
+
+On the other hand, we can't handle fixed-length @tc[(Vector ...)] types, because
+occurrence typing currently can't track which case we are in when we check the
+length with @tc[(vector-length constant)]. We also can't handle functions, for
+hopefully obvious reasons.
+
+@; TODO: insert a link to the type-expander document in the paragraph below.
+
+We run into a problem though with types declared via define-type without
+informing the type-expander. The type-expander handles these by expanding just
+their arguments, and leaving the type untouched, but we can't ignore them in our
+case.
+
+For all these other cases, we'll just check that they don't contain any
+reference to a link-request type.
+
+@chunk[<fold-type-cases2>
+       [other
+        (fold-check-no-link-requests #'other)
+        #'other]]
+
+The checker below is approximate, and is just meant to catch the error as soon
+as possible, and we include a fall-back case for anything we couldn't handle
+properly. If we let a link-request slip, it should be caught by the type
+checker, unless it is absorbed by a larger type, like in
+@tc[(U Any link-request)], in which case it doesn't matter.
+
+@chunk[<fold-check-no-link-requests>
+       (define (fold-check-no-link-requests stx)
+         (syntax-parse stx
+           [(~and whole (~or (~literal node/link-request) ...))
+            (raise-syntax-error
+             'graph
+             "Found a link request buried somewhere I can't access"
+             whole)]
+           [(~and whole (t ...))
+            (stx-map fold-check-no-link-requests #'(t ...))]
+           [whole whole]))]
+
+@section{TODO}
+
+@chunk[<multiassoc-syntax>
+       (define (multiassoc-syntax query alist)
+         (map stx-cdr
+              (filter (λ (xy) (free-identifier=? query (stx-car xy)))
+                      (syntax->list alist))))
+       (define (assoc-syntax query alist)
+         (let ([res (assoc query (map syntax-e (syntax->list alist))
+                           free-identifier=?)])
+           (unless res (raise-syntax-error '? (format "Can't find ~a in ~a"
+                                                      query
+                                                      alist)))
+           (cdr res)))]
+
+@CHUNK[<old-make-graph-database>
+       ;; The actual traversal code:
+       ;; TODO: write a tail-recursive version, it's cleaner than using set!.
+       (: make-graph-database
+          (→ root-transform.param.type ...
+             (case→ (→ 'node.name (Listof (Pairof Any node.incomplete)))
+                    ...)))
+       (define (make-graph-database root-transform.param.name ...)
+         (let ([pending : (Listof (U node.link-request ...))
+                (list (cons (list 'root-transform.name
+                                  root-transform.param.name ...)
+                            (λ () (root-transform.function
+                                   root-transform.param.name ...))))]
+               [all-transformed : (Listof (Pairof Symbol Any)) '()]
+               ;; the key is actually the second element in a
+               ;; link-request-???, but should be just a number like in
+               ;; the C# version.
+               [node.transformed : (Listof (Pairof Any node.incomplete)) '()]
+               ...)
+           (do : (case→ (→ 'node.name (Listof (Pairof Any node.incomplete)))
+                        ...)
+             ()
+             [(null? pending)
+              (ann (λ (selector)
+                     (cond [(eq? selector 'node.name) node.transformed] ...))
+                   (case→ (→ 'node.name (Listof (Pairof Any node.incomplete)))
+                          ...))]
+             (let ((request (car pending)))
+               ;; Must be immediately after the (let (...), because we cons to
+               ;; that list in the block below.
+               (set! pending (cdr pending))
+               ;; Skip already-transformed link requests. TODO: map a number
+               ;; for each.
+               (unless (member (car request) all-transformed)
+                 ;; Call the lambda-part of the request.
+                 (let ([transformed ((cdr request))])
+                   (cond
+                     [(eq? (car transformed) 'node.name)
+                      (set! pending
+                            (list* ((cdr transformed)
+                                    'node/field-filter-out-primitives/name)
+                                   ...
+                                   pending))
+                      (set! all-transformed (cons (car request)
+                                                  all-transformed))
+                      (set! node.transformed
+                            (cons (cons (car request) (cdr transformed))
+                                  node.transformed))]
+                     ...
+                     ;; Make sure all cases are treated, at compile-time.
+                     [else (typecheck-fail #'#,stx
+                                           "incomplete coverage")])))))))]
+
+@section{Tests}
+
+@chunk[<test-graph>
+       (values)]
+
+@section{Conclusion}
+
+@chunk[<*>
+       (begin
+         (module main typed/racket
+           (require (for-syntax racket/sequence
+                                ;; in-syntax on older versions
+                                ;;;unstable/sequence
+                                syntax/parse
+                                syntax/parse/experimental/template
+                                racket/syntax
+                                racket/function
+                                syntax/stx
+                                racket/pretty
+                                "../lib/low-untyped.rkt"
+                                "../lib/untyped.rkt")
+                    (prefix-in DEBUG-tr: typed/racket)
+                    syntax/parse
+                    "../lib/low.rkt"
+                    "structure.lp2.rkt"
+                    "variant.lp2.rkt"
+                    "../type-expander/multi-id.lp2.rkt"
+                    "../type-expander/type-expander.lp2.rkt")
+           (provide make-graph-constructor
+                    #|graph|#)
+           
+           (begin-for-syntax
+             <multiassoc-syntax>)
+           <pre-declare-transform/link-request>
+           
+           <make-graph-constructor>
+           
+           #|<graph>|#)
+         
+         (require 'main)
+         (provide (all-from-out 'main))
+         
+         (module* test typed/racket
+           (require (submod "..")
+                    "../type-expander/type-expander.lp2.rkt"
+                    "../lib/test-framework.rkt")
+           
+           ;; Debug
+           <pre-declare-transform/link-request>
+           (require syntax/parse
+                    "../lib/low.rkt"
+                    "structure.lp2.rkt"
+                    "variant.lp2.rkt"
+                    "../type-expander/multi-id.lp2.rkt"
+                    "../type-expander/type-expander.lp2.rkt")
+           ;;
+           
+           <test-graph>
+           <test-make-graph-constructor>
+           
+           (require (submod ".." doc))))]

graph/graph/list-lang.rkt

@@ -0,0 +1,16 @@
+#lang racket
+
+(require typed/racket);(only-meta-in 0 typed/racket))
+
+(provide (except-out (all-from-out typed/racket)
+                     #%module-begin)
+         (rename-out [module-begin #%module-begin]))
+
+(require (for-syntax syntax/parse))
+
+(define-syntax (module-begin stx)
+  (syntax-parse stx
+    [(_ forms ... ((~literal define-list-values) name rest ...) values ...)
+     #'(#%module-begin (define-for-syntax name '(values ...))
+                       (define name rest ... '(values ...))
+                       forms ...)]))

graph/graph/remember.rkt

@@ -0,0 +1,40 @@
+#lang s-exp "list-lang.rkt"
+
+(provide all-remembered-list all-remembered-alist)
+
+;; For older versions:
+#|
+(require/typed unstable/list
+               [(group-by group-by-untyped)
+                (∀ (A B) (->* [(→ A B) (Listof A)]
+                              [(→ B B Any)]
+                              (Listof (Listof A))))])
+
+;; Circumvent problem with contracts: with the imported untyped version,
+;; two identical keys are never equal?. I think this is because  the keys are
+;; wrapped with contracts when they are passed to equal?, and therefore are not
+;; equal?, because we're comparing two distinct contract wrappers, instead of
+;; comparing their contents.
+(: group-by (∀ (A B) (->* [(→ A B) (Listof A)]
+                          [(→ B B Any)]
+                          (Listof (Listof A)))))
+(define (group-by key lst [same? equal?])
+  (group-by-untyped key lst (λ ([x : B] [y : B]) (same? x y))))
+|#
+
+(define all-remembered-alist
+  (map (λ ([g : (Listof (Pairof Symbol Any))]) : (Pairof Symbol (Listof Any))
+         (cons (caar g) (remove-duplicates (map (inst cdr Symbol Any) g))))
+       (group-by (inst car Symbol Any) all-remembered-list)))
+
+(define-list-values all-remembered-list : (Listof (Pairof Symbol Any)))
+(structure a b c)
+(structure a b c d)
+(structure a b c y)
+(structure a b)
+(structure x y z)
+(structure)
+(structure f g)
+(structure faa fab fav)
+(structure fba fbv)
+(structure fav)

graph/graph/structure.lp2.rkt

@@ -0,0 +1,499 @@
+#lang scribble/lp2
+@(require "../lib/doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Implementation of structures}
+
+@(table-of-contents)
+
+@section{@racket[define-structure]}
+
+Structures are represented using regular racket @tc[struct]s, see
+@seclink["structures" #:doc "type-system.scrbl"]{the overview document}.
+@;secref["structures" #:doc "type-system.scrbl"].
+
+@chunk[<structure>
+       (define-multi-id structure
+         #:type-expander structure-type-expander
+         #:match-expander structure-match-expander
+         #:call (λ/syntax-parse (_ [field value] ...)
+                  #'((make-structure-constructor field ...) value ...)))]
+
+@chunk[<define-structure>
+       (define-syntax (define-structure stx)
+         (syntax-parse stx
+           [(_ name [field type] ...)
+            (define/with-syntax ([sorted-field sorted-type] ...)
+              (sort-car-fields #'([field type] ...)))
+            (define/with-syntax (pat ...) (generate-temporaries #'(field ...)))
+            #'(define-multi-id name
+                #:type-expand-once
+                (structure [field type] ...)
+                #:match-expander
+                (λ (stx2)
+                  (syntax-case stx2 ()
+                    [(_ pat ...) #'(structure [field pat] ...)]))
+                #:else
+                (inst (make-structure-constructor field ...) type ...))]))]
+
+
+@chunk[<test-define-structure>
+       (define-structure st [a Number] [b String])
+       (define-structure st2 [b String] [a Number])]
+
+Test constructor:
+
+@chunk[<test-define-structure>
+       (check-equal:? (get (st 1 "b") b) : String "b")
+       (check-equal:? (get (st2 "a" 2) b) : String "a")]
+
+Test constructor, as id:
+
+@chunk[<test-define-structure>
+       (check-equal:? (get (cadr (map st '(1 2 3) '("x" "y" "z"))) b)
+                      : String "y")
+       (check-equal:? (get (cadr (map st2 '("d" "e" "f") '(1 2 3))) b)
+                      : String "e")]
+
+Test the type-expander:
+
+@chunk[<test-define-structure>
+       (check-equal? (get (ann (st2 "g" 123) st2) b) "g")]
+
+Test the match-expander:
+
+@chunk[<test-define-structure>
+       (check-equal:? (match (st2 "h" 7) [(st x y) (cons x y)])
+                      : (Pairof Number String)
+                      '(7 . "h"))]
+
+Test equality:
+
+@chunk[<test-define-structure>
+       (check-equal? (ann (st 1 "i") st) (st 1 "i"))
+       (check-equal? (ann (st2 "j" 2) st2) (st2 "j" 2))
+       (check-equal? (ann (st 1 "k") st) (st2 "k" 1))]
+
+@section{Pre-declaring structs}
+
+We wish to pre-declare all @tc[struct] types for various reasons:
+
+@itemlist[
+ @item{Anonymous, on-the-fly declaration (otherwise we need to be in a
+  definition-context to be able to declare a @racket[struct]).}
+ @item{If we use @code{(get-field s b)} in module @code{A}, and define a
+  @racket[struct] type with a field @code{b} in module @code{B}, then the module
+  @code{A} would have to require @code{B}, and we could easily run into cyclic
+  dependencies.
+  
+  Moving the @racket[struct] definition to another place solves that problem.}]
+
+In order to pre-declare the @tc[struct]s, we need to remember them across
+compilations, for that we use @tc[remember-all] and @tc[get-remembered] defined
+below in section @secref{remember}. We then need to make these identifiers
+available in the correct syntax scope. The easiest way to do that, is to have a
+private macro @tc[(declare-all-structs (name field ...) ...)] which does all the
+required definitions, namely defining the struct, as well as @tc[make-struct],
+@tc[get-field], and the match-expander eventually.
+
+We do not wish to remember the type of each field, as they may be a non-exported
+identifier from some module. It should not cause any problem when declaring the
+parameter type @tc[(U g1 g2 …)] for a compiler pass, because by then, we should
+have access to all the types we care about, and fill the rest with @tc[∀] types.
+
+@chunk[<check-remember-fields>
+       (define-for-syntax (check-remember-fields fields)
+         (check-remember-all 'structure (sort-fields fields)))]
+
+Since get-field is a macro, it should not care about the type of the field(s),
+and the code it expands to should be a @tc[cond] which only tests the field part
+of the structure.
+
+@CHUNK[<declare-all-structs>
+       (define-syntax/parse (declare-all-structs fields→stx-name-alist:id
+                                                 (name field ...) ...)
+         #'(begin
+             <struct-declarations>
+             
+             (define-for-syntax fields→stx-name-alist
+               (map (λ (x) (cons (map syntax->datum
+                                      (syntax->list (stx-cdr x)))
+                                 (stx-car x)))
+                    (syntax->list #'((name field ...) ...))))))]
+
+This macro should be called only once, and given as parameters the whole
+remembered list of structs:
+
+@CHUNK[<declare-all-structs>
+       (define-syntax/parse (call-declare-all-structs fields→stx-name-alist:id)
+         #`(declare-all-structs fields→stx-name-alist
+                                #,@named-sorted-structures))
+       
+       (call-declare-all-structs fields→stx-name-alist)]
+
+This list of structures associates their collection of fields with an arbitrary
+name. The fields are sorted lexicographically and duplicate entries are removed,
+so that @tc[(structure a b)] and @tc[(structure b a)] are equivalent, and only
+one low-level @tc[struct] is generated for them.
+
+@CHUNK[<named-sorted-structures>
+       (define-for-syntax named-sorted-structures
+         (for/list ([s (remove-duplicates (map (λ (s) (sort s symbol<?))
+                                               (get-remembered 'structure)))]
+                    [i (in-naturals)])
+           `(,(string->symbol (format "struct-~a" i)) . ,s)))]
+
+We will also need utility functions to sort the fields when querying this
+associative list.
+
+@chunk[<sort-car-fields>
+       (define-for-syntax (sort-car-fields car-fields)
+         (sort (syntax->list car-fields)
+               symbol<?
+               #:key (∘ syntax-e stx-car)))]
+
+@chunk[<sort-fields>
+       (define-for-syntax (sort-fields fields)
+         (sort (syntax->list fields)
+               symbol<?
+               #:key syntax-e))]
+
+@subsection{Type}
+
+The struct declarations are rather standard. We use @tc[#:transparent], so that
+@tc[equal?] compares instances memberwise.
+
+@; TODO: write “field : Tfield”, it's cleaner.
+@CHUNK[<struct-declarations>
+       (struct (field ...) name ([field : field] ...) #:transparent)
+       ...]
+
+@section{Constructor}
+
+We provide a macro which returns an anonymous @tc[structure] constructor. It can
+be used to make @tc[structure] instances like this:
+
+@chunk[<test-make-structure-constructor>
+       (check-equal? (begin ((make-structure-constructor a b c) 1 "b" #t)
+                            #t)
+                     #t)]
+
+To create such an instance, we use the underlying @tc[struct]'s constructor.
+First, we need to check if the list of fields was already remembered, in which
+case we return the associated @tc[struct] name. Otherwise, we trigger an error,
+knowing that the list of fields has been remembered, so the next compilation
+should succeed.
+
+@CHUNK[<make-structure-constructor>
+       (define-syntax/parse (make-structure-constructor field ...)
+         (if (check-remember-fields #'(field ...))
+             (let ()
+               (define/with-syntax (sorted-field ...)
+                 (sort-fields #'(field ...)))
+               (define/with-syntax (TTemp ...)
+                 (generate-temporaries #'(field ...)))
+               #`(λ #:∀ (TTemp ...) ([field : TTemp] ...)
+                   (#,(fields→stx-name #'(field ...)) sorted-field ...)))
+             (remember-all-errors #'list stx #'(field ...))))]
+
+To get the structure name from the list of fields, we need to sort
+lexicographically the list of fields during lookup in
+@tc[fields→stx-name-alist].
+The fields in @tc[fields→stx-name-alist] are already sorted.
+
+@chunk[<fields→stx-name>
+       (define-for-syntax (fields→stx-name fields)
+         (cdr (assoc (syntax->datum (datum->syntax #f (sort-fields fields)))
+                     fields→stx-name-alist)))]
+
+@subsection{Accessor}
+
+@CHUNK[<get-field2>
+       (define-syntax/parse (get v field:id)
+         (define structs (filter (λ (s)
+                                   (member (syntax->datum #'field) (car s)))
+                                 fields→stx-name-alist))
+         (define/with-syntax (name? ...)
+           (map (λ (s) <get-predicate>) structs))
+         (define/with-syntax (name-field ...)
+           (map (λ (s) <get-field-accessor>) structs))
+         #`(let ([v-cache v])
+             (cond
+               [(name? v-cache)
+                (let ([accessor name-field])
+                  (accessor v-cache))]; cover does not see the call otherwise?
+               ...
+               [else (typecheck-fail #,stx #:covered-id v-cache)])))]
+
+@chunk[<get-predicate>
+       (my-st-type-info-predicate (get-struct-info stx (cdr s)))]
+
+@CHUNK[<get-field-accessor>
+       (list-ref (my-st-type-info-accessors (get-struct-info stx (cdr s)))
+                 (indexof (syntax->datum #'field) (reverse (car s))))]
+
+@chunk[<test-get-field>
+       (check-equal:?
+        (get ((make-structure-constructor a b c d) 1 "b" 'value-c 4) c)
+        : 'value-c
+        'value-c)]
+
+@subsection{Match-expander}
+
+@chunk[<syntax-class-for-match>
+       (begin-for-syntax
+         (define-syntax-class match-field-or-field-pat
+           (pattern [field:id pat ...])
+           (pattern field:id #:with (pat ...) #'())))]
+
+@chunk[<match-expander>
+       <syntax-class-for-match>
+       (define-for-syntax (structure-match-expander stx)
+         (syntax-parse stx
+           [(_ :match-field-or-field-pat ...)
+            (if (check-remember-fields #'(field ...))
+                (let ()
+                  (define/with-syntax name (fields→stx-name #'(field ...)))
+                  (define/with-syntax ([sorted-field sorted-pat ...] ...)
+                    (sort-car-fields #'((field pat ...) ...)))
+                  #'(name (and sorted-field sorted-pat ...) ...))
+                <match-expander-remember-error>)]))]
+
+If we just return @racket[(remember-all-errors list stx #'(field ...))] when a
+recompilation is needed, then the identifier @tc[delayed-error-please-recompile]
+becomes a variable bound by @tc[match], and may proceed without triggering any
+error, if the body of the clause works without that part of the pattern (either
+it does not use the variables defined within, or they were shadowing other
+variables).
+
+Therefore, we use that unbound identifier in a way for it to be read (to trigger
+the error), but not bound to part of a pattern. Furthermore, in case the
+sub-patterns in @tc[(pat ...)] contain themselves structs that have not yet been
+remembered, we use them (without caring about what they match), so that they are
+expanded, and get a chance to remember what they need for the next compilation,
+instead of needing an extra recompilation.
+
+@CHUNK[<match-expander-remember-error>
+       #`(app #,(remember-all-errors #'list stx #'(field ...))
+              (and pat ...) ...)]
+
+@chunk[<test-match-expander>
+       (let ([test-match 
+              (λ ([val : Any])
+                (match val
+                  [(structure a b c y) (list a b c y)]
+                  [(structure d
+                              [a (? number?)]
+                              [c (? symbol?) 'value-c]
+                              [b bb (? string?)])
+                   (list a bb c d)]
+                  [else 'other]))])
+         (check-equal? (test-match
+                        ((make-structure-constructor a b c d) 1 "b" 'value-c 4))
+                       '(1 "b" value-c 4))
+         (check-equal? (test-match
+                        ((make-structure-constructor a b c y) 1 2 3 4))
+                       '(1 2 3 4))
+         (check-equal? (test-match 'bad) 'other))]
+
+@subsection{Anonymous type}
+
+@subsection{Accessing information about racket's structs at compile-time}
+@chunk[<my-st-type-info>
+       (begin-for-syntax
+         (struct my-st-type-info
+           (type-descriptor
+            constructor
+            predicate
+            accessors
+            mutators
+            super-type)
+           #:transparent))]
+
+@CHUNK[<struct-info>
+       (define-for-syntax (get-struct-info stx s)
+         (let* ([fail (λ () (raise-syntax-error 'get-struct-info
+                                                "not a structure definition"
+                                                stx
+                                                s))]
+                [v (if (identifier? s)
+                       (syntax-local-value s fail)
+                       (fail))]
+                [i (if (not (struct-info? v)) (fail) (extract-struct-info v))])
+           (apply my-st-type-info i)))]
+
+@subsection{Type-expander}
+
+@CHUNK[<type-expander>
+       (define-for-syntax (structure-type-expander stx)
+         (syntax-parse stx
+           [(_ [field type] ...)
+            (if (check-remember-fields #'(field ...))
+                (let ()
+                  (define/with-syntax ([sorted-field sorted-type] ...)
+                    (sort-car-fields #'((field type) ...)))
+                  (if (null? (syntax->list #'(sorted-type ...)))
+                      (fields→stx-name #'(field ...))
+                      #`(#,(fields→stx-name #'(field ...)) sorted-type ...)))
+                (remember-all-errors #'U stx #'(field ...)))]))]
+
+@chunk[<test-type-expander>
+       (check-equal? (get (ann ((make-structure-constructor a b c) 1 "b" #t)
+                               (structure [a Number] [c Boolean] [b String]))
+                          b)
+                     "b")]
+
+@section[#:tag "remember"]{Closed-world assumption and global compilation}
+
+In order to be able to access elements in the list as deep as they can be, we
+need to know the length of the longest structure used in the whole program. 
+
+Knowing what structures exist and what elements they contain can only help, so
+we'll remember that instead.
+
+The @tc[remember-all] for-syntax function below memorizes its arguments across
+compilations, and adds them to the file “@code{remember.rkt}”:
+
+@CHUNK[<remember-all>
+       (require (for-syntax "remember.rkt"))
+       
+       (define-for-syntax (check-remember-all category value)
+         (let ([datum-value (syntax->datum (datum->syntax #f value))])
+           (if (not (member (cons category datum-value) all-remembered-list))
+               (let ((file-name (build-path (this-expression-source-directory)
+                                            "remember.rkt")))
+                 ;; Add the missing field names to all-fields.rkt
+                 (with-output-file [port file-name] #:exists 'append
+                                   (writeln (cons category datum-value) port))
+                 #f)
+               #t)))
+       
+       (define-for-syntax (remember-all-errors id fallback stx-list)
+         ;<remember-all-hard-error>
+         #`(#,id #,(for/list ([cause `(,@(syntax->list stx-list) ,fallback)])
+                     (syntax/loc cause delayed-error-please-recompile))))]
+
+@CHUNK[<remember-all-hard-error>
+       (raise-syntax-error
+        (car (syntax->datum stx))
+        (format "The fields ~a were added to ~a. Please recompile now."
+                (string-join (map symbol->string missing) ", ")
+                file-name)
+        #f
+        #f
+        (filter (λ (f) (not (member (syntax->datum f) all-fields)))
+                (syntax->list fields)))]
+
+We can, during subsequent compilations, retrieve the list of already-memorized
+fields for a given tag.
+
+@CHUNK[<get-remembered>
+       (define-for-syntax (get-remembered category)
+         (cdr (or (assoc category all-remembered-alist) '(_))))]
+
+If we start with an empty “@code{remember.rkt}” file, it will throw an error at
+each call with a not-yet-remembered value. In order to avoid that, we use the
+macro @tc[(delayed-error-please-recompile)], which expands to an undefined
+identifier @code{please-recompile}. That error is caught later, and gives a
+chance to more calls to @tc[remember-all] to be executed during macro-expansion.
+We define @tc[delayed-error-please-recompile] in a submodule, to minimize the
+chances that we could write a definition for that identifier.
+
+@CHUNK[<delayed-error-please-recompile>
+       (begin-for-syntax
+         (module m-please-recompile typed/racket
+           (define-syntax (delayed-error-please-recompile stx)
+             #'please-recompile)
+           (provide delayed-error-please-recompile))
+         
+         (require 'm-please-recompile))]
+
+@section{Conclusion}
+
+@chunk[<*>
+       (begin
+         (module main typed/racket
+           (require (for-syntax racket
+                                racket/syntax
+                                syntax/parse
+                                mzlib/etc
+                                racket/struct-info
+                                syntax/stx
+                                racket/sequence
+                                ;; in-syntax on older versions:
+                                ;;;unstable/sequence
+                                "../lib/low-untyped.rkt")
+                    "../lib/low.rkt"
+                    "../type-expander/type-expander.lp2.rkt"
+                    "../type-expander/multi-id.lp2.rkt")
+           (provide define-structure
+                    make-structure-constructor
+                    get
+                    structure)
+           
+           <remember-all>
+           <get-remembered>
+           <check-remember-fields>
+           
+           <named-sorted-structures>
+           <sort-car-fields>
+           <sort-fields>
+           <declare-all-structs>
+           <fields→stx-name>
+           <make-structure-constructor>
+           <delayed-error-please-recompile>
+           
+           <my-st-type-info>
+           <struct-info>
+           <get-field2>
+           ;<get-field>
+           
+           <match-expander>
+           <type-expander>
+           
+           <structure>
+           <define-structure>)
+         
+         (require 'main)
+         (provide (all-from-out 'main))
+         
+         (module* test typed/racket
+           (require (submod "..")
+                    "../lib/low.rkt"
+                    "../type-expander/type-expander.lp2.rkt"
+                    typed/rackunit)
+           
+           <test-make-structure-constructor>
+           <test-get-field>
+           <test-match-expander>
+           <test-type-expander>
+           <test-define-structure>
+           
+           (require (submod ".." doc))))]
+
+@section{Optimizing access to fields}
+
+We can represent the structuress as lists of key/value pairs. Then, if we know
+the field @tc[b] can be at indices 3, 5 and 8 (for exeample), then we can access
+it in 3, 5 or 8 steps, depending on the value's structure type, because we have
+to traverse the list elements until we reach its value. In the worst case, the
+access can be done in @${O(\mathit{max\_index\_for\_b})}, but on average it
+should be less because of the fields with low indices.
+
+We can also represent the structures using racket's structs, this is the method
+chosen above. Then, to access the field @tc[b], we need to use the @tc[sᵢ-b]
+field, where @tc[sᵢ] is the struct type of the value. To know that type, we need
+to test the value's type against all the struct types, which costs
+@${O(\left\vert{}S\right\vert)} then the access via @tc[sᵢ-b] can be done in
+@${O(1)}.
+
+A possible optimization would be to add an extra @tc[type-tag] field to all
+structs, via a base struct @tc[(struct (T) Base ([type-tag : T]))]. Then, the
+child structs would be defined so:
+
+@chunk[<optimized-child-struct>
+       (struct (T) Child-Struct Base ([g : String]))
+       (define-type Child (Child-Struct Child-Tag))]
+
+The tag can be constructed so that a value's struct type can be known in
+@${O(\log{} \left\vert{}S\right\vert)}.

graph/graph/type-system.scrbl

@@ -0,0 +1,107 @@
+#lang scribble/lp2
+@(require "../lib/doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Overview of the implementation choices for structures, graphs and passes}
+
+@;(table-of-contents)
+
+@section[#:tag "structures"]{Structures}
+
+@;(+ 1 2 3) gives @(format "~a" (+ 1 2 3)).
+
+@;@(require racket/string racket/list)
+@;@(string-join (map (λ (x) (format "~a bottles of beer on the wall, take one down and pass it around, ~a bottles of beer on the wall" x (- x 1)))
+@;                   (reverse (range 1 99)))
+@;              "\n")
+
+Structures are represented as lists of key/value pairs.
+@note{We need lists and can't use vectors (or hash tables) because the latter are mutable in @code|{typed/racket}|,
+ and the typing system has no guarantee that accessing the same element twice will yield the same value (so occurence typing can't narrow the type in branches of conditionnals).}
+@note{Actually, we can use structs (they are immutable by default, and the occurrence typing knows that). There are two problems with them:
+ we can't have subtyping (although knowing all the structs used in the program means we can just filter them and use a @code{(U S1 S2 …)},
+ and to declare the structs, we would need to be in a define-like environment (therefore making anonymous structure types problematic), although since we know all the structs in advance, we can pre-declare them in a shared file.}
+
+@chunk[<example-simple-structure>
+       (define-type abc (List (Pairof 'a Number)
+                              (Pairof 'b String)
+                              (Pairof 'c (U 'x 'y))))
+       
+       (: make-abc (→ Number String (U 'x 'y) abc))
+       (define (make-abc a b c)
+         (list (cons 'a a) (cons 'b b) (cons 'c c)))
+       (make-abc 1 "b" 'x)]
+
+Occurrence typing works:
+
+@chunk[<example-simple-structure-occurrence>
+       (: f (→ abc (U 'x #f)))
+       (define (f v)
+         (if (eq? 'x (cdr (cddr v)))
+             (cdr (cddr v))
+             #f))]
+
+@section{Passes, subtyping and tests}
+
+
+Below is the definition of a function which works on @tc[(structure [a Number] [b String] [c Boolean])], and returns the same structure extended with a field @tc[[d Number]],
+but only cares about fields @tc[a] and @tc[c], so tests don't need to provide a value for @tc[b].
+
+@chunk[<example-pass-which-extends-input>
+       (: pass-calc-d (∀ (TB) (→ (List (Pairof 'a Number)
+                                       (Pairof 'b TB)
+                                       (Pairof 'c Boolean))
+                                 (List (Pairof 'a Number)
+                                       (Pairof 'b TB)
+                                       (Pairof 'c Boolean)
+                                       (Pairof 'd Number)))))
+       (define (pass-calc-d v)
+         (list (car v) ; a
+               (cadr v) ; b
+               (caddr v) ; c
+               (cons 'd (+ (cdar v) (if (cdaddr v) 0 1)))))]
+
+The example above can be called to test it with a dummy value for @tc[b]:
+
+@chunk[<example-pass-which-extends-input>
+       (pass-calc-d '((a . 1) (b . no-field) (c . #t)))]
+
+But when called with a propper value for @tc[b], we get back the original string as expected, and the type is correct:
+
+@chunk[<example-pass-which-extends-input>
+       (ann (pass-calc-d '((a . 1) (b . "some string") (c . #t)))
+            (List (Pairof 'a Number)
+                  (Pairof 'b String)
+                  (Pairof 'c Boolean)
+                  (Pairof 'd Number)))]
+
+If the pass should be able to work on multiple graph types (with more or less info), then it should be easy to mark it as a @tc[case→] function.
+It's probably better to avoid too permissive subtyping, otherwise, imagine we have a pass which removes @tc[Addition]s and @tc[Substraction]s from an AST,
+and replaces them with a single @tc[Arithmetic] node type. If we have full duck typing, we could call it with @tc[Addition]s and @tc[Substraction] hidden in fields
+it does not know about, and so it would fail to replace them. Also, it could be called with an already-processed AST which already contains just @tc[Arithmetic] node types,
+which would be a bug most likely. Therefore, explicitly specifying the graph type on which the passes work seems a good practice. Some parts
+can be collapsed easily into a @tc[∀] type @tc[T], when we're sure there shouldn't be anything that interests us there.
+
+@section{Graphs}
+
+In order to be able to have cycles, while preserving the benefits of occurrence typing, we need to make sure that from the type system's point of view, accessing a successor node twice will return the same value each time.
+
+The easiest way is to wrap the to-be-created value inside a @tc[Promise]. Occurrence typing works on those:
+
+@chunk[<test-promise-occurence-typing>
+       (: test-promise-occurence (→ (Promise (U 'a 'b)) (U 'a #f)))
+       (define (test-promise-occurence p)
+         (if (eq? (force p) 'a)
+             (force p)
+             #f))]
+
+@section{Conclusion}
+
+@chunk[<*>
+       (module main typed/racket
+         <example-simple-structure>
+         <example-simple-structure-occurrence>
+         
+         <example-pass-which-extends-input>
+         
+         <test-promise-occurence-typing>)]

graph/graph/variant.lp2.rkt

@@ -0,0 +1,255 @@
+#lang scribble/lp2
+@(require "../lib/doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Variants}
+
+@(table-of-contents)
+
+@section{Introduction}
+
+We define variants (tagged unions), with the following constraints:
+
+@itemlist[
+ @item{Unions are anonymous: two different unions can contain the same tag, and
+  there's no way to distinguish these two occurrences of the tag}
+ @item{The tag can be followed by zero or more “fields”}
+ @item{An instance of a variant only @racket[match]es with its constructor and
+  the same number of fields}]
+
+See @url{https://github.com/andmkent/datatype/} for an existing module providing
+Algebraic Data Types.
+
+@section{@racket[constructor]}
+
+We define the variant as a @tc[list], with the tag symbol in the first element.
+We can't use a @tc[vector], because these are mutable in @tc[typed/racket], and
+occurrence typing can't work properly on mutable data structures (yet).
+
+@chunk[<constructor>
+       (define-multi-id constructor
+         #:type-expander <type-expander>
+         #:match-expander <match-expander>
+         #:call <make-instance>)]
+
+@chunk[<test-constructor>
+       (check-equal? (ann (constructor a 1 "x")
+                          (constructor a Number String))
+                     (list 'a 1 "x"))
+       (check-equal? (ann (constructor b)
+                          (constructor b))
+                     (list 'b))
+       (check-equal? (ann (constructor c 2 "y")
+                          (constructor c Number String))
+                     (constructor c 2 "y"))
+       (check-not-equal? (constructor d 2 "y")
+                         (constructor d 2 "y" 'z))
+       (check-not-equal? (constructor e 2 "y")
+                         (constructor F 2 "y"))]
+
+@subsection{Type-expander}
+
+@chunk[<type-expander>
+       (λ/syntax-parse (_ tag:id type:expr ...)
+         #'(List 'tag type ...))]
+
+@subsection{Match-expander}
+
+@chunk[<match-expander>
+       (λ/syntax-parse (_ tag:id pat:expr ...)
+         #'(list 'tag pat ...))]
+
+@subsection{Actual constructor}
+
+@chunk[<make-instance>
+       (λ/syntax-parse (_ tag:id value:expr ...)
+         (define/with-syntax (arg ...) (generate-temporaries #'(value ...)))
+         (define/with-syntax (T ...) (generate-temporaries #'(value ...)))
+         #'((λ #:∀ (T ...) ([arg : T] ...) : (List 'tag T ...)
+              (list 'tag arg ...))
+            value ...))]
+
+@section{@racket[define-variant]}
+
+In @tc[define-variant], we only define the type (which is the union of all the
+possible constructors. We don't define the constructors, for two reasons: the
+same @tc[constructor]s could appear in several variants, so we would define them
+twice, and it is likely that a constructor will have the same identifier as an
+existing variable or function.
+
+@chunk[<define-variant>
+       (define-syntax/parse (define-variant name [tag:id type:expr ...] ...)
+         #'(define-type name (U (constructor tag type ...) ...)))]
+
+@chunk[<test-define-variant>
+       (define-variant v1 [x Number String] [y String Number] [z Number String])
+       (check-equal? (ann (constructor x 1 "a")
+                          (U [constructor w Number String]
+                             [constructor x Number String]
+                             [constructor y String Number]))
+                     (constructor x 1 "a"))
+       (check-equal? (constructor x 1 "a")
+                     (constructor x 1 "a"))
+       (check-equal? (ann (constructor x 1 "a") v1)
+                     (constructor x 1 "a"))
+       (check-equal? (ann (constructor x 1 "a") v1)
+                     (ann (constructor x 1 "a") v1))
+       (check-not-equal? (ann (constructor x 2 "b") v1)
+                         (ann (constructor y "b" 2) v1))
+       (check-not-equal? (ann (constructor x 3 "c") v1)
+                         (ann (constructor z 3 "c") v1))]
+
+This makes pattern-matching more verbose, though, since we have to specify
+@tc[(variant tag pat ...)] each time, instead of just @tc[(tag pat ...)]. I
+don't really know how to solve that. It should be noted that constructors are
+likely to have names starting with a capital letter, so maybe this reduces the
+number of name collisions.
+
+@section{@racket{tagged}}
+
+@CHUNK[<tagged>
+       (define-multi-id tagged
+         #:type-expander
+         (λ/syntax-parse (_ tag:id . structure-type)
+           #`(constructor tag #,(syntax/loc #'structure-type
+                                  (structure . structure-type))))
+         #:match-expander
+         (λ/syntax-parse (_ tag:id . structure-pat)
+           #`(constructor tag #,(syntax/loc #'structure-pat
+                                  (structure . structure-pat))))
+         #:call
+         (λ/syntax-parse (_ tag:id . structure-field-value)
+           #`(constructor tag #,(syntax/loc #'structure-field-value
+                                  (structure . structure-field-value)))))]
+
+@chunk[<test-tagged>
+       (check-equal? (match (ann (tagged foo [x "o"] [y 3] [z 'z])
+                                 (tagged foo
+                                         [x String]
+                                         [z 'z]
+                                         [y Fixnum]))
+                       [(tagged foo z x y) (list z y x)])
+                     '(z 3 "o"))]
+
+@section{@racket{define-tagged}}
+
+@chunk[<define-tagged>
+       (define-syntax/parse (define-tagged tag:id [field type] ...
+                              (~optional #:type-noexpand))
+         (define/with-syntax (pat ...) (generate-temporaries #'(field ...)))
+         (define/with-syntax (value ...) (generate-temporaries #'(field ...)))
+         #'(define-multi-id tag
+             #:type-expand-once
+             (tagged tag [field type] ...)
+             #:match-expander
+             (λ/syntax-parse (_ pat ...)
+               #'(tagged tag [field pat] ...))
+             #:call
+             (λ/syntax-parse (_ value ...)
+               #'(tagged tag [field value] ...))))]
+
+@chunk[<test-define-tagged>
+       (define-tagged tagged-s1)
+       (define-tagged tagged-s2 [f Fixnum] [g String])
+       (define-tagged tagged-s3 [g String] [f Fixnum])
+       (define-tagged tagged-s4 [f Fixnum] [g String])
+       
+       (check-equal? (match (ann (tagged-s1) (tagged tagged-s1))
+                       [(tagged-s1) #t])
+                     #t)
+       
+       (check-equal? (match (ann (tagged-s2 99 "z") tagged-s2)
+                       [(tagged-s2 f g) (cons g f)])
+                     '("z" . 99))
+       
+       (let ()
+         (check-equal? (match (ann (tagged-s2 99 "in-let") tagged-s2)
+                         [(tagged-s2 f g) (cons g f)])
+                       '("in-let" . 99)))
+       
+       (define (test-match val)
+         (match val
+           [(tagged-s2 x y) (list 'found-s2 y x)]
+           [(tagged-s3 x y) (list 'found-s3 y x)]
+           [(tagged-s4 x y) (list 'found-s4 y x)]))
+       
+       (check-equal?
+        (test-match (ann (tagged-s2 2 "flob")
+                         (tagged tagged-s2 [f Fixnum] [g String])))
+        '(found-s2 "flob" 2))
+       
+       (check-equal?
+        (test-match (ann (tagged-s3 "flob" 2)
+                         (tagged tagged-s3 [g String] [f Fixnum])))
+        '(found-s3 2 "flob"))
+       
+       ;; g and f are inverted in the “ann”
+       (check-equal?
+        (test-match (ann (tagged-s4 2 "flob")
+                         (tagged tagged-s4 [g String] [f Fixnum])))
+        '(found-s4 "flob" 2))
+       
+       (define (test-match-verbose val)
+         (match val
+           [(tagged tagged-s2 g [f y]) (list 'found-s2 g y)]
+           [(tagged tagged-s3 [g y] f) (list 'found-s2 f y)]
+           [(tagged tagged-s4 [f y] g) (list 'found-s2 g y)]))
+       
+       (check-equal?
+        (test-match (ann (tagged-s2 3 "flob")
+                         (tagged tagged-s2 [f Fixnum] [g String])))
+        '(found-s2 "flob" 3))
+       
+       ;; g and f are inverted in the “ann”
+       (check-equal?
+        (test-match (ann (tagged-s3 "flob" 3)
+                         (tagged tagged-s3 [f Fixnum] [g String])))
+        '(found-s3 3 "flob"))
+       
+       (check-equal?
+        (test-match (ann (tagged-s4 3 "flob")
+                         (tagged tagged-s4 [f Fixnum] [g String])))
+        '(found-s4 "flob" 3))
+       
+       (check-not-equal? (tagged-s2 4 "flob")
+                         (tagged-s3 "flob" 4))
+       (check-not-equal? (tagged-s2 4 "flob")
+                         (tagged-s4 4 "flob"))]
+
+@section{Conclusion}
+
+@chunk[<*>
+       (begin
+         (module main typed/racket
+           (require (for-syntax syntax/parse
+                                racket/syntax
+                                "../lib/low-untyped.rkt")
+                    "../lib/low.rkt"
+                    "../type-expander/multi-id.lp2.rkt"
+                    "../type-expander/type-expander.lp2.rkt"
+                    "structure.lp2.rkt")
+           (provide constructor
+                    define-variant
+                    tagged
+                    define-tagged)
+           
+           <constructor>
+           <define-variant>
+           <tagged>
+           <define-tagged>)
+         
+         (require 'main)
+         (provide (all-from-out 'main))
+         
+         (module* test typed/racket
+           (require (submod "..")
+                    typed/rackunit
+                    "../lib/low.rkt"
+                    "../type-expander/type-expander.lp2.rkt")
+           
+           <test-constructor>
+           <test-define-variant>
+           <test-tagged>
+           <test-define-tagged>
+           
+           (require (submod ".." doc))))]

graph/lib/doc.rkt

@@ -0,0 +1,132 @@
+#lang racket
+
+;; Math
+(require slideshow/pict)
+(provide (all-from-out slideshow/pict))
+(require "doc/math.rkt")
+(provide (all-from-out "doc/math.rkt"))
+; @setup-math is returned in @doc-lib-setup.
+
+
+
+
+;(require "low-untyped.rkt")
+;(#lang reader "scribble-custom/lp2.rkt" #:lang typed/racket)
+
+;; http://lists.racket-lang.org/users/archive/2015-January/065752.html
+;; http://bugs.racket-lang.org/query/?cmd=view%20audit-trail&database=default&pr=14068
+(require (for-label (only-meta-in 0 typed/racket)))
+(provide (for-label (all-from-out typed/racket)))
+
+;(require scriblib/footnote)
+;(provide (all-from-out scriblib/footnote))
+
+(require (only-in scribble/base [margin-note note]))
+(provide note)
+
+(require (for-syntax mzlib/etc))
+(define-syntax (doc-lib-setup stx)
+  ;(display (build-path (this-expression-source-directory) (this-expression-file-name)))
+  #'setup-math) ;; NOTE: setup-math must be returned, not just called!
+
+(provide doc-lib-setup)
+
+;(require (only-in scribble/manual code))
+;(define-syntax-rule (tc . args)
+;  (code #:lang "typed/racket" . args))
+;(provide tc)
+
+(require (only-in scribble/private/lp chunk CHUNK))
+(provide chunk CHUNK)
+
+
+
+
+
+
+;; Copied from /usr/local/racket-6.2.900.6/share/pkgs/scribble-lib/scribble/private/lp.rkt
+
+(require (for-syntax racket/base syntax/boundmap)
+         scribble/scheme scribble/decode scribble/manual (except-in scribble/struct table))
+
+(begin-for-syntax
+  ;; maps chunk identifiers to a counter, so we can distinguish multiple uses
+  ;; of the same name
+  (define chunk-numbers (make-free-identifier-mapping))
+  (define (get-chunk-number id)
+    (free-identifier-mapping-get chunk-numbers id (lambda () #f)))
+  (define (inc-chunk-number id)
+    (free-identifier-mapping-put! chunk-numbers id (+ 1 (free-identifier-mapping-get chunk-numbers id))))
+  (define (init-chunk-number id)
+    (free-identifier-mapping-put! chunk-numbers id 2)))
+
+(define-syntax-rule (make-chunk chunk-id racketblock)
+  (define-syntax (chunk-id stx)
+    (syntax-case stx ()
+      [(_ name expr (... ...))
+       ;; no need for more error checking, using chunk for the code will do that
+       (identifier? #'name)
+       (let* ([n (get-chunk-number (syntax-local-introduce #'name))]
+              [str (symbol->string (syntax-e #'name))]
+              [tag (format "~a:~a" str (or n 1))])
+         
+         (when n
+           (inc-chunk-number (syntax-local-introduce #'name)))
+         
+         (syntax-local-lift-expression #'(quote-syntax (a-chunk name expr (... ...))))
+         
+         (with-syntax ([tag tag]
+                       [str str]
+                       [((for-label-mod (... ...)) (... ...))
+                        (map (lambda (expr)
+                               (syntax-case expr (require)
+                                 [(require mod (... ...))
+                                  (let loop ([mods (syntax->list #'(mod (... ...)))])
+                                    (cond
+                                      [(null? mods) null]
+                                      [else 
+                                       (syntax-case (car mods) (for-syntax)
+                                         [(for-syntax x (... ...))
+                                          (append (loop (syntax->list #'(x (... ...))))
+                                                  (loop (cdr mods)))]
+                                         [x
+                                          (cons #'x (loop (cdr mods)))])]))]
+                                 [else null]))
+                             (syntax->list #'(expr (... ...))))]
+                       
+                       [(rest (... ...)) (if n
+                                             #`((subscript #,(format "~a" n)))
+                                             #`())])
+           #`(begin
+               (require (for-label for-label-mod (... ...) (... ...)))
+               #,@(if n
+                      #'()
+                      #'((define-syntax name (make-element-id-transformer
+                                              (lambda (stx) #'(chunkref name))))
+                         (begin-for-syntax (init-chunk-number #'name))))
+               ;(make-splice
+               ;(list (make-toc-element
+               ;#f
+               ;(list (elemtag '(chunk tag)
+               ;               (bold (italic (racket name)) " ::=")))
+               ;(list (smaller (elemref '(chunk tag) #:underline? #f
+               ;                        str
+               ;                        rest (... ...)))))
+               (racket expr (... ...)))))]))) ;))
+
+(make-chunk chunk2 racketblock)
+(make-chunk CHUNK2 RACKETBLOCK)
+
+(define-syntax (chunkref stx)
+  (syntax-case stx ()
+    [(_ id)
+     (identifier? #'id)
+     (with-syntax ([tag (format "~a:1" (syntax-e #'id))]
+                   [str (format "~a" (syntax-e #'id))])
+       #'(elemref '(chunk tag) #:underline? #f str))]))
+
+(provide chunk2 CHUNK2)
+
+(provide tc TC)
+(define-syntax-rule (tc . rest) (chunk2 name . rest))
+(define-syntax-rule (TC . rest) (CHUNK2 name . rest))

graph/lib/doc/MathJax

@@ -0,0 +1 @@
+Subproject commit ba9afeb5a743249acdea17540b48b14ebc95dbe4

graph/lib/doc/bracket

@@ -0,0 +1 @@
+Subproject commit bcf8a50895c19d9cd4850184a973deadc6fa6a09

graph/lib/doc/example.lp2.rkt

@@ -0,0 +1,59 @@
+#lang scribble/lp2
+@(require "../doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Implementation of structures}
+
+@;Racket is distributed with implementations of many SRFIs, most of
+@;which can be implemented as libraries. To import the bindings of SRFI
+@;@math{n}, use
+@;
+@;@racketblock[
+@;(require @#,elem{@racketidfont{srfi/}@math{n}})
+@;]
+
+@section{A section}
+
+In section @secref{sec:foo} we present, blah blah.
+
+@subsection[#:tag "sec:foo"]{My subsection}
+
+@$${\frac{2x}{x^2}}
+@(colorize (filled-ellipse 30 15) "blue")
+@; Line comment
+
+Blah @math{n}, as described by M@._ Foo@.__
+@racketblock[
+ (require @#,elem{@racketidfont{srfi/}@math{n}})]
+
+@CHUNK[<foo>
+       (define (foo)
+         (syntax-e #`#,"foo"))]
+
+@(define to-insert 42)
+@chunk[<*>
+       ;(displayln #,to-insert) ;; Should work.
+       (provide foo)
+       <foo>
+
+       (module* test racket
+         (require (submod ".."))
+         (require rackunit)
+         (check-equal? (foo) "foo")
+         
+         (require (submod ".." doc)))]
+
+It would be nice to be able to alter existing chunks, by inserting stuff later,
+for example:
+
+@chunk[<c>
+       (define-syntax-rule (double x)
+         (+ x x))]
+
+But we would actually want:
+
+@chunk[<redef-c>
+       (define-syntax-rule (double x) -- should be greyed out
+         (let ((x-cache x))
+           (+ x-cache x-cache))) -- everything except the changed bits should
+                                 -- be greyed out]

graph/lib/doc/math-scribble

@@ -0,0 +1 @@
+bracket/math-scribble

graph/lib/doc/math.rkt

@@ -0,0 +1,36 @@
+#lang racket
+
+;; This file is derived from the one which can be found at:
+;; https://github.com/soegaard/bracket/blob/master/docs/pr-math.rkt
+
+(require "math-scribble/math-scribble.rkt")
+
+(provide mathjax-source setup-math
+         (all-from-out "math-scribble/math-scribble.rkt"))
+
+(require scribble/html-properties
+         scribble/base
+         scribble/core)
+
+(define mathjax-source
+  "MathJax/MathJax.js?config=default"
+  ;"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML"
+  ; "http://c328740.r40.cf1.rackcdn.com/mathjax/latest/MathJax.js?config=default"
+  ;"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-HTML"
+  )
+
+(define setup-math
+  (compound-paragraph
+   (style #f (list))
+   (list
+    (paragraph 
+     (style 
+      #f (list (alt-tag "script")
+               (attributes `((type . "text/javascript")
+                             (src . ,mathjax-source )))))
+     '())
+    (paragraph
+     (style
+      #f (list (alt-tag "script")
+               (attributes '((type . "text/x-mathjax-config")))))
+     "MathJax.Hub.Config({ tex2jax: {inlineMath: [['$','$']]} });"))))

graph/lib/doc/template.lp2.rkt

@@ -0,0 +1,70 @@
+#lang scribble/lp2
+@(require "../../lib/doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Life, the Universe and Everything.}
+
+@(table-of-contents)
+
+@section{Introduction}
+
+@chunk[<foo>
+       (define foo 42)]
+
+Here is a macro:
+
+@CHUNK[<scribble-macro-expansion>
+       (define-for-syntax mymacro-tmp
+         (syntax-rules () [(_ a b) (let ((b 1)) a)]))
+       (define-syntax (mymacro-stx stx) #`'#,(mymacro-tmp stx))
+       (provide mymacro-stx)
+       (define-syntax mymacro mymacro-tmp)]
+
+We can use it like this:
+
+@chunk[<scribble-macro-expansion-example>
+       (mymacro (+ x 3) x)]
+
+Which expands to (requires a bit of set-up boilerplate to have the output in
+scribble, see
+@url{http://lists.racket-lang.org/users/archive/2014-December/065175.html}):
+@(begin
+   (require syntax/location scribble/eval)
+   (define here (quote-source-file))
+   (define evaluator (make-base-eval #:lang 'typed/racket))
+   (evaluator `(begin
+                 (require (for-syntax racket/base))
+                 (dynamic-require '(file ,here) #f)
+                 (current-namespace
+                  (module->namespace '(file ,here))))))
+
+@interaction[#:eval evaluator
+             (mymacro-stx (+ x 3) x)]
+
+@chunk[<test-foo>
+       (check-equal? foo 42)]
+
+@section{Conclusion}
+
+@chunk[<*>
+       (begin
+         (module main typed/racket
+           (require (for-syntax syntax/parse
+                                racket/syntax
+                                "../../lib/low-untyped.rkt")
+                    "../../lib/low-untyped.rkt")
+           (provide foo)
+           
+           <foo>
+           <scribble-macro-expansion>)
+         
+         (require 'main)
+         (provide (all-from-out 'main))
+         
+         (module* test typed/racket
+           (require (submod "..")
+                    typed/rackunit)
+           
+           <test-foo>
+           
+           (require (submod ".." doc))))]

graph/lib/eval-get-values.rkt

@@ -0,0 +1,11 @@
+#lang typed/racket
+
+(module m racket
+  (provide eval-get-values)
+  
+  (define (eval-get-values expr namespace)
+    (call-with-values (λ () (eval expr namespace)) list)))
+
+(require/typed 'm [eval-get-values (→ Any Namespace (Listof Any))])
+
+(provide eval-get-values)

graph/lib/lib.rkt

@@ -0,0 +1,153 @@
+#lang typed/racket
+
+(require "low.rkt")
+(provide (all-from-out "low.rkt"))
+
+;; Types
+(provide AnyImmutable)
+;; Functions
+(provide ∘ eval-get-values generate-indices)
+;; Macros
+(provide mapp comment)
+
+(require "eval-get-values.rkt")
+
+(define ∘ compose)
+
+(require (for-syntax syntax/parse
+                     racket/syntax))
+
+;; raco pkg install alexis-util
+(require alexis/util/threading)
+
+;; From alexis/util/threading
+(provide ~> ~>> _ (rename-out [_ ♦]))
+
+(define-syntax (comment stx)
+  #'(values))
+
+(define-type AnyImmutable (U Number
+                             Boolean
+                             True
+                             False
+                             String
+                             Keyword
+                             Symbol
+                             Char
+                             Void
+                             ;Input-Port   ;; Not quite mutable, but not really immutable either.
+                             ;Output-Port  ;; Not quite mutable, but not really immutable either.
+                             ;Port         ;; Not quite mutable, but not really immutable either.
+                             #| I haven't checked the mutability of the ones in the #||# comments below
+                             Path
+                             Path-For-Some-System
+                             Regexp 
+                             PRegexp
+                             Byte-Regexp
+                             Byte-PRegexp
+                             Bytes
+                             Namespace
+                             Namespace-Anchor
+                             Variable-Reference
+                             |#
+                             Null
+                             #|
+                             EOF
+                             Continuation-Mark-Set
+                             |#
+                             ; Undefined ;; We definitely don't want that one, it's not mutable but it's an error if present anywhere 99.9% of the time.
+                             #|
+                             Module-Path
+                             Module-Path-Index
+                             Resolved-Module-Path
+                             Compiled-Module-Expression
+                             Compiled-Expression
+                             Internal-Definition-Context
+                             Pretty-Print-Style-Table
+                             Special-Comment
+                             Struct-Type-Property
+                             Impersonator-Property
+                             Read-Table
+                             Bytes-Converter
+                             Parameterization
+                             Custodian
+                             Inspector
+                             Security-Guard
+                             UDP-Socket ;; Probably not
+                             TCP-Listener ;; Probably not
+                             Logger ;; Probably not
+                             Log-Receiver ;; Probably not
+                             Log-Level
+                             Thread
+                             Thread-Group
+                             Subprocess
+                             Place
+                             Place-Channel
+                             Semaphore ;; Probably not
+                             FSemaphore ;; Probably not
+                             Will-Executor
+                             Pseudo-Random-Generator
+                             Path-String
+                             |#
+                             (Pairof AnyImmutable AnyImmutable)
+                             (Listof AnyImmutable)
+                             ; Plus many others, not added yet.
+                             ; -> ; Not closures, because they can contain mutable variables, and we can't eq? them
+                             ; maybe Prefab? Or are they mutable?
+                             ))
+
+(define-syntax (mapp stx)
+  (syntax-parse stx
+    [(_ var:id lst:expr body ...)
+     #'(let ((l lst))
+         (if (null? l)
+             '()
+             (let ((result (list (let ((var (car l)))
+                                   body ...))))
+               (set! l (cdr l))
+               (do ([stop : Boolean #f])
+                 (stop (reverse result))
+                 (if (null? l)
+                     (set! stop #t)
+                     (begin
+                       (set! result
+                             (cons (let ((var (car l)))
+                                     body ...)
+                                   result))
+                       (set! l (cdr l))))))))]))
+
+;; TODO: this does not work, because Null is (Listof Any)
+; (mapp x (cdr '(1)) (* x x))
+
+;; TODO: foldll
+(define-syntax (foldll stx)
+  (syntax-parse stx
+    [(_ var:id acc:id lst:expr init:expr body ...)
+     #'(let ((l lst))
+         (if (null? l)
+             '()
+             (let ((result (list (let ((var (car l)))
+                                   body ...))))
+               (set! l (cdr l))
+               (do ([stop : Boolean #f])
+                 (stop (reverse result))
+                 (if (null? l)
+                     (set! stop #t)
+                     (begin
+                       (set! result
+                             (cons (let ((var (car l)))
+                                     body ...)
+                                   result))
+                       (set! l (cdr l))))))))]))
+(: generate-indices (∀ (T) (case→ (→ Integer (Syntax-Listof T) (Listof Integer))
+                                  (→ (Syntax-Listof T) (Listof Nonnegative-Integer)))))
+(define generate-indices
+  (case-lambda
+    [(start stx)
+     (for/list ([v (my-in-syntax stx)]
+                [i (in-naturals start)])
+       i)]
+    [(stx)
+     (for/list ([v (my-in-syntax stx)]
+                [i : Nonnegative-Integer (ann (in-naturals) (Sequenceof Nonnegative-Integer))])
+       i)]))

graph/lib/low-untyped.rkt

@@ -0,0 +1,16 @@
+#lang typed/racket/no-check
+
+;; When creating the html document with scribble/lp2, it does not see the macros defined in low.rkt when including it with sugar/include.
+;; Using a raw include/reader works.
+
+;(require sugar/include)
+;(include-without-lang-line "low.rkt")
+
+;; typed/racket/no-check does not require (for-syntax racket/base). TODO: file a bug report?
+(require (for-syntax racket/base))
+(include/reader "low.rkt" (λ (source-name in)
+                            (port-count-lines! in)
+                            (do ()
+                              [(let-values ([(line column position) (port-next-location in)]) (> line 1))]
+                              (read-line in))
+                            (read-syntax source-name in)))

graph/lib/low.rkt

@@ -0,0 +1,344 @@
+#lang typed/racket
+
+(provide degub)
+(: degub (∀ (T) (→ T T)))
+(define (degub x) (display "degub:") (displayln x) x)
+
+;; ==== low/require-provide.rkt ====
+(provide require/provide)
+
+(define-syntax (require/provide stx)
+  (syntax-case stx ()
+    [(_ require-spec ...)
+     #'(begin
+         (require require-spec ...)
+         (provide (all-from-out require-spec ...)))]))
+
+(module+ test
+  (require typed/rackunit)
+  (module ma typed/racket
+    (define require-provide-foo 7)
+    (provide require-provide-foo))
+  (module mb typed/racket
+    (require (submod ".." ".."))
+    (require/provide (submod ".." ma)))
+  (require 'mb)
+  (check-equal? require-provide-foo 7))
+
+;; ==== low/define-syntax-parse.rkt ====
+(require syntax/parse
+         syntax/parse/define)
+
+(provide define-syntax/parse
+         λ/syntax-parse)
+
+(begin-for-syntax
+  (require (for-syntax racket/base
+                       racket/stxparam)
+           racket/stxparam)
+  
+  (provide stx)
+  
+  (define-syntax-parameter stx
+    (lambda (stx)
+      (raise-syntax-error (syntax-e stx) "Can only be used in define-syntax/parse"))))
+
+(define-simple-macro (define-syntax/parse (name . args) . body)
+  (define-syntax (name stx2)
+    (syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+                         (syntax-parse stx2
+                           [(_ . args) . body]))))
+
+(define-simple-macro (λ/syntax-parse args . body)
+  (λ (stx2)
+    ;(syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+    (syntax-parse stx2
+      [args . body])));)
+
+;; If you include this as a file, you need to do:
+;(begin-for-syntax (provide stx))
+;; It's not provided by (all-from-out) :-(
+
+;; ==== low/check-type-and-equal.rkt ====
+(require ;"define-syntax-parse.rkt"
+  (for-syntax syntax/parse
+              syntax/parse/experimental/template)
+  typed/rackunit)
+
+(provide check-equal:?)
+
+;; TODO: this won't expand types in the ann.
+
+(define-syntax/parse
+  (check-equal:? actual
+                 (~optional (~seq (~datum :) type))
+                 expected)
+  (template (check-equal? (?? (ann actual type) actual) expected)))
+
+;; ==== low/typed-fixnum.rkt ===
+
+(provide fxxor)
+
+;; For fxxor, used to compute hashes.
+;; The type obtained just by writing (require racket/fixnum) is wrong, so we get a more precise one.
+(require/typed racket/fixnum [(fxxor fxxor2) (→ Fixnum Fixnum Fixnum)])
+
+(: fxxor (→ Fixnum * Fixnum))
+(define (fxxor . args)
+  (foldl fxxor2 0 args))
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (fxxor2 13206 23715) 28469)
+  (check-equal? (fxxor 0) 0)
+  (check-equal? (fxxor 13206) 13206)
+  (check-equal? (fxxor 13206 23715 314576) 304101))
+
+;; ==== Rest ====
+(provide nameof
+         first-value second-value third-value fourth-value fifth-value sixth-value seventh-value eighth-value ninth-value tenth-value
+         (rename-out [compose ∘])
+         stx-list
+         stx-e
+         stx-pair
+         ;string-set!
+         ;string-copy!
+         ;string-fill!
+         with-output-file
+         in-tails
+         in-heads
+         in-split
+         in-split*
+         *in-split
+         my-in-syntax
+         indexof
+         Syntax-Listof
+         check-duplicate-identifiers)
+
+(require (for-syntax syntax/parse syntax/parse/experimental/template))
+
+(define-syntax-rule (nameof x) (begin x 'x))
+
+(module+ test
+  (require typed/rackunit)
+  (let ((y 3))
+    (check-equal? (nameof y) 'y)))
+
+;(define (raise-multi-syntax-error name message exprs)
+;(let ([e (exn:fail:syntax "message" (current-continuation-marks) (list #'aaa #'bbb))])
+;  ((error-display-handler) (exn-message e) e))
+
+(define-syntax-rule (λstx (param ...) body ...)
+  (λ (param ...)
+    (with-syntax ([param param] ...)
+      body ...)))
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (syntax->datum ((λstx (foo bar) #'(foo bar)) #'a #'b))
+                (syntax->datum #'(a b))))
+
+(define-syntax-rule (define-value-getter name v ... last-v)
+  (define-syntax-rule (name expr)
+    (call-with-values (λ () expr) (λ (v ... last-v . rest) last-v))))
+
+(define-value-getter first-value   v1)
+(define-value-getter second-value  v1 v2)
+(define-value-getter third-value   v1 v2 v3)
+(define-value-getter fourth-value  v1 v2 v3 v4)
+(define-value-getter fifth-value   v1 v2 v3 v4 v5)
+(define-value-getter sixth-value   v1 v2 v3 v4 v5 v6)
+(define-value-getter seventh-value v1 v2 v3 v4 v5 v6 v7)
+(define-value-getter eighth-value  v1 v2 v3 v4 v5 v6 v7 v8)
+(define-value-getter ninth-value   v1 v2 v3 v4 v5 v6 v7 v8 v9)
+(define-value-getter tenth-value   v1 v2 v3 v4 v5 v6 v7 v8 v9 v10)
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (first-value   (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 1)
+  (check-equal? (second-value  (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 2)
+  (check-equal? (third-value   (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 3)
+  (check-equal? (fourth-value  (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 4)
+  (check-equal? (fifth-value   (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 5)
+  (check-equal? (sixth-value   (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 6)
+  (check-equal? (seventh-value (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 7)
+  (check-equal? (eighth-value  (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 8)
+  (check-equal? (ninth-value   (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 9)
+  (check-equal? (tenth-value   (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) 10))
+
+(define-match-expander stx-list
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ pat ...)
+       #'(? syntax?
+            (app syntax->list (list pat ...)))])))
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (match #'(1 2 3) [(stx-list a b c) (list (syntax-e c)
+                                                         (syntax-e b)
+                                                         (syntax-e a))])
+                '(3 2 1))
+  #;(check-equal? (match #`(1 . (2 3)) [(stx-list a b c) (list (syntax-e c)
+                                                               (syntax-e b)
+                                                               (syntax-e a))])
+                  '(3 2 1)))
+
+(define-match-expander stx-e
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ pat)
+       #'(? syntax?
+            (app syntax-e pat))])))
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (match #'x [(stx-e s) s]) 'x)
+  (check-equal? (match #'(x . y) [(stx-e (cons a b)) (cons (syntax-e b)
+                                                           (syntax-e a))])
+                '(y . x)))
+
+(define-match-expander stx-pair
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ pat-car pat-cdr)
+       #'(? syntax?
+            (app syntax-e (cons pat-car pat-cdr)))])))
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (match #'(x . y) [(stx-pair a b) (cons (syntax-e b)
+                                                       (syntax-e a))])
+                '(y . x))
+  (check-equal? (match #'(x y z) [(stx-pair a b) (cons (map syntax->datum b)
+                                                       (syntax->datum a))])
+                '((y z) . x)))
+
+(define-syntax (string-set! stx)
+  (raise-syntax-error 'string-set! "Do not mutate strings." stx))
+(define-syntax (string-copy! stx)
+  (raise-syntax-error 'string-copy! "Do not mutate strings." stx))
+(define-syntax (string-fill! stx)
+  (raise-syntax-error 'string-fill! "Do not mutate strings." stx))
+
+#|
+(define-syntax (with-output-file stx)
+  (syntax-parse stx
+    [(_ filename:expr (~optional (~seq #:mode mode:expr)) (~optional (~seq #:exists exists:expr)) body ...)
+     (template (with-output-to-file filename
+                 (λ () body ...)
+                 (?? (?@ #:mode mode))
+                 (?? (?@ #:exists exists))))]))
+|#
+
+(define-syntax (with-output-file stx)
+  (syntax-parse stx
+    [(_ [var:id filename:expr] (~optional (~seq #:mode mode:expr)) (~optional (~seq #:exists exists:expr)) body ...)
+     (template (call-with-output-file filename
+                 (λ (var) body ...)
+                 (?? (?@ #:mode mode))
+                 (?? (?@ #:exists exists))))]))
+
+(: in-tails (∀ (T) (→ (Listof T) (Listof (Pairof T (Listof T))))))
+(define (in-tails l)
+  (if (null? l)
+      '()
+      (cons l (in-tails (cdr l)))))
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (for/list : (Listof (Listof Number))
+                  ([x : (Listof Number) (in-tails '(1 2 3 4 5))]) x)
+                '((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5)))
+  (let ((l '(1 2 3 4 5)))
+    (check-true (eq? (caddr (for/list : (Listof (Listof Number))
+                              ([x : (Listof Number) (in-tails l)]) x))
+                     (cddr l)))))
+
+(: in-heads (∀ (T) (→ (Listof T) (Listof (Pairof T (Listof T))))))
+(define (in-heads l)
+  (: my-append1 (→ (Listof T) T (Pairof T (Listof T))))
+  (define (my-append1 x y)
+    (if (null? x)
+        (list y)
+        (cons (car x) (my-append1 (cdr x) y))))
+  
+  (define (on-heads/private [acc-head : (Listof T)] [l : (Listof T)])
+    : (Listof (Pairof T (Listof T)))
+    (if (null? l)
+        '()
+        (let ([new-head (my-append1 acc-head (car l))])
+          (cons new-head (on-heads/private new-head (cdr l))))))
+  (on-heads/private '() l))
+
+(module+ test
+  (require typed/rackunit)
+  (check-equal? (for/list : (Listof (Listof Number))
+                  ([x : (Listof Number) (in-heads '(1 2 3 4 5))]) x)
+                '((1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5))))
+
+;; Can't write the type of on-split, because typed/racket doesn't allow writing (Sequenceof A B), just (Sequenceof A).
+;; in-parallel's type has access to the multi-valued version of Sequenceof, though, so we let typed/racket propagate the inferred type.
+(define #:∀ (T) (in-split [l : (Listof T)])
+  (in-parallel (sequence-append (in-value '()) (in-heads l))
+               (sequence-append (in-tails l) (in-value '()))))
+
+;; Same as in-split, but without the empty tail.
+(define #:∀ (T) (in-split* [l : (Listof T)])
+  (in-parallel (sequence-append (in-value '()) (in-heads l))
+               (sequence-append (in-tails l))))
+
+;; Same as in-split, but without the empty head.
+(define #:∀ (T) (*in-split [l : (Listof T)])
+  (in-parallel (in-heads l)
+               (sequence-append (sequence-tail (in-tails l) 1) (in-value '()))))
+
+(define #:∀ (T) (*in-split* [l : (Listof T)])
+  (in-parallel (in-heads l)
+               (sequence-tail (in-tails l) 1)))
+
+(: indexof (∀ (A B) (→ A (Listof B) (→ A B Any) (U #f Integer))))
+(define (indexof elt lst [compare equal?])
+  (let rec ([lst lst] [index 0])
+    (if (null? lst)
+        #f
+        (if (compare elt (car lst))
+            index
+            (rec (cdr lst) (+ index 1))))))
+
+;; See also syntax-e, which does not flatten syntax pairs, and syntax->list, which isn't correctly typed (won't take #'(a . (b c d e))).
+(define-type (Syntax-Listof T)
+  (Rec R (Syntaxof (U Null
+                      (Pairof T R)
+                      (Listof T)))))
+
+;; in-syntax is now provided by racket/sequence.
+(: my-in-syntax (∀ (T) (→ (Syntax-Listof T)
+                          (Listof T))))
+(define (my-in-syntax stx)
+  (let ((e (syntax-e stx)))
+    (if (null? e)
+        e
+        (if (syntax? (cdr e))
+            (cons (car e) (my-in-syntax (cdr e)))
+            e))))
+
+(define (test-in-syntax)
+  (my-in-syntax #'((a . b) (c . d))) ; (ann `(,#'(a . b) ,#'(c . d)) (Listof (Syntaxof (U (Pairof (Syntaxof 'a) (Syntaxof 'b)) (Pairof (Syntaxof 'c) (Syntaxof 'c))))))
+  (my-in-syntax #'(a . (b c d e)))   ; (ann `(,#'a ,#'b ,#'c ,#'d ,#'e) (Listof (Syntaxof (U 'a 'b 'c 'd))))
+  (my-in-syntax #'()))               ; (ann '() (Listof (Syntaxof Nothing)))
+
+
+(: check-duplicate-identifiers (→ (Syntaxof (Listof (Syntaxof Symbol)))
+                                  Boolean))
+(define (check-duplicate-identifiers ids)
+  (if (check-duplicate-identifier (my-in-syntax ids)) #t #f))
+
+(require syntax/parse/define)
+(provide define-simple-macro)
+
+(require racket/match)
+(provide (all-from-out racket/match)
+         (rename-out [match-lambda match-λ]
+                     [match-lambda* match-λ*]
+                     [match-lambda** match-λ**]))

graph/lib/path.rkt

@@ -0,0 +1,15 @@
+#lang typed/racket
+;(require mzlib/etc)
+;(this-expression-file-name)
+
+(provide define-to-this-file-name)
+
+(define-syntax (define-to-this-file-name stx)
+  (syntax-case stx ()
+    [(_ name)
+     #`(begin (define name #,(syntax-source #'dummy))
+              (define-for-syntax name #,(syntax-source #'dummy)))]))
+
+;(define-syntax (get-current-file stx)
+;  #`(format "Macro in ~a, Use in ~a" structure.rkt-path #,(syntax-source stx)))
+

graph/lib/syntax/quasitemplate.rkt

@@ -0,0 +1,85 @@
+#lang racket
+
+(require syntax/parse/experimental/template
+         (for-syntax syntax/parse
+                     racket/syntax))
+
+(provide quasitemplate
+         (all-from-out syntax/parse/experimental/template))
+
+;; subst-quasitemplate returns a stx-pair, with definitions for
+;; with-syntax in the stx-car, and a template in the stx-cdr.
+;; The template is either of the form ('eh-tmpl . tmpl), in which case it is an
+;; ellipsis-head template, or of the form ('tmpl . tmpl), in which case it is
+;; a regular template.
+
+;; Appending the stx-car from the two branches at each recursion step is
+;; extremely inefficient (in the worst case O(n²)), so while gathering them, we
+;; store them as a binary tree, and then we flatten it with flatten-defs.
+
+;; Note that quasitemplate can still take O(n²) time, because of ellipsis-head
+;; templates which are not handled very efficiently.
+
+(define-for-syntax (flatten-defs stx acc)
+  (syntax-parse stx
+    [(l r) (flatten-defs #'r (flatten-defs #'l acc))]
+    [() acc]
+    [(def) #`(def . #,acc)]))
+
+;; There are two cases for the transformation of #,@(expr):
+;; If it is in a car position, we write:
+;;   (with-syntax ([(tmp ...) expr]) (tmp ... . the-cdr))
+;; If it is in a cdr position, we write:
+;;   (with-syntax ([tmp expr]) (the-car . tmp))
+(define-for-syntax (subst-quasitemplate car? stx)
+  (syntax-parse stx #:literals (unsyntax unsyntax-splicing)
+    [(unsyntax expr)
+     (with-syntax ([tmp (gensym)])
+       #`(([tmp expr]) . #,(if car? #'{tmp} #'tmp)))]
+    [(unsyntax-splicing expr)
+     (with-syntax ([tmp (gensym)])
+       (if car?
+           #'(... (([(tmp ...) expr]) . {tmp ...}))
+           #'(([tmp expr]) . tmp)))]
+    [((unsyntax-splicing expr)) ;; In last position in a list
+     (if car?
+         #'(([tmp expr]) . {tmp})
+         #'(([tmp expr]) . tmp))]
+    [(a . b)
+     (with-syntax ([(defs-a sa ...) (subst-quasitemplate #t #'a)]
+                   [(defs-b . sb) (subst-quasitemplate #f #'b)])
+       #`((defs-a defs-b) . #,(if car? #'{(sa ... . sb)} #'(sa ... . sb))))]
+    [x
+     #`(() . #,(if car? #'{x} #'x))]))
+
+(define-syntax (quasitemplate stx)
+  (syntax-parse stx
+    [(_ tmpl)
+     (with-syntax* ([(defs . new-tmpl) (subst-quasitemplate #f #'tmpl)]
+                    [(flattened-defs ...) (flatten-defs #'defs #'())])
+       #'(with-syntax (flattened-defs ...)
+           (template new-tmpl)))]))
+
+(module+ test
+  (require rackunit)
+  (define-syntax-rule (check . tmpl)
+    (check-equal? (syntax->datum (quasitemplate . tmpl))
+                  (syntax->datum (quasisyntax . tmpl))))
+  
+  (check (a #,(+ 1 2)))
+  (check (a #,(+ 1 2) #,(+ 3 4)))
+  (check (a #,@(list 1 2) #,@(list 3 4)))
+  (check (#,@(list 1 2) #,@(list 3 4) . #,(list* 5 6)))
+  (check (a (#,@(list 1 2) #,@(list 3 4) . #,(list* 5 6)) c))
+  (check (a . (#,@(list 1 2) #,@(list 3 4) . #,(list* 5 6))))
+  (check (a (#,@(list 1 2) #,@(list 3 4) . #,(list* 5 6))))
+  
+  (check (#,@(list 1 2) #,@(list 3 4) #,@(list* 5 6)))
+  (check (a (#,@(list 1 2) #,@(list 3 4) #,@(list* 5 6)) c))
+  (check (a . (#,@(list 1 2) #,@(list 3 4) #,@(list* 5 6))))
+  (check (a (#,@(list 1 2) #,@(list 3 4) #,@(list* 5 6))))
+  (check (a #,@1))
+  (check (a (#,@1)))
+  (check (a (#,@1) c))
+  (check ((#,@1) b))
+  (check ((#,@1) b)))

graph/lib/test-framework.rkt

@@ -0,0 +1,44 @@
+#lang typed/racket
+
+;; Using check-equal? on our variants result in the following error message:
+;; Attempted to use a higher-order value passed as `Any` in untyped code
+;; check-equal? and check-not-equal? are replaced by versions that work with “higher-order values” below.
+
+(require (except-in (only-meta-in 0 typed/rackunit) ;; typed/racket risks complaining that it can't do for-meta in all-from-out otherwise.
+                    check-equal?
+                    check-not-equal?))
+
+(provide (all-from-out typed/rackunit)
+         check-equal?
+         check-not-equal?
+         check-eval-equal?
+         check-eval-string-equal?
+         check-eval-string-equal?/ns)
+
+(require "eval-get-values.rkt")
+
+(require syntax/parse/define)
+
+(define-simple-macro (check-equal? x y . message)
+  (check-true (equal? x y) . message))
+
+(define-simple-macro (check-not-equal? x y . message)
+  (check-true (not (equal? x y)) . message))
+
+(define-simple-macro (check-eval-equal? to-eval y . message)
+  (check-true (equal? (eval-get-values to-eval (variable-reference->namespace (#%variable-reference))) y) . message))
+
+(define-simple-macro (check-eval-string-equal? to-eval y . message)
+  (check-true (equal? (eval-get-values (read (open-input-string to-eval)) (variable-reference->namespace (#%variable-reference)))
+                      y)
+              . message))
+
+(define-simple-macro (check-eval-string-equal?/ns ns-anchor to-eval y . message)
+  (check-true (equal? (eval-get-values (read (open-input-string to-eval)) (namespace-anchor->namespace ns-anchor))
+                      y)
+              . message))
+
+(define-syntax-rule (test-module body ...)
+  (module* test typed/racket
+    (require (submod ".."))
+    body ...))

graph/lib/untyped.rkt

@@ -0,0 +1,5 @@
+#lang typed/racket
+
+(require "low-untyped.rkt")
+(require/provide "untyped/for-star-list-star.rkt"
+                 "untyped/ids.rkt")

graph/lib/untyped/for-star-list-star.rkt

@@ -0,0 +1,46 @@
+#lang racket
+
+(provide for*/list*)
+
+(require (for-syntax syntax/parse))
+
+(define-syntax (for*/list* stx)
+  (define-syntax-class sequences
+    #:description "([id seq-expr] ...) or (* [id seq-expr] ...)"
+    (pattern ((~optional (~and star (~datum *))) (id:id seq-expr:expr) ...)
+             #:with for-kind (if (attribute star) #'for*/list #'for/list)))
+  
+  (syntax-parse stx
+    [(_ sequences:sequences ... body)
+     (foldl (λ (for-kind clauses acc)
+              #`(#,for-kind #,clauses #,acc))
+            #'body
+            (reverse (syntax-e #'(sequences.for-kind ...)))
+            (reverse (syntax-e #'(([sequences.id sequences.seq-expr] ...) ...))))]))
+
+;; Test for*/list*
+(module* test racket
+  (require rackunit)
+  (require (submod ".."))
+  (check-equal? (for*/list* ([x '(a b c)]
+                             [y '(1 2 3)])
+                            (* [z '(d e f)]
+                               [t '(4 5 6)])
+                            (list x y z t))
+                '(((a 1 d 4) (a 1 d 5) (a 1 d 6) (a 1 e 4) (a 1 e 5) (a 1 e 6) (a 1 f 4) (a 1 f 5) (a 1 f 6))
+                  ((b 2 d 4) (b 2 d 5) (b 2 d 6) (b 2 e 4) (b 2 e 5) (b 2 e 6) (b 2 f 4) (b 2 f 5) (b 2 f 6))
+                  ((c 3 d 4) (c 3 d 5) (c 3 d 6) (c 3 e 4) (c 3 e 5) (c 3 e 6) (c 3 f 4) (c 3 f 5) (c 3 f 6))))
+  (check-equal? (for*/list* ([x '(a b c)])
+                            ([y '(1 2 3)])
+                            (* [z '(d e f)]
+                               [t '(4 5 6)])
+                            (list x y z t))
+                '((((a 1 d 4) (a 1 d 5) (a 1 d 6) (a 1 e 4) (a 1 e 5) (a 1 e 6) (a 1 f 4) (a 1 f 5) (a 1 f 6))
+                   ((a 2 d 4) (a 2 d 5) (a 2 d 6) (a 2 e 4) (a 2 e 5) (a 2 e 6) (a 2 f 4) (a 2 f 5) (a 2 f 6))
+                   ((a 3 d 4) (a 3 d 5) (a 3 d 6) (a 3 e 4) (a 3 e 5) (a 3 e 6) (a 3 f 4) (a 3 f 5) (a 3 f 6)))
+                  (((b 1 d 4) (b 1 d 5) (b 1 d 6) (b 1 e 4) (b 1 e 5) (b 1 e 6) (b 1 f 4) (b 1 f 5) (b 1 f 6))
+                   ((b 2 d 4) (b 2 d 5) (b 2 d 6) (b 2 e 4) (b 2 e 5) (b 2 e 6) (b 2 f 4) (b 2 f 5) (b 2 f 6))
+                   ((b 3 d 4) (b 3 d 5) (b 3 d 6) (b 3 e 4) (b 3 e 5) (b 3 e 6) (b 3 f 4) (b 3 f 5) (b 3 f 6)))
+                  (((c 1 d 4) (c 1 d 5) (c 1 d 6) (c 1 e 4) (c 1 e 5) (c 1 e 6) (c 1 f 4) (c 1 f 5) (c 1 f 6))
+                   ((c 2 d 4) (c 2 d 5) (c 2 d 6) (c 2 e 4) (c 2 e 5) (c 2 e 6) (c 2 f 4) (c 2 f 5) (c 2 f 6))
+                   ((c 3 d 4) (c 3 d 5) (c 3 d 6) (c 3 e 4) (c 3 e 5) (c 3 e 6) (c 3 f 4) (c 3 f 5) (c 3 f 6))))))

graph/lib/untyped/ids.rkt

@@ -0,0 +1,114 @@
+#lang racket
+
+(provide format-ids
+         hyphen-ids
+         format-temp-ids
+         #|t/gen-temp|#)
+
+(require racket/syntax) ;; Used to bind format-id in macroexpansion below.
+(require racket/sequence) ;; Used to bind in-syntax in macroexpansion below.
+;; Used to bind in-syntax on older versions in macroexpansion below:
+;(require unstable/sequence)
+(require (for-syntax racket/syntax
+                     syntax/parse
+                     racket/string
+                     racket/sequence
+                     ;unstable/sequence ;; in-syntax on older versions
+                     #|syntax/parse/experimental/template|#)
+         syntax/strip-context)
+
+;; Actually, this could be just a regular function:
+;; test (with list?, syntax? and combinations thereof) if we should iterate or
+;; just put the value as-is.
+(begin-for-syntax
+  (define-syntax-class var-expr
+    #:description
+    (string-append "#'identifier or #'(identifier ooo), where ooo is a"
+                   " literal “...”, or #'(identifier ...), or an expression")
+    (pattern (~and whole ((~literal syntax) var:id))
+             #:with code #'(in-value whole))
+    (pattern (~and whole ((~literal syntax) (var:id (~literal ...))))
+             #:with code #'(in-syntax whole))
+    (pattern (~and whole ((~literal syntax) (vars:id ...)))
+             #:with (var . _) #`(vars ... #,(gensym 'empty))
+             #:with code #'(in-syntax whole))
+    (pattern expr:expr
+             #:with var (gensym)
+             #:with code #'(let ((s expr)) (if (string? s) (in-value s) s)))))
+
+;; TODO: infinite loop if we only have constants which ar handled with for-value
+(define-syntax (format-ids stx)
+  (syntax-parse stx
+    [(_ lexical-context:expr format:expr v:var-expr ...)
+     (define/with-syntax (tmp ...) (generate-temporaries #'(v.var ...)))
+     #'(let ([lex-ctx lexical-context])
+         (for/list ([tmp v.code] ...)
+           (format-id (if (procedure? lex-ctx) (lex-ctx tmp ...) lex-ctx)
+                      format
+                      tmp ...)))]))
+
+(define-syntax (hyphen-ids stx)
+  (syntax-parse stx
+    ;; TODO: allow single #'foo instead of (var expr), and use in-value
+    [(_ lexical-context:expr v:var-expr ...)
+     #`(format-ids lexical-context
+                   #,(string-join (for/list ([x (in-syntax #'(v ...))])  "~a")
+                                  "-")
+                   v ...)]))
+
+(define-syntax (format-temp-ids stx)
+  (syntax-parse stx
+    [(_ . rest)
+     ;; Introduce the binding in a fresh scope.
+     #'(format-ids (λ _ ((make-syntax-introducer) #'())) . rest)]))
+
+#|
+(define-template-metafunction (t/gen-temp stx)
+  (syntax-parse stx
+    [(_ . id:id)
+     #:with (temp) (generate-temporaries #'(id))
+     #'temp]
+    [(_ id:id ...)
+     (generate-temporaries #'(id ...))]))
+|#
+
+(module* test racket
+  (require (submod "..")
+           rackunit
+           (for-syntax racket/syntax
+                       (submod "..")))
+  
+  (check-equal? (format-ids #'a "~a-~a" #'() #'())
+                '())
+  (check-equal? (map syntax->datum
+                     (format-ids #'a "~a-~a" #'(x1 x2 x3) #'(a b c)))
+                '(x1-a x2-b x3-c))
+  
+  (define-syntax (test1 stx)
+    (syntax-case stx ()
+      [(_ (let1 d1) x y)
+       (begin
+         (define/with-syntax (foo-x foo-y)
+           (format-ids (λ (xy)
+                         (if (string=? (symbol->string (syntax->datum xy))
+                                       "b")
+                             stx
+                             #'()))
+                       "foo-~a"
+                       #'(x y)))
+         #'(let1 d1 (let ((foo-b 2) (foo-c 'b)) (cons foo-x foo-y))))]))
+
+  (check-equal? (test1 (let ((foo-b 1) (foo-c 'a))) b c)
+                '(1 . b))
+  
+  (define-syntax (fubar stx)
+    (define/with-syntax (v1 ...) #'(1 2 3))
+    (define/with-syntax (v2 ...) #'('a 'b 'c))
+    ;; the resulting ab and ab should be distinct identifiers:
+    (define/with-syntax (id1 ...) (format-temp-ids "~a" #'(ab cd ab)))
+    (define/with-syntax (id2 ...) (format-temp-ids "~a" #'(ab cd ab)))
+    #'(let ([id1 v1] ...)
+        (let ([id2 v2] ...)
+          (list (cons id1 id2) ...))))
+  
+  (check-equal? (fubar) '((1 . a) (2 . b) (3 . c))))

graph/main.rkt

@@ -0,0 +1,207 @@
+#lang typed/racket
+
+(require "type-expander/type-expander.lp2.rkt")
+(require "type-expander/multi-id.lp2.rkt")
+(require "graph/variant.lp2.rkt")
+
+
+(define-type from (List (Pairof Number Boolean)
+                        (Listof (U Number (Pairof Number String)))))
+(define-type to (List (Pairof String Boolean)
+                      (Listof (U String (Pairof String String)))))
+
+(: convert1 (→ from to))
+(define (convert1 v)
+  (match v [(list a b) (list (convert2 a) (convert3 b))]))
+
+(: convert2 (→ (Pairof Number Boolean) (Pairof String Boolean)))
+(define (convert2 v)
+  (match v [(cons a b) (cons (convert4 a) (convert5 b))]))
+
+(: convert3 (→ (Listof (U Number (Pairof Number String)))
+               (Listof (U String (Pairof String String)))))
+(define (convert3 v)
+  (match v [(? list?) (map convert6 v)]))
+
+(: convert4 (→ Number String))
+(define (convert4 v)
+  (match v [(? number?) (format "~a" v)]))
+
+(: convert5 (→ Boolean Boolean))
+(define (convert5 v)
+  (match v [(? boolean?) v]))
+
+(: convert6 (→ (U Number (Pairof Number String))
+               (U String (Pairof String String))))
+(define (convert6 v)
+  (match v
+    [(? number?) (format "~a" v)]
+    [(? pair?) (cons (convert4 (car v)) (convert7 (cdr v)))]))
+
+(: convert7 (→ String String))
+(define (convert7 v)
+  (match v [(? string?) v]))
+
+(require typed/rackunit)
+(check-equal? (convert1 '((123 . #t) (1 2 (3 . "b") 4 (5 . "x") 6)))
+              '(("123" . #t) ("1" "2" ("3" . "b") "4" ("5" . "x") "6")))
+
+
+
+
+#|
+(define-type from (List (Pairof Number Boolean) (Listof Number)))
+(define-type to (List (Pairof String Boolean) (Listof String)))
+
+(: convert (case→ (→ from to)
+                  (→ (Pairof (Listof Number) Null) (Pairof (Listof String) Null))
+                  (→ (Pairof Number Boolean) (Pairof String Boolean))
+                  (→ (Listof Number) (Listof String))
+                  (→ Number String)
+                  (→ Boolean Boolean)))
+(define (convert v)
+  (cond
+    [(pair? v) (cons (convert (car v)) (convert (cdr v)))]
+    [(null? v) v]
+    [(number? v) (format "~a" v)]
+    [(boolean? v) v]))
+|#
+
+
+
+
+
+
+
+;; Tests with incomplete / outer-incomplete type-expander.
+
+(define-type-expander (outer-incomplete stx)
+  (syntax-case stx ()
+    [(_ n)
+     #;(raise-syntax-error
+        'incomplete
+        (format "Type doesn't have an incomplete counterpart: ~a"
+                (syntax->datum #'n))
+        #'n)
+     ;; Just for testing:
+     #''error]))
+
+(define-type C Boolean)
+
+(define-type C/incomplete (Pairof 'C Boolean))
+
+(define-type-expander (incomplete stx)
+  (syntax-case stx ()
+    [(_ n)
+     (cond [(free-identifier=? #'n #'C) #'C/incomplete]
+           [else #'(outer-incomplete n)])]))
+
+(let ()
+  (define-type-expander (outer-incomplete stx)
+    (syntax-case stx () [(_ n) #'(incomplete n)]))
+  (let ()
+    (define-type A Number)
+    (define-type B String)
+    
+    (define-type A/incomplete (Pairof 'A Number))
+    (define-type B/incomplete (Pairof 'B String))
+    
+    (define-type-expander (incomplete stx)
+      (syntax-case stx ()
+        [(_ n)
+         (cond [(free-identifier=? #'n #'A) #'A/incomplete]
+               [(free-identifier=? #'n #'B) #'B/incomplete]
+               [else
+                #'(outer-incomplete n)])]))
+    
+    (define-type TA A)
+    (define-type TAI (incomplete A))
+    (displayln (ann '(A . 1) TAI))
+    
+    (define-type TC C)
+    (define-type TCI (incomplete C))
+    (displayln (ann #t TC))
+    (displayln (ann '(C . #t) TCI))
+    
+    (let ()
+      (define-type A Boolean)
+      (define-type TA A)
+      (define-type TAI (incomplete A))
+      (displayln (ann 'error TAI))
+      (void))))
+
+(require (prefix-in tr: typed/racket))
+
+;(define-type ma (tagged ma (fav String) (faa ma) (fab mb)))
+;(define-type mb (tagged mb (fbv String) (fba ma)))
+
+;(define-type ma (List (U ma Number) (U ma Number)) #:omit-define-syntaxes)
+;(define-multi-id ma
+;  #:match-expander (λ (stx) #'(list a b))
+;  #:call (λ (stx) #'(list 1 (list 2 3))))
+
+;(match (ann (ma) ma)
+;  [(ma) #t])
+
+
+#|
+(module m typed/racket
+  (provide ma)
+  (require "type-expander/type-expander.lp2.rkt")
+  (require "graph/variant.lp2.rkt")
+  
+  ;(let ()
+  ;(define-tagged ma (fav String))
+  ;(define-tagged ma (fav String) (faa ma) (fab mb))
+  (define-tagged ma (fav String) (faa ma) (fab Number))
+  ;(define-tagged mb (fbv String) (fba ma))
+  (define-type ma/incomplete ma)
+  ;(define-type mb/incomplete mb)
+  (void);)
+  )
+
+(require 'm)
+|#
+
+#|
+(require "graph/graph.rkt")
+
+(define ma "boom")
+
+(graph g
+       [ma (fav String)
+           (faa ma)
+           (fab mb)]
+       [mb (fbv String)
+           (fba ma)])
+
+(define mb "boom")
+|#
+
+#|
+(require typed/rackunit)
+
+;(require "graph/structure.lp2.rkt")
+;(get ((make-struct-constructor a b c d) 1 "b" 'value-c 4) c)
+
+(require "type-expander/type-expander.lp2.rkt")
+(: w0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d))
+(define w0 '(2 "abc" #,(x . z) #(1 "b" x) d))
+
+(require (for-syntax racket/list))
+(define-type-expander (Repeat stx)
+  (syntax-case stx ()
+    [(_ t n) #`(List #,@(map (λ (x) #'t)
+                             (range (syntax->datum #'n))))]))
+
+(: x (→ (Repeat Number 5)))
+(define (x) (list 1 2 3 4 5))
+(check-equal? (x) '(1 2 3 4 5))
+
+(require "graph/structure.lp2.rkt")
+(define-structure st2 [b String] [a Number])
+
+(module* test typed/racket
+  (require (submod "..")))
+
+|#

graph/make/.gitignore

@@ -0,0 +1 @@
+/make

graph/make/lib.rkt

@@ -0,0 +1,194 @@
+#lang typed/racket
+
+(provide make/proc
+         argv
+         string-prefix?
+         string-suffix?
+         find-files-by-extension
+         t-rule
+         rules
+         ;rule
+         implicit-rule
+         for/rules
+         path-string->string
+         path-string->path
+         path-append
+         regexp-case
+         dirname
+         underscore-extension
+         compile-zos
+         rkt->zo-dir
+         rkt->zo-file
+         make-collection
+         run
+         run!)
+
+(require/typed make [make/proc (→ (Listof
+                                   (Pairof (U Path-String (Listof Path-String))
+                                           (Pairof (Listof Path-String)
+                                                   (U Null
+                                                      (List (-> Any))))))
+                                  (U String (Vectorof String) (Listof String))
+                                  Void)])
+;(require/typed make/collection [make-collection (→ Any (Listof Path-String) (U String (Vectorof String)) Void)])
+
+(require/typed srfi/13
+               [string-suffix? (->* (String String) (Integer Integer Integer Integer) Boolean)]
+               [string-prefix? (->* (String String) (Integer Integer Integer Integer) Boolean)])
+
+(define (find-files-by-extension [ext : String])
+  (find-files (λ ([path : Path]) (string-suffix? ext (path->string path)))))
+
+;(: drop-extension (→ Path-String * String String))
+;(define (drop-extension path . exts)
+;  (map (λ () exts)
+
+(define-type t-rule (Pairof (U Path-String (Listof Path-String))
+                            (Pairof (Listof Path-String)
+                                    (U Null
+                                       (List (-> Any))))))
+(: rules (→ (U t-rule (Listof t-rule)) * (Listof t-rule)))
+(define (rules . rs)
+  (apply append (map (λ ([x : (U t-rule (Listof t-rule))])
+                       (cond [(null? x) '()] ;; x = '() is an empty (Listof t-rule)
+                             [(null? (cdr x)) x] ;; x = '([target dep maybe-proc]) is a (Listof t-rule) with just one element
+                             [(null? (cadr x)) (list x)] ;; x = '[target () maybe-proc] is a t-rule with an empty list of dependencies
+                             ;; Below, either x = '[target (dep₁ . ?) maybe-proc] or x = '([target dep maybe-proc] [target dep maybe-proc])
+                             [(null? (cdadr x)) (list x)] ;; x = '[target (dep₁ . ()) maybe-proc]
+                             [(list? (cadadr x)) x] ;; x = '([target dep maybe-proc] [target (?) maybe-proc])
+                             [else (list x)])) ; x = '[target (dep₁ dep₂ . ()) maybe-proc]
+                     rs)))
+
+#|
+(define-syntax (rule stx)
+  (syntax-case stx ()
+    [(_ (target ...) (depend ...) body0 . body)
+     #'(list (list target ...)
+             (list depend ...)
+             (λ () body0 . body))]
+    [(_ (target ...) (depend ...))
+     #'(list (list target ...)
+             (list depend ...))]))
+|#
+
+(define-syntax-rule (implicit-rule (arg ...) (target ...) (depend ...) body ...)
+  (λ ([arg : Path] ...)
+    (list (list target ...)
+          (list depend ...)
+          (λ () body ...))))
+
+(define-syntax-rule (for/rules ([arg files] ...) (target ...) (depend ...) body ...)
+  (map (implicit-rule (arg ...) (target ...) (depend ...) body ...) files ...))
+
+(: path-string->string (→ Path-String String))
+(define (path-string->string ps)
+  (if (string? ps)
+      ps
+      (path->string ps)))
+
+(: path-string->path (→ Path-String Path))
+(define (path-string->path ps)
+  (if (string? ps)
+      (string->path ps)
+      ps))
+
+(: path-append (→ Path-String Path-String Path))
+(define (path-append a b)
+  (string->path (string-append (path-string->string a)
+                               (path-string->string b))))
+
+(define-syntax-rule (regexp-case input [pattern replacement] ...)
+  (let ([input-cache input]) ;; TODO: should also cache the patterns, but lazily.
+    (cond
+      [(regexp-match pattern input-cache) (regexp-replace pattern input-cache replacement)]
+      ...
+      [else input-cache])))
+
+(: dirname (→ Path Path))
+(define (dirname p)
+  (let-values ([(base name must-be-dir?) (split-path p)])
+    (case base
+      ['relative (build-path 'same)] ;; If the path is "..", then this is wrong.
+      ['#f (error (format "Can't get parent directory of ~a" p))]
+      [else base])))
+
+(: underscore-extension (→ Path-String String * Path))
+(define (underscore-extension path . ext)
+  (if (null? ext)
+      (path-string->path path)
+      (let ([p (path-string->string path)]
+            [e (path-string->string (car ext))])
+        (if (string-suffix? (car ext) p)
+            (let* ([pos (- (string-length p) (string-length e))]
+                   [left (substring p 0 pos)])
+              (string->path (string-append left (string-replace e "." "_"))))
+            (apply underscore-extension path (cdr ext))))))
+
+;; TODO: do pattern-matching on paths, with (match) ?
+
+(define (argv)
+  (let ([argv (current-command-line-arguments)])
+    (if (= (vector-length argv) 0)
+        #("zo")
+        argv)))
+
+;; make-collection from /usr/local/racket-6.2.900.6/share/pkgs/make/collection-unit.rkt
+(require/typed compiler/compiler [compile-zos (->* (Any) (#:module? Any #:verbose? Any) (→ (Listof Path-String) (U Path-String #f 'auto) Void))])
+(require/typed dynext/file [append-zo-suffix (→ Path-String Path)])
+
+(: cache (∀ (T) (→ (→ T) (→ T))))
+(define (cache producer)
+  (let ([cache : (U False (List T)) #f]) ;; Use (List T) instead of T, so that if the producer returns #f, we don't call it each time.
+    (λ ()
+      (let ([c cache]) ;; since cache is mutated by set!, occurrence typing won't work on it, so we need to take a copy.
+        (if c
+            (car c)
+            (let ((producer-result (producer)))
+              (set! cache (list producer-result))
+              producer-result))))))
+
+(: rkt->zo-dir (→ Path-String Path))
+(define (rkt->zo-dir src-file)
+  (simplify-path (build-path src-file 'up "compiled") #f))
+
+(: rkt->zo-file (→ Path-String Path))
+(define (rkt->zo-file src-file)
+  (build-path (rkt->zo-dir src-file) (append-zo-suffix (assert (file-name-from-path src-file)))))
+
+(: make-collection  (→ Any (Listof Path-String) (U String (Vectorof String)) Void))
+(define (make-collection collection-name collection-files argv)
+  (printf "building collection ~a: ~a\n" collection-name collection-files)
+  (let* ([zo-compiler (cache (λ () (compile-zos #f)))]
+         [src-dir (current-directory)]
+         [rkts (sort collection-files
+                     (lambda ([a : Path] [b : Path])
+                       (string-ci<? (path->string a) (path->string b))))]
+         [zos (map (lambda ([rkt : Path-String])
+                     (rkt->zo-file rkt))
+                   rkts)]
+         [rkt->zo-list
+          (map (lambda ([rkt : Path-String] [zo : Path])
+                 `(,zo (,rkt)
+                       ,(lambda ()
+                          (let ([dest (rkt->zo-dir rkt)])
+                            (unless (directory-exists? dest) (make-directory dest))
+                            ((zo-compiler) (list rkt) dest)))))
+               rkts zos)])
+    (make/proc (append `(("zo" ,zos)) rkt->zo-list) argv)))
+
+(: run (→ (U Path-String (Pairof Path-String (Listof (U Path-String Bytes)))) [#:set-pwd? Any] (U Path-String Bytes) * Boolean))
+(define (run arg0 #:set-pwd? [set-pwd? #f] . args)
+  (if (list? arg0)
+      (apply run arg0)
+      (begin
+        (displayln (string-append (string-join (cons (path-string->string arg0) (map (λ (x) (format "~a" x)) args)) " ")))
+        (display "\033[1;34m")
+        (flush-output)
+        (let ((result (apply system* arg0 args)))
+          (display "\033[m")
+          (flush-output)
+          (unless result
+            (raise "Command failed."))
+          result))))
+
+(define-syntax-rule (run! . rest) (let () (run . rest) (values)))

graph/make/make.rkt

@@ -0,0 +1,82 @@
+#lang typed/racket
+
+(require "lib.rkt")
+
+(displayln "Make started")
+;(current-directory "..")
+
+; TODO:
+;raco pkg install alexis-util
+;And some other collections too.
+;
+;cat graph/structure.lp2.rkt | awk '{if (length > 80) print NR "\t" length "\t" $0}' | sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'
+
+;; TODO: should directly exclude them in find-files-by-extension.
+(define excluded-dirs (list "docs/" "bug/" "lib/doc/bracket/" "lib/doc/math-scribble/" "lib/doc/MathJax/"))
+(define (exclude-dirs [files : (Listof Path)] [excluded-dirs : (Listof String) excluded-dirs])
+  (filter-not (λ ([p : Path])
+                (ormap (λ ([excluded-dir : String])
+                         (string-prefix? excluded-dir (path->string p)))
+                       excluded-dirs))
+              files))
+
+(define scrbl-files (exclude-dirs (find-files-by-extension ".scrbl")))
+(define lp2-files (exclude-dirs (find-files-by-extension ".lp2.rkt")))
+(define rkt-files (exclude-dirs (find-files-by-extension ".rkt")))
+(define html-sources (append scrbl-files lp2-files))
+(define html-files (map (λ ([scrbl-or-lp2 : Path]) (build-path "docs/" (regexp-case (path->string scrbl-or-lp2) [#rx"\\.scrbl" ".html"] [#rx"\\.lp2\\.rkt" ".lp2.html"])))
+                        html-sources))
+(define mathjax-links (map (λ ([d : Path]) (build-path d "MathJax")) (remove-duplicates (map dirname html-files))))
+
+(: scribble (→ Path (Listof Path) Any))
+(define (scribble file all-files)
+  (run `(,(or (find-executable-path "scribble") (error "Can't find executable 'scribble'"))
+         "--html"
+         "--dest" ,(build-path "docs/" (dirname file))
+         "+m"
+         "--redirect-main" "http://docs.racket-lang.org/"
+         "--info-out" ,(build-path "docs/" (path-append file ".sxref"))
+         ,@(append-map (λ ([f : Path-String]) : (Listof Path-String)
+                         (let ([sxref (build-path "docs/" (path-append f ".sxref"))])
+                           (if (file-exists? sxref)
+                               (list "++info-in" sxref)
+                               (list))))
+                       (remove file all-files))
+         ,file)))
+
+;(make-collection "phc" rkt-files (argv))
+;(make-collection "phc" '("graph/all-fields.rkt") #("zo"))
+;(require/typed compiler/cm [managed-compile-zo (->* (Path-String) ((→ Any Input-Port Syntax) #:security-guard Security-Guard) Void)])
+;(managed-compile-zo (build-path (current-directory) "graph/all-fields.rkt"))
+
+;; make-collection doesn't handle dependencies due to (require), so if a.rkt requires b.rkt, and b.rkt is changed, a.rkt won't be rebuilt.
+;; this re-compiles each-time, even when nothing was changed.
+;((compile-zos #f) rkt-files 'auto)
+
+;; This does not work, because it tries to create the directory /usr/local/racket-6.2.900.6/collects/syntax/parse/private/compiled/drracket/
+;(require/typed compiler/cm [managed-compile-zo (->* (Path-String) ((→ Any Input-Port Syntax) #:security-guard Security-Guard) Void)])
+;(for ([rkt rkt-files])
+;  (managed-compile-zo (build-path (current-directory) rkt)))
+
+(run! `(,(or (find-executable-path "raco") (error "Can't find executable 'raco'"))
+       "make"
+       ,@rkt-files))
+
+(make/proc
+ (rules (list "zo" (append html-files
+                           mathjax-links))
+        (for/rules ([scrbl-or-lp2 html-sources]
+                    [html html-files])
+                   (html)
+                   (scrbl-or-lp2)
+                   (scribble scrbl-or-lp2 html-sources))
+        (for/rules ([mathjax-link mathjax-links])
+                   (mathjax-link)
+                   ()
+                   (make-file-or-directory-link (simplify-path (apply build-path `(same ,@(map (λ (x) 'up) (explode-path (dirname mathjax-link))) "lib" "doc" "MathJax")) #f)
+                                                mathjax-link)))
+ (argv))
+
+(run! `(,(or (find-executable-path "raco") (error "Can't find executable 'raco'"))
+       "cover"
+       ,@(exclude-dirs rkt-files (list "make/"))))

graph/type-expander/multi-id.lp2.rkt

@@ -0,0 +1,182 @@
+#lang scribble/lp2
+@(require "../lib/doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Easy declararation of new identifiers with
+ type-expander, match-expander, …}
+
+@section{@racket[multi-id]}
+
+TODO: maybe we should cache @tc[p-else] and @tc[p-get].
+
+@chunk[<fail-set!>
+       #'(raise-syntax-error
+          'self
+          (format "can't set ~a" (syntax->datum #'self)))]
+
+@chunk[<stx-class-kw-else>
+       (define-splicing-syntax-class kw-else
+         (pattern (~seq #:mutable-else p-else)
+                  #:with p-just-set! #'#'(set! p-else . rest)
+                  #:with p-just-call #'#'(p-else . rest)
+                  #:with p-just-id #'#'p-else)
+         (pattern (~seq #:else p-else)
+                  #:with p-just-set! <fail-set!>
+                  #:with p-just-call #'#'(p-else . rest)
+                  #:with p-just-id #'#'p-else))]
+
+@chunk[<stx-class-kw-set!+call+id>
+       (define-splicing-syntax-class kw-set!+call+id
+         (pattern (~seq (~optional (~seq #:set! p-user-set!:expr))
+                        (~optional (~or (~seq #:call p-user-call:expr)
+                                        (~seq #:call-id p-user-call-id:id)))
+                        (~optional (~seq #:id p-user-id:expr)))
+                  #:attr p-just-set!
+                  (and (attribute p-user-set!) #'(p-user-set! stx))
+                  #:attr p-just-call
+                  (cond [(attribute p-user-call)
+                         #'(p-user-call stx)]
+                        [(attribute p-user-call-id)
+                         #'(syntax-case stx ()
+                             [(_ . rest) #'(p-user-call-id . rest)])]
+                        [else #f])
+                  #:attr p-just-id
+                  (and (attribute p-user-id) #'(p-user-id stx))))]
+
+Since we have an issue with the type-expander and recursive types (it goes in an
+infinite loop), we temporarily provide a workaround with the
+@tc[#:type-noexpand] and @tc[#:type-expand-once] keywords.
+
+@chunk[<multi-id>
+       (require (only-in typed/racket [define-type tr:define-type]))
+       
+       (begin-for-syntax
+         <stx-class-kw-else>
+         <stx-class-kw-set!+call+id>)
+       (define-syntax/parse
+         (define-multi-id name:id
+           (~optional (~or (~seq #:type-expander p-type:expr)
+                           (~seq #:type-noexpand p-type-noexpand:expr)
+                           (~seq #:type-expand-once p-type-expand-once:expr)))
+           (~optional (~or (~seq #:match-expander p-match:expr)
+                           (~seq #:match-expander-id p-match-id:id)))
+           (~optional (~seq #:custom-write p-write:expr))
+           (~or (~seq #:set!-transformer p-set!:expr)
+                :kw-else
+                :kw-set!+call+id))
+         (template
+          (begin
+            (?? (tr:define-type name p-type-noexpand #:omit-define-syntaxes))
+            (?? (define-type name p-type-expand-once #:omit-define-syntaxes))
+            (define-syntax name
+              (let ()
+                (struct tmp ()
+                  (?? (?@ #:property prop:type-expander p-type))
+                  (?? (?@ #:property prop:match-expander p-match))
+                  (?? (?@ #:property prop:match-expander
+                          (λ (stx) (syntax-case stx ()
+                                     [(_ . rest) #'(p-match-id . rest)]))))
+                  (?? (?@ #:property prop:custom-write p-write))
+                  #:property prop:set!-transformer
+                  (?? p-set!
+                      (λ (_ stx)
+                        (syntax-case stx (set!)
+                          [(set! self . rest) (?? p-set! <fail-set!>)]
+                          (?? [(_ . rest) p-just-call])
+                          (?? [_ p-just-id])))))
+                (tmp))))))]
+
+@chunk[<test-multi-id>
+       (define (p1 [x : Number]) (+ x 1))
+       
+       (define-type-expander (Repeat stx)
+         (syntax-case stx ()
+           [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                    (range (syntax->datum #'n))))]))
+       
+       (define-multi-id foo
+         #:type-expander
+         (λ (stx) #'(List (Repeat Number 3) 'x))
+         #:match-expander
+         (λ (stx) #'(vector _ _ _))
+         #:custom-write
+         (λ (self port mode) (display "custom-write for foo" port))
+         #:set!-transformer
+         (λ (_ stx)
+           (syntax-case stx (set!)
+             [(set! self . _)
+              (raise-syntax-error 'foo (format "can't set ~a"
+                                               (syntax->datum #'self)))]
+             [(_ . rest) #'(+ . rest)]
+             [_ #'p1])))
+       
+       (check-equal? (ann (ann '((1 2 3) x) foo)
+                          (List (List Number Number Number) 'x))
+                     '((1 2 3) x))
+       
+       ;(set! foo 'bad)
+       
+       (let ([test-match (λ (val) (match val [(foo) #t] [_ #f]))])
+         (check-equal? (test-match #(1 2 3)) #t)
+         (check-equal? (test-match '(1 x)) #f))
+       
+       (check-equal? (foo 2 3) 5)
+       (check-equal? (map foo '(1 5 3 4 2)) '(2 6 4 5 3))]
+
+It would be nice to test the @tc[(set! foo 'bad)] case, but grabbing the
+compile-time error is a challenge (one could use @tc[eval], but it's a bit heavy
+to configure).
+
+Test with @tc[#:else]:
+
+@chunk[<test-multi-id>
+       (define-multi-id bar
+         #:type-expander
+         (λ (stx) #'(List `,(Repeat 'x 2) Number))
+         #:match-expander
+         (λ (stx) #'(cons _ _))
+         #:custom-write
+         (λ (self port mode) (display "custom-write for foo" port))
+         #:else p1)
+       
+       (check-equal? (ann (ann '((x x) 79) bar)
+                          (List (List 'x 'x) Number))
+                     '((x x) 79))
+       
+       ;(set! bar 'bad)
+       
+       (let ([test-match (λ (val) (match val [(bar) #t] [_ #f]))])
+         (check-equal? (test-match '(a . b)) #t)
+         (check-equal? (test-match #(1 2 3)) #f))
+       
+       (check-equal? (bar 6) 7)
+       (check-equal? (map bar '(1 5 3 4 2)) '(2 6 4 5 3))]
+
+@section{Conclusion}
+
+@chunk[<*>
+       (begin
+         (module main typed/racket
+           (require "type-expander.lp2.rkt"
+                    "../lib/low.rkt")
+           (require (for-syntax
+                     racket/syntax
+                     syntax/parse
+                     syntax/parse/experimental/template
+                     (only-in "type-expander.lp2.rkt" prop:type-expander)))
+           (provide define-multi-id)
+           
+           <multi-id>)
+         
+         (require 'main)
+         (provide (all-from-out 'main))
+         
+         (module* test typed/racket
+           (require (submod "..")
+                    "type-expander.lp2.rkt"
+                    typed/rackunit
+                    (for-syntax racket/list))
+           
+           <test-multi-id>
+           
+           (require (submod ".." doc))))]

graph/type-expander/type-expander.lp2.rkt

@@ -0,0 +1,943 @@
+#lang scribble/lp2
+@(require "../lib/doc.rkt")
+@doc-lib-setup
+
+@title[#:style manual-doc-style]{Extensible types}
+
+We want to have extensible types. Unlike @tc[require] and @tc[provide], which
+come with @tc[define-require-syntax] and @tc[define-provide-syntax], and unlike
+@tc[match], which comes with @tc[define-match-expander], @tc[typed/racket]
+doesn't provide a way to define type expanders (yet).
+
+We re-define the forms @tc[:], @tc[define], @tc[lambda] etc. to equivalents that
+expand type expanders defined via our macro @tc[define-type-expander]. Ideally,
+this would be handled directly by @tc[typed/racket], which would call the
+type-expander itself.
+
+@(table-of-contents)
+
+@section{@racket[prop:type-expander]}
+
+Match expanders are identified by the @tc[prop:type-expander]
+@tech{structure type property}, which allows the same identifier to act as a
+@tc[prop:rename-transformer], @tc[prop:match-expander] and
+@tc[prop:type-expander] for example.
+
+@chunk[<prop:type-expander>
+       (define-values (prop:type-expander
+                       has-prop:type-expander?
+                       get-prop:type-expander-value)
+         (make-struct-type-property 'type-expander prop-guard))]
+
+The prop:type-expander property should either be the index of a field which will
+contain the expander procedure, or directly an expander procedure.
+
+@chunk[<prop-guard>
+       (define (prop-guard val struct-type-info-list)
+         (cond <prop-guard-field-index>
+               <prop-guard-procedure>
+               [else
+                (raise-argument-error
+                 'prop:type-expander-guard
+                 (string-append
+                  "an exact non-negative integer designating a field index "
+                  "within the structure that should contain a procedure of "
+                  "arity 1, or a procedure of arity 1.")
+                 val)]))]
+
+If the value is a field index, it should be within bounds. The
+@tc[make-struct-field-accessor] function does that for us, and also returns
+an accessor that can be passed directly an instance of the struct.
+
+@chunk[<prop-guard-field-index>
+       [(exact-nonnegative-integer? val)
+        (make-struct-field-accessor (cadddr struct-type-info-list) val)]]
+
+The expander procedure will take one argument: the piece of syntax corresponding
+to the use of the expander. If the property's value is a procedure, we therefore
+check that the it's arity includes 1.
+
+When the property value is a field index, we return a field accessor, that when
+given the struct instance, will return the actual type expander procedure.
+We therfore need to follow the same convention here, by wrapping val in a
+single-parameter function.
+
+@chunk[<prop-guard-procedure>
+       [(procedure? val)
+        (if (arity-includes? (procedure-arity val) 1)
+            (λ (_) val)
+            (raise-argument-error 'prop:type-expander-guard
+                                  "procedure arity should be 1"
+                                  val))]]
+
+@subsection{type-expander struct}
+
+We make a simple struct that implements just @tc[prop:type-expander] and nothing
+else.
+
+@chunk[<type-expander-struct>
+       (struct type-expander (expander-proc)
+         #:property prop:type-expander (struct-field-index expander-proc))]
+
+@section{@racket[expand-type]}
+
+@chunk[<apply-type-expander>
+       (define (apply-type-expander type-expander-stx stx)
+         (let ([type-expander (syntax-local-value type-expander-stx)])
+           (((get-prop:type-expander-value type-expander) type-expander) stx)))]
+
+@CHUNK[<bind-type-vars>
+       (define (bind-type-vars type-vars stx)
+         (let ([def-ctx (syntax-local-make-definition-context)]
+               [err-expr #'(λ _ (raise-syntax-error
+                                 "Type name used out of context"))])
+           (for ([var (syntax->list type-vars)])
+             (syntax-local-bind-syntaxes (list var) err-expr def-ctx))
+           (internal-definition-context-seal def-ctx)
+           (internal-definition-context-introduce def-ctx stx)))]
+
+@CHUNK[<expand-type>
+       (define (expand-type stx)
+         (define-syntax-class type-expander
+           (pattern (~var expander
+                          (static has-prop:type-expander? "a type expander"))))
+         (define-syntax-class fa (pattern (~or (~literal ∀) (~literal All))))
+         (syntax-parse stx
+           [:type-expander
+            (expand-type (apply-type-expander #'expander #'expander))]
+           [(~and expander-call-stx (:type-expander . args))
+            (expand-type (apply-type-expander #'expander #'expander-call-stx))]
+           ;; TODO: handle the pattern (∀ (TVar ... ooo) T)
+           [(∀:fa (TVar ...) T)
+            #`(∀ (TVar ...) #,(expand-type (bind-type-vars #'(TVar ...) #'T)))]
+           [((~literal Rec) R T)
+            #`(Rec R #,(expand-type (bind-type-vars #'(R) #'T)))]
+           [((~literal quote) T) (expand-quasiquote 'quote 1 #'T)]
+           [((~literal quasiquote) T) (expand-quasiquote 'quasiquote 1 #'T)]
+           [((~literal syntax) T) (expand-quasiquote 'syntax 1 #'T)]
+           [((~literal quasisyntax) T) (expand-quasiquote 'quasisyntax 1 #'T)]
+           [(T TArg ...)
+            #`(T #,@(stx-map expand-type #'(TArg ...)))]
+           [T #'T]))]
+
+@CHUNK[<define-type-expander>
+       (define-syntax/parse (define-type-expander (name:id arg:id) . body)
+         #'(define-syntax name (type-expander (λ (arg) . body))))]
+
+@subsection{Tests for @racket[expand-type]}
+
+@CHUNK[<test-expand-type>
+       (require (for-syntax typed/rackunit
+                            syntax/parse))
+       
+       (define-syntax (test-expander stx)
+         (syntax-parse stx
+           [(_ type expanded-type)
+            (check-equal? (syntax->datum (expand-type #'type))
+                          (syntax->datum #'expanded-type))
+            #'(values)]))]
+
+Simple identity expander test, with a different case when used just as an
+identifier.
+
+@CHUNK[<test-expand-type>
+       (define-type-expander (id stx)
+         (syntax-case stx ()
+           [(_ t) #'t]
+           [x #'(∀ (A) (→ A A))]))
+       
+       (test-expander (id Number) Number)
+       (test-expander id (∀ (A) (→ A A)))]
+
+@CHUNK[<test-expand-type>
+       (define-type-expander (double stx)
+         (syntax-case stx ()
+           [(_ t) #'(id (Pairof (id t) t))]))
+       
+       (test-expander (∀ (A) (→ A (id (double (id A)))))
+                      (∀ (A) (→ A (Pairof A A))))]
+
+Shadowing and @tc[∀] variables:
+
+@CHUNK[<test-expand-type>
+       (test-expander (∀ (id) (→ id))
+                      (∀ (id) (→ id)))
+       (test-expander (∀ (id2) (→ id))
+                      (∀ (id2) (→ (∀ (A) (→ A A)))))]
+
+@CHUNK[<test-expand-type>
+       (define-type-expander (Repeat stx)
+         (syntax-case stx ()
+           [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                    (range (syntax->datum #'n))))]))
+       
+       (test-expander (Repeat Number 5)
+                      (List Number Number Number Number Number))]
+
+@CHUNK[<test-expand-type>
+       (: count-five-more (→ Number (Repeat Number 5)))
+       (define (count-five-more x)
+         (list (+ x 1) (+ x 2) (+ x 3) (+ x 4) (+ x 5)))
+       
+       (check-equal? (count-five-more 3)
+                     '(4 5 6 7 8))
+       (check-equal? (ann (count-five-more 15) (Repeat Number 5))
+                     '(16 17 18 19 20))]
+
+@section{Example type-expanders: quasiquote and quasisyntax}
+
+@CHUNK[<expand-quasiquote>
+       (define (expand-quasiquote mode depth stx)
+         (define (wrap t)
+           (if (or (eq? mode 'syntax) (eq? mode 'quasisyntax))
+               #`(Syntaxof #,t)
+               t))
+         (define (wrap-quote t)
+           (if (or (eq? mode 'syntax) (eq? mode 'quasisyntax))
+               #`(Syntaxof (quote #,t))
+               #`(quote #,t)))
+         (define expand-quasiquote-rec (curry expand-quasiquote mode depth))
+         (syntax-parse stx
+           [((~literal quote) T)
+            (wrap #`(List #,(wrap-quote #'quote)
+                          #,(expand-quasiquote-rec #'T)))]
+           [((~literal quasiquote) T)
+            (wrap #`(List #,(wrap-quote #'quasiquote)
+                          #,(if (eq? mode 'quasiquote)
+                                (expand-quasiquote mode (+ depth 1) #'T)
+                                (expand-quasiquote-rec #'T))))]
+           [((~literal unquote) T)
+            (if (eq? mode 'quasiquote)
+                (if (= depth 1)
+                    (expand-type #'T)
+                    (wrap #`(List #,(wrap-quote #'unquote)
+                                  #,(expand-quasiquote mode (- depth 1) #'T))))
+                (wrap #`(List #,(wrap-quote #'unquote)
+                              #,(expand-quasiquote-rec #'T))))]
+           [((~literal syntax) T)
+            (wrap #`(List #,(wrap-quote #'quote)
+                          #,(expand-quasiquote-rec #'T)))]
+           [((~literal quasisyntax) T)
+            (wrap #`(List #,(wrap-quote #'quasisyntax)
+                          #,(if (eq? mode 'quasisyntax)
+                                (expand-quasiquote mode (+ depth 1) #'T)
+                                (expand-quasiquote-rec #'T))))]
+           [((~literal unsyntax) T)
+            (if (eq? mode 'quasisyntax)
+                (if (= depth 1)
+                    (expand-type #'T)
+                    (wrap #`(List #,(wrap-quote #'unsyntax)
+                                  #,(expand-quasiquote mode (- depth 1) #'T))))
+                (wrap #`(List #,(wrap-quote #'unsyntax)
+                              #,(expand-quasiquote-rec #'T))))]
+           ;; TODO For lists, we should consider the cases where syntax-e gives
+           ;; a pair vs the cases where it gives a list.
+           [(T . U)
+            #:when (syntax? (cdr (syntax-e stx)))
+            (wrap #`(Pairof #,(expand-quasiquote-rec #'T)
+                            #,(expand-quasiquote-rec #'U)))]
+           [() (wrap #'Null)]
+           [(T ...)
+            (wrap #`(List #,@(stx-map expand-quasiquote-rec #'(T ...))))]
+           [(T ... U . S)
+            (wrap #`(List* #,@(stx-map expand-quasiquote-rec #'(T ... U S))))]
+           [#(T ...)
+            (wrap #`(Vector #,@(stx-map expand-quasiquote-rec #'(T ...))))]
+           [#&T (wrap #`(Boxof #,(expand-quasiquote-rec #'T)))]
+           ; TODO: Prefab with #s(prefab-struct-key type ...)
+           [T:id (wrap #''T)]
+           [T #:when (string? (syntax-e #'T)) (wrap #'T)]
+           [T:number (wrap #'T)]
+           [T:keyword (wrap #''T)]
+           [T:char (wrap #'T)]
+           [#t (wrap #'True)]
+           [#t (wrap #'False)]
+           [_ (raise-syntax-error 'expand-quasiquote
+                                  "Unknown quasiquote contents"
+                                  stx)]))]
+
+@section{Overloading @racket[typed/racket] forms}
+
+Througout this section, we provide alternative definitions of the
+@tc[typed/racket] forms @tc[:], @tc[lambda], @tc[define], @tc[struct], @tc[ann],
+@tc[inst]… . We write these definitions with @tc[syntax-parse], using the syntax
+classes defined in section @secref{syntax-classes}.
+
+Most of the time, we will use the experimental @tc[template] macro from
+@tc[syntax/parse/experimental/template] which allows more concise code than the
+ususal @code{#'()} and @code{#`()}. In order to expand types and bind type
+variables in the result, we define two template metafunctions:
+
+@chunk[<template-metafunctions>
+       (define-template-metafunction (template-expand-type stx)
+         (syntax-parse stx
+           [(_ () t) (expand-type #'t)]
+           [(_ tvars t) (expand-type (bind-type-vars #'tvars #'t))]))]
+
+@subsection{@racket[:]}
+
+We provide a new definition for the @tc[:] operator, which calls the old one
+after expanding the type argument.
+
+@CHUNK[<:>
+       (define-syntax/parse (new-: x:id t:expr)
+         #`(: x #,(expand-type #'t)))]
+
+@CHUNK[<test-:>
+       (: c0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d))
+       (define c0 '(2 "abc" #,(x . z) #(1 "b" x) d))]
+
+@subsection[#:tag "syntax-classes"]{syntax classes}
+
+The syntax classes from @tc[typed-racket/base-env/annotate-classes] match
+against the @tc[:] literal. Since we provide a new definition for it, the syntax
+class doesn't match code using our definition of @tc[:]. We therefore can't use
+the original implementations of @tc[:curried-formals] and @tc[lambda-formals],
+and instead have to roll out our own versions.
+
+We take that as an opportunity to expand the types directly from the syntax
+classes using @tc[#:with], instead of doing that inside the macros that use
+them.
+
+@CHUNK[<syntax-classes>
+       (define-syntax-class colon
+         (pattern (~literal new-:)))
+       
+       (define-splicing-syntax-class (new-maybe-kw-type-vars)
+         #:attributes (vars maybe)
+         (pattern kw+vars:lambda-type-vars
+                  #:with vars #'kw+vars.type-vars
+                  #:with maybe #'kw+vars)
+         (pattern (~seq)
+                  #:with vars #'()
+                  #:attr maybe #f))
+       
+       (define-splicing-syntax-class (new-maybe-type-vars)
+         #:attributes (vars maybe)
+         (pattern vars:type-variables
+                  #:with maybe #'vars)
+         (pattern (~seq)
+                  #:with vars #'()
+                  #:attr maybe #f))
+       
+       (define-splicing-syntax-class (new-kw-formal tvars)
+         #:attributes ([expanded 1])
+         (pattern (~seq kw:keyword id:id)
+                  #:with (expanded ...) #'(kw id))
+         (pattern (~seq kw:keyword [id:id
+                                    (~optional (~seq :colon type:expr))
+                                    (~optional default:expr)])
+                  #:with tvars tvars
+                  #:with (expanded ...)
+                  (template (kw [id (?@ : (template-expand-type tvars type))
+                                 (?? default)]))))
+       
+       (define-splicing-syntax-class (new-mand-formal tvars)
+         #:attributes ([expanded 1])
+         (pattern id:id
+                  #:with (expanded ...) #'(id))
+         (pattern [id:id :colon type:expr]
+                  #:with tvars tvars
+                  #:with (expanded ...)
+                  (template ([id : (template-expand-type tvars type)])))
+         (pattern (~var kw (new-kw-formal tvars))
+                  #:with (expanded ...) #'(kw.expanded ...)))
+       
+       (define-splicing-syntax-class (new-opt-formal tvars)
+         #:attributes ([expanded 1])
+         (pattern [id:id (~optional (~seq :colon type:expr)) default:expr]
+                  #:with tvars tvars
+                  #:with (expanded ...)
+                  (template ([id (?@ : (template-expand-type tvars type))
+                              default])))
+         (pattern (~var kw (new-kw-formal tvars))
+                  #:with (expanded ...) #'(kw.expanded ...)))
+       
+       (define-syntax-class (new-rest-arg tvars)
+         #:attributes ([expanded 0])
+         (pattern rest:id
+                  #:with expanded #'rest)
+         (pattern (rest:id
+                   :colon type:expr
+                   (~or (~and x* (~describe "*" (~or (~datum *) (~datum ...*))))
+                        (~seq (~datum ...) bound:expr)))
+                  #:with tvars tvars
+                  #:with expanded
+                  (template (rest : (template-expand-type tvars type)
+                                  (?? x* (?@ (... ...) (template-expand-type
+                                                        tvars bound)))))))
+       
+       (define-syntax-class (new-lambda-formals tvars)
+         (pattern (~or ((~var mand (new-mand-formal tvars)) ...
+                        (~var opt (new-opt-formal tvars)) ...
+                        . (~var rest (new-rest-arg tvars)))
+                       ((~var mand (new-mand-formal tvars)) ...
+                        (~var opt (new-opt-formal tvars)) ...))
+                  ;; TODO: once template supports ?? in tail position, use it.
+                  #:with expanded #`(mand.expanded ...
+                                     ...
+                                     opt.expanded ...
+                                     ...
+                                     . #,(if (attribute rest)
+                                             #'rest.expanded
+                                             #'()))))
+       
+       (define-syntax-class (new-curried-formals tvars)
+         (pattern (f:id . (~var args (new-lambda-formals tvars)))
+                  #:with expanded #'(f . args.expanded))
+         (pattern ((~var lhs (new-curried-formals tvars))
+                   . (~var args (new-lambda-formals tvars)))
+                  #:with expanded #'(lhs.expanded . args.expanded)))
+       
+       (define-splicing-syntax-class (new-optionally-annotated-name tvars)
+         (pattern (~seq name:id (~optional (~seq :colon type:expr)))
+                  #:with tvars tvars
+                  #:with expanded
+                  (template (name
+                             (?? (?@ : (template-expand-type tvars type)))))))
+       
+       (define-syntax-class (new-name-or-parenthesised-annotated-name tvars)
+         (pattern name:id
+                  #:with expanded #'name)
+         (pattern [id:id :colon type:expr]
+                  #:with tvars tvars
+                  #:with expanded
+                  (template [id : (template-expand-type tvars type)])))]
+
+@subsection{@racket[define-type]}
+
+@chunk[<define-type>
+       (define-syntax (new-define-type stx)
+         (syntax-parse stx
+           [(_ (~or name:id (name:id TVar ...)) type . rest)
+            (template
+             (define-type (?? (name TVar ...) name)
+               (template-expand-type (?? (TVar ...) ()) type)
+               . rest))]))]
+
+@chunk[<test-define-type>
+       (let ()
+         (define-type-expander (Repeat stx)
+           (syntax-case stx ()
+             [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                      (range (syntax->datum #'n))))]))
+         
+         (define-type R5 (Repeat Number 5))
+         (check-equal? (ann '(1 2 3 4 5) R5) '(1 2 3 4 5)))]
+
+@subsection{@racket[define]}
+
+@chunk[<define>
+       (define-syntax (new-define stx)
+         (syntax-parse stx
+           [(_ tvars:new-maybe-kw-type-vars
+               (~or v:id
+                    (~var formals (new-curried-formals #'tvars.vars)))
+               (~optional (~seq :colon type))
+               e ...)
+            (template
+             (define (?@ . tvars) (?? v formals.expanded)
+               (?? (?@ : (template-expand-type tvars.vars type)))
+               e ...))]))]
+
+@CHUNK[<test-define>
+       (define d0
+         : `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d)
+         '(2 "abc" #,(x . z) #(1 "b" x) d))
+       (check-equal? (ann d0 (List 2
+                                   "abc"
+                                   (List 'unsyntax (Pairof (U 'x 'y) (U 'y 'z)))
+                                   (Vector 1 "b" 'x) 'd))
+                     '(2 "abc" (unsyntax (x . z)) #(1 "b" x) d))
+       
+       (: d1 (→ Number (→ Number Number)))
+       (define ((d1 [x : Number]) [y : Number]) : Number (+ x y))
+       (check-equal? (ann ((d1 2) 3) Number) 5)
+       
+       (: d2 (→ Number (→ Number Number)))
+       (define ((d2 [x : Number]) [y : Number]) (+ x y))
+       (check-equal? (ann ((d2 3) 4) Number) 7)
+       
+       (define #:∀ (T) ((d3 [x : T]) [y : T]) : (Pairof T T) (cons x y))
+       (check-equal? (ann ((d3 'x) 'y) (Pairof Symbol Symbol)) '(x . y))]
+
+@subsection{@racket[lambda]}
+
+@CHUNK[<lambda>
+       (define-syntax (new-lambda stx)
+         (syntax-parse stx
+           [(_ tvars:new-maybe-kw-type-vars
+               (~var args (new-lambda-formals #'tvars.vars))
+               (~optional (~seq :colon ret-type))
+               e ...)
+            (template (lambda (?@ . tvars) args.expanded
+                        (?? (?@ : (template-expand-type tvars.vars ret-type)))
+                        e ...))]))]
+
+@CHUNK[<test-lambda>
+       (check-equal? ((ann (lambda ([x : Number]) : Number (* x 2))
+                           (→ Number Number))
+                      3)
+                     6)
+       (check-equal? ((ann (λ ([x : Number]) : Number (* x 2))
+                           (→ Number Number))
+                      3)
+                     6)
+       (check-equal? ((λ x x) 1 2 3) '(1 2 3))
+       (check-equal? ((λ #:∀ (A) [x : A ...*] : (Listof A) x) 1 2 3) '(1 2 3))]
+
+@subsection{@racket[struct]}
+
+@chunk[<struct>
+       (define-syntax (new-struct stx)
+         (syntax-parse stx
+           [(_ tvars:new-maybe-type-vars
+               (~and name+parent (~or name:id [name:id parent:id]))
+               ([field:id :colon type:expr] ...)
+               . rest)
+            (template (struct (?? tvars.maybe) name+parent
+                        ([field : (template-expand-type tvars.vars type)] ...)
+                        . rest))]))]
+
+@chunk[<test-struct>
+       (struct s0 ())
+       (struct s1 ([x : Number]))
+       (struct s2 ([x : Number] [y : Number]))
+       (struct s3 ([x : Number] [y : Number]) #:transparent)
+       (struct s4 () #:transparent)
+       (struct (A B) s5 ([x : A] [y : B]) #:transparent)
+       (struct (A B) s6 () #:transparent)
+       
+       (check (λ (a b) (not (equal? a b))) (s0) (s0))
+       (check-equal? (s1-x (s1 123)) 123)
+       (check-equal? (s2-x (s2 2 3)) 2)
+       (check-equal? (s2-y (s2 2 3)) 3)
+       (check-equal? (s3-x (s3 4 5)) 4)
+       (check-equal? (s3-y (s3 4 5)) 5)
+       (check-equal? (s4) (s4))
+       (check-equal? (s5-x (s5 6 7)) 6)
+       (check-equal? (s5-y (s5 6 7)) 7)
+       (check-equal? (s5 6 7) (s5 6 7))
+       (check-equal? (s6) (s6))]
+
+@subsection{@racket[ann]}
+
+@chunk[<ann>
+       (define-syntax/parse (new-ann value:expr (~optional :colon) type:expr)
+         (template (ann value (template-expand-type () type))))]
+
+@chunk[<test-ann>
+       (let ()
+         (define-type-expander (Repeat stx)
+           (syntax-case stx ()
+             [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                      (range (syntax->datum #'n))))]))
+         (check-equal? (ann (ann '(1 2 3)
+                                 (Repeat Number 3))
+                            (List Number Number Number))
+                       '(1 2 3)))]
+
+@subsection{@racket[inst]}
+
+@chunk[<inst>
+       (define-syntax/parse (new-inst v
+                                      (~optional :colon) t ...
+                                      (~optional (~seq last (~datum ...) b:id)))
+         (template (inst v (template-expand-type () t) ...
+                         (?? (?@ (template-expand-type () last)
+                                 (... ...) b)))))]
+
+@chunk[<test-inst>
+       (let ()
+         (define-type-expander (Repeat stx)
+           (syntax-case stx ()
+             [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                      (range (syntax->datum #'n))))]))
+         
+         (: f (∀ (A B C D) (→ (Pairof A B) (Pairof C D) (List A C B D))))
+         (define (f x y) (list (car x) (car y) (cdr x) (cdr y)))
+         
+         (check-equal? ((inst f
+                              (Repeat Number 3)
+                              (Repeat String 2)
+                              (Repeat 'x 1)
+                              (Repeat undefined-type 0))
+                        '((1 2 3) . ("a" "b"))
+                        '((x) . ()))
+                       '((1 2 3) (x) ("a" "b") ())))]
+
+@subsection{@racket[let]}
+
+@chunk[<let>
+       (define-syntax/parse
+         (new-let
+          (~optional (~seq loop:id (~optional (~seq :colon return-type:expr))))
+          tvars:new-maybe-kw-type-vars
+          ([(~var name (new-optionally-annotated-name #'tvars.vars))
+            e:expr] ...)
+          . rest)
+         (template
+          (let (?? (?@ loop (?? (?@ : (template-expand-type tvars.vars
+                                                            return-type)))))
+            (?@ . tvars)
+            ([(?@ . name.expanded) e] ...)
+            . rest)))]
+
+@chunk[<test-let>
+       (check-equal? (let loop-id ([x 1])
+                       (if (= x 2)
+                           x
+                           (loop-id (+ x 1))))
+                     2)
+       (check-equal? (let () 'x) 'x)
+       (check-equal? (ann (let #:∀ (T) ([a : T 3]
+                                        [b : (Pairof T T) '(5 . 7)])
+                            (cons a b))
+                          (Pairof Number (Pairof Number Number)))
+                     '(3 5 . 7))]
+
+@subsection{@racket[let*]}
+
+@chunk[<let*>
+       (define-syntax/parse
+         (new-let*
+          ([(~var name (new-optionally-annotated-name #'()))
+            e:expr] ...)
+          . rest)
+         (template
+          (let* ([(?@ . name.expanded) e] ...)
+            . rest)))]
+
+@chunk[<test-let*>
+       (let ()
+         (define-type-expander (Repeat stx)
+           (syntax-case stx ()
+             [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                      (range (syntax->datum #'n))))]))
+         
+         (check-equal? (let* ([x* : (Repeat Number 3) '(1 2 3)]
+                              [y* : (Repeat Number 3) x*])
+                         y*)
+                       '(1 2 3)))]
+
+@subsection{@racket[let-values]}
+
+@chunk[<let-values>
+       (define-syntax/parse
+         (new-let-values
+          ([((~var name (new-name-or-parenthesised-annotated-name #'())) ...)
+            e:expr] ...)
+          . rest)
+         (template
+          (let-values ([(name.expanded ...) e] ...)
+            . rest)))]
+
+@chunk[<test-let-values>
+       (let ()
+         (define-type-expander (Repeat stx)
+           (syntax-case stx ()
+             [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                      (range (syntax->datum #'n))))]))
+         
+         (check-equal? (ann (let-values
+                                ([([x : (Repeat Number 3)])
+                                  (list 1 2 3)])
+                              (cdr x))
+                            (List Number Number))
+                       '(2 3))
+         
+         (check-equal? (ann (let-values
+                                ([([x : (Repeat Number 3)] [y : Number])
+                                  (values (list 1 2 3) 4)])
+                              (cons y x))
+                            (Pairof Number (List Number Number Number)))
+                       '(4 . (1 2 3)))
+         
+         (check-equal? (ann (let-values
+                                ([(x y)
+                                  (values (list 1 2 3) 4)])
+                              (cons y x))
+                            (Pairof Number (List Number Number Number)))
+                       '(4 . (1 2 3))))]
+
+@subsection{@racket[make-predicate]}
+
+@chunk[<make-predicate>
+       (define-syntax/parse (new-make-predicate type:expr)
+         (template (make-predicate (template-expand-type () type))))]
+
+@chunk[<test-make-predicate>
+       (let ()
+         (define-type-expander (Repeat stx)
+           (syntax-case stx ()
+             [(_ t n) #`(List #,@(map (λ (x) #'t)
+                                      (range (syntax->datum #'n))))]))
+         (check-equal? ((make-predicate (Repeat Number 3)) '(1 2 3)) #t)
+         (check-equal? ((make-predicate (Repeat Number 3)) '(1 "b" 3)) #f))]
+
+@subsection[#:tag "other-forms"]{Other @racket[typed/racket] forms}
+
+The other @tc[typed/racket] forms below do not have an alternative definition
+yet.
+
+@chunk[<other-forms>
+       (define-syntax (missing-forms stx)
+         (syntax-parse stx
+           [(_ name ...)
+            (define/with-syntax (tmp ...) (generate-temporaries #'(name ...)))
+            #'(begin
+                (begin
+                  (define-syntax (tmp stx)
+                    (raise-syntax-error
+                     'name
+                     (format "~a not implemented yet for type-expander" 'name)))
+                  (provide (rename-out [tmp name])))
+                ...)]))
+       
+       (missing-forms
+        ;; TODO: add all-defined-out in prims.rkt
+        ;; top-interaction.rkt
+        :type
+        :print-type
+        :query-type/args
+        :query-type/result
+        ;; case-lambda.rkt
+        case-lambda
+        case-lambda:
+        pcase-lambda:
+        ;; (submod "prims-contract.rkt" forms)
+        require/opaque-type 
+        require-typed-struct-legacy
+        require-typed-struct
+        require/typed-legacy
+        require/typed
+        require/typed/provide
+        require-typed-struct/provide
+        cast
+        ;make-predicate
+        define-predicate
+        ;; prims.rkt
+        define-type-alias
+        define-new-subtype
+        define-typed-struct
+        define-typed-struct/exec
+        ;ann
+        ;inst
+        ;:
+        define-struct:
+        define-struct
+        ;struct
+        struct:
+        λ:
+        ;lamdba
+        ;λ
+        ;define
+        ;let
+        ;let*
+        letrec
+        ;let-values
+        letrec-values
+        let/cc
+        let/ec
+        let:
+        let*:
+        letrec:
+        let-values:
+        letrec-values:
+        let/cc:
+        let/ec:
+        for
+        for/list
+        for/vector
+        for/hash
+        for/hasheq
+        for/hasheqv
+        for/and
+        for/or
+        for/sum
+        for/product
+        for/lists
+        for/first
+        for/last
+        for/fold
+        for*
+        for*/list
+        for*/lists
+        for*/vector
+        for*/hash
+        for*/hasheq
+        for*/hasheqv
+        for*/and
+        for*/or
+        for*/sum
+        for*/product
+        for*/first
+        for*/last
+        for*/fold
+        for/set
+        for*/set
+        do
+        do:
+        with-handlers
+        define-struct/exec:
+        define-struct/exec)]
+
+@section{Future work}
+
+We have not implemented alternative type-expanding definitions for all the
+@tc[typed/racket] forms, as noted in @secref{other-forms}.
+
+Integrating the type-expander directly into typed/racket would avoid the need to
+provide such definitions, and allow using type-expanders in vanilla
+@tc[typed/racket], instead of having to @tc[require] this library. However, the
+code wrapping the @tc[typed/racket] forms could be re-used by other libraries
+that alter the way @tc[typed/racket] works, so implementing the remaining forms
+could still be useful.
+
+Also, we would need to provide a @tc[syntax-local-type-introduce] function,
+similar to the @tc[syntax-local-match-introduce] function provided by @tc[match]
+for example.
+
+@section{Conclusion}
+
+When an identifier is @tc[require]d from another module, it is not the same as
+the one visible within the defining module. This is a problem for @tc[:],
+because we match against it in our syntax classes, using @tc[(~literal :)], but
+when it is written in another module, for example @tc[(define foo : Number 42)],
+it is not the same identifier as the one used by original definition of @tc[:],
+and therefore the @tc[(~literal :)] won't match. I suspect that issue to be due
+to contract wrappers added by @tc[typed/racket].
+
+To get around that problem, we define @tc[:] in a separate module, and
+@tc[require] it in the module containing the syntax classes:
+
+@chunk[<module-colon>
+       (module colon typed/racket
+         (require (for-syntax racket
+                              syntax/parse)
+                  "../lib/low.rkt")
+         (require (for-syntax (submod ".." expander)))
+         
+         (provide new-:)
+         
+         <:>)]
+
+Since our @tc[new-:] macro needs to call the @tc[type-expander], and the other
+forms too, we can't define @tc[type-expander] in the same module as these forms,
+it needs to be either in the same module as @tc[new-:], or in a separate module.
+Additionally, expand-type needs to be required @tc[for-syntax] by the forms, but
+needs to be @tc[provide]d too, so it is much easier if it is defined in a
+separate module (that should be used only @tc[for-syntax], so it will be written
+in @tc[racket], not @tc[typed/racket]).
+
+@chunk[<module-expander>
+       (module expander racket
+         (require racket)
+         (require syntax/parse)
+         (require syntax/stx)
+         
+         (require (for-template typed/racket))
+         
+         (provide prop:type-expander
+                  type-expander
+                  apply-type-expander
+                  bind-type-vars
+                  expand-type)
+         
+         <prop-guard>
+         <prop:type-expander>
+         <type-expander-struct>
+         
+         <apply-type-expander>
+         <expand-quasiquote>
+         <bind-type-vars>
+         <expand-type>)]
+
+We can finally define the overloaded forms, as well as the extra
+@tc[<define-type-expander>].
+
+@chunk[<module-main>
+       (module main typed/racket
+         (require (for-syntax racket
+                              racket/syntax
+                              syntax/parse
+                              syntax/parse/experimental/template)
+                  "../lib/low.rkt")
+         
+         (require (submod ".." expander))
+         (require (for-syntax (submod ".." expander)))
+         (require (for-syntax typed-racket/base-env/annotate-classes))
+         (require (submod ".." colon))
+         
+         (provide prop:type-expander
+                  expand-type
+                  define-type-expander
+                  (rename-out [new-: :]
+                              [new-define-type define-type]
+                              [new-define define]
+                              [new-lambda lambda]
+                              [new-lambda λ]
+                              [new-struct struct]
+                              [new-ann ann]
+                              [new-inst inst]
+                              [new-let let]
+                              [new-let* let*]
+                              [new-let-values let-values]
+                              [new-make-predicate make-predicate]))
+         
+         <define-type-expander>
+         
+         (begin-for-syntax
+           <template-metafunctions>
+           <syntax-classes>)
+         
+         <define-type>
+         <define>
+         <lambda>
+         <struct>
+         <ann>
+         <inst>
+         <let>
+         <let*>
+         <let-values>
+         <make-predicate>
+         <other-forms>)]
+
+And, last but not least, we will add a @tc[test] module.
+
+@chunk[<module-test>
+       (module* test typed/racket
+         (require typed/rackunit)
+         (require (submod ".."))
+         (require (for-syntax (submod ".." expander)))
+         (require (for-syntax racket/list))
+         
+         <test-expand-type>
+         
+         <test-:>
+         <test-define-type>
+         <test-define>
+         <test-lambda>
+         <test-struct>
+         <test-ann>
+         <test-inst>
+         <test-let>
+         <test-let*>
+         <test-let-values>
+         <test-make-predicate>
+         
+         ;; Make the code coverage take the docs into account.
+         (require (submod ".." doc)))]
+
+We can now assemble the modules in this order:
+
+@chunk[<*>
+       (begin
+         <module-expander>
+         <module-colon>
+         <module-main>
+         
+         (require 'main)
+         (provide (all-from-out 'main))
+         
+         <module-test>)]