[redo type compatability test to take advantage of new newtype representation. fix built in data table entries for unboxed tuples.
John Meacham <john@repetae.net>**20061109014403] hunk ./DataConstructors.hs 41
-import E.Shadow
hunk ./DataConstructors.hs 146
+tunboxedtuple :: Int -> (Constructor,Constructor)
hunk ./DataConstructors.hs 150
-            conType = tipe,
-            conSlots = replicate n Unknown,
+            conType = dtipe,
+            conSlots = map EVar typeVars,
hunk ./DataConstructors.hs 153
-            conExpr = Unknown, -- error "expr" ELam (tVr 2 rt) (ELit (LitCons dc [EVar (tVr 2 rt)] tipe)),
+            conExpr =  foldr ($) (ELit litCons { litName = dc, litArgs = map EVar vars, litType = ftipe }) (map ELam vars),
hunk ./DataConstructors.hs 161
-            conType = eHash,
-            conSlots = replicate n Unknown,
+            conType = foldr EPi eHash (replicate n tvr { tvrType = eStar }),
+            conSlots = replicate n eStar,
hunk ./DataConstructors.hs 173
-        tipe = ELit (litCons { litName = tc, litArgs = [], litType = eHash })
-
+        tipe = foldr ELam ftipe typeVars
+        typeVars = take n [ tvr { tvrType = eStar, tvrIdent = v } | v <- [ 2,4 ..]]
+        vars =  [ tvr { tvrType = EVar t, tvrIdent = v } | v <- [ 2*n + 16, 2*n + 18 ..] | t <- typeVars ]
+        ftipe = ELit (litCons { litName = tc, litArgs = map EVar typeVars, litType = eHash })
+        dtipe = foldr EPi (foldr EPi ftipe [ v { tvrIdent = 0 } | v <- vars]) typeVars
hunk ./DataConstructors.hs 276
+
+typesCompatable :: forall m . Monad m => DataTable -> E -> E -> m ()
+typesCompatable dataTable a b = f (-2 :: Id) a b where
+        f :: Id -> E -> E -> m ()
+        f _ (ESort a) (ESort b) = when (a /= b) $ fail $ "Sorts don't match: " ++ pprint (ESort a,ESort b)
+        f _ (EVar a) (EVar b) = when (a /= b) $ fail $ "Vars don't match: " ++ pprint (a,b)
+        f c (ELit LitCons { litName = n, litArgs = xs, litType = t }) (ELit LitCons { litName = n', litArgs = xs', litType = t' }) | n == n' = do
+            f c t t'
+            when (not $ sameShape1 xs xs') $ fail "Arg lists don't match"
+            zipWithM_ (f c) xs xs'
+        f c (EAp a b) (EAp a' b') = do
+            f c a a'
+            f c b b'
+        f c (ELam va ea) (ELam vb eb) = lam va ea vb eb c
+        f c (EPi va ea) (EPi vb eb)   = lam va ea vb eb c
+        f c (EPi (TVr { tvrIdent = 0, tvrType =  a}) b) (ELit (LitCons { litName = n, litArgs = [a',b'], litType = t })) | conName tarrow == n, t == eStar = do
+            f c a a'
+            f c b b'
+        f c (ELit (LitCons { litName = n, litArgs = [a',b'], litType = t })) (EPi (TVr { tvrIdent = 0, tvrType =  a}) b)  | conName tarrow == n, t == eStar = do
+            f c a a'
+            f c b b'
+        f c (ELit (LitCons {  litAliasFor = Just af, litArgs = as })) b = do
+            f c (foldl eAp af as) b
+        f c a (ELit (LitCons {  litAliasFor = Just af, litArgs = as })) = do
+            f c a (foldl eAp af as)
+        f _ a b = fail $ "Types don't match:" ++ pprint (a,b)
+
+        lam :: TVr -> E -> TVr -> E -> Id -> m ()
+        lam va ea vb eb c = do
+            f c (tvrType va) (tvrType vb)
+            f (c - 2) (subst va (EVar va { tvrIdent = c }) ea) (subst vb (EVar vb { tvrIdent = c }) eb)
+
+
+{-
hunk ./DataConstructors.hs 351
+-}
hunk ./DataConstructors.hs 597
-        vt = case conVirtual const of
-            Nothing -> empty
-            Just ss -> text "virtual:" <+> tshow ss
+        vt = text "virtual:" <+> tshow conVirtual
hunk ./DataConstructors.hs 604
+            conVirtual = conVirtual,
hunk ./DataConstructors.hs 608
-    xs = [text x <+> hang 0 (c y) | (x,y) <- ds]
-    ds = sortBy (\(x,_) (y,_) -> compare x y) [ (show x,y)  | (x,y) <-  Map.toList mp]
+    xs = [text x <+> hang 0 (c y) | (x,y) <- ds ]
+    (ubt,ubd) = tunboxedtuple 3
+    ds = sortBy (\(x,_) (y,_) -> compare x y) [ (show x,y)  | (x,y) <-  Map.toList mp ++ [(conName ubt,ubt),(conName ubd,ubd)]]
hunk ./E/TypeCheck.hs 247
-        e1 <- strong nds (followAliases dataTable t1)
-        e2 <- strong nds (followAliases dataTable t2)
+        e1 <- strong nds (t1)
+        e2 <- strong nds (t2)
hunk ./E/TypeCheck.hs 250
-            Right () -> return (followAliases dataTable e1)
+            Right () -> return (e1)