Merge remote-tracking branch 'all/split-library' into graph-rich-return

.travis.yml

@@ -47,6 +47,7 @@ install:
 - make build-dep
 
 script:
+- racket --version
 - make
 
 after_success:

graph-lib/README.md

@@ -201,15 +201,11 @@ Library functions and utilities
   
   Utilities that complement racket and typed/racket's standard libraries.
 
-* `lib/low.rkt`
+* `lib/low.rkt` and `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/for-star-list-star.rkt`
 
   A utility macro similar to `for*/list` to iterate over collections and return
@@ -218,7 +214,8 @@ Library functions and utilities
 
 * `lib/untyped.rkt`
 
-  Aggregates `lib/low-untyped.rkt`, and `lib/untyped/for-star-list-star.rkt`.
+  Aggregates `(submod "lib/low.rkt" untyped)`, and
+  `lib/untyped/for-star-list-star.rkt`.
 
 * `lib/test-framework.rkt`
   

graph-lib/graph/dotlang.rkt

@@ -11,16 +11,15 @@
     
   
   (require "get.lp2.rkt"
-           "../lib/low-untyped.rkt"
+           (submod "../lib/low.rkt" untyped)
            (for-syntax racket/string
                        syntax/parse
                        racket/syntax
-                       syntax/stx
                        syntax/strip-context
                        racket/struct
                        racket/function
                        syntax/srcloc
-                       "../lib/low-untyped.rkt"))
+                       (submod "../lib/low.rkt" untyped)))
   
   #|
   (define-syntax/parse (dot x:id)

graph-lib/graph/fold-queues.lp2.rkt

@@ -226,7 +226,7 @@ position in the vector equal to the index associated to it in the hash table:
          (require (for-syntax syntax/parse
                               syntax/parse/experimental/template
                               racket/syntax
-                              "../lib/low-untyped.rkt")
+                              (submod "../lib/low.rkt" untyped))
                   "../lib/low.rkt"
                   "../type-expander/type-expander.lp2.rkt")
          

graph-lib/graph/get.lp2.rkt

@@ -201,7 +201,7 @@ The type for the function generated by @tc[λget] mirrors the cases from
        (module main typed/racket
          (require (for-syntax syntax/parse
                               racket/syntax
-                              "../lib/low-untyped.rkt")
+                              (submod "../lib/low.rkt" untyped))
                   "../lib/low.rkt"
                   "structure.lp2.rkt"
                   "variant.lp2.rkt"

graph-lib/graph/graph-5-multi-ctors.lp2.rkt

@@ -150,9 +150,7 @@ name) with the right type, so that the user doesn't see all the types in the
          (require (for-syntax syntax/parse
                               syntax/parse/experimental/template
                               racket/syntax
-                              syntax/stx
+                              (submod "../lib/low.rkt" untyped))
-                              "../lib/low-untyped.rkt"
-                              "../lib/low/multiassoc-syntax.rkt")
                   "../lib/low.rkt"
                   "graph.lp2.rkt"
                   "get.lp2.rkt"

graph-lib/graph/graph-6-rich-returns.lp2.rkt

