Update to new unison internal libraries, with support

I'd already been working on caching values in the jit in the
internal libraries, so it was convenient to include those changes in
the update that also parses the extended v4 format. This requires a
bit of additional racket code, but the consequences are disabled
until some supporting code is available in the base library.

Some definitions will be tagged as `value` indicating that they can
be expanded into racket definitions that will only be evaluated
once. The code for expanding things that way is included, too. But
the feature is turned off, so everything will expand in the old way.

scheme-libs/racket/unison/boot.ss

@@ -216,12 +216,17 @@
 ; This builds the core definition for a unison definition. It is just
 ; a lambda expression with the original code, but with an additional
 ; keyword argument for threading purity information.
-(define-for-syntax (make-impl name:impl:stx arg:stx body:stx)
+(define-for-syntax (make-impl value? name:impl:stx arg:stx body:stx)
   (with-syntax ([name:impl name:impl:stx]
                 [args arg:stx]
                 [body body:stx])
-    (syntax/loc body:stx
-      (define (name:impl . args) . body))))
+    (cond
+      [value?
+        (syntax/loc body:stx
+          (define name:impl . body))]
+      [else
+       (syntax/loc body:stx
+         (define (name:impl . args) . body))])))
 
 (define frame-contents (gensym))
 
@@ -235,41 +240,53 @@
 (define-for-syntax
   (make-fast-path
     #:force-pure force-pure?
+    #:value value?
     loc ; original location
     name:fast:stx name:impl:stx
     arg:stx)
 
   (with-syntax ([name:impl name:impl:stx]
                 [name:fast name:fast:stx]
                 [args arg:stx])
-    (if force-pure?
-      (syntax/loc loc
-        ; note: for some reason this performs better than
-        ; (define name:fast name:impl)
-        (define (name:fast . args) (name:impl . args)))
-
-      (syntax/loc loc
-        (define (name:fast #:pure pure? . args)
-          (if pure?
-            (name:impl #:pure pure? . args)
-            (with-continuation-mark
-              frame-contents
-              (vector . args)
-              (name:impl #:pure pure? . args))))))))
+    (cond
+      [value?
+       (syntax/loc loc
+         (define (name:fast) name:impl))]
+
+      [force-pure?
+       (syntax/loc loc
+         ; note: for some reason this performs better than
+         ; (define name:fast name:impl)
+         (define (name:fast . args) (name:impl . args)))]
+
+      [else
+       (syntax/loc loc
+         (define (name:fast #:pure pure? . args)
+           (if pure?
+             (name:impl #:pure pure? . args)
+             (with-continuation-mark
+               frame-contents
+               (vector . args)
+               (name:impl #:pure pure? . args)))))])))
 
 (define-for-syntax
-  (make-main loc inline? name:stx ref:stx name:impl:stx n)
+  (make-main loc value? inline? name:stx ref:stx name:impl:stx n)
   (with-syntax ([name name:stx]
                 [name:impl name:impl:stx]
                 [gr ref:stx]
                 [n (datum->syntax loc n)])
-    (if inline?
-      (syntax/loc loc
-        (define name
-          (unison-curry #:inline n gr name:impl)))
-      (syntax/loc loc
-        (define name
-          (unison-curry n gr name:impl))))))
+    (cond
+      [value?
+       (syntax/loc loc
+         (define (name) name:impl))]
+      [inline?
+       (syntax/loc loc
+         (define name
+           (unison-curry #:inline n gr name:impl)))]
+      [else
+       (syntax/loc loc
+         (define name
+           (unison-curry n gr name:impl)))])))
 
 (define-for-syntax
   (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)
@@ -299,7 +316,8 @@
              [no-link-decl? #f]
              [trace? #f]
              [inline? #f]
-             [recursive? #f])
+             [recursive? #f]
+             [value? #f])
             ([h hs])
     (values
       (or internal? (eq? h 'internal))
@@ -308,7 +326,9 @@
       (or no-link-decl? (eq? h 'no-link-decl))
       (or trace? (eq? h 'trace))
       (or inline? (eq? h 'inline))
-      (or recursive? (eq? h 'recursive)))))
+      (or recursive? (eq? h 'recursive))
+      ; TODO: enable values
+      value?)))
 
 (define-for-syntax
   (make-link-def gen-link? loc name:stx name:link:stx)
@@ -343,7 +363,8 @@
                   no-link-decl?
                   trace?
                   inline?
-                  recursive?)
+                  recursive?
+                  value?)
     (process-hints hints))
 
 
@@ -356,9 +377,10 @@
       ([(link ...) (make-link-def gen-link? loc name:stx name:link:stx)]
        [fast (make-fast-path
                #:force-pure #t ; force-pure?
+               #:value value?
                loc name:fast:stx name:impl:stx arg:stx)]
-       [impl (make-impl name:impl:stx arg:stx expr:stx)]
-       [main (make-main loc inline? name:stx ref:stx name:impl:stx arity)]
+       [impl (make-impl value? name:impl:stx arg:stx expr:stx)]
+       [main (make-main loc value? inline? name:stx ref:stx name:impl:stx arity)]
        ; [(decls ...)
        ;  (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)]
        [(traces ...)

scheme-libs/racket/unison/primops-generated.rkt

@@ -176,6 +176,13 @@
        (if (null? hints)
          (list def '#:local ln head body)
          (list def '#:local ln '#:hints hints head body)))]
+    [(unison-data _ t (list nm hs bd))
+     #:when (= t ref-schemedefn-defineval:tag)
+     (let-values
+       ([(head) (text->ident nm)]
+        [(def hints) (decode-hints (chunked-list->list hs))]
+        [(body) (decode-term bd)])
+       (list def '#:hints (cons 'value hints) (list head) body))]
     [(unison-data _ t (list nm bd))
      #:when (= t ref-schemedefn-alias:tag)
      (list 'define (text->ident nm) (decode-term bd))]
@@ -684,16 +691,31 @@
        "unison-termlink-derived?"
        tl)]))
 
+; Converts a link->code map into an appropriately sorted list
+; for code generation. It's necessary to topologically sort
+; the code so that values occur after the things they reference.
+(define (codemap->link-order defs)
+  (define input
+    (for/list ([(tl co) defs])
+      (unison-tuple
+        (termlink->reference tl)
+        (unison-code-rep co))))
+
+  (define result (topsort-code-refs (list->chunked-list input)))
+
+  (for/list ([r (in-chunked-list result)])
+    (reference->termlink r)))
+
 ; Given a list of termlink, code pairs, returns multiple lists
 ; of definitions and declarations. The lists are returned as
 ; multiple results, each one containing a particular type of
 ; definition.
 ;
-; This is the version for compiling to intermediate code.
+; This is the version for compiling to runtime code.
 (define (gen-codes:runtime arities defs)
   (for/lists (lndefs lndecs dfns)
-             ([(tl co) defs])
-    (gen-code:runtime arities tl co)))
+             ([tl (codemap->link-order defs)])
+    (gen-code:runtime arities tl (hash-ref defs tl))))
 
 ; Given a list of termlink, code pairs, returns multiple lists
 ; of definitions and declarations. The lists are returned as
@@ -703,8 +725,8 @@
 ; This is the version for compiling to intermediate code.
 (define (gen-codes:intermed arities defs)
   (for/lists (lndefs lndecs codefs codecls dfns)
-             ([(tl co) defs])
-      (gen-code:intermed arities tl co)))
+             ([tl (codemap->link-order defs)])
+      (gen-code:intermed arities tl (hash-ref defs tl))))
 
 (define (flatten ls)
   (cond

unison-src/transcripts-manual/gen-racket-libs.md

@@ -4,7 +4,7 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that
 Next, we'll download the jit project and generate a few Racket files from it.
 
 ```ucm
-jit-setup/main> lib.install @unison/internal/releases/0.0.21
+jit-setup/main> lib.install @unison/internal/releases/0.0.22
 ```
 
 ```unison

unison-src/transcripts-manual/gen-racket-libs.output.md

@@ -3,12 +3,12 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that
 Next, we'll download the jit project and generate a few Racket files from it.
 
 ``` ucm
-jit-setup/main> lib.install @unison/internal/releases/0.0.21
+jit-setup/main> lib.install @unison/internal/releases/0.0.22
 
-  Downloaded 14985 entities.
+  Downloaded 14996 entities.
 
-  I installed @unison/internal/releases/0.0.21 as
-  unison_internal_0_0_21.
+  I installed @unison/internal/releases/0.0.22 as
+  unison_internal_0_0_22.
 
 ```
 ``` unison