Start generalizing default declarations for NamedDefaults

src/computation/haskell/haskell.H

@@ -1200,7 +1200,7 @@ struct ModuleDecls
 {
     Decls type_decls;
 
-    std::optional<DefaultDecl> default_decl;
+    std::vector<Located<DefaultDecl>> default_decls;
 
     std::vector<FixityDecl> fixity_decls;
 

src/computation/haskell/haskell.cc

@@ -980,12 +980,7 @@ ModuleDecls::ModuleDecls(const Decls& topdecls)
         else if (decl.is_a<KindSigDecl>())
             type_decls.push_back(ldecl);
         else if (auto d = decl.to<DefaultDecl>())
-        {
-            if (default_decl)
-                throw myexception()<<"Found more than 1 default declaration in module!";
-            else
-                default_decl = *d;
-        }
+            default_decls.push_back({loc,*d});
         else
             throw myexception()<<"I don't recognize declaration '"<<decl.print()<<"'";
     }

src/computation/rename/rename.H

@@ -81,11 +81,15 @@ struct renamer_state
     Hs::DataFamilyInstanceDecl rename(Hs::DataFamilyInstanceDecl);
     Hs::TypeFamilyInstanceDecl rename(Hs::TypeFamilyInstanceDecl);
     Hs::TypeFamilyInstanceEqn rename(Hs::TypeFamilyInstanceEqn);
-    Haskell::KindSigDecl rename(Haskell::KindSigDecl KS);
+    Hs::KindSigDecl rename(Hs::KindSigDecl);
     Hs::LTypeCon rename_type(Hs::LTypeCon);
     Hs::LType rename_type(Hs::LType);
     Hs::Context rename(Hs::Context);
 
+    std::vector<Located<Hs::DefaultDecl>> rename_default_decls(std::vector<Located<Hs::DefaultDecl>>);
+
+    Hs::DefaultDecl rename(Hs::DefaultDecl);
+
     Hs::Exp rename(const Hs::Exp& E, const bound_var_info& bound, std::set<std::string>& free_vars);
     Hs::LExp rename(Hs::LExp E, const bound_var_info& bound, std::set<std::string>& free_vars);
 

src/computation/rename/rename.cc

@@ -92,6 +92,7 @@ Hs::ModuleDecls rename_infix(const Module& m, Hs::ModuleDecls M)
     // 1. Handle value decls
     M.value_decls = rename_infix(m, M.value_decls);
 
