
_DocDebug:=TRUE;

_GenerateDocSinAtom1:=
  function(sinelt)
    if IsList(sinelt) then
      if IsBound(sinelt[1]) then
        return(SPrint(sinelt[1]));
      else
        return "";
      fi;
    else
      return(SPrint(sinelt));
    fi;
  end;
_GenerateDocSinAtom2:=
  function(sinelt)
    local gatm,atype,aname,aexpl,amiscrec,adefval;
    gatm:=_GenerateDocSinAtom1(sinelt);

    CheckArgs(sinelt,["atype","aname","aexpl","amiscrec"],[]);
    atype:=__ARGREC.("atype");
    aname:=__ARGREC.("aname");
    aexpl:=__ARGREC.("aexpl");
    amiscrec:=__ARGREC.("amiscrec");
    adefval:=_GetEntry_rec_string(amiscrec,"Default",__FAILUREREC);

    ## okay, we might have FAILURE as value, so ...
    if not(IsSuccess(adefval)) and
      _GetEntry_rec_string(amiscrec,"Default",rec(Fail:=SUCCESS))=SUCCESS then
      Unbind(adefval);
    fi;

    if IsBound(adefval) then
      return("<"+gatm+">"+" "+SPrint(aname)+": defaults to "+SPrint(adefval)+" ("+SPrint(aexpl)+")");
    elif IsSuccess(aexpl) then
      return("<"+gatm+">"+" "+SPrint(aname)+" ("+SPrint(aexpl)+")");
    elif IsSuccess(aname) then
      return("<"+gatm+">"+" "+SPrint(aname));
    else
      if gatm="" then
        return "";
      else
        return("<"+gatm+">");
      fi;
    fi;
  end;

_FlattenSin:=
  function(sin)
    local boundp1;
    boundp1:=
      function(atom)
        if IsBound(atom[1]) then
          return atom[1];
        else
          return void;
        fi;
      end;
    return _Filtered_func_list(i->not(i=void),_Apply_func_list(boundp1,sin));
  end;



___GenerateDocSinSou:=
  field->
    (format_fun->
      (separator->
        (function(docrec)
          local buf,i,gsinsou;
          buf:="";
          if IsBound(docrec.(field)) then
            for i in [1.._Size_list(docrec.(field))-1] do
              gsinsou:=format_fun(docrec.(field)[i]);
              buf:=buf+gsinsou+separator;
            od;
            if _Size_list(docrec.(field))>0 then
               gsinsou:=format_fun(docrec.(field)[_Size_list(docrec.(field))]);
               buf:=buf+gsinsou;
            fi;
            return buf;
          else
            return "";
          fi;
        end)));

__GenerateDocSin:=___GenerateDocSinSou("sin");
_GenerateDocSin:=__GenerateDocSin(_GenerateDocSinAtom2)(", ");


_GenerateDocName:=docrec->docrec.name;


__GenerateDocSig:=
  format_fun->
   (separator->
     function(docrec)
       local gnam,gsin,opt;
       gnam:=_GenerateDocName(docrec);
       if docrec.kind="FUNCTION" then
         gsin:=__GenerateDocSin(format_fun)(separator)(docrec);
         if IsBound(docrec.opt) then
           if gsin="" then
             opt:="[optargs]";
           else
             opt:=" [, optargs]";
           fi;
         else
           opt:="";
         fi;
         return(gnam+"("+gsin+opt+")");
       elif docrec.kind="OPERATION" then
         if IsBound(docrec.sin) then
           gsin:=__GenerateDocSin(format_fun)(separator)(docrec);
           return(_Mapconcat_func_list_string(i->format_fun(i),Butlast(docrec.sin),"   ")+
             " "+gnam+" "+format_fun(Last(docrec.sin)));
         fi;
       else
         return(gnam);
       fi;
     end);
_GenerateDocSig:=__GenerateDocSig(_GenerateDocSinAtom2)(", ");

_GenerateDocSigH:=
  function(docrec)
    local gnam,gsin,opt;
    gnam:=_GenerateDocName(docrec);
    if IsBound(docrec.sin) then
      gsin:=__GenerateDocSin(_GenerateDocSinAtom1)(",")(docrec);
      return(gnam+"("+gsin+")");
    else
      return(gnam);
    fi;
  end;


