(***********************************************************************
This file was generated automatically by the Mathematica front end.
It contains Initialization cells from a Notebook file, which typically
will have the same name as this file except ending in ".nb" instead of
".m".

This file is intended to be loaded into the Mathematica kernel using
the package loading commands Get or Needs.  Doing so is equivalent to
using the Evaluate Initialization Cells menu command in the front end.

DO NOT EDIT THIS FILE.  This entire file is regenerated automatically 
each time the parent Notebook file is saved in the Mathematica front end.
Any changes you make to this file will be overwritten.
***********************************************************************)












(* File SafeMathProg *)

(* Package for safer Mathematica programming. *)

(* Version 1. Feb 8, 1997 *)

(* Author: Peter Fritzson, Dept. of Computer Science, Linkoping University
 * S-581 83 Linkoping, Sweden.
 * Email: petfr@ida.liu.se      WWW: //www.ida.liu.se/~pelab
 *) 



(* History *)
 
 (****
    Version 2. Sep 2, 1997, Johan Gunnarsson
 	*	Changed Clear in BeginFunction to ClearAll to assure that
 		attributes are removed from symbols.
 	*   Added the function ReplaceAllHoldFuncRepeated    
 	 
 	Version 3. Sept 970926, Peter F.  Change local function symbol context to "$`"
 	* Implemented NamedCall, for named function calls.
 	
 	Version 3.1 971004, Peter F. Error checking version of EndFunction: checks
 	for misspelled or undeclared names. Changed names 
 	from FunctionStart, FunctionEnd to BeginFunction, EndFunction.
 	
 	Version 3.11 971004, JG
 		Moved removeHold from ObjectMathConv to this package
  ****)



(*** TODO  possible improvement List:

** ??OBS Declaration of functions in the package global section currently does not
   work, since BeginFunction and EndFunction always appends a "Private`"
   to the symbol context. Need to find better solutions, e.g.
   BeginPublic, EndPublic, BeginPrivate, EndPrivate, BeginImplementation,
   EndImplementation (petfr 970926)

** Would like to remove "Global`" from the context path when defining functions.
   However, we first need a solution to catch parsing errors between BeginFunction
   and EndFunction, so that the Global context can be restored. (petfr 970926)

A. Investigate performance of Names[] for use in checkMultipleNames.
  One could create a flg, Developmentflg, which enables all debugging
  support from BeginFunction and EndFunction. If this flg is False,
  faster loading could be enabled.

***) 





BeginPackage["MathCore`SafeMathProg`"];



(* Exported  functions *)

