substrate-lang 0.9.4 → 0.10.0

package/substrate/compiler/checker.sub

@@ -8,7 +8,7 @@
 
 ;; ---- uses ----
 
-(struct checking [phase i32] [counter i32] [instances (ptr hash-table)] [throwers (ptr hash-table)]
+(struct checking [phase i32] [counter i32] [throwers (ptr hash-table)]
         [strings (ptr hash-table)] [copies (ptr hash-table)] [layouts (ptr hash-table)] [types (ptr hash-table)]
         [rethrown datum] [datum datum] [next (ptr checking)])
 
@@ -23,9 +23,9 @@
 (define meaning-of (fn (datum) -> datum) 0)
 (define inline-call-of (fn (datum datum) -> datum) 0)
 (define inline-copy-of (fn (datum) -> datum) 0)
-(define expand-head-of (fn (datum bool) -> datum) 0)
-(define scope-shape-of (fn (datum bool) -> datum) 0)
-(define apply-form-of (fn (datum datum bool) -> datum) 0)
+(define expand-head-of (fn (datum) -> datum) 0)
+(define scope-shape-of (fn (datum) -> datum) 0)
+(define apply-form-of (fn (datum datum) -> datum) 0)
 (define prune-local-scopes (fn (datum) -> datum) 0)
 (define facts-of (fn (datum) -> datum) 0)
 (define datum-type-of (fn () -> datum) 0)
@@ -33,8 +33,8 @@
 
 (define (set-expander! [meaning (fn (datum) -> datum)]
                        [inline-call (fn (datum datum) -> datum)] [inline-copy (fn (datum) -> datum)]
-                       [head (fn (datum bool) -> datum)] [shape (fn (datum bool) -> datum)]
-                       [apply (fn (datum datum bool) -> datum)] [prune (fn (datum) -> datum)] [facts (fn (datum) -> datum)]
+                       [head (fn (datum) -> datum)] [shape (fn (datum) -> datum)]
+                       [apply (fn (datum datum) -> datum)] [prune (fn (datum) -> datum)] [facts (fn (datum) -> datum)]
                        [quoted (fn () -> datum)] [syntax-function (fn (datum i32) -> datum)])
   (set! meaning-of meaning)
   (set! inline-call-of inline-call)
@@ -48,12 +48,10 @@
   (set! syntax-function-of syntax-function)
   (set-type-query! local-type-of))
 
-(define twice i32 0)
-
-(define (expand-head [s datum]) -> datum (expand-head-of s (!= twice 0)))
+(define (expand-head [s datum]) -> datum (expand-head-of s))
 (define (expand-in [s datum] [env datum]) -> datum (set! scope-env env) (expand-head s))
-(define (scope-shape! [m datum]) -> datum (scope-shape-of m (!= twice 0)))
-(define (apply-form! [t datum] [s datum]) -> datum (apply-form-of t s (!= twice 0)))
+(define (scope-shape! [m datum]) -> datum (scope-shape-of m))
+(define (apply-form! [t datum] [s datum]) -> datum (apply-form-of t s))
 
 (define (substrate-expansion [kind datum] [env datum] [s datum] [context datum] [states (ptr (ptr void))] [phase i32]) -> datum
   (let ([outer-here here] [outer-state state] [outer-env scope-env] [out datum 0])
@@ -103,9 +101,7 @@
 
 (define (checker-recover!)
   (set! here 0)
-  (set! state 0)
-  (set! twice 0)
-  (set! type-arguments nil))
+  (set! state 0))
 
 (define (state-at [states (ptr (ptr void))] [phase i32]) -> (ptr checking)
   (let ([s (cast (ptr checking) (@ states))])
@@ -114,7 +110,6 @@
       (set! s (new (current-arena) checking))
       (set! (-> s phase) phase)
       (set! (-> s counter) 0)
-      (set! (-> s instances) (make-table))
       (set! (-> s throwers) (make-table))
       (set! (-> s strings) (make-table))
       (set! (-> s copies) (make-table))
@@ -254,11 +249,7 @@
          `(,(car t) ,(for/list ([u (cadr t)]) (shown-as u full))
            ,@(if (== (caddr t) 'void) nil `(-> ,(shown-as (caddr t) full))))]
         [(array-type? t) `(array ,(shown-as (cadr t) full) ,(caddr t))]
-        [(struct-type? t)
-         (let ([name (if full (cadr t) (caddr t))])
-           (if (pair? (cdddr t)) (cons name (for/list ([u (cadddr t)]) (shown-as u full))) name))]
-        [(enum-type? t) (if full (cadr t) (caddr t))]
-        [(and (pair? t) (== (car t) 'tvar)) (cadr t)]
+        [(or (struct-type? t) (enum-type? t)) (if full (cadr t) (caddr t))]
         [(values-type? t) (cons 'values (for/list ([u (cdr t)]) (shown-as u full)))]
         [(== t 'none) 'void]
         [else (settled-type t)]))
@@ -267,25 +258,11 @@
   (let ([a (shown t)] [b (shown u)])
     (if (equal? a b) `(,(shown-as t #t) ,(shown-as u #t)) `(,a ,b))))
 
-(define type-arguments datum nil)
-
-(define (type-variables [ps datum]) -> datum (for/list ([p ps]) (cons p `(tvar ,p))))
-
-(define (parse-types-with [s datum] [ts datum]) -> datum
-  (let ([saved type-arguments] [r datum 0])
-    (set! type-arguments s)
-    (set! r (try (for/list ([t ts]) (parse-type t)) [catch-all (set! type-arguments saved) (rethrow)]))
-    (set! type-arguments saved)
-    r))
-
 (define (parse-type [s datum]) -> datum
   (syntax-match s
     [('quote t) (syntax->datum t)]
     [(? identifier? x)
-     (let ([bound (assq (syntax-e x) type-arguments)])
-       (cond [bound (cdr bound)]
-             [(memq (syntax-e x) '(void i8 u8 i16 u16 i32 u32 i64 u64 f32 f64 exnref bool string)) (syntax-e x)]
-             [else (named-type x)]))]
+     (if (memq (syntax-e x) '(void i8 u8 i16 u16 i32 u32 i64 u64 f32 f64 exnref bool string)) (syntax-e x) (named-type x))]
     [('ptr t) `(ptr ,(parse-type t))]
     [('slice t)
      (let ([u (kept! (parse-type t) t)])
@@ -302,22 +279,11 @@
     [('values t ...)
      (when (null? t) (substrate-error s "expected a type" nil))
      `(values ,@(for/list ([u t]) (scalar! (parse-type u) u)))]
-    [((? identifier? h) a ...) (applied-type s h a)]
     [_ (substrate-error s "expected a type" nil)]))
 
-(define (applied-type [s datum] [h datum] [a datum]) -> datum
-  (let ([v (type-binding h)])
-    (unless (and v (== (car v) 'substrate-struct) (pair? (parameters-of v)))
-      (substrate-error h "~a is not a type that takes types" `(,(syntax-e h))))
-    (unless (== (length a) (length (parameters-of v)))
-      (substrate-error s "~a takes ~a type~a, not ~a"
-                       `(,(syntax-e h) ,(fixnum (length (parameters-of v))) ,(plural (length (parameters-of v))) ,(fixnum (length a)))))
-    `(struct ,(identifier-name h) ,(cadr v) ,(for/list ([t a]) (kept! (complete! (parse-type t) t) t)))))
+(define (numbers-of [v datum]) -> datum (if (> (length v) 4) (list-ref v 4) 0))
 
-(define (parameters-of [v datum]) -> datum (if (> (length v) 4) (list-ref v 4) nil))
-(define (numbers-of [v datum]) -> datum (if (> (length v) 5) (list-ref v 5) 0))
-
-;; A type's compile-time value: (substrate-struct name (field ...) kind (parameter ...)) or
+;; A type's compile-time value: (substrate-struct name (field ...) kind), with an enum's case numbers after the kind, or
 ;; (substrate-typedef type).
 (define (type-binding [x datum]) -> datum
   (if (== (identifier-binding-kind x) 'compile-time-value) (type-value (syntax-local-value x)) 0))
@@ -328,9 +294,9 @@
         known
         (let* ([l (syntax->list v)]
                [t datum (syntax-match (if (!= l 0) l nil)
-                    [('substrate-struct n fs k (p ...)) `(substrate-struct ,(syntax-e n) ,fs ,(syntax-e k) ,(for/list ([q p]) (syntax-e q)))]
-                    [('substrate-struct n fs k (p ...) (x ...))
-                     `(substrate-struct ,(syntax-e n) ,fs ,(syntax-e k) ,(for/list ([q p]) (syntax-e q)) ,(for/list ([y x]) (syntax-e y)))]
+                    [('substrate-struct n fs k) `(substrate-struct ,(syntax-e n) ,fs ,(syntax-e k))]
+                    [('substrate-struct n fs k (x ...))
+                     `(substrate-struct ,(syntax-e n) ,fs ,(syntax-e k) ,(for/list ([y x]) (syntax-e y)))]
                     [('substrate-typedef t) `(substrate-typedef ,(syntax->datum t))]
                     [_ 0])])
           (when (!= t 0) (hash-set! (-> state types) (cast u64 v) (cast u32 t)))
@@ -340,7 +306,6 @@
   (let ([v (type-binding x)])
     (when (== v 0) (substrate-error x "~a is not a type" `(,(syntax-e x))))
     (cond [(== (car v) 'substrate-typedef) (cadr v)]
-          [(pair? (parameters-of v)) (substrate-error x "~a takes types: write (~a type ...)" `(,(syntax-e x) ,(syntax-e x)))]
           [(!= (numbers-of v) 0) `(enum ,(identifier-name x) ,(cadr v))]
           [else `(struct ,(identifier-name x) ,(cadr v))])))
 
@@ -348,15 +313,11 @@
   (syntax-match s
     [(? identifier? x) (or (memq (syntax-e x) '(i8 u8 i16 u16 i32 u32 i64 u64 f32 f64 bool string)) (type-binding x))]
     [('slice t) (type-syntax? t)]
-    [((? identifier? h) a ...)
-     (or (memq (syntax-e h) '(ptr array fn closure))
-         (let ([v (type-binding h)])
-           (and v (== (car v) 'substrate-struct) (pair? (parameters-of v))
-                (not (ormap (lambda ([x datum]) -> bool (keyword? (syntax-e x))) a)))))]
+    [((? identifier? h) a ...) (!= (memq (syntax-e h) '(ptr array fn closure)) 0)]
     [_ #f]))
 
 (define (scalar! [t datum] [where datum]) -> datum
-  (unless (or (arithmetic? t) (address-type? t) (== t 'exnref) (== t 'bool) (view-type? t) (enum-type? t) (and (pair? t) (== (car t) 'tvar)))
+  (unless (or (arithmetic? t) (address-type? t) (== t 'exnref) (== t 'bool) (view-type? t) (enum-type? t))
     (substrate-error where "expected a number or pointer type, not ~s" `(,(shown t))))
   t)
 
@@ -401,15 +362,12 @@
   (let ([known (datum-get (-> state layouts) (cdr t))])
     (when (!= known 0) (return known))
     (let* ([v (type-value (syntax-local-value (name-identifier (cadr t))))] [items (syntax->list (caddr v))]
-           [saved type-arguments] [l datum 0])
-      (datum-put! (-> state layouts) (cdr t) 'laying-out)
-      (set! type-arguments (for/list ([p (parameters-of v)] [a (if (pair? (cdddr t)) (cadddr t) nil)]) (cons p a)))
-      (set! l (try (if (memq (cadddr v) '(variant enum))
-                       (variant-layout items)
-                       (let ([r (lay-out items (== (cadddr v) 'union))])
-                         `(,(fixnum (round-up (fixnum-value (car r)) (fixnum-value (cadr r)))) ,(cadr r) ,(caddr r))))
-                   [catch-all (set! type-arguments saved) (rethrow)]))
-      (set! type-arguments saved)
+           [l (begin
+                (datum-put! (-> state layouts) (cdr t) 'laying-out)
+                (if (memq (cadddr v) '(variant enum))
+                    (variant-layout items)
+                    (let ([r (lay-out items (== (cadddr v) 'union))])
+                      `(,(fixnum (round-up (fixnum-value (car r)) (fixnum-value (cadr r)))) ,(cadr r) ,(caddr r)))))])
       (datum-put! (-> state layouts) (cdr t) l)
       l)))
 
@@ -444,8 +402,6 @@
 
 (define (substrate-define [s datum]) -> datum
   (syntax-match s
-    [(_ #:forall ((? identifier? p) ...) ((? identifier? f) ((? identifier? x) t) ...) rest ...)
-     (let ([r (result-and-body rest)]) (generic s p f x t (car r) (cdr r)))]
     [(_ ((? identifier? f) ((? identifier? x) t) ...) (? placement? k) rest ...)
      (let ([r (result-and-body rest)]) (function s f x t (car r) (cdr r) f k))]
     [(_ ((? identifier? f) ((? identifier? x) t) ...) rest ...)
@@ -472,11 +428,6 @@
                                ,(at s (syn `(#%checked body ,definer (,@xs) ,(if (!= to 0) to '#f) (quote ,(cons rt ps)) ,@body))))))
             (#%fact ,f (quote (substrate-function ,ps ,rt)))))))
 
-(define (generic [s datum] [ps datum] [f datum] [xs datum] [ts datum] [r datum] [body datum]) -> datum
-  (parse-types-with (type-variables (for/list ([p ps]) (syntax-e p))) (cons r ts))
-  (syn `(define-syntax ,f
-          (quote-syntax (#%form mark (#%substrate-generic (,f (,@ps) (,@(for/list ([x xs] [t ts]) `(,x ,t))) ,r (,@body) ,s)))))))
-
 (define (global-definition [s datum] [x datum] [t datum] [init datum]) -> datum
   (let ([ty (kept! (complete! (parse-type t) t) t)])
     (syn `(begin
@@ -545,12 +496,11 @@
 
 (define (aggregate-type [s datum] [kind datum]) -> datum
   (syntax-match s
-    [(_ #:forall ((? identifier? p) ...) (? identifier? name) field ...) (aggregate name field kind p)]
-    [(_ (? identifier? name) field ...) (aggregate name field kind nil)]))
+    [(_ (? identifier? name) field ...) (aggregate name field kind)]))
 
-(define (aggregate [name datum] [fields datum] [kind datum] [ps datum]) -> datum
+(define (aggregate [name datum] [fields datum] [kind datum]) -> datum
   (distinct! (for/list ([f fields]) (syntax-match f [((? identifier? g) _) g] [_ (substrate-error f "expected [field type]" nil)])) '"field")
-  (syn `(begin (define-syntax ,name (quote-syntax (substrate-struct ,name (,@fields) ,kind (,@ps))))
+  (syn `(begin (define-syntax ,name (quote-syntax (substrate-struct ,name (,@fields) ,kind)))
                ,(second-pass (syn `(substrate-struct-check ,name))))))
 
 (define (distinct! [ids datum] [what datum])
@@ -561,10 +511,9 @@
 
 (define (substrate-variant [s datum]) -> datum
   (syntax-match s
-    [(_ #:forall ((? identifier? p) ...) (? identifier? name) c ...) (variant-form name c p)]
-    [(_ (? identifier? name) c ...) (variant-form name c nil)]))
+    [(_ (? identifier? name) c ...) (variant-form name c)]))
 
-(define (variant-form [name datum] [cs datum] [ps datum]) -> datum
+(define (variant-form [name datum] [cs datum]) -> datum
   (let ([cases (for/list ([c cs])
                  (syntax-match c
                    [((? identifier? n) f ...)
@@ -574,7 +523,7 @@
                    [(? identifier? n) `(,n)]
                    [_ (substrate-error c "expected [case [field type] ...]" nil)]))])
     (distinct! (for/list ([c cases]) (car c)) '"case")
-    (syn `(begin (define-syntax ,name (quote-syntax (substrate-struct ,name (,@(for/list ([c cases]) `(,@c))) variant (,@ps))))
+    (syn `(begin (define-syntax ,name (quote-syntax (substrate-struct ,name (,@(for/list ([c cases]) `(,@c))) variant)))
                  ,@(for/list ([c cases] [i (numbers-below (length cases))])
                      `(define-syntax ,(car c) (quote-syntax (#%form mark (#%substrate-construct ,name ,i ,(car c))))))
                  ,(second-pass (syn `(substrate-struct-check ,name)))))))
@@ -582,7 +531,7 @@
 (define (substrate-struct-check [s datum]) -> datum
   (syntax-match s
     [(_ name)
-     (when (null? (parameters-of (type-binding name))) (layout (named-type name)))
+     (layout (named-type name))
      (syn '(begin))]))
 
 (define (substrate-exception [s datum]) -> datum
@@ -775,9 +724,6 @@
       [('offsetof)
        (unless (and (== n 3) (identifier? (caddr l))) (substrate-error s "expected (offsetof type field)" nil))
        (use `(,(piece 'type 0 (cadr l)) ,(piece 'name 0 (caddr l))))]
-      [('inst)
-       (unless (and (>= n 2) (identifier? (cadr l))) (substrate-error s "expected (inst generic type ...)" nil))
-       (use (cons (piece 'name 0 (cadr l)) (for/list ([t (cddr l)]) (piece 'type 0 t))))]
       [('throw)
        (unless (and (>= n 2) (identifier? (cadr l))) (substrate-error s "expected (throw exception value ...)" nil))
        (use (cons (piece 'name 0 (cadr l)) (exprs-in 0 (cddr l))))]
@@ -1318,33 +1264,21 @@
            (let* ([t (piece-at m 1)] [ty (parse-type t)])
              (unless (struct-type? ty) (substrate-error t "~s is not a struct" `(,(shown ty))))
              (cons 'lit (caddr (field-of ty (piece-at m 2)))))]
-          [('inst) (check-inst s m)]
           [('#%datum) (literal s (syntax-e (piece-at m 1)))]
           [('new) (check-new m env)]
           [('copy) (check-copy m env)]
-          [else (check-marked s fenv (mark-arguments m) env hint)]))))
+          [else (check-marked s fenv (mark-arguments m) env)]))))
 
 (define (mark-arguments [m datum]) -> datum (if (== (car m) 'group) (pieces-from m 1) nil))
 
-(define (check-marked [s datum] [fenv datum] [args datum] [env datum] [hint datum]) -> datum
+(define (check-marked [s datum] [fenv datum] [args datum] [env datum]) -> datum
   (syntax-match fenv
-    [('#%substrate-generic g)
-     (if (pair? (syntax-e s))
-         (check-generic-call s g args env hint)
-         (syntax-match g [(f . _) (substrate-error s "~a is generic: give its types, (inst ~a type ...)" `(,(syntax-e f) ,(syntax-e f)))]))]
     [('#%substrate-construct v i n)
-     (let ([t (construct-type s v i args env hint)])
+     (let ([t (named-type v)])
        (if (enum-type? t)
            (begin (case-fields s t (syntax-e i) n args) (cons t (enum-constant t (syntax-e i))))
            (cons t (construct s t i n args env (temp t)))))]))
 
-(define (check-inst [s datum] [m datum]) -> datum
-  (let* ([f (piece-at m 1)] [h (expand-head f)])
-    (syntax-match (if (== (car h) 'form) (caddr h) 0)
-      [('#%substrate-generic g)
-       (let ([i (instance g (for/list ([u (pieces-from m 2)]) (parse-type u)) s)]) (cons (cons 'fn (function-type i)) (function-ref i)))]
-      [_ (substrate-error f "~a is not a generic function" `(,(syntax->datum f)))])))
-
 (define (check-core [name datum] [e datum] [env datum] [hint datum]) -> datum
   (let ([m (if (== name 'let*) 0 (core-shape name e))])
     (when (and (== m 0) (!= name 'let*)) (substrate-error e "~a is only allowed at module level" `(,name)))
@@ -1353,7 +1287,7 @@
       [('#%app)
        (let* ([f (piece-at m 1)] [fm (if (identifier? f) (meaning-of f) 0)])
          (if (literal-head? f fm)
-             (check-literal e f (cddr (syntax->list e)) env hint)
+             (check-literal e f (cddr (syntax->list e)) env)
              (check-call e f (callee f fm env) (pieces-from m 2) env)))]
       [('quote) (cons (datum-type) `(quote ,(syntax->datum (piece-at m 1))))]
       [('quote-syntax) (cons (datum-type) `(quote ,(syntax-local-introduce (prune-local-scopes (piece-at m 1)))))]
@@ -1714,89 +1648,10 @@
       (case (car p)
         [('call) (cadr (cadddr p))]
         [('array) (array-of-type (cadr p) (caddr p))]
-        [else (if (null? (parameters-of (type-binding (cadr p)))) (let ([t (named-type (cadr p))]) (if (enum-type? t) 0 t)) 0)])))
+        [else (let ([t (named-type (cadr p))]) (if (enum-type? t) 0 t))])))
 
 (define (temp [t datum]) -> datum (address (frame-place t (frame-slot! t)) 0))
 
-;; ---- generics ----
-
-(define (check-generic-call [e datum] [g datum] [args datum] [env datum] [hint datum]) -> datum
-  (syntax-match g
-    [(f (p ...) ((x a) ...) r _ _)
-     (let* ([ps (for/list ([q p]) (syntax-e q))]
-            [s (begin (set! twice (+ twice 1)) (infer e (parse-types-with (type-variables ps) a) args env))]
-            [i (instance g (for/list ([q ps]) (bound-type e s q (syntax-e f))) e)]
-            [r (check-call e i `(,(function-type i) #f direct ,(info-of i 'func "a function")) args env)])
-       (set! twice (- twice 1))
-       r)]))
-
-(define (infer [e datum] [ts datum] [args datum] [env datum]) -> datum
-  (unless (== (length ts) (length args))
-    (substrate-error e "expected ~a argument~a, got ~a" `(,(fixnum (length ts)) ,(plural (length ts)) ,(fixnum (length args)))))
-  (infer-from ts args env (infer-from ts args env nil #f) #t))
-
-(define (infer-from [ts datum] [args datum] [env datum] [s datum] [constants bool]) -> datum
-  (cond [(null? ts) s]
-        [(known-type? (car ts) s) (infer-from (cdr ts) (cdr args) env s constants)]
-        [else
-         (let ([r (check (car args) env 0)])
-           (infer-from (cdr ts) (cdr args) env
-                       (if (and (not constants) (literal-type? (car r)))
-                           s
-                           (let ([u (unify (car ts) (settled-type (car r)) s)])
-                             (if (!= u 0)
-                                 u
-                                 (substrate-error (car args) "expected ~s, got ~s" (shown-apart (applied (car ts) s) (car r))))))
-                       constants))]))
-
-(define (known-type? [t datum] [s datum]) -> bool
-  (cond [(and (pair? t) (== (car t) 'tvar)) (!= (assq (cadr t) s) 0)]
-        [(pair? t) (andmap (lambda ([u datum]) -> bool (known-type? u s)) t)]
-        [else #t]))
-
-(define (applied [t datum] [s datum]) -> datum
-  (cond [(and (pair? t) (== (car t) 'tvar)) (let ([b (assq (cadr t) s)]) (if (!= b 0) (cdr b) t))]
-        [(pair? t) (for/list ([u t]) (applied u s))]
-        [else t]))
-
-(define (unify [t datum] [u datum] [s datum]) -> datum
-  (cond [(and (pair? t) (== (car t) 'tvar))
-         (let ([b (assq (cadr t) s)])
-           (cond [(== b 0) (cons (cons (cadr t) u) s)]
-                 [(equal? (cdr b) u) s]
-                 [else 0]))]
-        [(and (pair? t) (pair? u) (== (length t) (length u))) (unify-each t u s)]
-        [(equal? t u) s]
-        [else 0]))
-
-(define (unify-each [t datum] [u datum] [s datum]) -> datum
-  (if (null? t) s (let ([s2 (unify (car t) (car u) s)]) (if (!= s2 0) (unify-each (cdr t) (cdr u) s2) 0))))
-
-(define (bound-type [e datum] [s datum] [p datum] [f datum]) -> datum
-  (let ([b (assq p s)])
-    (if (!= b 0) (cdr b) (substrate-error e "~a's type ~a is not known from its arguments: give it, (inst ~a type ...)" `(,f ,p ,f)))))
-
-(define (instance [g datum] [ts datum] [where datum]) -> datum
-  (syntax-match g
-    [(f (p ...) ((x a) ...) r (body ...) s)
-     (let* ([key (cons (identifier-name f) ts)] [known (datum-get (-> state instances) key)])
-       (if (!= known 0)
-           known
-           (let ([name (fresh (format "~a<~a>" `(,(syntax-e f) ,(joined (for/list ([t ts]) (format "~s" `(,(shown t))))))))]
-                 [sub (for/list ([q p] [t ts]) (cons (syntax-e q) t))])
-             (datum-put! (-> state instances) key (syntax-local-introduce name))
-             (let ([saved (body-state)])
-               (syntax-local-lift-definition
-                (at s (function s name x (for/list ([y a]) (replace y sub)) (replace r sub) (for/list ([b body]) (replace b sub)) f 0)))
-               (restore-body! saved))
-             (syntax-local-introduce name))))]))
-
-(define (replace [x datum] [sub datum]) -> datum
-  (cond [(identifier? x)
-         (let ([b (assq (syntax-e x) sub)]) (if (!= b 0) (datum->syntax x (cons 'quote (cons (cdr b) nil)) x) x))]
-        [(!= (syntax->list x) 0) (syntax-rewrap x (for/list ([y (syntax->list x)]) (replace y sub)))]
-        [else x]))
-
 ;; ---- closures ----
 
 (define (check-lambda [e datum] [m datum] [env datum]) -> datum
@@ -1900,8 +1755,8 @@
 (define (literal-head? [f datum] [fm datum]) -> bool
   (and (!= fm 0) (== (car fm) 'compile-time-value) (!= (struct-binding f) 0)))
 
-(define (check-literal [e datum] [f datum] [args datum] [env datum] [hint datum]) -> datum
-  (let* ([pairs (literal-pairs e f args)] [t (literal-type e f pairs env hint)])
+(define (check-literal [e datum] [f datum] [args datum] [env datum]) -> datum
+  (let* ([pairs (literal-pairs e f args)] [t (named-type f)])
     (cons t (construct-literal t pairs env (temp t)))))
 
 (define (literal-pairs [e datum] [f datum] [args datum]) -> datum
@@ -1920,21 +1775,6 @@
       (when (pair? missing) (substrate-error e "~a needs ~a" `(,(syntax-e f) ,(joined missing)))))
     (reverse out)))
 
-(define (literal-type [e datum] [f datum] [pairs datum] [env datum] [hint datum]) -> datum
-  (let ([v (struct-binding f)])
-    (cond [(null? (parameters-of v)) (named-type f)]
-          [(and (struct-type? hint) (== (cadr hint) (identifier-name f))) hint]
-          [else
-           (let* ([ps (parameters-of v)]
-                  [types (parse-types-with (type-variables ps) (for/list ([p pairs]) (declared-type v (car p))))]
-                  [s (infer e types (for/list ([p pairs]) (cdr p)) env)])
-             `(struct ,(identifier-name f) ,(cadr v) ,(for/list ([p ps]) (bound-type e s p (syntax-e f)))))])))
-
-(define (declared-type [v datum] [name datum]) -> datum
-  (for/each ([d (syntax->list (caddr v))])
-    (syntax-match d [(g gt) (when (== (syntax-e g) name) (return gt))]))
-  0)
-
 (define (construct-literal [t datum] [pairs datum] [env datum] [dst datum]) -> datum
   (let ([d (fresh-key!)] [fields (caddr (layout t))])
     `(let ((,d i32 ,dst to))
@@ -2015,18 +1855,6 @@
                                   hint)
                   hint c)))))
 
-(define (construct-type [e datum] [v datum] [i datum] [args datum] [env datum] [hint datum]) -> datum
-  (let ([b (type-binding v)])
-    (cond [(null? (parameters-of b)) (named-type v)]
-          [(and (struct-type? hint) (== (cadr hint) (identifier-name v))) hint]
-          [else
-           (let* ([ps (parameters-of b)]
-                  [fields (parse-types-with (type-variables ps)
-                                            (for/list ([f (cdr (syntax->list (list-ref (syntax->list (caddr b)) (fixnum-value (syntax-e i)))))])
-                                              (syntax-match f [(_ ft) ft])))]
-                  [s (infer e fields args env)])
-             `(struct ,(identifier-name v) ,(cadr b) ,(for/list ([p ps]) (bound-type e s p (syntax-e v)))))])))
-
 (define (case-index [n datum] [t datum]) -> datum
   (syntax-match (let ([h (expand-head n)]) (if (== (car h) 'form) (caddr h) 0))
     [('#%substrate-construct v i _)
@@ -2900,7 +2728,7 @@
                     [_ (substrate-error c "expected a case or [case number]" nil)]))]
          [given (for/list ([c cs]) (syntax-match c [(_ k) k] [_ 0]))])
     (distinct! names '"case")
-    (syn `(begin (define-syntax ,name (quote-syntax (substrate-struct ,name (,@(for/list ([n names]) `(,n))) enum () ,(case-numbers cs given))))
+    (syn `(begin (define-syntax ,name (quote-syntax (substrate-struct ,name (,@(for/list ([n names]) `(,n))) enum ,(case-numbers cs given))))
                  ,@(for/list ([n names] [i (numbers-below (length names))])
                      `(define-syntax ,n (quote-syntax (#%form mark (#%substrate-construct ,name ,i ,n)))))))))
 

package/substrate/compiler/compile.sub

@@ -933,9 +933,9 @@
 ;; ---- linking ----
 
 (define (index-of [t (ptr hash-table)] [key datum] [what string]) -> datum
-  (let ([i (hash-ref t (cast u64 key))])
+  (let ([i (hash-find t (cast u64 key))])
     (when (== i 0) (fail "internal: ~a has no index" (cons (string->datum what) nil)))
-    (small (- i 1))))
+    (small (@ i))))
 
 (define (type-index [lk (ptr linker)] [sig datum]) -> datum
   (let ([known (datum-get (-> lk func-type-index) sig)])
@@ -965,7 +965,7 @@
 
 (define (number! [t (ptr hash-table)] [items datum] [n u32]) -> u32
   (while (pair? items)
-    (hash-set! t (cast u64 (car items)) (+ n 1))
+    (hash-set! t (cast u64 (car items)) n)
     (+= n 1)
     (set! items (cdr items)))
   n)