__GenerateDocSou:=___GenerateDocSinSou("sou");
__GenerateDocSog:=
  format_fun->
    (prestring->
      (separator->
        function(docrec)
          local gsin;
          gsin:=__GenerateDocSou(format_fun)(separator)(docrec);
          if gsin="" then
            return "";
          else
            return(prestring+gsin);
          fi;
        end));
_GenerateDocSog:=__GenerateDocSog(_GenerateDocSinAtom2)(" -> ")(", ");
_GenerateDocSogH:=__GenerateDocSog(_GenerateDocSinAtom1)("")(",");


___GenerateDocHash:=
  docsig->Hex(Digest(docsig,"SHA1")){[1..6]};
__GenerateDocHash:=
  docrec->___GenerateDocHash(_GenerateDocSigH(docrec));
_GenerateDocHash:=
  function(docrec)
    local dhash;
    dhash:=__GenerateDocHash(docrec);
    return(dhash);
  end;
DocGenHashByString:=___GenerateDocHash;
DocGenHashByRecord:=__GenerateDocHash;
DocHash:=___GenerateDocHash;

___GenerateDocSoghash:=
  docsog->Hex(Digest(docsog,"SHA1")){[1..6]};
__GenerateDocSoghash:=
  docrec->___GenerateDocSoghash(_GenerateDocSogH(docrec));
_GenerateDocSoghash:=
  function(docrec)
    local dhash;
    dhash:=__GenerateDocSoghash(docrec);
    return(dhash);
  end;



###
### AUX FUNS
###

IsUnique:=
  function(dry,elt)
    return not(elt in dry);
  end;
  
IsDryByPredicate:=
  function(dry,predfun)
    return
      function(predarg)
        local D,status;
        for D in dry do
          if predfun(D)=predarg then
            return false;
          fi;
        od;
        return true;
      end;
  end;

_DryViolatingByPredicate_dry_func_rec:=
  function(dry,predfun,optarg)
    return
      function(predarg)
        local D,status;
        for D in dry do
          if predfun(D)=predarg then
            return D;
          fi;
        od;
        return _GetFailEntry(optarg);
      end;
  end;

## add elt iff predfun(d)<>predarg for all d in dry
DryAddByPredicate:=
  function(dry,predfun)
    return
      function(predarg,elt)
        if IsDryByPredicate(dry,predfun)(predarg) then
          DryAdd_(dry,elt);
        fi;
      end;
  end;

DryReplaceByPredicate:=
  function(dry,predfun)
    return
      function(predarg,elt)
        local viol;
        viol:=_DryViolatingByPredicate_dry_func_rec(dry,predfun,rec())(predarg);
        if not(viol)=FAILURE and IsRec(viol) and not(viol=elt) and _DocDebug
           and not(viol.name=elt.name) then
          Print("## Hash Clash: #",viol.hash,": ");
          #if IsBound(viol.kind) then Print(viol.kind+" "); fi;
          if IsBound(viol.name) then Print(viol.name+" "); fi;
          Print(" vs. ");
          #if IsBound(elt.kind) then Print(elt.kind+" "); fi;
          if IsBound(elt.name) then Print(elt.name+" "); fi;
          Print("\n");
        fi;
        DryReplaceOrAdd_(dry,viol,elt);
      end;
  end;



###
### MAIN FUNS
###

#############################################################################
##
#F  __DocumentationKinds
##
__DocumentationKinds:=
  ["FUNCTION", "CONSTANT", "TYPE", "STATEMENT", "KEYWORD", "OPERATION"];
__DocumentationMandatoryFieldsPerKind:=
  [rec(
     kind:="FUNCTION",
     fields:=["kind","name","sin"]),
   rec(
     kind:="OPERATION",
     fields:=["kind","name","sin"]),
   rec(
     kind:="CONSTANT",
     fields:=["kind","name"]),
   rec(
     kind:="TYPE",
     fields:=["kind","name"]),
   rec(
     kind:="STATEMENT",
     fields:=["kind","name"]),
   rec(
     kind:="KEYWORD",
     fields:=["kind","name"])];
__DocumentationOptionalFields:=
  [["opt"],
   ["short"],
   ["ex"],
   ["see"]];


_CheckDocSigAtom:=
  function(sinatom)
    if IsList(sinatom) then
      if IsBound(sinatom[1]) then
        if sinatom[1]=unknown then
          return false;
        fi;
      fi;
    else
      if sinatom=unknown then
        return false;
      fi;
    fi;
    return true;
  end;

