[don't create built in instances until the appropriate class is defined. lift default instances to top level in type checker.
John Meacham <john@repetae.net>**20060309115806] hunk ./E/FromHs.hs 29
+import PrimitiveOperators
hunk ./E/FromHs.hs 363
+-- | return primitive instances associated with class given as argument
+primitiveInstances :: Name -> [(Name,TVr,E)]
+primitiveInstances name = [(n,setProperties [prop_INSTANCE] $ tVr (toId n) (getType v),v) | (cn,n,v) <- constantMethods, cn == name]
hunk ./E/FromHs.hs 569
-            cr = findClassRecord classHierarchy (toName ClassName name)
+            cr = findClassRecord classHierarchy className
+            className = (toName ClassName name)
hunk ./E/FromHs.hs 583
-        mthds <- mconcatMapM method  [  n | n :>: _ <- classAssumps cr]
-        return (cClass cr ++ mthds)
+        --mthds <- mconcatMapM method  [  n | n :>: _ <- classAssumps cr]
+        let mthds = []
+        return (cClass cr ++ mthds ++ primitiveInstances className)
hunk ./FrontEnd/Class.hs 87
+import PrimitiveOperators(primitiveInsts)
hunk ./FrontEnd/Class.hs 504
+instanceToTopDecls kt (ClassHierarchy classHierarchy) (HsClassDecl _ qualType methods)
+   = unzip $ map (defaultMethodToTopDecls kt methodSigs qualType) $ methodGroups where
+   HsQualType _ (HsTyApp (HsTyCon className) _) = qualType
+   methodGroups = groupEquations (filter (\x -> isHsPatBind x || isHsFunBind x)  methods)
+   methodSigs = case Map.lookup (toName ClassName className) classHierarchy  of
+           Nothing -> error $ "defaultInstanceToTopDecls: could not find class " ++ show className ++ "in class hierarchy"
+           Just sigs -> classAssumps sigs
hunk ./FrontEnd/Class.hs 546
-    renamedMethodDecls
-       = renameOneDecl newMethodName methodDecls
+    renamedMethodDecls = renameOneDecl newMethodName methodDecls
+
+defaultMethodToTopDecls :: KindEnv -> [Assump] -> HsQualType -> (Name, HsDecl) -> (HsDecl,Assump)
+
+defaultMethodToTopDecls kt methodSigs (HsQualType cntxt classApp) (methodName, methodDecls)
+   = (renamedMethodDecls,newMethodName :>: sigFromClass) where
+    (HsTyApp (HsTyCon className) _) = classApp
+    newMethodName = defaultInstanceName methodName
+    sigFromClass = case [ s | n :>: s <- methodSigs, n == methodName] of
+        [x] -> x
+        _ -> error $ "sigFromClass: " ++ show methodSigs ++ " " ++ show  methodName
+     --  = newMethodSig cntxt newMethodName sigFromClass argType
+    renamedMethodDecls = renameOneDecl newMethodName methodDecls
hunk ./FrontEnd/Class.hs 762
-            tell [ClassRecord { className = toName ClassName className, classSrcLoc = sl, classSupers = map fst $ hsContextToContext cntxt, classInsts = [], classDerives = [], classAssumps = qualifiedMethodAssumps }]
+            tell [ClassRecord { className = toName ClassName className, classSrcLoc = sl, classSupers = map fst $ hsContextToContext cntxt, classInsts = [ i | i@(_ :=> IsIn n _) <- primitiveInsts, nameName n == className], classDerives = [], classAssumps = qualifiedMethodAssumps }]
+
hunk ./FrontEnd/Tc/Module.hs 189
-    let bindings = (funPatBinds ++ [ z | z <- cDefBinds, isHsFunBind z || isHsPatBind z] ++ liftedInstances)
+    let bindings = (funPatBinds ++  liftedInstances)
hunk ./FrontEnd/Tc/Module.hs 191
-        classNoDefaults = snub (concat [ getDeclNames z | z <- cDefBinds ])  List.\\ classDefaults
+        classNoDefaults = snub (concat [ getDeclNames z | z <- cDefBinds ]) -- List.\\ classDefaults
hunk ./FrontEnd/Tc/Module.hs 193
-        fakeForeignDecls = [ [HsForeignDecl bogusASrcLoc (Import "" [] []) Primitive Safe (nameName x) (HsQualType [] $ HsTyTuple []) ] | (x,_) <- Map.toList noDefaultSigs]
hunk ./FrontEnd/Tc/Module.hs 201
-    let program = makeProgram (Map.map schemeToType sigEnv) ( fakeForeignDecls ++ programBgs )
+    let program = makeProgram (Map.map schemeToType sigEnv) programBgs
hunk ./FrontEnd/Tc/Module.hs 220
-    (localVarEnv,checkedRules,coercions,ds) <- withOptionsT (modInfoOptions tms) $ runTc tcInfo $ do
-        (ds,out) <- listen (tiProgram program ds)
+    (localVarEnv,checkedRules,coercions,tcDs) <- withOptionsT (modInfoOptions tms) $ runTc tcInfo $ do
+        (tcDs,out) <- listen (tiProgram program ds)
hunk ./FrontEnd/Tc/Module.hs 228
-        return (env,checkedRules out,cc',ds)
+        return (env,checkedRules out,cc',tcDs)
hunk ./FrontEnd/Tc/Module.hs 232
-        mapM_ (putStrLn . HsPretty.render . HsPretty.ppHsDecl) ds
+        mapM_ (putStrLn . HsPretty.render . HsPretty.ppHsDecl) tcDs
hunk ./FrontEnd/Tc/Module.hs 263
-            tiDataDecls = ds,
+            tiDataDecls = tcDs ++ filter isHsClassDecl ds,
hunk ./Ho/Build.hs 36
+import Name.Name(Name())
hunk ./Ho/Build.hs 429
-initialHo = mempty { hoEs = es , hoClassHierarchy = ch, hoDataTable = dataTablePrims  }  where
-    ch = foldl addOneInstanceToHierarchy mempty (map ((,) False) primitiveInsts)
-    es = Map.fromList [  (n,(setProperties [prop_INSTANCE] $ tVr (atomIndex $ toAtom n) (getType v),v)) |  (n,v) <- constantMethods ] `mappend` es'
-    --es' = Map.fromList [ (n,(tVr (atomIndex $ toAtom n) (getType v),v)) | (n,t,p,d) <- theMethods, let v = f n t p d  ]
-    es' = Map.fromList [ (n,(setProperty prop_INSTANCE $ tVr (atomIndex $ toAtom n) (error "f no longer relevant"),v)) | (n,t,p,d) <- theMethods, let v = f n t p d  ]
-    f _ _ _ _ = error "f no longer relevant"
+
+initialHo = mempty { hoEs = mempty , hoClassHierarchy = mempty, hoDataTable = dataTablePrims  }  where
+    --ch = foldl addOneInstanceToHierarchy mempty (map ((,) False) primitiveInsts)
+    --es = Map.fromList [  (n,(setProperties [prop_INSTANCE] $ tVr (atomIndex $ toAtom n) (getType v),v)) |  (n,v) <- constantMethods ]
hunk ./Main.hs 206
-    --mapM_ (\(_,v,lc) -> printCheckName'' fullDataTable v lc) ds
+    mapM_ (\(_,v,lc) -> printCheckName'' fullDataTable v lc) ds
hunk ./Main.hs 209
-    rules' <- createInstanceRules (hoClassHierarchy ho' `mappend` hoClassHierarchy initialHo)   (Map.fromList [ (x,(y,z)) | (x,y,z) <- ds] `mappend` hoEs ho)
+    rules' <- createInstanceRules (hoClassHierarchy ho')   (Map.fromList [ (x,(y,z)) | (x,y,z) <- ds] `mappend` hoEs ho)
hunk ./utils/op_process.prl 127
-    #push @inst, "[] :=> IsIn (toHsName \"Prelude.Bounded\") (TCon \$ Tycon (toHsName \"$d->[0]\") Star)\n" unless $seen{'Prelude.Bounded',$d->[0]}++;
-    #push @inst, "[] :=> IsIn (toHsName \"Foreign.Storable.Storable\") (TCon \$ Tycon (toHsName \"$d->[0]\") Star)\n";
hunk ./utils/op_process.prl 129
+    my $c_num = hsname("Prelude.Num");
hunk ./utils/op_process.prl 132
-    push @cmeth, "(toInstName \"Foreign.Storable.sizeOf.$d->[0]\", ELam (tVr 0 $t) \$ " . const("sizeof($d->[1])","tInt") . ")";
-    push @cmeth, "(toInstName \"Foreign.Storable.poke.$d->[0]\", buildPoke $cncons $t \"$d->[1]\")";
-    push @cmeth, "(toInstName \"Foreign.Storable.peek.$d->[0]\", buildPeek $cncons $t \"$d->[1]\")";
-    push @cmeth, "(toInstName \"Prelude.maxBound.$d->[0]\", " . const($d->[3],$t,"\"$d->[1]\"") . ")";
-    push @cmeth, "(toInstName \"Prelude.minBound.$d->[0]\", " . const($d->[4],$t,"\"$d->[1]\"") . ")";
+    push @cmeth, "($foreign_storable, toInstName \"Foreign.Storable.sizeOf.$d->[0]\", ELam (tVr 0 $t) \$ " . const("sizeof($d->[1])","tInt") . ")";
+    push @cmeth, "($foreign_storable, toInstName \"Foreign.Storable.poke.$d->[0]\", buildPoke $cncons $t \"$d->[1]\")";
+    push @cmeth, "($foreign_storable, toInstName \"Foreign.Storable.peek.$d->[0]\", buildPeek $cncons $t \"$d->[1]\")";
+    push @cmeth, "($prelude_bounded, toInstName \"Prelude.maxBound.$d->[0]\", " . const($d->[3],$t,"\"$d->[1]\"") . ")";
+    push @cmeth, "($prelude_bounded, toInstName \"Prelude.minBound.$d->[0]\", " . const($d->[4],$t,"\"$d->[1]\"") . ")";
hunk ./utils/op_process.prl 141
-        push @cmeth, "(toInstName \"Prelude.fromInt.$d->[0]\", ELam $ivar (EVar $ivar))";
-        push @cmeth, "(toInstName \"Prelude.toInt.$d->[0]\", ELam $ivar (EVar $ivar))";
+        push @cmeth, "($c_num, toInstName \"Prelude.fromInt.$d->[0]\", ELam $ivar (EVar $ivar))";
+        push @cmeth, "($c_num, toInstName \"Prelude.toInt.$d->[0]\", ELam $ivar (EVar $ivar))";
hunk ./utils/op_process.prl 144
-        push @cmeth, "(toInstName \"Prelude.fromInt.$d->[0]\", ELam $ivar (prim_integralCast (EVar $ivar) $t))";
-        push @cmeth, "(toInstName \"Prelude.toInt.$d->[0]\", ELam $tvar (prim_integralCast (EVar $tvar) tInt))" if $d->[2] =~ /int/ ;
+        push @cmeth, "($c_num, toInstName \"Prelude.fromInt.$d->[0]\", ELam $ivar (prim_integralCast (EVar $ivar) $t))";
+        push @cmeth, "($c_num, toInstName \"Prelude.toInt.$d->[0]\", ELam $tvar (prim_integralCast (EVar $tvar) tInt))" if $d->[2] =~ /int/ ;
hunk ./utils/op_process.prl 148
-        push @cmeth, "(toInstName \"Prelude.fromInteger.$d->[0]\", ELam $ivart (EVar $ivart))";
-        push @cmeth, "(toInstName \"Prelude.toInteger.$d->[0]\", ELam $ivart (EVar $ivart))";
+        push @cmeth, "($c_num, toInstName \"Prelude.fromInteger.$d->[0]\", ELam $ivart (EVar $ivart))";
+        push @cmeth, "($c_num, toInstName \"Prelude.toInteger.$d->[0]\", ELam $ivart (EVar $ivart))";
hunk ./utils/op_process.prl 151
-        push @cmeth, "(toInstName \"Prelude.fromInteger.$d->[0]\", ELam $ivart (prim_integralCast (EVar $ivart) $t))";
-        push @cmeth, "(toInstName \"Prelude.toInteger.$d->[0]\", ELam $tvar (prim_integralCast (EVar $tvar) tInteger))" if $d->[2] =~ /int/ ;
+        push @cmeth, "($c_num, toInstName \"Prelude.fromInteger.$d->[0]\", ELam $ivart (prim_integralCast (EVar $ivart) $t))";
+        push @cmeth, "($c_num, toInstName \"Prelude.toInteger.$d->[0]\", ELam $tvar (prim_integralCast (EVar $tvar) tInteger))" if $d->[2] =~ /int/ ;
hunk ./utils/op_process.prl 155
-    push @cmeth, "(toInstName \"Prelude.abs.$d->[0]\", ELam $tvar (build_abs \"$d->[1]\" $cncons (EVar $tvar)  ))" if $d->[2] =~ /int/ ;
+    push @cmeth, "($c_num, toInstName \"Prelude.abs.$d->[0]\", ELam $tvar (build_abs \"$d->[1]\" $cncons (EVar $tvar)  ))" if $d->[2] =~ /int/ ;
hunk ./utils/op_process.prl 157
-    push @cmeth, "(toInstName \"Prelude.signum.$d->[0]\", ELam $tvar (build_signum \"$d->[1]\" $cncons (EVar $tvar) ))" if $d->[2] =~ /int/ ;
+    push @cmeth, "($c_num, toInstName \"Prelude.signum.$d->[0]\", ELam $tvar (build_signum \"$d->[1]\" $cncons (EVar $tvar) ))" if $d->[2] =~ /int/ ;
hunk ./utils/op_process.prl 167
-        push @cmeth, "(toInstName \"$x$c->[1].$d->[0]\", op_$c->[0]  \"$c->[3]\" \"$d->[1]\" $cncons $t)";
+        push @cmeth, "($nn,toInstName \"$x$c->[1].$d->[0]\", op_$c->[0]  \"$c->[3]\" \"$d->[1]\" $cncons $t)";
hunk ./utils/op_process.prl 169
-        push @meth, "(toInstName \"$x$c->[1].$d->[0]\", \"$c->[0]\", \"prim_op_$c->[0].$c->[3]\", \"$d->[0]\")";
+        push @meth, "($nn,toInstName \"$x$c->[1].$d->[0]\", \"$c->[0]\", \"prim_op_$c->[0].$c->[3]\", \"$d->[0]\")";