[create deconstruction alternatives in the DataConstructor module
John Meacham <john@repetae.net>**20060130083227] hunk ./DataConstructors.hs 5
+    deconstructionExpression,
hunk ./DataConstructors.hs 11
-    lookupCType,
hunk ./DataConstructors.hs 12
+    lookupCType,
+    pprintTypeOfCons,
hunk ./DataConstructors.hs 17
-    pprintTypeOfCons,
hunk ./DataConstructors.hs 312
-        -- as = hsDeclArgs decl
-        --name = hsDeclName decl
hunk ./DataConstructors.hs 366
-constructionExpression wdt@(DataTable dt) n (ELit (LitCons pn xs _)) | pn == conName pc = sub (conExpr mc) where
-    Identity mc = getConstructor n wdt
-    Just pc = Map.lookup (conInhabits mc) dt
+constructionExpression dataTable n (ELit (LitCons pn xs _)) | pn == conName pc = sub (conExpr mc) where
+    Just mc = getConstructor n dataTable
+    Just pc = getConstructor (conInhabits mc) dataTable
hunk ./DataConstructors.hs 373
+deconstructionExpression ::
+    DataTable -- ^ table of data constructors
+    -> Name   -- ^ name of said constructor
+    -> E      -- ^ type of pattern
+    -> [TVr]  -- ^ variables to be bound
+    -> [TVr]  -- ^ name supply, types ignored, must be at least as many as bound variables exist
+    -> E      -- ^ body of alt
+    -> Alt E  -- ^ resulting alternative
+deconstructionExpression dataTable name typ@(ELit (LitCons pn xs _)) vs _vs' e | pn == conName pc = ans where
+    Just mc = getConstructor name dataTable
+    Just pc = getConstructor (conInhabits mc) dataTable
+    ans = Alt (LitCons name vs typ) e
+deconstructionExpression wdt n ty vs vs' e | Just fa <- followAlias wdt ty  = deconstructionExpression wdt n fa vs vs' e
+deconstructionExpression _ n e _ _ _ = error $ "deconstructionExpression: error in " ++ show n ++ ": " ++ show e
hunk ./E/FromHs.hs 491
+                        vs' <- newVars (map (const Unknown) vs)
+
hunk ./E/FromHs.hs 495
-                        return (Alt (LitCons (toName DataConstructor name) vs (getType b))  m)
+                        return $ deconstructionExpression dataTable (toName DataConstructor name) (getType b) vs vs' m
+                        --return (Alt (LitCons (toName DataConstructor name) vs (getType b))  m)