_CheckDocSig:=
  function(sig)
    local s,status;
    status:=true;
    for s in sig do
      status:=status and _CheckDocSigAtom(s);
    od;
    return status;
  end;

__DocumentationTranslation:=
  Alist(["$NAME","name"]);

#############################################################################
##
#F  CheckDocumentation( <record> )
##
CheckDocumentation:=
  function(docrec)
    local status,i,err,kind,mandfields;

    status:=true;

    ## first check the kind
    if IsBound(docrec.("kind")) then
      kind:=docrec.("kind");
      if Type(kind) <> string then
	err := "Kind must be a string!";
        Print(err,"\n");
	return false;
      fi;
    else
      err:="Kind is mandatory!";
      Print(err,"\n");
      return false;
    fi;

    ## now lookup the mandatory fields for this kind
    mandfields:=_First_func_list(i->i.("kind")=kind,__DocumentationMandatoryFieldsPerKind,rec(Fail:=false));
    if mandfields=false then
      err:=("Unknown kind.");
      Print(err,"\n");
      return false;
    else
      mandfields:=mandfields.("fields");
    fi;

    ## first of all mandatory fields
    for i in mandfields do
      if not(IsBound(docrec.(i))) then
        err:=("Rec field `"+i+"' is mandatory! :(");
        Print(err,"\n");
        status:=false;
      fi;
    od;

    ## FUNCTIONs must not carry an unknown type
    if IsBound(docrec.sin) then
      status:=status and _CheckDocSig(docrec.sin);
    fi;
    if IsBound(docrec.sou) then
      status:=status and _CheckDocSig(docrec.sou);
    fi;

    ## now go for translation
    ## This seems evil, so doing at runtime is more promising
    _MapAlist_func_alist(
      function(key,val)
        local qkey,tmp;
        qkey:=Replace(key,"\\$","\\$");
        tmp:=_GetEntry_rec_string(docrec,"short",rec(Fail:=FAILURE));
        if IsSuccess(tmp) then
          docrec.short:=Replace(tmp,qkey,
            _GetEntry_rec_string(docrec,val,rec(Fail:="")));
        fi;
      end, __DocumentationTranslation);
    _MapAlist_func_alist(
      function(key,val)
        local qkey,tmp;
        qkey:=Replace(key,"\\$","\\$");
        tmp:=_GetEntry_rec_string(docrec,"ex",rec(Fail:=""));
        if IsSuccess(tmp) then
          docrec.ex:=
            _Apply_func_list(i->Replace(i,qkey,
            _GetEntry_rec_string(docrec,val,rec(Fail:=""))),tmp);
        fi;
      end, __DocumentationTranslation);


    ## now optional fields
    #if IsBound(docrec.see) then
    #fi;

    return(true and status);
  end;


#############################################################################
##
#F  BlowUpDocumentation( <record> )
##
_BlowUpDocumentationHash:=
  function(docrec)
    if not(IsBound(docrec.hash)) then
      docrec.hash:=_GenerateDocHash(docrec);
    fi;
    return(docrec);
  end;
BlowUpDocumentation:=
  function(docrec)
    _BlowUpDocumentationHash(docrec);

    ##blow up no matter what
    docrec.sig:=_GenerateDocSig(docrec);
    docrec.sog:=_GenerateDocSog(docrec);

    ##blow up maybe
    if not(IsBound(docrec.docsrc)) and IsBound(__CURRENT_LIB) then
      docrec.docsrc:=__CURRENT_LIB;
    fi;

    ##blow up for debugging purposes
    if _DocDebug then
      if IsBound(docrec.sin) then
        docrec.sinflat:=_FlattenSin(docrec.sin);
      fi;
      if IsBound(docrec.sou) then
        docrec.souflat:=_FlattenSin(docrec.sou);
      fi;
      
      if not(IsBound(docrec.soghash)) then
        docrec.soghash:=_GenerateDocSoghash(docrec);
      fi;
      if not(IsBound(docrec.sig4hash)) then
        docrec.sig4hash:=_GenerateDocSigH(docrec);
      fi;
    fi;
    return(docrec);
  end;


#############################################################################
##
#F  RemoveDocumentation( <record> )
##
RemoveDocumentation:=
  function(docrec)
    RemAssoc_(__DOC,docrec.hash);
  end;