@@ -162,11 +162,8 @@ encapsulating the result types of mappings.
          (require (for-syntax syntax/parse
                               syntax/parse/experimental/template
                               racket/syntax
-                              syntax/stx
+                              (submod "../lib/low.rkt" untyped)
-                              "../lib/low-untyped.rkt"
+                              "rewrite-type.lp2.rkt" #|debug|#)
-                              "../lib/low/multiassoc-syntax.rkt"
-                              "rewrite-type.lp2.rkt"; debug
-                              )
                   (rename-in "../lib/low.rkt" [~> threading:~>])
                   "graph.lp2.rkt"
                   "get.lp2.rkt"

graph-lib/graph/graph.lp2.rkt

@@ -761,12 +761,11 @@ We will be able to use this type expander in function types, for example:
        (module main typed/racket
          (require (for-syntax syntax/parse
                               racket/syntax
-                              syntax/stx
                               syntax/parse/experimental/template
                               racket/sequence
                               racket/pretty
                               "rewrite-type.lp2.rkt"
-                              "../lib/low-untyped.rkt"
+                              (submod "../lib/low.rkt" untyped)
                               "meta-struct.rkt")
                   racket/splicing
                   "fold-queues.lp2.rkt"

graph-lib/graph/graph2.lp2.rkt_

@@ -1,618 +0,0 @@
-#lang debug scribble/lp2
-@(require "../lib/doc.rkt")
-@doc-lib-setup
-
-@title[#:style manual-doc-style]{Graph library}
-
-@(table-of-contents)
-
-@; TODO: allow a mapping to return a new placeholder, in order to act as a
-@; redirect. All references to the old placeholder will act as if they were to
-@; the new placeholder.
-
-@section{Introduction}
-
-This module provides a @tc[graph] macro which helps constructing immutable
-graphs (using lambdas to defer potentially cyclic references).
-
-
-
-
-
-
-
-
-
-
-@subsection{Example usage}
-
-We will start with a running example, which will help us both show the macro's
-syntax, and show some of the key advantages offered by this graph library.
-
-@subsection{The graph's type}
-
-Each node type in the graph is a variant's constructor, tagged with the node
-name. For example, a graph representing a city and its inhabitants could use
-these variants:
-
-@chunk[<example-variants>
-       [City [streets : (Listof Street)] [people : (Listof Person)] <m-city>]
-       [Street [houses : (Listof House)] <m-street>]
-       [House [owner : Person] [location : Street] <m-house>]
-       [Person [name : String]] <m-person>]
-
-Notice the cycle in the type: a street contains houses, which are located on the
-same street.
-
-@subsubsection{A seed from which to unravel the graph: the root parameters}
-
-In order to build a graph with that type, we start from the root parameters.
-Here, we will take a representation of the city as a list of
-@tc[(street . person-name)] pairs, and will convert it to a more convenient
-graph representation. Our single root parameter will thus be the whole list:
-
-@chunk[<example-root>
-       '(["Amy" . "Ada street"]
-         ["Jack" . "J street"]
-         ["Anabella" . "Ada street"])]
-
-We then provide a mapping from the root parameter to the root node, in our case
-@tc[City]. When processing the root parameter, one can call mappings that will
-create other nodes.
-
-@subsubsection{Mapping the root parameters to the root node}
-
-Here is the root mapping for our example. It maps over the list of names and
-street names @tc[c], and calls for each element the @tc[m-street] mapping and
-the @tc[Person] node constructor.
-
-@; Would be nicer with (map (∘ (curry street c) my-car) c)), but that doesn't
-@; typecheck (yet).
-@chunk[<m-city>
-       [(m-city [c : (Listof (Pairof String String))]) : City
-        (City (remove-duplicates (map (curry m-street c) (cars c)))
-              (remove-duplicates (map m-person (cdrs c))))]]
-
-@subsubsection{More mappings}
-
-Next, we write the @tc[m-street] mapping, which takes a street name and the
-whole city @tc[c] in list form, and creates a @tc[Street] node.
-
-@chunk[<m-street>
-       [(m-street [c : (Listof (Pairof String String))] [s : String]) : Street
-        (Street (map (curry (curry m-house s) c)
-                     (cars (filter (λ ([x : (Pairof String String)])
-                                     (equal? (cdr x) s))
-                                   c))))]]
-
-The @tc[m-house] mapping calls back the @tc[m-street] mapping, to store for each
-house a reference to the containing street. Normally, this would cause infinite
-recursion in an eager language, like @tc[typed/racket]. However, the mappings
-aren't called directly, and instead the @tc[m-street] function here returns a
-placeholder. This allows us to not worry about mutually recursive mappings: a
-mapping can be called any number of times with the same data, it will actually
-only be run once.
-
-The @tc[make-graph-constructor] macro will post-process the result of each
-mapping, and replace the placeholders with promises for the the result of the
-mapping. The promises are not available during graph construction, so there is
-no risk of forcing one before it is available.
-
-Finally, we write the @tc[m-house] mapping.
-
-@chunk[<m-house>
-       [(m-house [s : String]
-                 [c : (Listof (Pairof String String))]
-                 [p : String])
-        : House
-        (House (m-person p) (m-street c s))]]
-
-@chunk[<m-person>
-       [(m-person [p : String]) : Person
-        (Person p)]]
-
-@identity{
- Notice how we are calling directly the @tc[Person] constructor above. We also
- called it directly in the @tc[m-city] mapping. Since @tc[Person] does not
- contain references to @tc[House], @tc[Street] or @tc[City], we do not need to
- delay creation of these nodes by calling yet another mapping.
- 
- @; TODO: above: Should we merge two identical instances of Person? They won't
- @; necessarily be eq? if they contain cycles deeper in their structure, anyway.
- @; And we are already merging all equal? placeholders, so there shouldn't be
- @; any blowup in the number of nodes.
- @; It would probably be better for graph-map etc. to have all the nodes in the
- @; database, though.
- 
- The number and names of mappings do not necessarily reflect the graph's type.
- Here, we have no mapping named @tc[m-person], because that node is always
- created directly. Conversely, we could have two mappings, @tc[m-big-street] and
- @tc[m-small-street], with different behaviours, instead of passing an extra
- boolean argument to @tc[m-street].
- 
- @; TODO: make the two street mappings
-}
-
-@subsubsection{Making a constructor for the graph}
-
-@identity{
- @chunk[<make-constructor-example>
-        (make-graph-constructor (<example-variants>)
-                                <example-root>)]
-  
- @subsubsection{Creating a graph instance}
- 
- @chunk[<use-example>
-        (define g <make-constructor-example>)]
-}
-
-@subsection{More details on the semantics}
-
-Let's take a second look at the root mapping:
-
-@chunk[<m-city-2>
-       [(m-city [c : (Listof (Pairof String String))]) : City
-        (City (remove-duplicates (map (curry m-street c) (cars c)))
-              (remove-duplicates (map Person (cdrs c))))]]
-
-The first case shows that we can use @tc[m-street] as any other function,
-passing it to @tc[curry], and calling @tc[remove-duplicates] on the results.
-Note that each placeholder returned by @tc[m-street] will contain all
-information passed to it, here a street name and @tc[c]. Two placeholders for
-@tc[m-street] will therefore be @tc[equal?] if and only if all the arguments
-passed to @tc[m-street] are @tc[equal?]. The placeholders also include a symbol
-specifying which mapping was called, so two placeholders for two different
-mappings will not be @tc[equal?], even if identical parameters were supplied.
-
-@identity{
- The second case shows that we can also directly call the constructor for the
- @tc[Person] node type. If that type contains references to other nodes, the
- constructor here will actually accept either a placeholder, or an actual
- instance, which itself may contain placeholders.
- 
- The node type allowing placeholders is derived from the ideal type given above.
- Here, the type for @tc[Person] is @tc[[String]], so there are no substitutions
- to make. On the contrary, the type for @tc[City], originally expressed as
- @tc[[(Listof Street) (Listof Person)]], will be rewritten into
- @tc[[(Listof (U Street Street-Placeholder))
-      (Listof (U Person Person-Placeholder))]].
-}
-
-The @tc[rewrite-type] module we use to derive types with placeholders from the
-original ones only handles a handful of the types offered by @tc[typed/racket].
-In particular, it does not handle recursive types described with @tc[Rec] yet.
-
-@section{Implementation}
-
-In this section, we will describe how the @tc[make-graph-constructor] macro is
-implemented.
-
-@subsection{The macro's syntax}
-
-We use a simple syntax for @tc[make-graph-constructor], and make it more
-flexible through wrapper macros.
-
-@chunk[<signature>
-       (make-graph-constructor
-        (root-expr:expr ...)
-        ([node <field-signature> … <mapping-declaration>] …))]
-
-Where @tc[<field-signature>] is:
-
-@chunk[<field-signature>
-       [field-name:id (~literal :) field-type:expr]]
-
-And @tc[<mapping-declaration>] is:
-
-@chunk[<mapping-declaration>
-       ((mapping:id [param:id (~literal :) param-type:expr] …)
-        . mapping-body)]
-
-@subsection{The different types of a node and mapping}
-
-A single node name can refer to several types:
-
-@itemlist[
- @item{The @emph{ideal} type, expressed by the user, for example
-  @racket[[City (Listof Street) (Listof Person)]], it is never used as-is in
-  practice}
- @item{The @emph{placeholder} type, type and constructor, which just store the
-  arguments for the mapping along with a tag indicating the node name}
- @item{The @emph{incomplete} type, in which references to other node types are
-  allowed to be either actual (@racket[incomplete]) instances, or placeholders.
-  For example, @racket[[City (Listof (U Street Street/placeholder-type))
-                        (Listof (U Person Person/placeholder-type))]].}
- @item{The @emph{with-indices} type, in which references to other node types
-  must be replaced by an index into the results list for the target node's
-  @racket[with-promises] type. For example,
-  @racket[[City (Listof (Pairof 'Street/with-indices-tag Index))
-           (Listof (Pairof 'Person/with-indices-tag Index))]].}
- @item{The @emph{with-promises} type, in which references to other node types
-  must be replaced by a @racket[Promise] for the target node's
-  @racket[with-promises] type. For example,
-  @racket[[City (Listof (Promise Street/with-promises-type))
-           (Listof (Promise Person/with-promises-type))]].}
- @item{The @emph{mapping function}, which takes some parameters and
-  returns a node (this is the code directly provided by the user)}]
-
-We derive identifiers for these based on the @tc[node] or @tc[mapping] name:
-
-@;;;;
-@chunk[<define-ids2>
-       (define-temp-ids "~a/make-placeholder" (mapping …) #:first-base root)
-       (define-temp-ids "~a/placeholder-type" (mapping …))
-       (define-temp-ids "~a/make-incomplete" (node …))
-       (define-temp-ids "~a/incomplete-type" (node …))
-       (define-temp-ids "~a/make-with-indices" (node …))
-       (define-temp-ids "~a/with-indices-type" (node …))
-       (define-temp-ids "~a/make-with-promises" (node …))
-       (define-temp-ids "~a/with-promises-type" (node …))
-       (define-temp-ids "~a/function" (mapping …))]
-
-@chunk[<define-ids2>
-       (define/with-syntax (root/make-placeholder . _)
-         #'(mapping/make-placeholder …))]
-
-@subsection{Overview}
-
-The macro relies heavily on two sidekick modules: @tc[rewrite-type], and
-@tc[fold-queue]. The former will allow us to derive from the ideal type of a
-node the incomplete type and the with-promises type. It will also allow us to
-search in instances of incomplete nodes, in order to extract the placehoders,
-and replace these parts with promises. The latter, @tc[fold-queue], will be used
-to process all the pending placeholders, with the possibility to enqueue new
-ones as these placeholders are discovered inside incomplete nodes.
-
-When the graph constructor is called with the arguments for the root parameters,
-it is equivalent to make and then resolve an initial placeholder. We will use a
-function from the @tc[fold-queue] library to process the queues of pending
-placeholders, starting with a queue containing only that root placeholder.
-We will have one queue for each placeholder type.@note{It we had only one queue,
- we would have only one collection of results, and would need a @racket[cast]
- when extracting nodes from the collection of results.} The
-queues' element types will therefore be these placeholder types.
-
-@chunk[<fold-queue-type-element>
-       mapping/placeholder-type]
-
-The return type for each queue will be the corresponding with-promises type. The
-fold-queues function will therefore return a vector of with-promises nodes.
-
-@chunk[<fold-queue-type-result>
-       <with-promises-type>]
-
-@; Problem: how do we ensure we return the right type for the root?
-@; How do we avoid casts when doing look-ups?
-@; We need several queues, handled in parallel, with distinct element types.
-@; * Several result aggregators, one for each type, so we don't have to cast
-@; * Several queues, so that we can make sure the root node is of the expected
-@;   type.
-
-@; TODO: clarity.
-@; The @tc[fold-queues] function allows us to associate each element with a tag,
-@; so that, inside the processing function and outside, we can refer to an
-@; element using this tag, which can be more lightweight than keeping a copy of
-@; the element.
-@; 
-@; We will tag our elements with an @tc[Index], which prevents memory leakage:
-@; if we kept references to the original data added to the queue, a graph's
-@; representation would hold references to its input, which is not the case when
-@; using simple integers to refer to other nodes, instead of using the input for
-@; these nodes. Also, it makes lookups in the database much faster, as we will
-@; be able to use an array instead of a hash table.
-
-@subsection{The queues of placeholders}
-
-The fold-queus macro takes a root element, in our case the root placeholder,
-which it will insert into the first queue. The next clauses are the queue
-handlers, which look like function definitions of the form
-@tc[(queue-name [element : element-type] Δ-queues enqueue)]. The @tc[enqueue]
-argument is a function used to enqueue elements and get a tag in return, which
-can later be used to retrieve the processed element.
-
-Since the @tc[enqueue] function is pure, it takes a parameter of the same type
-as @tc[Δ-queues] representing the already-enqueued elements, and returns a
-modified copy, in addition to the tag. The queue's processing body should return
-the latest @tc[Δ-queues] in order to have these elements added to the queue.
-
-@chunk[<fold-queue>
-       (fold-queues <root-placeholder>
-                    [(mapping/placeholder-tag [e : <fold-queue-type-element>]
-                                              Δ-queues
-                                              enqueue)
-                     : <fold-queue-type-result>
-                     <fold-queue-body>]
-                    ...)]
-
-@subsection{Making placeholders for mappings}
-
-We start creating the root placeholder which we provide to @tc[fold-queues].
-
-@chunk[<root-placeholder>
-       (root/make-placeholder root-expr ...)]
-
-To make the placeholder, we will need a @tc[make-placeholder] function for each
-@tc[mapping]. We define the type of each placeholder (a list of arguments,
-tagged with the @tc[mapping]'s name), and a constructor:
-
-@; TODO: just use (variant [mapping param-type ...] ...)
-
-@chunk[<define-mapping-placeholder>
-       (define-type mapping/placeholder-type (List 'mapping/placeholder-tag
-                                                   param-type ...))
-       
-       (: mapping/make-placeholder (→ param-type ... mapping/placeholder-type))
-       (define (mapping/make-placeholder [param : param-type] ...)
-         (list 'mapping/placeholder-tag param ...))]
-
-The code above needs some identifiers derived from @tc[mapping] names:
-
-@chunk[<define-ids>
-       (define-temp-ids "~a/make-placeholder" (mapping ...))
-       (define-temp-ids "~a/placeholder-type" (mapping ...))
-       (define-temp-ids "~a/placeholder-tag" (mapping ...))
-       (define/with-syntax (root/make-placeholder . _)
-         #'(mapping/make-placeholder ...))]
-
-@subsection{Making with-promises nodes}
-
-We derive the @tc[with-promises] type from each @emph{ideal} node type using
-the @tc[tmpl-replace-in-type] template metafunction from the rewrite-type
-library. We replace all occurrences of a @tc[node] name with a @tc[Promise] for
-that node's @tc[with-promises] type.
-
-@; TODO: use a type-expander here, instead of a template metafunction.
-
-@CHUNK[<define-with-promises-nodes>
-       (define-type field/with-promises-type
-         (tmpl-replace-in-type field-type
-                               [node (Promise node/with-promises-type)]
-                               …))
-       …
-       
-       (define-type node/with-promises-type (List 'with-promises
-                                                  'node
-                                                  field/with-promises-type …))
-       
-       (: node/make-with-promises (→ field/with-promises-type …
-                                     node/with-promises-type))
-       (define (node/make-with-promises field-name …)
-         (list 'with-promises 'node field-name …))]
-
-The code above needs some identifiers derived from @tc[node] and
-@tc[field-name]s:
-
-@chunk[<define-ids>
-       (define-temp-ids "~a/make-with-promises" (node ...))
-       (define-temp-ids "~a/with-promises-type" (node ...))
-       (define/with-syntax ((field/with-promises-type …) …)
-         (stx-map generate-temporaries #'((field-name …) …)))]
-
-@subsection{Making incomplete nodes}
-
-We derive the @tc[incomplete] type from each @emph{ideal} node type using
-the @tc[tmpl-replace-in-type] template metafunction from the rewrite-type
-library. We replace all occurrences of a @tc[node] name with a union of the
-node's @tc[incomplete] type, and all compatible @tc[placeholder] types.
-
-TODO: for now we allow all possible mappings, but we should only allow those
-which return type is the desired node type.
-
-@; TODO: use a type-expander here, instead of a template metafunction.
-
-@CHUNK[<define-incomplete-nodes>
-       (define-type field/incomplete-type <field/incomplete-type>)
-       …
-       
-       (define-type node/incomplete-type
-         (Pairof 'node/incomplete-tag (List field/incomplete-type …)))
-       
-       (: node/make-incomplete (→ field/incomplete-type … node/incomplete-type))
-       (define (node/make-incomplete field-name …)
-         (list 'node/incomplete-tag field-name …))]
-
-Since the incomplete type for fields will appear in two different places, above
-and in the incomplete-to-with-promises conversion routine below, we write it in
-a separate chunk:
-
-@chunk[<field/incomplete-type>
-       (tmpl-replace-in-type field-type
-                             [node (U node/incomplete-type
-                                      node/compatible-placeholder-types …)]
-                             …)]
-
-@identity{
-We must however compute for each node the set of compatible placeholder types.
-We do that
-
-@chunk[<define-compatible-placeholder-types>
-       (define/with-syntax ((node/compatible-placeholder-types ...) ...)
-         (for/list ([x (in-syntax #'(node ...))])
-           (multiassoc-syntax
-            x
-            #'([result-type . mapping/placeholder-type];;;;;;;;;;;;;;;;;;;;;;;;;;;; . (List 'mapping/placeholder-tag param-type ...)
-               …))))]
-
-The multiassoc-syntax function used above filters the associative syntax list
-and returns the @tc[stx-cdr] of the matching elements, therefore returning a
-list of @tc[mapping/placeholder-type]s for which the @tc[result-type] is the
-given @tc[node] name.
-
-@chunk[<multiassoc-syntax>
-       (define (multiassoc-syntax query alist)
-         (map stx-cdr
-              (filter (λ (xy) (free-identifier=? query (stx-car xy)))
-                      (syntax->list alist))))
-       
-       (define (cdr-assoc-syntax query alist)
-         (stx-cdr (findf (λ (xy) (free-identifier=? query (stx-car xy)))
-                         (syntax->list alist))))
-       
-       (define-template-metafunction (tmpl-cdr-assoc-syntax stx)
-         (syntax-parse stx
-           [(_ query [k . v] …)
-            (cdr-assoc-syntax #'query #'([k . v] …))]))]
-
-The code above also needs some identifiers derived from @tc[node] and
-@tc[field-name]s:
-
-@chunk[<define-ids>
-       (define-temp-ids "~a/make-incomplete" (node …))
-       (define-temp-ids "~a/incomplete-type" (node …))
-       (define-temp-ids "~a/incomplete-tag" (node …))
-       (define-temp-ids "~a/incomplete-fields" (node …))
-       (define/with-syntax ((field/incomplete-type …) …)
-         (stx-map-nested #'((field-name …) …)))]
-}
-
-@subsection{Converting incomplete nodes to with-promises ones}
-
-@chunk[<convert-incomplete-to-with-promises>
-       [node/incomplete-type
-        node/with-promises-type
-        (λ (x) (and (pair? x) (eq? (car x) 'node/incomplete-tag)))
-        (λ ([x : node/incomplete-type] [acc : Void])
-          <convert-incomplete-successor>)]]
-
-@chunk[<convert-placeholder-to-with-promises>
-       [mapping/placeholder-type
-        (tmpl-replace-in-type result-type [node node/with-promises-type] …)
-        (λ (x) (and (pair? x)
-                    (eq? (car x) 'mapping/placeholder-tag)))
-        (λ ([x : mapping/placeholder-type] [acc : Void])
-          <convert-placeholder-successor>)]]
-
-
-@; TODO: this would be much simpler if we forced having only one mapping per
-@; node, and extended that with a macro.
-
-@chunk[<define-compatible-mappings>
-       (define/with-syntax ((node/compatible-mappings ...) ...)
-         (for/list ([x (in-syntax #'(node ...))])
-           (multiassoc-syntax
-            x
-            #'([result-type . mapping]
-               …))))]
-
-@chunk[<convert-incomplete-successor>
-       (error (~a "Not implemented yet " x))]
-
-@chunk[<convert-placeholder-successor>
-       (% index new-Δ-queues = (enqueue 'mapping/placeholder-tag x Δ-queues)
-          (list 'mapping/placeholder-tag index)
-          (error (~a "Not implemented yet " x)))]
-
-
-@subsection{Processing the placeholders}
-
-@; TODO: also allow returning a placeholder (which means we should then
-@; process that placeholder in turn). The placeholder should return the
-@; same node type, but can use a different mapping?
-@; Or maybe we can do this from the ouside, using a wrapper macro?
-
-@CHUNK[<fold-queue-body>
-       (let ([mapping-result (apply mapping/function (cdr e))])
-         (tmpl-fold-instance <the-incomplete-type>
-                             Void
-                             <convert-incomplete-to-with-promises> …
-                             <convert-placeholder-to-with-promises> …))
-       'todo!]
-
-@chunk[<the-incomplete-type>
-       (tmpl-cdr-assoc-syntax result-type
-                              [node . (List <field/incomplete-type> …)]
-                              …)]
-
-@section{The mapping functions}
-
-We define the mapping functions as they are described by the user, with an
-important change: Instead of returning an @emph{ideal} node type, we expect them
-to return an incomplete node type.
-
-@chunk[<define-mapping-function>
-       (define-type mapping/incomplete-result-type
-         (tmpl-replace-in-type result-type
-                               [node (List 'node/incomplete-tag
-                                           <field/incomplete-type> …)]
-                               …))
-       
-       (: mapping/function (→ param-type … mapping/incomplete-result-type))
-       (define mapping/function
-         (let ([mapping mapping/make-placeholder]
-               …
-               [node node/make-incomplete]
-               …)
-           (λ (param …)
-             . mapping-body)))]
-
-@chunk[<define-ids>
-       (define-temp-ids "~a/function" (mapping ...))
-       (define-temp-ids "~a/incomplete-result-type" (mapping ...))]
-
-@section{Temporary fillers}
-
-@chunk[<with-promises-type>
-       Any]
-
-
-@section{Putting it all together}
-
-@chunk[<make-graph-constructor>
-       (define-syntax/parse <signature>
-         <define-ids>
-         (let ()
-           <define-ids2>
-           <define-compatible-placeholder-types>
-           ((λ (x) (pretty-write (syntax->datum x)) x)
-            (template
-             (let ()
-               (begin <define-mapping-placeholder>) …
-               (begin <define-with-promises-nodes>) …
-               (begin <define-incomplete-nodes>) …
-               (begin <define-mapping-function>) …
-               <fold-queue>)))))]
-
-@section{Conclusion}
-
-@chunk[<module-main>
-       (module main typed/racket
-         (require (for-syntax syntax/parse
-                              racket/syntax
-                              syntax/stx
-                              syntax/parse/experimental/template
-                              racket/sequence
-                              racket/pretty; DEBUG
-                              alexis/util/threading; DEBUG
-                              "rewrite-type.lp2.rkt"
-                              "../lib/low-untyped.rkt")
-                  alexis/util/threading; DEBUG
-                  "fold-queues.lp2.rkt"
-                  "rewrite-type.lp2.rkt"
-                  "../lib/low.rkt")
-         
-         (begin-for-syntax
-           <multiassoc-syntax>)
-         
-         (provide make-graph-constructor)
-         <make-graph-constructor>)]
-
-@chunk[<module-test>
-       (module* test typed/racket
-         (require (submod "..")
-                  "fold-queues.lp2.rkt"; DEBUG
-                  "rewrite-type.lp2.rkt"; DEBUG
-                  "../lib/low.rkt"; DEBUG
-                  typed/rackunit)
-         
-         <use-example>
-         
-         g)]
-
-@chunk[<*>
-       (begin
-         <module-main>
-         
-         (require 'main)
-         (provide (all-from-out 'main))
-         
-         <module-test>)]

graph-lib/graph/graph_old.lp2.rkt

@@ -840,9 +840,8 @@ checker, unless it is absorbed by a larger type, like in
                                 syntax/parse/experimental/template
                                 racket/syntax
                                 racket/function
-                                syntax/stx
                                 racket/pretty
-                                "../lib/low-untyped.rkt"
+                                (submod "../lib/low.rkt" untyped)
                                 "../lib/untyped.rkt")
                     (prefix-in DEBUG-tr: typed/racket)
                     syntax/parse

graph-lib/graph/map.rkt

@@ -2,9 +2,8 @@
 
 (require (for-syntax racket/syntax
                      racket/function
-                     syntax/stx
                      syntax/parse
-                     "../lib/low-untyped.rkt")
+                     (submod "../lib/low.rkt" untyped))
          "../lib/low.rkt"
          "get.lp2.rkt"
          "../type-expander/type-expander.lp2.rkt")

graph-lib/graph/map1.rkt

@@ -1,7 +1,7 @@
 #lang typed/racket
 
 (require (for-syntax syntax/parse
-                     "../lib/low-untyped.rkt")
+                     (submod "../lib/low.rkt" untyped))
          "../type-expander/type-expander.lp2.rkt")
 
 (provide curry-map)

graph-lib/graph/map3.rkt

@@ -1,10 +1,9 @@
 #lang typed/racket
 
 (require (for-syntax racket/syntax
-                     syntax/stx
                      syntax/parse
                      syntax/parse/experimental/template
-                     "../lib/low-untyped.rkt")
+                     (submod "../lib/low.rkt" untyped))
          "../lib/low.rkt"
          "get.lp2.rkt"
          "../type-expander/type-expander.lp2.rkt")

graph-lib/graph/map_old.rkt

@@ -1,10 +1,9 @@
 #lang debug typed/racket
 
 (require (for-syntax racket/syntax
-                     syntax/stx
                      syntax/parse
                      syntax/parse/experimental/template
-                     "../lib/low-untyped.rkt")
+                     (submod "../lib/low.rkt" untyped))
          (for-meta 2
                    racket/base
                    racket/syntax)

graph-lib/graph/queue.lp2.rkt

@@ -375,7 +375,7 @@ was a tag requested.
          (module main typed/racket
            (require (for-syntax syntax/parse
                                 racket/syntax
-                                "../lib/low-untyped.rkt")
+                                (submod "../lib/low.rkt" untyped))
                     "../lib/low.rkt"
                     racket/set
                     racket/format)

graph-lib/graph/rewrite-type.lp2.rkt

@@ -630,11 +630,10 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and
            (require
              (for-syntax syntax/parse
                          racket/syntax
-                         syntax/stx
                          racket/format
                          syntax/parse/experimental/template
                          racket/sequence
-                         "../lib/low-untyped.rkt"
+                         (submod "../lib/low.rkt" untyped)
                          (only-in "../type-expander/type-expander.lp2.rkt"
                                   expand-type)
                          "meta-struct.rkt")

graph-lib/graph/structure.lp2.rkt

@@ -591,12 +591,10 @@ chances that we could write a definition for that identifier.
                                 syntax/parse/experimental/template
                                 mzlib/etc
                                 racket/struct-info
-                                syntax/stx
                                 racket/sequence
                                 ;; in-syntax on older versions:
                                 ;;;unstable/sequence
-                                "../lib/low-untyped.rkt"
+                                (submod "../lib/low.rkt" untyped)
-                                "../lib/low/multiassoc-syntax.rkt"
                                 "meta-struct.rkt")
                     "../lib/low.rkt"
                     "../type-expander/type-expander.lp2.rkt"

graph-lib/graph/variant.lp2.rkt

@@ -281,7 +281,7 @@ number of name collisions.
            (require (for-syntax syntax/parse
                                 syntax/parse/experimental/template
                                 racket/syntax
-                                "../lib/low-untyped.rkt")
+                                (submod "../lib/low.rkt" untyped))
                     "../lib/low.rkt"
                     "../type-expander/multi-id.lp2.rkt"
                     "../type-expander/type-expander.lp2.rkt"

graph-lib/lib/doc.rkt

@@ -10,7 +10,7 @@
 
 (require scriblib/render-cond)
 
-;(require "low-untyped.rkt")
+;(require "(submod low.rkt untyped)")
 ;(#lang reader "scribble-custom/lp2.rkt" #:lang typed/racket)
 
 ;; http://lists.racket-lang.org/users/archive/2015-January/065752.html

graph-lib/lib/doc/template.lp2.rkt

@@ -50,8 +50,8 @@ scribble, see
        (module main typed/racket
          (require (for-syntax syntax/parse
                               racket/syntax
-                              "../../lib/low-untyped.rkt")
+                              (submod "../../lib/low.rkt" untyped))
-                  "../../lib/low-untyped.rkt")
+                  (submod "../../lib/low.rkt" untyped))
          (provide foo)
          
          <foo>

graph-lib/lib/low/aliases.rkt

@@ -0,0 +1,26 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide (all-from-out racket/match)
+           ∘
+           …
+           …+
+           match-λ
+           match-λ*
+           match-λ**
+           generate-temporary)
+  
+  (require racket/match)
+  
+  (require (only-in racket
+                    [compose ∘]
+                    [... …])
+           (only-in syntax/parse
+                    [...+ …+]))
+  
+  (require (only-in racket/match
+                    [match-lambda match-λ]
+                    [match-lambda* match-λ*]
+                    [match-lambda** match-λ**]))
+  
+  (require/typed racket/syntax [generate-temporary (→ Any Identifier)]))

graph-lib/lib/low/cond-let.rkt

@@ -0,0 +1,19 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide cond-let)
+  
+  (require (for-syntax syntax/parse
+                       (submod "aliases.rkt" untyped)))
+  
+  (define-syntax (cond-let stx)
+    (syntax-parse stx
+      [(_)
+       #'(typecheck-fail #,stx)]
+      [(_ #:let bindings:expr clause …)
+       #'(let bindings (cond-let clause …))]
+      [(_ [condition:expr (~seq #:else-let binding …) … . body] clause …)
+       #'(if condition
+             (begin . body)
+             (let (binding … …)
+               (cond-let clause …)))])))

graph-lib/lib/low/fixnum.rkt

@@ -0,0 +1,20 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules
+  (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)))

graph-lib/lib/low/generate-indices.rkt

@@ -0,0 +1,23 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide generate-indices)
+  
+  (require "typed-untyped.rkt")
+  (require-typed/untyped "sequence.rkt")
+  (: 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/lib/low/ids.rkt

@@ -0,0 +1,308 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:untyped-first
+  (provide !temp
+           (rename-out [!temp &])
+           format-ids
+           hyphen-ids
+           format-temp-ids
+           #|!temp|#
+           define-temp-ids)
+  
+  (require "typed-untyped.rkt")
+  (require-typed/untyped "sequence.rkt"
+                         "aliases.rkt")
+  (begin-for-syntax (require "typed-untyped.rkt")
+                    (require-typed/untyped "aliases.rkt"))
+  
+  (module m-!temp racket
+    (provide !temp)
+    
+    (require syntax/parse
+             syntax/parse/experimental/template)
+    
+    (define-template-metafunction (!temp stx)
+      (syntax-parse stx
+        [(_ id:id)
+         #:with (temp) (generate-temporaries #'(id))
+         #'temp]
+        #|[(_ . id:id)
+       #:with (temp) (generate-temporaries #'(id))
+       #'temp]
+      [(_ id:id ...)
+       (generate-temporaries #'(id ...))]|#)))
+  (require 'm-!temp)
+  
+  (require/typed racket/syntax
+                 [format-id (→ Syntax String (U String Identifier) *
+                               Identifier)])
+  (require (only-in racket/syntax define/with-syntax)
+           (only-in syntax/stx stx-map)
+           (for-syntax racket/base
+                       racket/syntax
+                       syntax/parse
+                       syntax/parse/experimental/template))
+  ;(require racket/sequence) ;; in-syntax
+  
+  (define-type S-Id-List
+    (U String
+       Identifier
+       (Listof String)
+       (Listof Identifier)
+       (Syntaxof (Listof Identifier))))
+  
+  ; TODO: format-ids doesn't accept arbitrary values. Should we change it?
+  ; 
+  (: format-ids (→ (U Syntax (→ (U String Identifier) * Syntax))
+                   String
+                   S-Id-List *
+                   (Listof Identifier)))
+  (define (format-ids lex-ctx format . vs)
+    (let* ([seqs
+            (map (λ ([v : S-Id-List])
+                   (cond
+                     [(string? v) (in-cycle (in-value v))]
+                     [(identifier? v) (in-cycle (in-value v))]
+                     [(list? v) (in-list v)]
+                     [else (in-list (syntax->list v))]))
+                 vs)]
+           [justconstants (andmap (λ (x) (or (string? x) (identifier? x))) vs)]
+           [seqlst (apply sequence-list seqs)])
+      (for/list : (Listof Identifier)
+        ([items seqlst]
+         [bound-length (if justconstants
+                           (in-value 'yes)
+                           (in-cycle (in-value 'no)))])
+        
+        (apply format-id
+               (if (procedure? lex-ctx) (apply lex-ctx items) lex-ctx)
+               format
+               items))))
+  
+  (: hyphen-ids (→ (U Syntax (→ (U String Identifier) * Syntax))
+                   S-Id-List *
+                   (Listof Identifier)))
+  
+  (define (hyphen-ids lex-ctx . vs)
+    (apply format-ids
+           lex-ctx
+           (string-join (map (λ _ "~a") vs) "-")
+           vs))
+  
+  (: format-temp-ids (→ String
+                        S-Id-List *
+                        (Listof Identifier)))
+  
+  (define (format-temp-ids format . vs)
+    ;; Introduce the binding in a fresh scope.
+    (apply format-ids (λ _ ((make-syntax-introducer) #'())) format vs))
+  
+  ;; Also in ==== syntax.rkt ====, once we split into multiple files, require it
+  (begin-for-syntax
+    (define (syntax-cons-property stx key v)
+      (let ([orig (syntax-property stx key)])
+        (syntax-property stx key (cons v (or orig '()))))))
+  
+  ;; Also in ==== syntax.rkt ====, once we split into multiple files, require it
+  (begin-for-syntax
+    (define (identifier-length id) (string-length (symbol->string
+                                                   (syntax-e id)))))
+  
+  (begin-for-syntax
+    (define-syntax-class dotted
+      (pattern id:id
+               #:attr make-dotted
+               (λ (x) x)
+               #:attr wrap
+               (λ (x f) (f x #t)))
+      (pattern (nested:dotted (~literal ...));(~and dots (~literal ...)) ...+)
+               #:with id #'nested.id
+               #:attr make-dotted
+               (λ (x) #`(#,((attribute nested.make-dotted) x) (... ...)));dots …
+               #:attr wrap
+               (λ (x f) (f ((attribute nested.wrap) x f) #f))))
+    
+    (define-syntax-class simple-format
+      (pattern format
+               #:when (string? (syntax-e #'format))
+               #:when (regexp-match #rx"^[^~]*~a[^~]*$" (syntax-e #'format))
+               #:attr pos (regexp-match-positions #rx"^([^~]*)~a([^~]*)$"
+                                                  (syntax-e #'format))
+               #:attr left-start 1
+               #:attr left-end (+ 1 (cdr (cadr (attribute pos))))
+               #:attr left-len (cdr (cadr (attribute pos)))
+               
+               #:attr right-start (+ 1 (car (caddr (attribute pos))))
+               #:attr right-end (+ 1 (cdr (caddr (attribute pos))))
+               #:attr right-len (- (attribute right-end)
+                                   (attribute right-start)))))
+  
+  (define-syntax (define-temp-ids stx)
+    (syntax-parse stx
+      #|
+      ;; TODO : factor this with the next case.
+      [(_ format ((base:id (~literal ...)) (~literal ...)))
+       #:when (string? (syntax-e #'format))
+       (with-syntax ([pat (format-id #'base (syntax-e #'format) #'base)])
+         #'(define/with-syntax ((pat (... ...)) (... ...))
+             (stx-map (curry format-temp-ids format)
+                      #'((base (... ...)) (... ...)))))]
+|#
+      
+      ;; New features (arrows and #:first) special-cased for now
+      ;; TODO: make these features more general.
+      [(_ format:simple-format base:dotted #:first-base first-base)
+       #:with first (format-id #'first-base (syntax-e #'format) #'first-base)
+       (let ([first-base-len (identifier-length #'first-base)])
+         (syntax-cons-property #'(define-temp-ids format base #:first first)
+                               'sub-range-binders
+                               (list
+                                (if (> (attribute format.left-len) 0)
+                                    (vector (syntax-local-introduce #'first)
+                                            0
+                                            (attribute format.left-len)
+                                            
+                                            (syntax-local-introduce #'format)
+                                            (attribute format.left-start)
+                                            (attribute format.left-len))
+                                    '())
+                                (vector (syntax-local-introduce #'first)
+                                        (attribute format.left-len)
+                                        first-base-len
+                                        
+                                        (syntax-local-introduce #'first-base)
+                                        0
+                                        first-base-len)
+                                (if (> (attribute format.right-len) 0)
+                                    (vector (syntax-local-introduce #'first)
+                                            (+ (attribute format.left-len)
+                                               first-base-len)
+                                            (attribute format.right-len)
+                                            
+                                            (syntax-local-introduce #'format)
+                                            (attribute format.right-start)
+                                            (attribute format.right-len))
+                                    '()))))]
+      
+      [(_ format:simple-format
+          base:dotted
+          (~optional (~seq #:first first)))
+       (let* ([base-len (string-length (symbol->string (syntax-e #'base.id)))])
+         (define/with-syntax pat
+           (format-id #'base.id (syntax-e #'format) #'base.id))
+         (define/with-syntax pat-dotted ((attribute base.make-dotted) #'pat))
+         
+         (define/with-syntax format-temp-ids*
+           ((attribute base.wrap) #'(compose car
+                                             (curry format-temp-ids format)
+                                             generate-temporary)
+                                  (λ (x deepest?)
+                                    (if deepest?
+                                        x
+                                        #`(curry stx-map #,x)))))
+         
+         (syntax-cons-property
+          (template (begin (define/with-syntax pat-dotted
+                             (format-temp-ids* #'base))
+                           (?? (?@ (define/with-syntax (first . _)
+                                     #'pat-dotted)))))
+          'sub-range-binders
+          (list (if (> (attribute format.left-len) 0)
+                    (vector (syntax-local-introduce #'pat)
+                            0
+                            (attribute format.left-len)
+                            
+                            (syntax-local-introduce #'format)
+                            (attribute format.left-start)
+                            (attribute format.left-len))
+                    '())
+                (vector (syntax-local-introduce #'pat)
+                        (attribute format.left-len)
+                        base-len
+                        
+                        (syntax-local-get-shadower #'base.id)
+                        0
+                        base-len)
+                (if (> (attribute format.right-len) 0)
+                    (vector (syntax-local-introduce #'pat)
+                            (+ (attribute format.left-len) base-len)
+                            (attribute format.right-len)
+                            
+                            (syntax-local-introduce #'format)
+                            (attribute format.right-start)
+                            (attribute format.right-len))
+                    '()))))]
+      [(_ format base:dotted)
+       #:when (string? (syntax-e #'format))
+       #:when (regexp-match #rx"^[^~]*$" (syntax-e #'format))
+       (define/with-syntax pat (format-id #'base (syntax-e #'format)))
+       (define/with-syntax pat-dotted ((attribute base.make-dotted) #'pat))
+       (define/with-syntax format-temp-ids*
+         ((attribute base.wrap) #'(λ (x)
+                                    (car (format-temp-ids
+                                          (string-append format "~a")
+                                          "")))
+                                (λ (x deepest?)
+                                  (if deepest?
+                                      x
+                                      #`(curry stx-map #,x)))))
+       (syntax-cons-property
+        #'(define/with-syntax pat-dotted
+            (format-temp-ids* #'base))
+        'sub-range-binders
+        (list (vector (syntax-local-introduce #'pat)
+                      0
+                      (string-length (syntax-e #'format))
+                      
+                      (syntax-local-introduce #'format)
+                      1
+                      (string-length (syntax-e #'format)))))]
+      [(_ name:id format:expr . vs)
+       #`(define/with-syntax name (format-temp-ids format . vs))]))
+  
+  (module+ test
+    (require-typed/untyped "typed-rackunit.rkt")
+    (require ;(submod "..")
+      (for-syntax racket/syntax
+                  (submod ".." ".." untyped)))
+    
+    (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))
+    
+    ;; Since the presence of "Syntax" in the parameters list makes format-ids
+    ;; require a chaperone contract instead of a flat contract, we can't run the
+    ;; two tests below directly, we would need to require the untyped version of
+    ;; this file, which causes a cycle in loading.
+    
+    (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-lib/lib/low/list.rkt

@@ -0,0 +1,41 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide indexof
+           replace-first
+           map+fold)
+  
+  (: 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))))))
+  
+  (: replace-first (∀ (A B C) (->* (B
+                                    C
+                                    (Listof (U A B)))
+                                   (#:equal? (→ (U A B) (U A B) Any : #:+ B))
+                                   (Rec R (U (Pairof (U A B) R)
+                                             Null
+                                             (Pairof C (Listof (U A B))))))))
+  (define (replace-first from to l #:equal? [equal? eq?])
+    (if (null? l)
+        '()
+        (if (equal? from (car l))
+            (cons to (cdr l))
+            (cons (car l)
+                  (replace-first from to (cdr l))))))
+  
+  (: map+fold (∀ (E R A) (→ (→ E A (values R A)) A (Listof E)
+                            (Values (Listof R) A))))
+  (define (map+fold f init-acc lst)
+    (let ([result (foldl (λ ([item : E] [acc : (Pairof (Listof R) A)])
+                           (let-values ([(item new-acc) (f item (cdr acc))])
+                             (cons (cons item (car acc))
+                                   new-acc)))
+                         (cons '() init-acc)
+                         lst)])
+      (values (car result) (cdr result)))))

graph-lib/lib/low/logn-id.rkt

@@ -1,12 +1,14 @@
 #lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide define-logn-ids)
   
   (require (for-syntax syntax/parse
                        racket/syntax
                        racket/function
                        racket/match
-                     syntax/stx))
+                       syntax/stx)
-
+           "typed-untyped.rkt")
-(provide define-logn-ids)
   
   (begin-for-syntax
     (define (insert make-node v ts)
@@ -45,12 +47,15 @@
            [`(node ,s ,a ,b) #`(begin (struct #,s #,@parent ())
                                       #,(make-structs a (list s))
                                       #,(make-structs b (list s)))]
-         [`(leaf ,t ,s ,a ,_) #`(begin (struct #,s #,@parent () #:type-name #,t)
+           [`(leaf ,t ,s ,a ,_) #`(begin (struct #,s #,@parent
+                                           ()
+                                           #:type-name #,t)
                                          (define #,a (#,s)))]))
        (define (make-btd bt)
          (match bt
            [`(node ,s ,(and a `(,_ ,sa . ,_)) ,b)
-          #`(if ((make-predicate #,sa) v-cache)
+            #`(if (if-typed ((make-predicate #,sa) v-cache)
+                            #,(format-id sa "~a?" sa))
                   #,(make-btd a)
                   #,(make-btd b))]
            [`(leaf ,s ,a ,t ,tmp)
@@ -74,4 +79,4 @@
                            [c 3]
                            [d 4]
                            [e 5])
-                2))
+                  2)))

graph-lib/lib/low/misc.rkt

@@ -0,0 +1,53 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide hash-set**
+           ;string-set!
+           ;string-copy!
+           ;string-fill!
+           with-output-file)
+  
+  (require (for-syntax syntax/parse syntax/parse/experimental/template))
+  
+  ;; hash-set**: hash-set a list of K V pairs.
+  (begin
+    (: hash-set** (∀ (K V)
+                     (→ (HashTable K V) (Listof (Pairof K V)) (HashTable K V))))
+    (define (hash-set** h l)
+      (if (null? l)
+          h
+          (hash-set** (hash-set h (caar l) (cdar l)) (cdr l)))))
+  
+  ;; Disable string mutation
+  (begin
+    (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)))
+  
+  ;; with-output-file
+  (begin
+    #|
+    (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))))]))))

graph-lib/lib/low/multiassoc-syntax.rkt

@@ -1,35 +1,35 @@
-#lang racket
+#lang typed/racket
-
+(require "typed-untyped.rkt")
-(require syntax/parse
+(define-typed/untyped-modules #:no-test
-         syntax/parse/experimental/template
-         syntax/stx)
-
   (provide multiassoc-syntax
            cdr-assoc-syntax
-         tmpl-cdr-assoc-syntax)
+           assoc-syntax)
   
-(require "../low.rkt") ;; For the identifier "…"
+  (require "typed-untyped.rkt")
+  (require-typed/untyped "aliases.rkt"
+                         "stx.rkt")
   
   ;; TODO: cdr-stx-assoc is already defined in lib/low.rkt
   
+  (define-type (Stx-AList A)
+    (Syntaxof (Listof (Syntaxof (Pairof Identifier A)))))
+  
+  (: multiassoc-syntax (∀ (A) (→ Identifier (Stx-AList A) (Listof A))))
   (define (multiassoc-syntax query alist)
-  (map stx-cdr
+    ((inst map A (Syntaxof (Pairof Identifier A)))
-       (filter (λ (xy) (free-identifier=? query (stx-car xy)))
+     stx-cdr
+     (filter (λ ([xy : (Syntaxof (Pairof Identifier A))])
+               (free-identifier=? query (stx-car xy)))
              (syntax->list alist))))
   
+  (: cdr-assoc-syntax (∀ (A) (→ Identifier (Stx-AList A) A)))
   (define (cdr-assoc-syntax query alist)
-  (stx-cdr (assoc-syntax query alist)))
+    (stx-cdr (assert (assoc-syntax query alist))))
   
+  (: assoc-syntax (∀ (A) (→ Identifier
+                            (Stx-AList A)
+                            (U False (Syntaxof (Pairof Identifier A))))))
   (define (assoc-syntax query alist)
-  (findf (λ (xy) (free-identifier=? query (stx-car xy)))
+    (findf (λ ([xy : (Syntaxof (Pairof Identifier A))])
-         (syntax->list alist)))
+             (free-identifier=? query (stx-car xy)))
-
+           (syntax->list alist))))
-(define-template-metafunction (tmpl-cdr-assoc-syntax stx)
-  (syntax-parse stx
-    [(_ (~optional (~seq #:default default)) query [k . v] …)
-     (if (attribute default)
-         (let ([r (assoc-syntax #'query #'([k . v] …))])
-           (if r
-               (stx-cdr r)
-               #'default))
-         (cdr-assoc-syntax #'query #'([k . v] …)))]))

graph-lib/lib/low/not-implemented-yet.rkt

@@ -0,0 +1,19 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide ? ?*)
+  
+  (define-syntax (?* stx)
+    (syntax-case stx ()
+      [(q . rest)
+       (quasisyntax/loc stx
+         ((λ () : (U) #,(syntax/loc #'q (error "Not implemented yet"))
+            . rest)))]))
+  
+  (define-syntax (? stx)
+    (syntax-case stx ()
+      [(q t . rest)
+       (quasisyntax/loc stx
+         ((ann (λ () #,(syntax/loc #'q (error "Not implemented yet"))
+                 . rest)
+               (→ t))))])))

graph-lib/lib/low/percent.rkt

@@ -0,0 +1,67 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide % define%)
+
+  (require (for-syntax syntax/parse))
+  
+  #|(define-syntax (% stx)
+  (syntax-parse stx #:literals (= → :)
+    [(_ (~seq (~or ((~and var (~not :)) ...)
+                   (~seq (~and var (~not (~or = → :))) ...)) = expr)
+        ...
+        (~optional (~literal →)) . body)
+     #'(let-values ([(var ...) expr] ...) . body)]))|#
+  
+  (begin-for-syntax
+    (define-syntax-class %pat
+      (pattern v:id
+               #:with expanded #'v)
+      (pattern ()
+               #:with expanded #'(list))
+      (pattern (x:%pat . rest:%pat)
+               #:with expanded #'(cons x.expanded rest.expanded)))
+    (define-splicing-syntax-class %assignment
+      #:attributes ([pat.expanded 1] [expr 0])
+      #:literals (= →)
+      (pattern (~seq (~and maybe-pat (~not (~or = →))) ... (~datum =) expr:expr)
+               #:with [pat:%pat ...] #'(maybe-pat ...))))
+  
+  (define-syntax (% stx)
+    (syntax-parse stx #:literals (= →)
+      [(_ :%assignment ... (~optional (~literal →)) . body)
+       #'(match-let*-values ([(pat.expanded ...) expr] ...) . body)]))
+  
+  (begin-for-syntax
+    (define-syntax-class typed-pat
+      (pattern [x:%pat (~literal :) type:expr]
+               #:with (tmp) (generate-temporaries #'(x))
+               #:with var-type #`[tmp : type]
+               #:with (expanded ...) #'([x.expanded tmp]))
+      (pattern x:id
+               #:with var-type #'x
+               #:with (expanded ...) #'())
+      (pattern x:%pat
+               #:with (tmp) (generate-temporaries #'(x))
+               #:with var-type #'tmp
+               #:with (expanded ...) #'([x.expanded tmp]))))
+  
+  (define-syntax (define% stx)
+    (syntax-parse stx
+      [(_ (name param:typed-pat ...)
+          (~and (~seq ret ...) (~optional (~seq (~literal :) ret-type)))
+          . body)
+       #'(define (name param.var-type ...)
+           (match-let (param.expanded ... ...) ret ... . body))]))
+  
+  #|
+  (begin-for-syntax
+    (define-syntax-class λ%expr
+      (pattern e:id #:where (symbol->string e))
+      (pattern e)
+      (pattern (e . rest:λ%expr))))
+  
+  (define-syntax (λ% stx)
+    (syntax-parse stx
+      [(_ expr )]))
+  |#)

graph-lib/lib/low/repeat-stx.rkt

@@ -0,0 +1,114 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide repeat-stx)
+  
+  (require syntax/stx
+           (for-syntax racket/base
+                       racket/syntax
+                       syntax/parse))
+  
+  (define-for-syntax (repeat-stx-2 stx)
+    (syntax-parse stx
+      [(a:id b:id)
+       #'(λ _ a)]
+      [(a:id (b:expr (~literal ...)))
+       #`(λ (bs) (stx-map #,(repeat-stx-2 #'(a b)) bs))]))
+  
+  (define-for-syntax (repeat-stx-1 stx)
+    (syntax-parse stx
+      [(a:id b:expr)
+       #`(λ (a bs) (#,(repeat-stx-2 #'(a b)) bs))]
+      [((a:expr (~literal ...)) (b:expr (~literal ...)))
+       #`(λ (s1 s2) (stx-map #,(repeat-stx-1 #'(a b)) s1 s2))]))
+  
+  (define-syntax (repeat-stx stx)
+    (syntax-parse stx
+      [(_ a:expr b:expr)
+       #`(#,(repeat-stx-1 #'(a b)) #'a #'b)])))
+
+(module test racket
+  (require (submod ".." untyped))
+  (require syntax/parse
+           rackunit)
+  
+  (check-equal?
+   (syntax-parse #'(1 2)
+     [(a b)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a b)))])
+   1)
+  
+  (check-equal?
+   (syntax-parse #'(1 2 3)
+     [(a b ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a (b ...))))])
+   '(1 1))
+  
+  (check-equal?
+   (syntax-parse #'(1 (2 3) (uu vv ww) (xx yy))
+     [(a (b ...) ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a ((b ...) ...))))])
+   '((1 1) (1 1 1) (1 1)))
+  
+  (check-equal?
+   (syntax-parse #'(1 ((2) (3 3)) ((uu) (vv vv) (ww ww ww)) ((xx) (yy)))
+     [(a ((b ...) ...) ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a (((b ...) ...) ...))))])
+   '(((1) (1 1)) ((1) (1 1) (1 1 1)) ((1) (1))))
+  
+  (check-equal?
+   (syntax-parse #'([1 x] [2 y] [3 z])
+     [([a b] ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) (b ...))))])
+   '(1 2 3))
+  
+  (check-equal?
+   (syntax-parse #'((1 2 3) (a b))
+     [([a b ...] ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) ((b ...) ...))))])
+   '((1 1) (a)))
+  
+  (check-equal?
+   (syntax-parse #'(((1 2 3) (a b)) ((x y z t) (-1 -2)))
+     [[[[a b ...] ...] ...]
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx ((a ...) ...) (((b ...) ...) ...))))])
+   '(((1 1) (a)) ((x x x) (-1))))
+  
+  (check-equal?
+   (syntax-parse #'((f (1 2 3) (a b)) (g (x y z t) (-1 -2)))
+     [[[a (b ...) ...] ...]
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) (((b ...) ...) ...))))])
+   '(((f f f) (f f)) ((g g g g) (g g))))
+  
+  (check-equal?
+   (syntax-parse #'((h () ()) (i () (x y z) ()))
+     [([a (b ...) ...] ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) (((b ...) ...) ...))))])
+   '((() ()) (() (i i i) ()))))

graph-lib/lib/low/require-provide.rkt

@@ -0,0 +1,22 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules
+  (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)))

graph-lib/lib/low/sequence.rkt

@@ -0,0 +1,186 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules
+  (provide sequence-length>=
+           in-last?
+           in-tails
+           in-heads
+           in-split
+           in-split*
+           *in-split
+           Syntax-Listof
+           my-in-syntax
+           in-syntax
+           sequence-cons
+           sequence-null
+           sequence-list)
+  
+  (require racket/sequence)
+  
+  ;; sequence-length>=
+  (begin
+    (: sequence-length>= (→ (Sequenceof Any) Index Boolean))
+    (define (sequence-length>= s l)
+      (let-values ([(more? next) (sequence-generate s)])
+        (define (rec [remaining : Index]) : Boolean
+          (if (= remaining 0)
+              #t
+              (and (more?)
+                   (begin (next)
+                          (rec (sub1 remaining))))))
+        (rec l))))
+  
+  ;; in-last?
+  ;; Returns a sequence of the same length as `s`. All values in the sequence
+  ;; are #f, except for the last one which is 'last.
+  (begin
+    (: in-last? (→ (Sequenceof Any) (Sequenceof (U #f 'last))))
+    (define (in-last? s)
+      (if (sequence-length>= s 1)
+          (sequence-append (sequence-map (λ _ #f) (sequence-tail s 1))
+                           (in-value 'last))
+          empty-sequence)))
+  
+  ;; in-heads and in-tails
+  (begin
+    (: 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)))))
+  
+  ;; in-split, in-split*, *in-split, *in-split*
+  (begin
+    ;; Can't write the type of in-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))))
+  
+  ;; my-in-syntax and Syntax-Listof
+  (begin
+    ;; 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)
+      ; (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)))
+      ; (ann `(,#'a ,#'b ,#'c ,#'d ,#'e) (Listof (Syntaxof (U 'a 'b 'c 'd))))
+      (my-in-syntax #'(a . (b c d e)))
+      ; (ann '() (Listof (Syntaxof Nothing)))
+      (my-in-syntax #'())))
+  
+  ;; combining sequences:
+  ;; sequence-cons
+  ;; sequence-null
+  ;; sequence-list
+  
+  (begin
+    (: sequence-cons (∀ (A B) (→ (Sequenceof A) (Sequenceof B)
+                                 (Sequenceof (cons A B)))))
+    (define (sequence-cons sa sb)
+      (sequence-map (λ ([x : (List A B)]) (cons (car x) (cadr x)))
+                    (in-values-sequence (in-parallel sa sb))))
+    
+    (: sequence-null (Sequenceof Null))
+    (define sequence-null (in-cycle (in-value '())))
+    
+    ;; sequence-list should have the type:
+    ;; (∀ (A ...) (→ (Sequenceof A) ... (Sequenceof (List A ...)))))
+    ;; But the type system rejects the two definitions below.
+    (: sequence-list (∀ (A) (→ (Sequenceof A) *
+                               (Sequenceof (Listof A)))))
+    (define (sequence-list . sequences)
+      (if (null? sequences)
+          sequence-null
+          (sequence-cons (car sequences)
+                         (apply sequence-list (cdr sequences)))))
+    
+    #|
+    (: sequence-list (∀ (A ...) (→ (Sequenceof A) ...
+                                   (Sequenceof (List A ...)))))
+    (define (sequence-list . sequences)
+      (if (null? sequences)
+          sequence-null
+          (sequence-cons (car sequences)
+                         (apply sequence-list (cdr sequences)))))
+    |#
+    
+    #|
+    (: sequence-list (∀ (F R ...)
+                        (case→ [→ (Sequenceof Null)]
+                               [→ (Sequenceof F) (Sequenceof R) ...
+                                  (Sequenceof (List F R ...))])))
+    (define sequence-list
+      (case-lambda
+        [()
+         sequence-null]
+        [(sequence . sequences)
+         (sequence-cons sequence (apply sequence-list sequences))]))
+    |#))

graph-lib/lib/low/set.rkt

@@ -0,0 +1,6 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide set-map→set)
+  (: set-map→set (∀ (e b) (→ (Setof e) (→ e b) (Setof b))))
+  (define (set-map→set s f) (list->set (set-map s f))))

graph-lib/lib/low/stx.rkt

@@ -0,0 +1,407 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules
+  (provide stx-list
+           stx-e
+           stx-pair
+           
+           syntax-cons-property
+           stx-map-nested
+           identifier-length
+           identifier->string
+           (rename-out [identifier->string identifier→string])
+           ;stx-map-nested
+           
+           stx-car
+           stx-cdr
+           stx-null?
+           stx-pair?
+           
+           stx-cons
+           
+           Stx-List?
+           Syntax-Pairs-of
+           
+           stx-drop-last
+           
+           stx-foldl
+           
+           stx-assoc
+           cdr-stx-assoc
+           
+           check-duplicate-identifiers
+           
+           nameof
+           (all-from-out syntax/stx))
+  
+  (require "typed-untyped.rkt")
+  (require-typed/untyped "sequence.rkt")
+  
+  (require syntax/stx)
+  
+  ;; match-expanders:
+  ;;   stx-list
+  ;;   stx-e
+  ;;   stx-pair
+  (begin
+    (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 ...) (map (inst syntax-e Positive-Byte) a)])
+                    '(1 2 3))
+      
+      #;(check-equal? (match #`(1 . (2 3))
+                        [(stx-list a b c) (list (syntax-e c)
+                                                (syntax-e b)
+                                                (syntax-e a))])
+                      '(3 2 1)))
+    
+    ;; stx-e
+    (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))))
+  
+  ;; utilities:
+  ;;   syntax-cons-property
+  ;;   identifier-length
+  ;;   identifier->string
+  ;;   stx-map-nested
+  (begin
+    (: syntax-cons-property (∀ (A) (→ (Syntaxof A) Symbol Any (Syntaxof A))))
+    (define (syntax-cons-property stx key v)
+      (let ([orig (syntax-property stx key)])
+        (syntax-property stx key (cons v (or orig '())))))
+    
+    (: identifier-length (→ Identifier Index))
+    (define (identifier-length id) (string-length (identifier->string id)))
+    
+    (: identifier->string (→ Identifier String))
+    (define (identifier->string id) (symbol->string (syntax-e id)))
+    
+    (: stx-map-nested (∀ (A B) (→ (→ A B)
+                                  (Syntaxof (Listof (Syntaxof (Listof A))))
+                                  (Listof (Listof B)))))
+    (define (stx-map-nested f stx)
+      (map (λ ([x : (Syntaxof (Listof A))])
+             (map f (syntax-e x)))
+           (syntax-e stx))))
+  
+  ;; accessors:
+  ;;   stx-car
+  ;;   stx-cdr
+  ;;   stx-null?
+  ;;   stx-pair?
+  (begin
+    #|
+    (require/typed syntax/stx
+                   [stx-car (∀ (A B) (→ (Syntaxof (Pairof A B)) A))]
+                   [stx-cdr (∀ (A B) (→ (Syntaxof (Pairof A B)) B))])
+    |#
+    
+    (: stx-car (∀ (A B)
+                  (case→ (→ (Syntaxof (Pairof A B)) A)
+                         ;; TODO: Not typesafe!
+                         (→ (U (Syntaxof (Listof A)) (Listof A)) A))))
+    (define (stx-car p) (car (if (syntax? p) (syntax-e p) p)))
+    
+    (: stx-cdr (∀ (A B)
+                  (case→ (→ (Syntaxof (Pairof A B))
+                            B)
+                         ;; TODO: Not typesafe!
+                         (→ (U (Syntaxof (Listof A)) (Listof A))
+                            (Listof A)))))
+    (define (stx-cdr p) (cdr (if (syntax? p) (syntax-e p) p)))
+    
+    (: stx-null? (→ Any Boolean : (U (Syntaxof Null) Null)))
+    (define (stx-null? v)
+      (if-typed
+       ((make-predicate (U (Syntaxof Null) Null)) v)
+       (or (null? v) (and (syntax? v) (null? (syntax-e v))))))
+    
+    (module+ test
+      (check-equal? (stx-null? #f) #f)
+      (check-equal? (stx-null? 'a) #f)
+      (check-equal? (stx-null? '()) #t)
+      (check-equal? (stx-null? #'()) #t)
+      (check-equal? (stx-null? #''()) #f)
+      (check-equal? (stx-null? #'a) #f))
+    
+    (: stx-pair? (→ Any Boolean : (U (Pairof Any Any)
+                                     (Syntaxof (Pairof Any Any)))))
+    (define (stx-pair? v)
+      (if-typed
+       ((make-predicate (U (Pairof Any Any)
+                           (Syntaxof (Pairof Any Any))))
+        v)
+       (or (pair? v) (and (syntax? v) (pair? (syntax-e v)))))))
+  
+  ;; constructors:
+  ;;   stx-cons
+  (begin
+    (module m-stx-cons-untyped racket
+      (provide stx-cons list->stx list*->stx)
+      
+      (define (stx-cons a b) #`(#,a . #,b))
+      (define (list->stx l) #`#,l)
+      (define (list*->stx l*) #`#,l*))
+    
+    (if-typed
+     (module m-stx-cons-typed typed/racket
+       (provide stx-cons list->stx list*->stx)
+       (require (only-in typed/racket/unsafe unsafe-require/typed))
+       (unsafe-require/typed
+        (submod ".." m-stx-cons-untyped)
+        [stx-cons (∀ (A B)
+                     (→ (Syntaxof A)
+                        (Syntaxof B)
+                        (Syntaxof (Pairof (Syntaxof A) (Syntaxof B)))))]
+        [list->stx (∀ (A)
+                      (→ (Listof (Syntaxof A))
+                         (Syntaxof (Listof (Syntaxof A)))))]
+        [list*->stx (∀ (A B)
+                       (→ (Rec R (U B (Pairof (Syntaxof A) R)))
+                          (Syntaxof (Rec R (U B (Pairof (Syntaxof A) R))))))]))
+     (module m-stx-cons-typed racket
+       (provide stx-cons list->stx list*->stx)
+       (require (submod ".." m-stx-cons-untyped))))
+    
+    (require 'm-stx-cons-typed)
+    
+    (module+ test
+      (require ;(submod "..")
+        typed/rackunit)
+      
+      (check-equal? (syntax->datum
+                     (ann (stx-cons #'a #'(b c))
+                          (Syntaxof (Pairof (Syntaxof 'a)
+                                            (Syntaxof (List (Syntaxof 'b)
+                                                            (Syntaxof 'c)))))))
+                    '(a b c))
+      
+      (check-equal? (syntax->datum
+                     (ann (stx-cons #'1 (ann #'2 (Syntaxof 2)))
+                          (Syntaxof (Pairof (Syntaxof 1)
+                                            (Syntaxof 2)))))
+                    '(1 . 2))))
+  
+  ;; stx-drop-last
+  (begin
+    (: drop-last (∀ (A) (→ (Listof A) (Listof A))))
+    (define (drop-last l)
+      (if (and (pair? l) (pair? (cdr l)))
+          (cons (car l) (drop-last (cdr l)))
+          '()))
+    
+    (define-type (Stx-List? A)
+      (U Null
+         (Pairof A (Stx-List? A))
+         (Syntaxof Null)
+         (Syntaxof (Pairof A (Stx-List? A)))))
+    
+    (define-type (Syntax-Pairs-of A)
+      (U (Syntaxof Null)
+         (Syntaxof (Pairof A (Syntax-Pairs-of A)))))
+    
+    (module+ test
+      (require-typed/untyped "typed-rackunit.rkt")
+      
+      (check-ann #'() (Stx-List? (Syntaxof Number)))
+      (check-ann #'(1) (Stx-List? (Syntaxof Number)))
+      (check-ann #'(1 2 3) (Stx-List? (Syntaxof Number)))
+      (check-ann #'(1 2 . ()) (Stx-List? (Syntaxof Number)))
+      (check-ann #'(1 . (2 . (3 . ()))) (Stx-List? (Syntaxof Number)))
+      (check-ann #'(1 . (2 3 . ())) (Stx-List? (Syntaxof Number)))
+      (check-ann #'(1 2 . (3 4 . (5))) (Stx-List? (Syntaxof Number))))
+    
+    (: stx->list (∀ (A) (→ (Stx-List? (Syntaxof A)) (Listof (Syntaxof A)))))
+    (define (stx->list l)
+      (cond [(null? l)
+             '()]
+            [(pair? l)
+             (cons (car l) (stx->list (cdr l)))]
+            [else
+             (stx->list (syntax-e l))]))
+    
+    (: stx-drop-last
+       (∀ (A) (→ (Stx-List? (Syntaxof A)) (Syntaxof (Listof (Syntaxof A))))))
+    (define (stx-drop-last l)
+      (list->stx (drop-last (stx->list l))))
+    #|
+      #;(cond [(null? l)
+             #'()]
+            [(pair? l)
+             (cond [(null? (cdr l))
+                    #'()]
+                   [(pair? (cdr l))
+                    ]
+                   [else
+             (let* ([res (stx-drop-last (cdr l))]
+                    [e (syntax-e res)])
+               (if (null? e)
+                   (stx-cons (car l) #'())
+                   (stx-cons (car l) res)))]
+            [else
+             (stx-drop-last (syntax-e l))])
+      
+      #;(if (if-typed ((make-predicate (Syntaxof Any)) l) (syntax? l))
+          (stx-drop-last (syntax-e l))
+          (if (null? l)
+              #'()
+              (stx-cons (car l)
+                        (stx-drop-last (cdr l)))))))
+      |#)
+  
+  ;; stx-foldl
+  (begin
+    (: stx-foldl
+       (∀ (E F G Acc)
+          (case→ (→ (→ E Acc Acc)
+                    Acc
+                    (U (Syntaxof (Listof E)) (Listof E))
+                    Acc)
+                 (→ (→ E F Acc Acc)
+                    Acc
+                    (U (Syntaxof (Listof E)) (Listof E))
+                    (U (Syntaxof (Listof F)) (Listof F))
+                    Acc)
+                 (→ (→ E F G Acc Acc)
+                    Acc
+                    (U (Syntaxof (Listof E)) (Listof E))
+                    (U (Syntaxof (Listof F)) (Listof F))
+                    (U (Syntaxof (Listof G)) (Listof G))
+                    Acc))))
+    (define stx-foldl
+      (case-lambda
+        [(f acc l)
+         (if (stx-null? l)
+             acc
+             (stx-foldl f (f (stx-car l) acc) (stx-cdr l)))]
+        [(f acc l l2)
+         (if (or (stx-null? l) (stx-null? l2))
+             acc
+             (stx-foldl f
+                        (f (stx-car l) (stx-car l2) acc)
+                        (stx-cdr l)
+                        (stx-cdr l2)))]
+        [(f acc l l2 l3)
+         (if (or (stx-null? l) (stx-null? l2) (stx-null? l3))
+             acc
+             (stx-foldl f
+                        (f (stx-car l) (stx-car l2) (stx-car l3) acc)
+                        (stx-cdr l)
+                        (stx-cdr l2)
+                        (stx-cdr l3)))])))
+  
+  ;; stx-assoc
+  ;; cdr-stx-assoc
+  (begin
+    (: stx-assoc (∀ (T) (case→
+                         (→ Identifier
+                            (U (Syntaxof (Listof (Syntaxof (Pairof Identifier
+                                                                   T))))
+                               (Listof (Syntaxof (Pairof Identifier T))))
+                            (U (Syntaxof (Pairof Identifier T)) #f))
+                         (→ Identifier
+                            (Listof (Pairof Identifier T))
+                            (U (Pairof Identifier T) #f)))))
+    (define (stx-assoc id alist)
+      (let* ([e-alist (if (syntax? alist)
+                          (syntax->list alist)
+                          alist)]
+             [e-e-alist (cond
+                          [(null? e-alist) '()]
+                          [(syntax? (car e-alist))
+                           (map (λ ([x : (Syntaxof (Pairof Identifier T))])
+                                  (cons (stx-car x) x))
+                                e-alist)]
+                          [else
+                           (map (λ ([x : (Pairof Identifier T)])
+                                  (cons (car x) x))
+                                e-alist)])]
+             [result (assoc id e-e-alist free-identifier=?)])
+        (if result (cdr result) #f)))
+    
+    (: cdr-stx-assoc
+       (∀ (T) (case→ (→ Identifier
+                        (U (Syntaxof (Listof (Syntaxof (Pairof Identifier T))))
+                           (Listof (Syntaxof (Pairof Identifier T)))
+                           (Listof (Pairof Identifier T)))
+                        (U T #f)))))
+    (define (cdr-stx-assoc id alist)
+      (if (null? alist)
+          #f
+          ;; The typechecker is not precise enough, and the code below does not
+          ;; work if we factorize it:
+          ;; (if (and (list? alist) (syntax? (car alist))) … …)
+          (if (list? alist)
+              (if (syntax? (car alist))
+                  (let ((res (stx-assoc id alist)))
+                    (if res (stx-cdr res) #f))
+                  (let ((res (stx-assoc id alist)))
+                    (if res (cdr res) #f)))
+              (let ((res (stx-assoc id alist)))
+                (if res (stx-cdr res) #f))))))
+  
+  ;; check-duplicate-identifiers
+  (begin
+    (: check-duplicate-identifiers (→ (Syntaxof (Listof (Syntaxof Symbol)))
+                                      Boolean))
+    (define (check-duplicate-identifiers ids)
+      (if (check-duplicate-identifier (my-in-syntax ids)) #t #f)))
+  
+  ;; nameof
+  (begin
+    ;; TODO: use the proper way to introduce arrows if possible.
+    (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)))
+  |#)

graph-lib/lib/low/syntax-parse.rkt

@@ -0,0 +1,132 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide define-syntax/parse
+           λ/syntax-parse
+           ~maybe
+           ~lit
+           ~or-bug
+           define-simple-macro
+           λstx
+           template/debug
+           quasitemplate/debug
+           meta-eval)
+  
+  (require syntax/parse
+           syntax/parse/define
+           syntax/parse/experimental/template
+           (for-syntax racket/base
+                       racket/syntax))
+  
+  (define-syntax ~maybe
+    (pattern-expander
+     (λ (stx)
+       (syntax-parse stx
+         [(self pat ...)
+          (define (s stx) (datum->syntax #'self stx stx stx))
+          #`(#,(s #'~optional) (#,(s #'~seq) pat ...))]))))
+  
+  ;; Circumvent the bug that causes "syntax-parse: duplicate attribute in: a" in
+  ;; (syntax-parse #'(x y z) [((~or a (a b c)) ...) #'(a ...)])
+  (define-syntax ~or-bug
+    (pattern-expander
+     (λ (stx)
+       (syntax-parse stx
+         [(self pat ...)
+          (define (s stx) (datum->syntax #'self stx stx stx))
+          #`(#,(s #'~and) x (#,(s #'~parse) (#,(s #'~or) pat ...) #'x))]))))
+  
+  (define-syntax ~lit
+    (pattern-expander
+     (λ (stx)
+       (syntax-parse stx
+         [(self (~optional (~seq name:id (~literal ~))) lit)
+          (define (s stx) (datum->syntax #'self stx stx stx))
+          (if (attribute name)
+              #`(#,(s #'~and) name (#,(s #'~literal) lit))
+              #`(#,(s #'~literal) lit))]
+         [(self (~optional (~seq name:id (~literal ~))) lit …)
+          (define (s stx) (datum->syntax #'self stx stx stx))
+          (if (attribute name)
+              #`(#,(s #'~and) name (#,(s #'~seq) (#,(s #'~literal) lit)))
+              #`(#,(s #'~seq) (#,(s #'~literal) lit)))]))))
+  
+  (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) body0 . body)
+    (define-syntax (name stx2)
+      (syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+                           (syntax-parse stx2
+                             [(_ . args) body0 . body]))))
+  
+  (define-simple-macro (λ/syntax-parse args . body)
+    (λ (stx2)
+      ;(syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+      (syntax-parse stx2
+        [args . body])))
+  
+  ;; λstx
+  (begin
+    (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)))))
+  
+  ;; template/debug
+  (begin
+    (define-syntax (template/debug stx)
+      (syntax-parse stx
+        [(_ debug-attribute:id . rest)
+         #'((λ (x)
+              (when (attribute debug-attribute)
+                (pretty-write (syntax->datum x)))
+              x)
+            (template . rest))])))
+  
+  ;; quasitemplate/debug
+  (begin
+    (define-syntax (quasitemplate/debug stx)
+      (syntax-parse stx
+        [(_ debug-attribute:id . rest)
+         #'((λ (x)
+              (when (attribute debug-attribute)
+                (pretty-write (syntax->datum x)))
+              x)
+            (quasitemplate . rest))])))
+  
+  ;; meta-eval
+  (begin
+    ;; TODO: this is kind of a hack, as we have to write:
+    #;(with-syntax ([(x …) #'(a bb ccc)])
+        (let ([y 70])
+          (quasitemplate
+           ([x (meta-eval (+ #,y (string-length
+                                  (symbol->string
+                                   (syntax-e #'x)))))]
+            …))))
+    ;; Where we need #,y instead of using:
+    ;; (+ y (string-length etc.)).
+    (module m-meta-eval racket
+      (provide meta-eval)
+      (require syntax/parse/experimental/template)
+      
+      (define-template-metafunction (meta-eval stx)
+        (syntax-case stx ()
+          [(_ . body)
+           #`#,(eval #'(begin . body))])))
+    (require 'm-meta-eval)))

graph-lib/lib/low/threading.rkt

@@ -0,0 +1,21 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  ;; raco pkg install alexis-util
+  ;; or:
+  ;; raco pkg install threading
+  (require alexis/util/threading
+           (for-syntax racket/syntax
+                       syntax/parse))
+  
+  (define-syntax-rule (~>_ clause ... expr) (~> expr clause ...))
+  (define-syntax (<~ stx)
+    (syntax-parse stx
+      [(_ expr clause ...)
+       (define/with-syntax (r-clause ...)
+         (reverse (syntax->list #'(clause ...))))
+       #'(~> expr r-clause ...)]))
+  
+  (define-syntax-rule (<~_ clause ... expr) (<~ expr clause ...))
+  
+  (provide <~ <~_ ~>_ ~> ~>> _ (rename-out [_ ♦] [<~_ <~♦] [~>_ ~>♦])))

graph-lib/lib/low/tmpl-multiassoc-syntax.rkt

@@ -0,0 +1,25 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide tmpl-cdr-assoc-syntax
+           (rename-out [tmpl-cdr-assoc-syntax !cdr-assoc]))
+  
+  (module m-tmpl-cdr-assoc-syntax racket
+    (provide tmpl-cdr-assoc-syntax)
+    
+    (require syntax/parse
+             syntax/parse/experimental/template
+             (submod "stx.rkt" untyped)
+             (submod "multiassoc-syntax.rkt" untyped)
+             (submod "aliases.rkt" untyped))
+    
+    (define-template-metafunction (tmpl-cdr-assoc-syntax stx)
+      (syntax-parse stx
+        [(_ (~optional (~seq #:default default)) query [k . v] …)
+         (if (attribute default)
+             (let ([r (assoc-syntax #'query #'([k . v] …))])
+               (if r
+                   (stx-cdr r)
+                   #'default))
+             (cdr-assoc-syntax #'query #'([k . v] …)))])))
+  (require 'm-tmpl-cdr-assoc-syntax))

graph-lib/lib/low/type-inference-helpers.rkt

@@ -0,0 +1,25 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide cars cdrs)
+  
+  #|
+  ;; This does not work, in the end.
+  (provide imap)
+  (define-syntax (imap stx)
+    (syntax-parse stx
+      [(_ lst:expr var:id (~optional (~literal →)) . body)
+       #'(let ()
+           (define #:∀ (T) (inlined-map [l : (Listof T)])
+             (if (null? l)
+                 '()
+                 (cons (let ([var (car l)]) . body)
+                       (inlined-map (cdr l)))))
+           (inlined-map lst))]))
+  |#
+  
+  (: cars (∀ (A) (→ (Listof (Pairof A Any)) (Listof A))))
+  (define (cars l) ((inst map A (Pairof A Any)) car l))
+  
+  (: cdrs (∀ (B) (→ (Listof (Pairof Any B)) (Listof B))))
+  (define (cdrs l) ((inst map B (Pairof Any B)) cdr l)))

graph-lib/lib/low/typed-rackunit-extensions.rkt

@@ -0,0 +1,69 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide check-equal?-classes
+           check-equal?-classes:)
+  
+  (require "typed-untyped.rkt")
+  (require-typed/untyped "syntax-parse.rkt"
+                         "sequence.rkt")
+  
+  (require (for-syntax syntax/parse
+                       syntax/parse/experimental/template
+                       racket/syntax
+                       (submod "aliases.rkt" untyped)
+                       (submod "syntax-parse.rkt" untyped)
+                       (submod "repeat-stx.rkt" untyped))
+           typed/rackunit)
+  
+  (: check-equal?-classes (∀ (A ...) (→ (Pairof String (Listof A)) ... Void)))
+  (define (check-equal?-classes . classes)
+    (for* ([(head tail) (in-split* classes)])
+      (let ([this-class (sequence-ref tail 0)]
+            [different-classes (in-sequences head (sequence-tail tail 1))])
+        (for ([val (cdr this-class)])
+          (for ([other-val (cdr this-class)])
+            #;(displayln (format "Test ~a ∈ ~a = ~a ∈ ~a …"
+                                 val
+                                 this-class
+                                 other-val
+                                 this-class))
+            (check-equal? val other-val
+                          (format "Test ~a ∈ ~a = ~a ∈ ~a failed."
+                                  val
+                                  this-class
+                                  other-val
+                                  this-class)))
+          (for ([different-class different-classes])
+            (for ([different-val (cdr different-class)])
+              #;(displayln (format "Test ~a ∈ ~a != ~a ∈ ~a ∈ ~a …"
+                                   val
+                                   this-class
+                                   different-val
+                                   different-class
+                                   (sequence->list different-classes)))
+              (check-not-equal? val different-val
+                                (format "Test ~a ∈ ~a != ~a ∈ ~a ∈ ~a failed."
+                                        val
+                                        this-class
+                                        different-val
+                                        different-class
+                                        (sequence->list
+                                         different-classes)))))))))
+  
+  (define-syntax/parse (check-equal?-classes:
+                        (~seq [(~maybe #:name name:expr)
+                               (~maybe (~lit :) c-type)
+                               (~seq val (~maybe (~lit :) v-type)) …])
+                        …)
+    (define/with-syntax ([a-val …] …)
+      (template ([(?? (ann val v-type) val) …] …)))
+    (define/with-syntax ([aa-val …] …)
+      (let ()
+        ;; TODO: this is ugly, repeat-stx should handle missing stuff instead.
+        (define/with-syntax (xx-c-type …) (template ((?? (c-type) ()) …)))
+        (syntax-parse (repeat-stx (xx-c-type …) ([val …] …))
+          [([((~optional c-type-rep)) …] …)
+           (template ([(?? name "") (?? (ann a-val c-type-rep) a-val) …] …))])))
+    (template
+     (check-equal?-classes (list aa-val …) …))))

graph-lib/lib/low/typed-rackunit.rkt

@@ -0,0 +1,95 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  ;; TODO: these won't expand types in the ann.
+  (provide check-equal?:
+           check-not-equal?:
+           check-ann)
+  
+  (require "typed-untyped.rkt")
+  
+  (require/typed rackunit
+                 [(check-true untyped:check-true)
+                  (->* (Any) (String) Any)]
+                 [#:struct check-info ([name : Symbol] [value : Any])]
+                 [make-check-info (→ Symbol Any check-info)]
+                 [make-check-location (→ (List Any
+                                               (U Number False)
+                                               (U Number False)
+                                               (U Number False)
+                                               (U Number False))
+                                         check-info)]
+                 [make-check-name (→ Any check-info)]
+                 [make-check-params (→ Any check-info)]
+                 [make-check-actual (→ Any check-info)]
+                 [make-check-expected (→ Any check-info)]
+                 [make-check-expression (→ Any check-info)]
+                 [make-check-message (→ Any check-info)]
+                 [with-check-info* (→ (Listof check-info) (→ Any) Any)])
+  
+  (require (for-syntax syntax/parse
+                       syntax/parse/experimental/template))
+  (require-typed/untyped "syntax-parse.rkt")
+  
+  (define-syntax/parse
+    (check-equal?: actual
+                   (~optional (~seq (~datum :) type))
+                   expected
+                   (~optional message:expr))
+    (quasitemplate
+     (with-check-info* (list (make-check-actual (format "~s" actual))
+                             (make-check-expected (format "~s" expected))
+                             (make-check-name 'check-equal?:)
+                             (make-check-params
+                              (format "~s" `(,actual (?? 'type) ,expected)))
+                             (make-check-location '(#,(syntax-source stx)
+                                                    #,(syntax-line stx)
+                                                    #,(syntax-column stx)
+                                                    #,(syntax-position stx)
+                                                    #,(syntax-span stx)))
+                             (make-check-expression '#,(syntax->datum stx)))
+                       (λ ()
+                         (untyped:check-true
+                          (equal? (?? (ann actual type) actual)
+                                  expected))))))
+  
+  (define-syntax/parse
+    (check-not-equal?: actual
+                       (~optional (~seq (~datum :) type))
+                       expected
+                       (~optional message))
+    (quasitemplate
+     (with-check-info* (list (make-check-actual (format "~s" actual))
+                             (make-check-expected (format "~s" expected))
+                             (make-check-name 'check-not-equal?:)
+                             (make-check-params
+                              (format "~s" `(,actual (?? 'type) ,expected)))
+                             (make-check-location '(#,(syntax-source stx)
+                                                    #,(syntax-line stx)
+                                                    #,(syntax-column stx)
+                                                    #,(syntax-position stx)
+                                                    #,(syntax-span stx)))
+                             (make-check-expression '#,(syntax->datum stx)))
+                       (λ ()
+                         (untyped:check-true
+                          (not (equal? (?? (ann actual type) actual)
+                                       expected)))))))
+  
+  (define-syntax/parse (check-ann value type (~optional message))
+    (quasitemplate
+     ((λ _ (void)) (ann value type))
+     #;(let ([value-cache value])
+       (with-check-info* (list (make-check-actual (format "~s" value-cache))
+                               (make-check-expected (format "~s" value-cache))
+                               (make-check-name 'check-ann)
+                               (make-check-params (format "~s" `(,value-cache
+                                                                 type)))
+                               (make-check-location '(#,(syntax-source stx)
+                                                      #,(syntax-line stx)
+                                                      #,(syntax-column stx)
+                                                      #,(syntax-position stx)
+                                                      #,(syntax-span stx)))
+                               (make-check-expression '#,(syntax->datum stx)))
+                         (λ ()
+                           (untyped:check-true
+                            (equal? (ann value type) value))))))))

graph-lib/lib/low/typed-untyped.rkt

@@ -0,0 +1,185 @@
+#lang racket
+
+(provide ;typed/untyped
+ require-typed/untyped-typed
+ require-typed/untyped
+ require/provide-typed/untyped
+ define-typed/untyped-modules
+ if-typed
+ when-typed
+ when-untyped)
+
+(require typed/untyped-utils
+         racket/require-syntax
+         (for-syntax syntax/parse
+                     racket/syntax
+                     syntax/stx
+                     syntax/strip-context))
+
+(module m-typed typed/racket
+  (provide (rename-out [require tr:require]
+                       [provide tr:provide])
+           ;typed/untyped
+           #;require-typed/untyped)
+  
+  #;(require (for-syntax syntax/parse
+                         racket/syntax
+                         syntax/stx
+                         syntax/strip-context)
+             racket/require-syntax)
+  
+  
+  
+  #;(define-syntax (require-typed/untyped stx)
+      (syntax-case stx ()
+        [(_ m)
+         (let ()
+           (define/with-syntax sb (datum->syntax #'m 'submod #'m #'m))
+           (define/with-syntax ty (datum->syntax #'m 'typed #'m #'m))
+           #'(require (sb m ty)))])))
+
+#;(require 'm-typed)
+
+;; require
+(define-syntax (require-typed/untyped-typed stx)
+  (syntax-parse stx
+    [(_ . (~and ms (m ...)))
+     (replace-context #'ms #'(require (submod m typed) ...))]))
+
+#;(define-require-syntax (typed/untyped-typed stx)
+    (syntax-case stx ()
+      [(_ m) (replace-context stx #'(submod m typed))]))
+
+#;(define-require-syntax (typed/untyped-untyped stx)
+    (syntax-case stx ()
+      [(_ m) (replace-context stx #'(submod m untyped))]))
+
+(define-syntax (require-typed/untyped-untyped stx)
+  (syntax-parse stx
+    [(_ . (~and ms (m ...)))
+     (replace-context #'ms #'(require (submod m untyped) ...))]))
+
+(define-typed/untyped-identifier require-typed/untyped
+  require-typed/untyped-typed
+  require-typed/untyped-untyped)
+
+#;(define-typed/untyped-identifier typed/untyped
+    typed/untyped-typed
+    typed/untyped-untyped)
+
+;; require/provide
+;; TODO: make a require expander instead.
+(define-syntax (require/provide-typed/untyped-typed stx)
+  (syntax-parse stx
+    [(_ . (~and ms (m ...)))
+     (replace-context #'ms
+                      #'(begin
+                          (require (submod m typed) ...)
+                          (provide (all-from-out (submod m typed) ...))))]))
+
+(define-syntax (require/provide-typed/untyped-untyped stx)
+  (syntax-parse stx
+    [(_ . (~and ms (m ...)))
+     (replace-context #'ms
+                      #'(begin
+                          (require (submod m untyped) ...)
+                          (provide (all-from-out (submod m untyped) ...))))]))
+
+(define-typed/untyped-identifier require/provide-typed/untyped
+  require/provide-typed/untyped-typed
+  require/provide-typed/untyped-untyped)
+
+#|
+(module mt typed/racket
+  (define-syntax-rule (require/provide-typed/untyped m)
+    (require m))
+  (provide require/provide-typed/untyped))
+(require 'mt)
+|#
+
+;; define-typed/untyped-modules
+(begin
+  (define-syntax (define-typed/untyped-modules stx)
+    (syntax-parse stx
+      [(_ (~optional (~and no-test #:no-test))
+          (~optional (~and untyped-first #:untyped-first)) . body)
+       (define (ds sym) (datum->syntax stx sym stx))
+       (define/with-syntax module-typed
+         #`(module #,(ds 'typed) #,(ds 'typed/racket)
+             . body))
+       (define/with-syntax module-untyped
+         #`(module #,(ds 'untyped) #,(ds 'typed/racket/no-check)
+             (#,(ds 'require) (#,(ds 'for-syntax) #,(ds 'racket/base)))
+             . body))
+       #`(begin
+           #,(if (attribute untyped-first) #'module-untyped #'module-typed)
+           #,(if (attribute untyped-first) #'module-typed #'module-untyped)
+           #,@(if (attribute no-test)
+                  #'()
+                  #`((module #,(ds 'test) #,(ds 'typed/racket)
+                       (#,(ds 'require) (#,(ds 'submod) #,(ds "..")
+                                                        #,(ds 'typed)
+                                                        #,(ds 'test)))
+                       (#,(ds 'require) (#,(ds 'submod) #,(ds "..")
+                                                        #,(ds 'untyped)
+                                                        #,(ds 'test))))))
+           (#,(ds 'require) '#,(ds 'typed))
+           (#,(ds 'provide) (#,(ds 'all-from-out) '#,(ds 'typed))))]))
+  
+  #| ;; test: should work in no-check but not in typed:
+  (define-typed/untyped-modules moo
+    (: foo One)
+    (define foo 2))
+  |#)
+
+;; if-typed
+(define-syntax-rule (if-typed-typed t u) t)
+(define-syntax-rule (if-typed-untyped t u) u)
+(define-typed/untyped-identifier if-typed
+  if-typed-typed
+  if-typed-untyped)
+
+;; when-typed and when-untyped
+(define-syntax-rule (when-typed . t) (if-typed (begin . t) (begin)))
+(define-syntax-rule (when-untyped . t) (if-typed (begin) (begin . t)))
+
+;; typed/untyped-prefix
+(begin
+  (define-syntax-rule (typed/untyped-prefix [typed-prefix ...]
+                                            [untyped-prefix ...]
+                                            . rest)
+    (if-typed (typed-prefix ... . rest)
+              (untyped-prefix ... . rest)))
+  #|
+  ;; test: should work in no-check but not in typed:
+  (typed/untyped-prefix
+   [module moo2 typed/racket]
+   [module moo2 typed/racket/no-check]
+   (: foo One)
+   (define foo 2))
+  |#)
+
+;; define-modules
+(begin
+  ;; define-modules
+  (define-syntax define-modules
+    (syntax-rules (no-submodule)
+      [(_ ([no-submodule] [name lang] ...) . body)
+       (begin (begin . body)
+              (module name lang . body) ...)]
+      [(_ ([name lang] ...) . body)
+       (begin (module name lang . body) ...)]))
+  
+  #|
+  ;; TODO: tests: test with a macro and check that we can use it in untyped.
+  ;; TODO: tests: test with two mini-languages with different semantics for some
+  ;; function.
+  (define-modules ([foo typed/racket] [foo-untyped typed/racket/no-check])
+    (provide x)
+    (: x (→ Syntax Syntax))
+    (define (x s) s))
+  
+  (module test racket
+    (require (submod ".." foo-untyped))
+    (x #'a))
+  |#)

graph-lib/lib/low/values.rkt

@@ -0,0 +1,37 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules
+  (provide first-value second-value third-value fourth-value fifth-value
+           sixth-value seventh-value eighth-value ninth-value tenth-value
+           cons→values
+           (rename-out [cons→values cons->values]))
+  
+  (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 #:∀ (A B) (cons→values [x : (Pairof A B)]) (values (car x) (cdr x))))

graph-lib/lib/sequences.rkt

@@ -1,45 +0,0 @@
-#lang typed/racket
-
-(provide sequence-cons sequence-null sequence-list)
-
-(: sequence-cons (∀ (A B) (→ (Sequenceof A) (Sequenceof B)
-                             (Sequenceof (cons A B)))))
-(define (sequence-cons sa sb)
-  (sequence-map (λ ([x : (List A B)]) (cons (car x) (cadr x)))
-                (in-values-sequence (in-parallel sa sb))))
-
-(: sequence-null (Sequenceof Null))
-(define sequence-null (in-cycle (in-value '())))
-
-;; sequence-list should have the type:
-;; (∀ (A ...) (→ (Sequenceof A) ... (Sequenceof (List A ...)))))
-;; But the type system rejects the two definitions below.
-(: sequence-list (∀ (A) (→ (Sequenceof A) *
-                           (Sequenceof (Listof A)))))
-(define (sequence-list . sequences)
-  (if (null? sequences)
-      sequence-null
-      (sequence-cons (car sequences) (apply sequence-list (cdr sequences)))))
-
-#|
-(: sequence-list (∀ (A ...) (→ (Sequenceof A) ...
-                               (Sequenceof (List A ...)))))
-(define (sequence-list . sequences)
-  (if (null? sequences)
-      sequence-null
-      (sequence-cons (car sequences) (apply sequence-list (cdr sequences)))))
-|#
-
-#|
-(: sequence-list (∀ (F R ...)
-                    (case→ [→ (Sequenceof Null)]
-                           [→ (Sequenceof F) (Sequenceof R) ...
-                              (Sequenceof (List F R ...))])))
-(define sequence-list
-  (case-lambda
-    [()
-     sequence-null]
-    [(sequence . sequences)
-     (sequence-cons sequence (apply sequence-list sequences))]))
-|#
-

graph-lib/lib/test-define-temp-ids.rkt

@@ -1,5 +1,5 @@
 #lang racket
-(require "low-untyped.rkt")
+(require (submod "low.rkt" untyped))
 
 (with-syntax ([((foo ...) ...) #'((aa bb cc) (x1 x2))])
   (define-temp-ids "___~a.truc" ((foo ...) ...) #:first-base fst)

graph-lib/lib/untyped.rkt

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

graph-lib/main.rkt

@@ -9,50 +9,6 @@
 (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)))

graph-lib/make/dependency-graph.rkt

@@ -62,6 +62,7 @@
 
 (define excluded
   '(typed/racket
+    typed/racket/no-check
     racket/base
     racket
     scribble/lp/lang/lang2))
@@ -119,7 +120,6 @@
   
   (define (tag-pair dep)
     (append (if (equal? (cdr dep) "lib/low.rkt") '(lib/low) '())
-            (if (equal? (cdr dep) "lib/low-untyped.rkt") '(lib/low) '())
             (if (equal? (categorize-main-module (car dep))
                         (categorize-main-module (cdr dep))) '(submodule) '())
             (if (lib? (cdr dep)) '(lib) '())))

graph-lib/make/make.rkt

@@ -137,6 +137,7 @@
 
 (run! `(,(find-executable-path-or-fail "raco")
         "make"
+        "-v"
         "-j" "5"
         ,@rkt-files))
 

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

@@ -1069,10 +1069,9 @@ in a separate module (that will be used only by macros, so it will be written in
        (module expander racket
          (require racket
                   syntax/parse
-                  syntax/stx
                   racket/format
                   syntax/id-table
-                  "../lib/low-untyped.rkt")
+                  (submod "../lib/low.rkt" untyped))
          
          (require (for-template typed/racket))
          
@@ -1101,7 +1100,7 @@ We can finally define the overloaded forms, as well as the extra
                               racket/syntax
                               syntax/parse
                               syntax/parse/experimental/template
-                              "../lib/low-untyped.rkt")
+                              (submod "../lib/low.rkt" untyped))
                   "../lib/low.rkt")
          
          (require (submod ".." expander))
@@ -1159,7 +1158,7 @@ And, last but not least, we will add a @tc[test] module.
                   "../lib/low.rkt"
                   (for-syntax (submod ".." expander)
                               racket/list
-                              "../lib/low-untyped.rkt"))
+                              (submod "../lib/low.rkt" untyped)))
          
          <test-expand-type>