
Begin["System`"]

Install::usage = "Install[\"command\"] starts an external program and
installs Mathematica definitions to call functions in it."

Reinstall::usage = "Reinstall[link] un-installs the specified external
package and installs it again."

Uninstall::usage = "Uninstall[link] terminates an external program started
by Install, and removes Mathematica definitions set up by it."

ThisLink::usage = "ThisLink is used in patterns for external packages
to distinguish between several instances of the same package."

LinkPatterns::usage = "LinkPatterns[link] gives the list of patterns
defined in the external package which is accessed via the specified link."
 
    
ExternalCall DefineExternal CallPacket ReturnPacket EvaluatePacket

Begin["`Private`"]

Install[comm_String] := Block[ {ThisLink}, 
	ThisLink = LinkOpen[comm]; 
	ThisLink = ConnectToExternalPackage[ThisLink];
	defineLinkObject[First[ThisLink], ThisLink];
	ThisLink
	]

Install[link_LinkObject] := Block[ {ThisLink = link}, 
	ThisLink = ConnectToExternalPackage[ThisLink];
	defineLinkObject[First[ThisLink], ThisLink];
	ThisLink
	]

ConnectToExternalPackage[link_LinkObject] :=
	Block[{ e, defined = {}}, 
  		While[
			(e = LinkRead[link]) =!= End && e =!= $Failed, 
	 		If[ StringQ[e], ToExpression[e]]
		];
		SetDelayed @@ { LinkPatterns[link], defined};
		link
	] 

ConnectToExternalPackage[_] := $Failed

defineLinkObject[s_String, link_LinkObject] := ( 
	If[  Length[LinkObject[s]] != 1,
		LinkObject[s]=.
	];
	LinkObject[s] = link
	)

defineLinkObject[__] = $Failed
          
DefineExternal[p_String, a_, n_] := Module[ {e},
	e = Hold[_ :=  ExternalCall[ _, CallPacket[_, _]]] ;
	e = ReplaceHeldPart[ e, ToHeldExpression[p], {1,1}];
	e = ReplacePart    [ e, ThisLink, {1,2,1}];
	e = ReplacePart    [ e, n, {1,2,2,1}];
	e = ReplaceHeldPart[ e, ToHeldExpression[a], {1,2,2,2}];
	ReleaseHold[e];
	defined = Append[defined, HoldForm @@ ToHeldExpression[p]]
	]


ExternalCall[ link_LinkObject, packet_CallPacket] := 
	If [LinkWrite[link, packet] =!= $Failed, 
		ExternalAnswer[link, LinkRead[link]]
	]
	(* Initial call - the link will answer either with 
		ReturnPacket (final result), or with  EvaluatePacket *)
		
ExternalAnswer[ link_LinkObject, EvaluatePacket[expr_]] := 
	If [LinkWrite[link, ReturnPacket[expr]] =!= $Failed, 
		ExternalAnswer[ link, LinkRead[link]]
	]
	(* having sent a ReturnPacket we get to the same state as after
	   the initial CallPacket. *)

ExternalAnswer[ link_LinkObject, ReturnPacket[result_]] := result

ExternalAnswer[ link_LinkObject, result_] := result

Uninstall[link_LinkObject] := ( LinkClose[link];
	LinkPatterns[link] //. HoldForm -> Unset;
	unset[linkPatterns[link]] //. {unset->Unset, linkPatterns -> LinkPatterns};
	First[link]
	)

Uninstall::unlink = "External package `1` has not been installed."

Uninstall[comm_String] := Module[{link = LinkObject[comm]},
	If[ Length[link] > 1,
		Uninstall[link]; ReleaseHold[Hold[LinkObject[x]=.]/. x :> comm]; comm,
		Message[Uninstall::unlink, comm]
	] ]

Reinstall[l_] := Module[ {name = Uninstall[l]},
    If [StringQ[name], Install[name]]
	]

End[]

End[]