#############################################################################
##
#F  AddDocumentation( <record> )
##
DocAddOnDryHash:=DryAddByPredicate(__DOC,i->i.hash);
##    rec(DefaultValues:=MergeRecords(__FAILUREREC,rec(ForceAdd:=FALSE,Success:=TRUE)))
InstallDocumentation:=
  function(arg)
    local docrec,optarg;

    CheckArgs(arg,["docrec","optarg"],[,rec(Fail:=FAILURE,Success:=TRUE,ForceAdd:=FALSE)]);
    docrec:=__ARGREC.("docrec");
    optarg:=__ARGREC.("optarg");

    if _USE_DOC_DUMP_P then
      return _GetSuccessEntry(optarg);
    fi;

    if _GetEntry_rec_string(optarg,"ForceAdd",rec(Fail:=FALSE)) then
      if CheckDocumentation(docrec) then 
        BlowUpDocumentation(docrec);
        _PutAssoc__alist_any_any(__DOC,docrec.hash,docrec);
        return true;
      else
        return _GetFailEntry(optarg);
      fi;
    else
      if CheckDocumentation(docrec) then 
        BlowUpDocumentation(docrec);
        if _Position_alist_any(__DOC,docrec.hash)=FAILURE then
          _AddAssoc__alist_any_any(__DOC,docrec.hash,docrec);
          return _GetSuccessEntry(optarg);
        else
          return _GetFailEntry(optarg);
        fi;
      else
        return _GetFailEntry(optarg);
      fi;
    fi;
  end;

MergeRecords2:=
  function(target,source)
    local rf,mergerec;
    mergerec:=ShallowCopy(target);
    if IsRec(source) and IsRec(mergerec) then
      for rf in RecFields(source) do
        mergerec.(rf):=source.(rf);
      od;
      return mergerec;
    fi;
  end;

MergeRecords:=
  function(arg)
    local rf,mergeprod;

    if IsBound(arg[1]) and IsList(arg[1]) then
      arg:=arg[1];
    fi;

    if _Size_list(arg)=1 then
      return arg[1];
    elif _Size_list(arg)>1 then
      mergeprod:=MergeRecords2(MergeRecords(Butlast(arg)),Last(arg));
      return mergeprod;
    else
      return VOID;
    fi;
  end;
AddDocumentation:=InstallDocumentation;

#############################################################################
##
#F  MergeDocumentation( <record> )
##

MergeDocumentation:=
  function(arg)
    local hash,oldrec,newrec,docrec,optarg;

    CheckArgs(arg,["docrec","optarg"],[,rec(Fail:=FAILURE,Success:=TRUE,Add:=FALSE)]);
    docrec:=__ARGREC.("docrec");
    optarg:=__ARGREC.("optarg");

    if _USE_DOC_DUMP_P then
      return _GetSuccessEntry(optarg);
    fi;

    if IsBound(docrec.hash) then
      hash := _GetEntry_rec_string(docrec,"hash",rec(Fail:=""));
    elif IsBound(docrec.sig4hash) then
      hash := DocHash(docrec.sig4hash);
    elif CheckDocumentation(docrec) then
      MergeDocumentation(BlowUpDocumentation(docrec),optarg);
      return _GetEntry_rec_string(optarg,"Success",rec(Fail:=FAILURE));
    else
      Print("## Cannot merge. "+
        "Too few information given in order to merge sensibly.");
      return _GetFailEntry(optarg);
    fi;
    oldrec:=Assoc(__DOC,hash);
    if oldrec=FAILURE then
      if _GetEntry_rec_string(optarg,"Add",rec(Fail:=FALSE)) then
        InstallDocumentation(docrec,optarg);
      else
        ##no, this probably means the respective
        ##doc entry is not in the dry anymore
        return _GetFailEntry(optarg);
      fi;
    else
      newrec:=MergeRecords(oldrec,docrec);
      _PutAssoc__alist_any_any(__DOC,hash,BlowUpDocumentation(newrec));
    fi;
    return _GetEntry_rec_string(optarg,"Success",rec(Fail:=TRUE));
  end;

#Print("InstallDocumentation profile: ");
#UTime();
#for i in [1..1000] do
#  _AddDocumentation_rec(rec(kind:="FUNCTION",name:="TEST",sin:=[[record],[elt-alg^boo]],sou:=[[]]),rec());
#od;
#UTime();
#
#Print("MergeDocumentation profile: ");
#UTime();
#for i in [1..1000] do
#  _MergeDocumentation_rec(rec(kind:="FUNCTION",name:="TEST",sin:=[[record],[elt-alg^boo]],sou:=[[]]),rec());
#od;
#UTime();
