[fix bugs relating to class instances of (->) enforce rule that Jhc@.-> only appears in case patterns
John Meacham <john@repetae.net>**20070314002737] hunk ./E/FromHs.hs 199
-        valToPat' (ELit LitCons { litAliasFor = af,  litName = x, litArgs = ts, litType = t }) = ELit $ litCons { litAliasFor = af, litName = x, litArgs = [ EVar (tVr j (getType z)) | z <- ts | j <- [2,4 ..], j `notElem` map tvrIdent args], litType = t }
-        valToPat' (EPi (TVr { tvrType =  a}) b)  = ELit $ litCons { litName = tc_Arrow, litArgs = [ EVar (tVr j (getType z)) | z <- [a,b] | j <- [2,4 ..], j `notElem` map tvrIdent args], litType = eStar }
+        valToPat' (ELit LitCons { litAliasFor = af,  litName = x, litArgs = ts, litType = t }) = (ELit litCons { litAliasFor = af, litName = x, litArgs = ts', litType = t },ts') where
+            ts' = [ EVar (tVr j (getType z)) | z <- ts | j <- [2,4 ..], j `notElem` map tvrIdent args]
+        --valToPat' (EPi (TVr { tvrType =  a}) b)  = ELit $ litCons { litName = tc_Arrow, litArgs = [ EVar (tVr j (getType z)) | z <- [a,b] | j <- [2,4 ..], j `notElem` map tvrIdent args], litType = eStar }
+        valToPat' (EPi tv@TVr { tvrType =  a} b)  = (EPi tvr { tvrType =  a'} b',[a',b']) where
+            a' = EVar (tVr ja (getType a))
+            b' = EVar (tVr jb (getType b))
+            (ja:jb:_) = [ j |  j <- [2,4 ..], j `notElem` map tvrIdent args]
hunk ./E/FromHs.hs 210
-        rule t = makeRule ("Rule.{" ++ show name ++ "}") (Module (show name),0) RuleSpecialization ruleFvs methodVar (tpat:map EVar args) (removeNewtypes dataTable body)  where
+        rule t = makeRule ("Rule.{" ++ show name ++ "}") (Module (show name),0) RuleSpecialization ruleFvs methodVar (vp:map EVar args) (removeNewtypes dataTable body)  where
hunk ./E/FromHs.hs 212
-            tpat = valToPat' (removeNewtypes dataTable $ tipe t)
+            (vp,vs) = valToPat' (removeNewtypes dataTable $ tipe t)
hunk ./E/FromHs.hs 214
-            vp@(ELit LitCons { litArgs =  vs }) = tpat
+            --vp@(ELit LitCons { litArgs =  vs }) = tpat
hunk ./E/FromHs.hs 221
-                    Nothing -> foldl EAp (EError ( show methodName ++ ": undefined at type " ++  PPrint.render (pprint t)) (eAp ty (valToPat' (tipe t)))) (map EVar args)
+                    Nothing -> foldl EAp (EError ( show methodName ++ ": undefined at type " ++  PPrint.render (pprint t)) (eAp ty (fst $ valToPat' (tipe t)))) (map EVar args)
hunk ./E/TypeAnalysis.hs 200
-    | otherwise = fail $ "getValue: no varinfo: " ++ show v
+    | otherwise = return $ value (vmapPlaceholder ())
+    -- | otherwise = fail $ "getValue: no varinfo: " ++ show v
hunk ./E/TypeAnalysis.hs 259
-        as' <- mapM (uncurry (f (n - 1))) as
-        return $ ELit (updateLit dataTable litCons { litName = h, litArgs = as', litType = kind })
+        as'@(~[fa,fb]) <- mapM (uncurry (f (n - 1))) as
+        if h == tc_Arrow
+         then return $ EPi tvr { tvrType = fa } fb
+         else return $ ELit (updateLit dataTable litCons { litName = h, litArgs = as', litType = kind })
hunk ./E/TypeAnalysis.hs 343
-        calt rule@Rule { ruleArgs = (arg:rs) } = Alt (valToPat' arg) (substMap (fromList [ (tvrIdent v,EVar r) | ~(EVar v) <- rs | r <- ras ]) $ ruleBody rule)
-
-        valToPat' (ELit LitCons { litName = x, litArgs = ts, litType = t, litAliasFor = af }) = LitCons { litName = x, litArgs = [ z | ~(EVar z) <- ts ], litType = t, litAliasFor = af }
-        valToPat' (EPi (TVr { tvrType =  EVar a}) (EVar b))  = litCons { litName = tc_Arrow, litArgs = [a,b], litType = eStar }
-        valToPat' x = error $ "expandPlaceholder.valToPat': " ++ show x
-
+        calt rule@Rule { ruleArgs = (arg:rs) } = Alt vp (substMap (fromList [ (tvrIdent v,EVar r) | ~(EVar v) <- rs | r <- ras ]) $ ruleBody rule) where
+            Just vp = eToPat arg