Fix various issues with runtime code loading

- Generated `cond` statements weren't being decoded properly. They have
  a trivial value in the 'scrutinee' field that was being turned into an
  empty-string variable.
- Fix decoding of character and scheme boolean literals
- Generate type link definitions for code used in the module
- Factor out runtime module definition functions to support other entry
  points besides the CACH primop
- Export some code loading functions for use in a standalone executable

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

@@ -41,7 +41,16 @@
 
   unison-POp-CACH
   unison-POp-LOAD
-  unison-POp-LKUP)
+  unison-POp-LKUP
+
+  ; some exports of internal machinery for use elsewhere
+  gen-code
+  reify-value
+  termlink->name
+
+  add-runtime-code
+  build-runtime-module
+  termlink->proc)
 
 (define-builtin-link Value.value)
 (define-builtin-link Value.reflect)
@@ -65,6 +74,11 @@
 (define (list->chunked-list l)
   (vector->chunked-list (list->vector l)))
 
+(define (assemble-cases hd sc cs)
+  (cond
+    [(equal? hd 'cond) `(cond ,@cs)]
+    [else `(,hd ,sc ,@cs)]))
+
 (define (decode-term tm)
   (match tm
     [(unison-data _ t (list tms))
@@ -80,9 +94,10 @@
         ,@(map decode-term (chunked-list->list tms)))]
     [(unison-data _ t (list hd sc cs))
      #:when (= t unison-schemeterm-cases:tag)
-     `(,(text->ident hd)
-        ,(decode-term sc)
-        ,@(map decode-term (chunked-list->list cs)))]
+     (assemble-cases
+       (text->ident hd)
+       (decode-term sc)
+       (map decode-term (chunked-list->list cs)))]
     [(unison-data _ t (list hd bs bd))
      #:when (= t unison-schemeterm-binds:tag)
      `(,(text->ident hd)
@@ -126,10 +141,23 @@
     [else
       (raise (format "decode-syntax: unimplemented case: ~a" dfn))]))
 
+(define (string->char st)
+  (cond
+    [(< (string-length st) 3) #f]
+    [(> (string-length st) 3) #f]
+    [(equal? (substring st 0 2) "#\\") (string-ref st 2)]
+    [else #f]))
+
 (define (text->ident tx)
   (let* ([st (chunked-string->string tx)]
-         [n (string->number st)])
-    (if n n (string->symbol st))))
+         [n (string->number st)]
+         [c (string->char st)])
+    (cond
+      [(equal? st "#f") #f]
+      [(equal? st "#t") #t]
+      [c c]
+      [n n]
+      [else (string->symbol st)])))
 
 (define (decode-ref rf)
   (match rf
@@ -433,6 +461,13 @@
         [0 (snd nil)
           (values fst snd)])]))
 
+(define (gen-typelinks code)
+  (map decode-syntax
+       (chunked-list->list
+         (gen-typelink-defns
+           (list->chunked-list
+             (map unison-code-rep code))))))
+
 (define (gen-code args)
   (let-values ([(tl co) (splat-upair args)])
     (match tl
@@ -500,6 +535,17 @@
         'unison/simple-wrappers
         nm))))
 
+(define (termlink->proc tl)
+  (match tl
+    [(unison-termlink-derived bs i)
+     (let ([mname (hash-ref runtime-module-map bs)])
+       (parameterize ([current-namespace runtime-namespace])
+         (dynamic-require `(quote ,mname) (termlink->name tl))))]
+    [(unison-termlink-builtin name)
+     (let ([mname (string->symbol (string-append "builtin-" name))])
+       (parameterize ([current-namespace runtime-namespace])
+         (resolve-builtin mname)))]))
+
 (define (resolve-proc gr)
   (sum-case (decode-ref (group-reference gr))
     [0 (tx)
@@ -512,50 +558,65 @@
        (parameterize ([current-namespace runtime-namespace])
          (dynamic-require `(quote ,mname) sym)))]))
 
-(define (add-runtime-module mname links defs)
-  (let ([names (map termlink->name links)])
-    (eval
-      `(module ,mname racket/base
-         (require unison/boot)
-         (require unison/primops)
-         (require unison/primops-generated)
-         (require unison/builtin-generated)
-         (require unison/simple-wrappers)
-         (provide ,@names)
-         ,@defs)
-      runtime-namespace)))
+(define (build-runtime-module mname tylinks tmlinks defs)
+  (let ([names (map termlink->name tmlinks)])
+    `(module ,mname racket/base
+       (require unison/boot
+                unison/data-info
+                unison/primops
+                unison/primops-generated
+                unison/builtin-generated
+                unison/simple-wrappers
+                unison/compound-wrappers)
+
+       (provide ,@names)
+
+       ,@tylinks
+
+       ,@defs)))
+
+(define (add-runtime-module mname tylinks tmlinks defs)
+  (eval (build-runtime-module mname tylinks tmlinks defs)
+        runtime-namespace))
 
 (define (code-dependencies co)
   (chunked-list->list
     (group-term-dependencies
       (unison-code-rep co))))
 
-(define (unison-POp-CACH dfns0)
+(define (add-runtime-code mname0 dfns0)
   (define (map-links dss)
     (map (lambda (ds) (map reference->termlink ds)) dss))
 
   (let ([udefs (chunked-list->list dfns0)])
     (cond
       [(not (null? udefs))
-       (let* ([links (map ufst udefs)]
-              [refs (map termlink->reference links)]
-              [depss (map (compose code-dependencies usnd) udefs)]
+       (let* ([tmlinks (map ufst udefs)]
+              [codes (map usnd udefs)]
+              [refs (map termlink->reference tmlinks)]
+              [depss (map code-dependencies codes)]
+              [tylinks (gen-typelinks codes)]
               [deps (flatten depss)]
               [fdeps (filter need-dependency? deps)]
               [rdeps (remove* refs fdeps)])
          (cond
-           [(null? fdeps) (sum 0 '())]
+           [(null? fdeps) #f]
            [(null? rdeps)
-            (let ([sdefs (flatten (map gen-code udefs))]
-                  [mname (generate-module-name links)])
-              (expand-sandbox links (map-links depss))
+            (let ([ndefs (map gen-code udefs)] [sdefs (flatten (map gen-code udefs))]
+                  [mname (or mname0 (generate-module-name tmlinks))])
+              (expand-sandbox tmlinks (map-links depss))
               (register-code udefs)
-              (add-module-associations links mname)
-              (add-runtime-module mname links sdefs)
-              (sum 0 '()))]
-           [else
-             (sum 1 (list->chunked-list rdeps))]))]
-      [else (sum 0 '())])))
+              (add-module-associations tmlinks mname)
+              (add-runtime-module mname tylinks tmlinks sdefs)
+              #f)]
+           [else (list->chunked-list rdeps)]))]
+      [else #f])))
+
+(define (unison-POp-CACH dfns0)
+  (let ([result (add-runtime-code #f dfns0)])
+    (if result
+      (sum 1 result)
+      (sum 0 '()))))
 
 (define (unison-POp-LOAD v0)
   (let* ([val (unison-quote-val v0)]