+    // default_decls aren't infix
     for(auto& [_,type_decl]: M.type_decls)
     {
         // 2. Handle default method decls
@@ -220,6 +221,8 @@ Haskell::ModuleDecls rename(const simplifier_options&, const Module& m, Haskell:
 
     M.type_decls = Rn.rename_type_decls(M.type_decls);
 
+    M.default_decls = Rn.rename_default_decls(M.default_decls);
+
     // Find all the names bound HERE, versus in individual decls.
 
     // The idea is that we only add unqualified names here, and they shadow

src/computation/rename/types.cc

@@ -276,6 +276,25 @@ Haskell::KindSigDecl renamer_state::rename(Haskell::KindSigDecl KS)
     return KS;
 }
 
+Hs::DefaultDecl renamer_state::rename(Hs::DefaultDecl DD)
+{
+    if (DD.maybe_class)
+    {
+        auto [loc, class_name] = *DD.maybe_class;
+        auto renamed_tycon = rename_type(Hs::LTypeCon({loc,class_name}));
+        DD.maybe_class = {{loc,unloc(renamed_tycon).name}};
+    }
+    for(auto& type: DD.types)
+        type = rename_type(type);
+    return DD;
+}
+
+vector<Located<Hs::DefaultDecl>> renamer_state::rename_default_decls(vector<Located<Hs::DefaultDecl>> default_decls)
+{
+    for(auto& [loc, decl]: default_decls)
+        decl = rename(decl);
+    return default_decls;
+}
 
 Haskell::Decls renamer_state::rename_type_decls(Haskell::Decls decls)
 {

src/computation/typecheck/default.cc

@@ -15,9 +15,50 @@ using std::tuple;
 
 void TypeChecker::get_defaults(const Hs::ModuleDecls& M)
 {
-    if (M.default_decl)
-        defaults() = desugar( M.default_decl->types );
-    else if (this_mod().language_extensions.has_extension(LangExt::ExtendedDefaultRules))
+    auto Num = find_prelude_tycon("Num");
+
+    for(auto& [loc,default_decl]: M.default_decls)
+    {
+        push_source_span(*loc);
+        if (auto dclass = default_decl.maybe_class)
+        {
+            bool named_defaults = this_mod().language_extensions.has_extension(LangExt::NamedDefaults);
+
+            {
+                push_source_span(*dclass->loc);
+                if (not named_defaults)
+                    record_error( Note() <<"Class-specific defaults only allowed with extension NamedDefaults" );
+                if (default_env().count(TypeCon(*dclass)))
+                {
+                    record_error( Note() <<"Duplicate default declaration." );
+                    // Original declaration at location; default_env().find->first.loc
+                }
+                pop_source_span();
+            }
+            // Check that the data types are all data types and instances of the class?
+            default_env().insert({TypeCon(*dclass), desugar(default_decl.types)});
+        }
+        else
+        {
+            if (default_env().count(Num))
+            {
+                record_error( Note() <<"Duplicate default declaration." );
+            }
+            // Check that the data types are all data types and instances of the class?
+            default_env().insert({Num, desugar( default_decl.types )});
+        }
+        pop_source_span();
+    }
+
+    if (not default_env().count(Num))
+    {
+        auto Integer = find_prelude_tycon("Integer");
+        auto Double = find_prelude_tycon("Double");
+        default_env().insert({Num, {Integer, Double}});
+    }
+
+    /*
+    if (this_mod().language_extensions.has_extension(LangExt::ExtendedDefaultRules))
     {
         defaults() = { TypeCon({noloc,"()"}), TypeCon({noloc,"[]"}), TypeCon({noloc,"Integer"}), TypeCon({noloc,"Double"}) };
 
@@ -31,6 +72,7 @@ void TypeChecker::get_defaults(const Hs::ModuleDecls& M)
         if (this_mod().language_extensions.has_extension(LangExt::OverloadedStrings))
             defaults().push_back( list_type( TypeCon({noloc,"Char"}) ) );
     }
+    */
 }
 
 // Constraints for defaulting must be of the form K a (e.g. Num a) where a is a MetaTypeVar.
@@ -105,7 +147,8 @@ TypeChecker::candidates(const MetaTypeVar& tv, const LIE& tv_wanteds)
     // Fail if none of the predicates is a numerical constraint
     if (not any_num or (extended and not any_interactive and not any_num)) return false;
 
-    for(auto& type: defaults() )
+    auto Num = find_prelude_tycon("Num");
+    for(auto& type: default_env().at(Num))
     {
         tv.fill(type);
         auto wanteds = WantedConstraints(tv_wanteds);

src/computation/typecheck/typecheck.H

@@ -40,13 +40,16 @@ global_value_env sig_env(const signature_env& signatures);
 
 typedef std::map<TypeCon,Kind> KindSigEnv;
 
+// Can the instances be something like (Log Double)?  I suppose they could.
+typedef std::map<TypeCon,std::vector<Type>> DefaultEnv;
+
 struct global_tc_state
 {
     Module& this_mod; // for name lookups like Bool, Num, etc.
 
     KindSigEnv kind_sigs;
 
-    std::vector<Type> defaults;
+    DefaultEnv default_env;
 
     std::optional<int> unification_level;
 
@@ -94,8 +97,8 @@ public:
 
     const TypeFamInfo* info_for_type_fam(const std::string& fname) const;
 
-          std::vector<Type>& defaults()       {return global_state->defaults;}
-    const std::vector<Type>& defaults() const {return global_state->defaults;}
+          DefaultEnv& default_env()       {return global_state->default_env;}
+    const DefaultEnv& default_env() const {return global_state->default_env;}
 
           std::vector<Message>& messages()       {return this_mod().messages;}
     const std::vector<Message>& messages() const {return this_mod().messages;}