Begin["MathCore`SafeMathProg`"];			(* exported names section *)
  
  BeginFunction;                (* Start of function cell and error checking *)
  EndFunction;                  (* End of function cell *)
  FunctionOrderedRules;         (* Keep function rule ordering *)
  start2;                       (* Help function to BeginFunction *)
  funcOrd2;                     (* Help function to FunctionOrderedRules *)
  checkMultipleNames;           (* Check mult. def. Call from BeginFunction *)
  extractLocalAndParamNames;    (* Extract list of local and parameter names *)
  extractContextNames;          (* Extract list of names with certain context*)
  BeginPackagePrivate;          (* Begin Private implementation section *)
  EndPackagePrivate;            (* End Private implementation section *)
  pushContext;                  (* Push context on context path *)
  popContext;                   (* Pop context from context path *)
  addContext;                   (* Add context on context path if not there *)
  removeContext;                (* Remove context from context path *)
  DoubleDefNames;               (* Check if both Private/nonprivate names *)
  CheckArgs;                    (* Turn on argument error checking *)
  OffCheckArgs;                 (* Turn off argument error checking *)
  ArgsErrorDialog;              (* Dummy function for debug stack backtrace *)
  ReplaceMarker;                (* Replace marker with held expression *)
  ReplaceAllHoldFunc;           (* Replace matching subexpr by appl. holdfunc *)
  ReplaceAllHoldFuncRepeated;	(* Do ReplaceAllHoldFunc until pattern cant't match *)
  HoldSymbol;                   (* Create a held symbol without evaluation *)
  defsToRules;                  (* Convert definition := to rule :> format *)
  ClearRemovePackageAll;        (* Clear and remove everything in a package *)
  NamedCall;                    (* Call with named parameters *)
  makePositionalCall;           (* Transform named call into positional call *)
  mergePositionArgs;            (* Merge positional and named args *)
  mkContextNameReplaceRule;     (* Make rule to replace name to spec context *)
  mkContextHoldName;            (* Attach context to name. return Hold[name] *)

(* General Utilities *)
	

(* Global variables *)
               
  om$$Functionstartnames;    (* BeginFunction stores list of function names
                              * names here, which is used by EndFunction *)

End[];  (* End of exported name section *)





(* Error messages *)

General::"wrongargs" = 
"`1` called with `2` arguments. Wrong number or nonmatching arguments: [`3`]";

General::errornames =
"Undeclared or misspelled names: `1` occurred within function `2`";

BeginFunction::forgotend = 
"You are currently in a Private context or you \n
forgot to do EndFunction[] in previous cell before doing BeginFunction for symbol `1` in this cell or \n
some parsing error previously prevented EndFunction[] from being executed in this cell. End[] is now executed.";

(* BeginFunction usage placed here, since   BeginFunction cell does not evaluate for some reason *)

BeginFunction::usage = 
"BeginFunction[fnames__Symbol] sets $Context to the context mark of the first name in fnames joined with Private`. It also clears all current definitions of the fnames symbols and turns on parameter passing error checking for names in fnames via calls to CheckArgs. \n
Example: \n
BeginFunction[Packagename`funcname]; \n
 funcname[args1...] := body1 ; \n
 funcname[args2...] := body2 ; \n
EndFunction[]; \n
\n
The use of BeginFunction...EndFunction fixes/avoids 5 kinds of bugs: \n
1. Remaining obsolete rules that has not been cleared - fixed by Clear.\n
2. Unevaluated expressions - turns on argument error checking.\n
3. Context problems caused by interactive function definitions - sets up
   a local Private environment just within the cell containing
    the function rules.\n
4. When there happens to be both a Private and a non-Private version of
   a symbol - usually causing strange bugs. The 4:th bug occurs if you forget
   both to mention the function name as an exported symbol and to put the 
   package context mark on the symbol at the call to BeginFunction. \n
5. A fifth bug - unintended function rule ordering - can be avoided by
   enclosing the rule definitions within FunctionOrderedRules[...], which 
   makes sure that rules are placed exactly in the specified order.
6. (petfr). A sixth bug - accidentally misspelled variable or function names,
   is detected by the new version of EndFunction, 970926.
7. (petfr). A seventh bug - forgetting to put an underscore after a function
   parameter name, e.g. param instead of param_, is also caught by the new version
   of EndFunction.
";


(* Begin[] for coming 3 cells:  CheckArgs,   BeginFunction *)

Begin["MathCore`SafeMathProg`Private`"];



(* CheckArgs *)

(* Functions for Error checking of nonmatching or wrong 
 * number of arguments **)

Clear[MathCore`SafeMathProg`CheckArgs, 
      MathCore`SafeMathProg`OffCheckArgs,
      MathCore`SafeMathProg`ArgsErrorDialog];


ArgsErrorDialog[] := Null;








CheckArgs::usage =
  "CheckArgs[f] will turn on error messages for f if f is called with wrong number of args, or nonmatching args.
   CheckArgs[f1,f2,...] similarly for several functions.
   OffCheckArgs[f1,f2,...] will turn off such error checking.
   A debugging dialog at the error can be initiated by the call:
   TraceDialog[expr,ArgsErrorDialog]
   where expr causes evaluation of the faulty call to f.
   In the dialog, Stack[_] can be used to give a backtrace of evaluations 
leading to the error.
    Note: CheckArgs CANNOT be used if any rule for f uses a pattern 
equivalent to x___, e.g. for  f[x___] := ..."; 

CheckArgs[funcname_] := (
 (* Only do Checkargs if there is no argument pattern similar to
  * someargs___ or  ___   someargs can be any name. *)
  If[
     Position[DownValues[funcname],
              HoldPattern[funcname[Verbatim[Pattern][y_,Verbatim[___]] |
                          Verbatim[___] ]]
             ] === {},
     (* Assign to DownValues to ensure that error check comes last *)
     DownValues[funcname] = Append[
       DownValues[funcname],
       (HoldPattern[funcname[zz$$args___]] :> 
          (Message[funcname::wrongargs, funcname, 
                   Length[List[zz$$args]], 
                  StringTake[ToString[HoldForm[List[zz$$args]]],{2,-2}] ];
           ArgsErrorDialog[];)
       )
     ]
   ];
  );  

CheckArgs[func1_,funcnames__] := (
  CheckArgs[func1]; 
  CheckArgs[funcnames]
)


OffCheckArgs[funcname_] := (funcname[zz$$args___] =.);


OffCheckArgs[func1_,funcnames__] := (
  OffCheckArgs[func1];
  OffCheckArgs[funcnames]
);





(*   BeginFunction - starting a function definition cell  *)

(* Clear[MathCore`SafeMathProg`BeginFunction];
 * Clear[MathCore`SafeMathProg`start2]; *)

(*** There seems to be some Strange bug that clears both  BeginFunction and
start2 after the first call to these functions if the two  Clears above are present *)

 BeginFunction[fname1_Symbol, fnames___Symbol] := (
  om$$Functionstartnames = Hold[fname1,fnames];
  start2[fname1, {fname1,fnames}]
);

start2[firstname_Symbol, {fn1_, fnames___Symbol}] := (
  checkMultipleNames[fn1];
  ClearAll[fn1];
  start2[firstname, {fnames}]
);

start2[firstname_Symbol, {}] := (
  If[$Context=!= "$`",
    (* Push global Private package context *)
    pushContext[Context[firstname]<>"Private`"];
    (* Begin local symbol context $` if not already there *)
    Begin["$`"]
  ];
(*** OLD code, commented out 970924 by petfr
  Begin[StringJoin[Context[firstname], "Private`"]];
  If[StringPosition[$Context, "Private"] =!= {},
    (* This message is not very useful. comment it out.
     * Message[  BeginFunction::forgotend, firstname];
     *)
    End[];
  ];
  Begin[StringJoin[Context[firstname], "Private`"]];
 ***)
);





EndFunction::usage = 
"EndFunction[] performs End[] to get out of the current Private context of the function definition cell, and applies CheckArgs to all functions that were previously mentioned as arguments to the previous call to BeginFunction.";

EndFunction[] := Module[{wrongnames},
  If[ValueQ[om$$Functionstartnames],
    Apply[CheckArgs, om$$Functionstartnames];
    popContext[Context[Evaluate[om$$Functionstartnames[[1]]]]<>"Private`"] 
    (*?? THIS Private stuff does not work for private functions *)
  ];
  Scan[
    Function[{fname},
      (* Names with $` prefix which are not locals or params, are undeclared
       * or misspelled. *)
      wrongnames = Complement[extractContextNames["$`",DownValues[fname]],
                                extractLocalAndParamNames[DownValues[fname]]];
      If[wrongnames =!= Hold[],
        wrongnames = HoldForm[Evaluate[wrongnames]]/.Hold->List;
        Begin["$`"];
        Message[fname::errornames,ToString[wrongnames],
                (Context[fname]<>SymbolName[fname]) ];
        End[]
      ]
    ],
    om$$Functionstartnames
  ]; (* end Scan *)
  
 (* by applying End last, we ensure that error checking for possible private
  * functions also work *)
  End[];
];





(* FunctionOrderedRules *)

FunctionOrderedRules::usage =
"FunctionOrderedRules[funcrule1; funcrule2; ...] defines a function
using these rules preserving the exact order of the given rules. \n
Example: 
FunctionOrderedRules[ f[x_Real] := x+2.0; f[x_Integer] := x+55; ];\n
Note: the heads of the rules must be compatible, i.e. you cannot mix
rules from different functions, or indexed names f[a][b][x_] in the
same rule list. Rules must be separated by semicolon. \n
One or more FunctionOrderedRules can be used to define one or more functions within the same FunctionBegin ... EndFunction pair.";

FunctionOrderedRules::missingsemi =  
"Error - missing semicolon after definition or varying function names. ";

Attributes[FunctionOrderedRules] := {HoldAll};

FunctionOrderedRules[CompoundExpression[defs__]] := (
  funcOrd2[DeleteCases[Hold[defs],Null]];
);

(* All function header names in rules must be the same: f_ *)
funcOrd2[Hold[defs:((f_[___] := _ )..)]] := (
  DownValues[f] = defsToRules[Hold[defs]];
);

funcOrd2[Hold[___]] := (
  Message[FunctionOrderedRules::missingsemi];
);

FunctionOrderedRules[___] := (
  Message[FunctionOrderedRules::missingsemi];
);





(* checkMultipleNames *)

Attributes[checkMultipleNames] = {HoldAll};

(*** OBS OBS:  To always performe this check before defining a function
 *** might  slow down loading
 *** of code.  Need to investigate performance of call to Names[ ].
 ***)

checkMultipleNames::multnameerr = 
"Warning, multiple definitions of symbol:\n
 `1`.  \n \n
If symbol is intended to be Private, remove the non-private versions. \n
Otherwise, if symbol is intended to be among the visible symbols of a package, then remove the Private version (e.g. perform Remove[\"Package\`Private\`name\"]), enter the symbol among the visible symbols of the package, and re-evaluate the package definitions.";

checkMultipleNames[symb_] := Module[
  {savecontext,
   symbnames = Names[StringJoin["*`", SymbolName[symb]]]
   },
  If[Length[symbnames] > 1, (
       savecontext = $Context;
       (* Change context to make visible Private context prefix *)
       $Context = "om$$Dummycontext`";
       Message[checkMultipleNames::multnameerr, ToString[symbnames]];

       $Context = savecontext;
  )];
]; (* checkMultipleNames *)



CheckArgs[BeginFunction, start2, EndFunction,
          FunctionOrderedRules, funcOrd2, checkMultipleNames];  

(* End[] for previous 5 cells:  CheckArgs,  BeginFunction, 
 * FunctionOrderedRules, checkMultiplenames. *)

End[];









(* extractLocalAndParamNames  - compute Hold[list] of local variables and parameters *)

(* Cannot use BeginFunction - EndFunction here, since EndFunction calls
   extractLocalAndParamNames
 *)
Clear[extractLocalAndParamNames]
(Begin["$`"];)

extractLocalAndParamNames::usage = "
extractLocalAndParamNames[fexpr] returns a hold list of all parameter names and local variables in the expression fexpr. including names in all local scopes, e.g Module, Block, With, Do, Table, etc. Typical call is:
extractLocalAndParamNames[DownValues[funcname]]
";

extractLocalAndParamNames[fexpr0_] := Module[{
  fexpr,
  patternnames,
  localnames,
  iteratornames,
  allnames
 },
  (* Transform away Symbol as a function call, not to clash with name_Symbol *)
  fexpr = fexpr0 /. HoldPattern[Symbol[x_]] :> Hold[x];
  (* First extract pattern variable names  {Hold[name1],...} *)
  (* This includes both formal parameter names and local patterns in function body *)
  (* Heads True is needed for patterns like f_[args___] *)
  patternnames = Cases[fexpr,
    Verbatim[Pattern][name_Symbol,_] :>  Hold[name], Infinity, Heads->True];
  (* Then get the names from all local scopes;  {Hold[names1],Hold[names2],...} *)
  localnames = (Cases[fexpr, 
      (Module|Block|With|Function)[names_,__] :>  Hold[names], Infinity]
    ) /. Hold[{names2___}]:>Hold[names2] /. HoldPattern[name_Symbol = _] :> name;
  (* Sum,Table,Do,Product have structure e.g. Table[expr,{name,...},{name,...}..] *)
  iteratornames = (Cases[fexpr,
    (Sum|Table|Do|Product|Plot|ParametricPlot|Plot3D|ParametricPlot3D|ContourPlot|
     DensityPlot|Play)[_, iterators:({_Symbol,__}..), (_->_)...] :>
                                                Hold[iterators], Infinity]
    ) /.  HoldPattern[List[name_Symbol,__]] :> name ;
  (* merge into single list: Hold[name1,name2...] which is returned *)
  allnames = Apply[Union, Join[patternnames,localnames,iteratornames]];
  If[allnames==={},
    Hold[],
    allnames
  ]
];  

End[];

CheckArgs[extractLocalAndParamNames];



































(* extractContextNames  - extract Hold[list] of all names with ctx context prefix *)

(* Cannot use BeginFunction - EndFunction here, since EndFunction calls
   extractContextNames
 *)
Clear[extractContextNames]
(Begin["$`"];)

extractContextNames::usage = "
extractContextNames[ctx_String,fexpr] returns a hold list of all names in fexpr with a ctx context prefix. 
Typical call is: extractContextNames[\"$`\",DownValues[funcname]]
";

extractContextNames[ctx_String,fexpr0_] := Module[{
  fexpr,
  extractnames
 },
  (* Transform away Symbol as a function call, not to clash with name_Symbol *)
  fexpr = fexpr0 /. HoldPattern[Symbol[x_]] :> Hold[x];
  extractnames = Apply[Union, Cases[fexpr, 
    name_Symbol/; Context[name] === ctx  :>  Hold[name], Infinity, Heads->True]];
  If[extractnames==={},
    Hold[],
    extractnames
  ]
];

End[];

CheckArgs[extractContextNames];
























(* BeginPackagePrivate, EndPackagePrivate  -  begin, end of implementation section *)

BeginFunction[BeginPackagePrivate, EndPackagePrivate]

BeginPackagePrivate::usage = "
BeginPackagePrivate starts the implementation section. \n
Example call: BeginPackagePrivate[\"packagename\`\"]  \n
";

(* It puts the private context on the context path, as well as setting
 * $Context to the private context. The reason for having both
 * is that $Context is temporarily rebound to "$`" by BeginFunction. Therefore
 * the private context must also be on the context path.
 *)

(* ??OBS NOTE:  it might be better to let BeginFunction put the Private package
 * context on its path.
 *)

BeginPackagePrivate[ctxname_String] := Module[{
  privatecontext = ctxname<>"Private`"
 },
  If[Cases[$ContextPath,privatecontext]=!={},
    pushContext[privatecontext]
  ];
  Begin[privatecontext]
];

EndPackagePrivate[ctxname_String] := Module[{
  privatecontext = ctxname<>"Private`",
  pos
 },
  pos = Position[$ContextPath,privatecontext];
  If[pos=!={},
    $ContextPath = Drop[$ContextPath,pos[[1]]];
    End[]
  ];
];


EndFunction[]



(* pushContext, popContext  -  push and pop on context path *)

(* Do not use BeginFunction, EndFunction, since pushContext and popContext
 * are called by BeginFunction and EndFunction
 *)

Clear[pushContext];
Clear[popContext];
(Begin["$`"];)

pushContext::usage="
pushContext[\"packagename\`\"] unconditionally pushes the context on the context path even if it is already there.
";

pushContext[ctx_String] := (
  If[Cases[$ContextPath,ctx]==={},
    $ContextPath = Prepend[$ContextPath,ctx]
  ]
);

popContext::usage="
popContext[] unconditionally pops the most recently added context;
popContext[\"packagename\`\"] removes the specific packagename context if present,
otherwise does nothing. If multiply present, removes the first.
";

popContext[] := (
  If[Length[$ContextPath]>1,  (* avoid dropping "System`" *)
    $ContextPath = Drop[$ContextPath,1]
  ]
);

popContext[ctx_String] := Module[{
  pos
 },
  pos = Position[$ContextPath,ctx];
  If[pos=!={},
    $ContextPath = Drop[$ContextPath,pos[[1]]];
  ]
];

End[];

CheckArgs[addContext,removeContext];



(* addContext, removeContext  -  add and remove context on context path *)

(* Do not use BeginFunction, EndFunction, since addContext and removeContext
 * are called by BeginFunction and EndFunction
 *)

Clear[addContext];
Clear[removeContext];
(Begin["$`"];)

addContext::usage="
addContext[\"packagename\`\"] add the context at beginning of context path if it is not already there, in which case the context path is unchanged.
";

addContext[ctx_String] := (
  If[Cases[$ContextPath,ctx]==={},
    $ContextPath = Prepend[$ContextPath,ctx]
  ]
);

removeContext::usage="
removeContext[] removes the context in front of the context path;
removeContext[\"packagename\`\"] removes the specific packagename context if present,
otherwise does nothing.
";

removeContext[] := (
  If[Length[$ContextPath]>1,  (* avoid dropping "System`" *)
    $ContextPath = Drop[$ContextPath,1]
  ]
);

removeContext[ctx_String] := Module[{
  pos
 },
  pos = Position[$ContextPath,ctx];
  If[pos=!={},
    $ContextPath = Drop[$ContextPath,pos[[1]]];
  ]
];


End[];

CheckArgs[addContext,removeContext];





BeginFunction[MathCore`SafeMathProg`DoubleDefNames];

DoubleDefNames::usage = 
"DoubleDefNames[packagename] checks for double defined symbols,
 i.e. both:
Package`symbol and Package`Private`symbol
The package must be in your path. The set of double defined names is returned.";

DoubleDefNames[packagename_] := Module[
  {names1,names2,isect},
  names1 = Names[StringJoin[packagename,"`*"]];
  names1 = Map[StringJoin[packagename,"`Private`",#]&,names1];
  names2 = Names[StringJoin[packagename,"`Private`*"]];
  isect = Intersection[names1,names2]
];

EndFunction[];


(* OBS: Never use BeginFunction on variable or constructor names *)






(* ReplaceMarker *)

BeginFunction[MathCore`SafeMathProg`ReplaceMarker];
   
ReplaceMarker::usage = 
  "ReplaceMarker[x,mark,Hold[y]] replaces all occurrences of mark in x by y 
without evaluating y. \n
  Example1: ReplaceMarker[Hold[Foo[a,amark]], amark, Hold[2+2]] produces 
Hold[Foo[a,2+2]] \n
  Exampe2: if new is bound to Hold[2+3], then ReplaceMarker[
  Hold[Foo[a,amark]], amark, new] produces Hold[Foo[a,2+3]]";  

ReplaceMarker[expr_,marker_,replaceholdexpr_Hold] := Module[
  {pos},
  pos = Position[expr,marker];
  (**?? Should report error if pos is {} *)
  Return[ReplacePart[expr,replaceholdexpr,pos,1]]
]; (* ReplaceMarker *)

EndFunction[];    













(* ReplaceAllHoldFunc - Replacement of matching parts without evaluation *)

BeginFunction[ReplaceAllHoldFunc];

ReplaceAllHoldFunc::usage="
ReplaceAllHoldFunc[holdexpr, pattern, holdfunc] performs symbolic replacement of all matching parts within holdexpr without evaluation. \n
It replaces all parts in holdexpr that matches pattern by the results of calling holdfunc on each of those parts wrapped in Hold. holdfunc should return each result wrapped in Hold. \n
This function is similar to ReplaceAll, but results are given by applying holdfunc. In ReplaceAll, results are from the right hand side of a rule.
Example: \n
ReplaceAllHoldFunc[Hold[(2+1)*(4+5)], HoldPattern[_+_], twice1func] \n
gives: Hold[(2+2+1)*(4+4+5)] \n
provided: twice1func[Hold[a_+b_]] := Hold[a+a+b] \n
";

ReplaceAllHoldFunc[holdexpr_Hold, pattern_, holdfunc_] := Module[
  {pos,n,result=holdexpr,i},
   (* get positions matching pattern *)
   pos = Position[holdexpr, pattern];
   n= Length[pos];
   (* replace one matched subexpr at a time *)
   For[i=1, i<=n, i++,
     result = ReplacePart[result,
                          holdfunc[Extract[result,pos[[i]],Hold]],
                          pos[[i]], 1];
   ];
   result
];

EndFunction[];









(* ReplaceAllHoldFuncRepeated - 
    the repreated version of ReplaceAllHoldFunc *)

BeginFunction[ReplaceAllHoldFuncRepeated]

ReplaceAllHoldFuncRepeated::usage = "ReplaceAllHoldFuncRepeated[holdexpr, \
pattern, holdfunc] calls ReplaceAllHoldFunc[holdexpr, pattern, holdfunc] \
repeatetly until pattern does not match anything in holdexpr."

ReplaceAllHoldFuncRepeated[holdexpr_Hold, pattern_, holdfunc_] := 
    Module[{result=holdexpr},
			While[!FreeQ[result,pattern], 
				result = ReplaceAllHoldFunc[result,pattern,holdfunc]];
		result
	];

EndFunction[]





(* HoldSymbol *)

BeginFunction[MathCore`SafeMathProg`HoldSymbol];

HoldSymbol::usage = 
"HoldSymbol[namestr_String] creates a \
symbol  for namestr and returns the symbol enclosed by Hold \
without evaluating it.   Ex: HoldSymbol[\"x\"] returns \
Hold[x] even if x is bound to some value.";

HoldSymbol[namestr_String] := 
  ToExpression[ToString[Hold[namestr], OutputForm]];  

EndFunction[];    





(* defsToRules *)

BeginFunction[defsToRules];

defsToRules::usage =
"defsToRules[Hold[defs]] converts a list of definitions in delayed form to a list of RuleDelayed rules.  \n
Example: defsToRules[Hold[Sin3[x_] := Sin[x]+5]] \n
gives: {HoldPattern[Sin3[x_]] :> Sin[x]+5}";

defsToRules[defs_Hold] := defsToRules[defs, {}];

(* Example input: Hold[ f[] := body, f[x_,y_] := body2, etc. ] *)

defsToRules[Hold[ hd1:(_[___]) := body1_, defsrest___],  {res___}] := (
  defsToRules[Hold[defsrest], {HoldPattern[hd1] :> body1,  res}]
);

(* return result *)
defsToRules[Hold[], res_] := res;

EndFunction[]; (* defsToRules *)



(* ClearRemovePackageAll  - clear and remove everything in a package *)

BeginFunction[ClearRemovePackageAll];

ClearRemovePackageAll::usage="
ClearRemovePackageAll[package] clears and removes all symbols in package
and symbols in subcontexts at all levels of package. \n
Example: ClearRemovePackageAll[\"mypackage\"]
";

ClearRemovePackageAll[packname_String] := (
  (* Turn off error message, if there are no matching symbols *)
  Off[Remove::rmnsm];
  Clear[Evaluate[StringJoin[packname,"`*"]]];
  Remove[Evaluate[StringJoin[packname,"`*"]]];
  (* Also remove symbols at context level 2,3,4, etc.  *)
  Clear[Evaluate[StringJoin[packname,"`*`*"]]];  
  Remove[Evaluate[StringJoin[packname,"`*`*"]]];
  (* Turn on error message again *)
  On[Remove::rmnsm];
);

EndFunction[];


















(* Check for doubledefined symbols appearing in both Private and package context *)
(*** NOT needed any longer:   DoubleDefNames["SaveMathProg"]  ***)






























































(* NamedCall - function call with named parameters *)

BeginFunction[NamedCall];

NamedCall::usage="
 NamedCall[NamedCall[Foo[x->35, y->888]]] will perform a function call to Foo
 which is equivalent to Foo[35,888]. Named parameters can occur in any order.
 If missing, specified default values for named parameters are filled in.
";

NamedCall::missvalue = "Error. Missing argument value of default value for parameter: `1` \n
 in function call: `2` "; 

NamedCall::wrongargname = "Error. Misspelled argument name(s): `1` \n 
in call: `2` \n
with parameters: `3`";

SetAttributes[NamedCall, HoldAll];

NamedCall[f_[args___]] := 
  Replace[makePositionalCall[f[args]], (
    (* define the cached upvalue on f *)
    Hold[positionalcall_] :> (
          f/: NamedCall[f[args]] := positionalcall;
    positionalcall )
  )
]

EndFunction[];





























BeginFunction[makePositionalCall];

makePositionalCall::usage="
 makePositionalCall[Foo[a,  z->777+1]] returns Hold[Foo[a, 35, 777+1]]
 for a function Foo with head: Foo[x_,  y_:35, z_:888].
  Named parameters can occur in any order, and within structured arg expressions.
 If missing, specified default values for named parameters are filled in.
";

SetAttributes[makePositionalCall, HoldAll];

makePositionalCall[f_[args___]] := Module[{
  paramslength = 0,
  parameterlist,
  parameternames,
  callargs = Hold[args],
  positionargs,
  argumentnames,
  namedargumentrules
},
  (* obtain the chosen parameter list, if there are several DownValue rules *)
  Print["downs =",DownValues[f]];
  Scan[
    Function[{rule2}, 
      Replace[rule2, 
        HoldPattern[Verbatim[RuleDelayed][Verbatim[HoldPattern][
                    (f2_)[params2___]], _ ]] :>
        If[Length[Hold[params2]]  > paramslength,
          parameterlist = Hold[params2];
          paramslength = Length[parameterlist];
        ]
      ]
    ] (* end local Function *) ,
    DownValues[f]
  ]; 
  (* Make sure that argumentnames and argumentlist have $` context prefix *)
  argumentnames = Cases[callargs,
	(Verbatim[Rule][name_, _]/; Context[name]=!="$`" :> Hold[name]) ,2];  
  callargs = callargs /. Map[mkContextNameReplaceRule[##,"$`"]&, argumentnames];
  argumentnames = Map[mkContextHoldName[##,"$`"]&, argumentnames];
  (* Make sure that formal parameter names have $` context prefix *)
  parameternames = Cases[parameterlist,
	(Verbatim[Pattern][name_, pat_]/; Context[name]=!="$`" :> Hold[name]), Infinity];
  parameterlist = parameterlist /. 
                             Map[mkContextNameReplaceRule[##,"$`"]&, parameternames];
  parameternames = Map[mkContextHoldName[##,"$`"]&, parameternames];
  If[Complement[argumentnames,parameternames]=!={},
    Message[NamedCall::wrongargname,
            ToString[Complement[argumentnames,parameternames]/Hold->HoldForm],
            ToString[HoldForm[f[args]]],
            ToString[parameternames/.Hold->HoldForm] ]
  ];
  (* Construct replacement rules for named arguments *)
  (* e.g. if x_  or x: occurs in the formal list, it is replaced by value *)
  namedargumentrules := Cases[callargs, HoldPattern[name_ -> value_] :> 
       HoldPattern[Verbatim[Pattern][name,Blank[]]] :> value ];
  (* Construct the new arguments. Start with the formal parameter list *)
  positionargs = parameterlist;
  (* Then replace the named arguments *)
  positionargs = positionargs /. namedargumentrules;
  (* Then loop over positionargs
   * Method: 1) if a position argument (not Rule), put it there.
   *         2) If Pattern variable still present, put the default value.
   *  If missing default in 2) then error.
  *)
  Replace[
    mergePositionArgs[Hold[f[args]], callargs, positionargs, Hold[]],
    Hold[args2___] :> Hold[f[args2]]
  ]
  
]; (* end of makePositionalCall *)

EndFunction[]













(* mergePositionArgs  -  merge into position argument list *)

(* Method: 1) if a position argument (not Rule), put it there.
 *         2) If Pattern variable still present, put the default value.
 *  If missing default in 2) then error.
 *)
 
(* Examples, see below *)

BeginFunction[mergePositionArgs]


(* Case: End of actual argument list *)
mergePositionArgs[fcall_, Hold[], 
                  Hold[paramarg1_,rest2___],
                  Hold[outargs___]] := (
  (* We have reached the end of actual arguments, but still more formals *)
  (* Put in a few dummy Rules Null->Null, and continue *)
  mergePositionArgs[fcall, Hold[Null->Null,Null->Null],
                    Hold[paramarg1,rest2], Hold[outargs]]
);

(* Case: End of formal parameter list. return the result. *)
mergePositionArgs[fcall_, Hold[posarg1_,rest1___], 
                  Hold[],
                  Hold[outargs___]] := (
  Hold[outargs]
);

(* Case: Handle positional arguments and optional defaults *)
mergePositionArgs[fcall_, Hold[posarg1_,rest1___], 
                  Hold[paramarg1_,rest2___],
                  Hold[outargs___]] :=  Module[{},
  Replace[Hold[posarg1], {
    (* Case: Rule, i.e. name->value. Already replaced. *)
    Hold[_ -> _] :> Null, (* continue with defaults, etc. below *)
    (* Case: positional argument. Put it in, and return *)
    _ :> Return[mergePositionArgs[fcall, Hold[rest1], Hold[rest2],
                                  Hold[outargs,posarg1] ]]
  }];  

  (* Here: use optional default value if needed *)
  Replace[Hold[paramarg1], {
    (* Case:  not replaced. use optional default value *)
    Hold[Verbatim[Optional][Verbatim[Pattern][_,_], value_]] :> (
      Print["Case 1. param1=",Hold[paramarg1]]; (*OBS*) 
      mergePositionArgs[fcall, Hold[rest1], Hold[rest2], Hold[outargs,value]]
    ) ,
    arg1_Hold :> (
      If[FreeQ[arg1,Pattern],
        Replace[arg1, {
          (* Case: already replaced parameter with default. Remove default value *)
          Hold[Verbatim[Optional][arg_, _]] :> (
          Print["Case 2. param1=",Hold[paramarg1]]; (*OBS*) 
            mergePositionArgs[fcall, Hold[rest1], Hold[rest2], Hold[outargs,arg]]
          ),
          (* Case: already replaced parameter. just return it *)
          arg_Hold :> (
            Print["Case 4. param1=",Hold[paramarg1]]; (*OBS*) 
            mergePositionArgs[fcall, Hold[rest1], Hold[rest2], Hold[outargs,arg]]
          )
        }], (
          (* False branch - Not Free of Pattern *)
          (* Case:  If Pattern still present: Error *)
          Print["Case 3. param1=",Hold[paramarg1]]; (*OBS*) 
          Message[NamedCall::missvalue,ToString[arg1/.Hold->HoldForm],
                  ToString[fcall/.Hold->HoldForm]];
          mergePositionArgs[fcall, Hold[rest1], Hold[rest2], Hold[outargs,Null]]
        )
      ] (* If *)
    )
  }] (* Replace *)
];

EndFunction[];





















(* mkContextNameReplaceRule  -  create a rule like (name :> $`name) *)

mkContextNameReplaceRule::usage = "
mkContextNameReplaceRule[Hold[a],\"myctx\`\"] will create a rule
HoldPattern[a] :> myctx\`a
";

BeginFunction[mkContextNameReplaceRule]

SetAttributes[mkContextNameReplaceRule, HoldAll];

mkContextNameReplaceRule[Hold[name_] | name_, ctx_String] := (
  Replace[mkContextHoldName[name,ctx], Hold[name2_] :> 
                                            RuleDelayed[HoldPattern[name],name2]]
);

EndFunction[];











(* mkContextHoldName  - attach ctx context to name. return Hold[ctxname] *)

BeginFunction[mkContextHoldName]

SetAttributes[mkContextHoldName, HoldAll];

mkContextHoldName[Hold[name_] | name_Symbol, ctx_String] := 
                                              HoldSymbol[ctx <> SymbolName[name]]

EndFunction[];













































EndPackage[]