GetExponent:=function(S, index) 
  expString := "";
  exponent := 1; 
  expPlace := index+1;
  while (expPlace le #S) and
        ((S[expPlace] ne "(") and 
         (S[expPlace] ne ")") and
         (S[expPlace] ne "*")) do
     expString := expString*S[expPlace];
     expPlace := expPlace +1;
  end while;
  if expString ne "" then
     return (StringToInteger(expString));
  else
     return(1);
  end if;
end function;

Exp:=function(S, exp)
  word := (S*"*")^exp;
  word := Substring(word, 1, (#word)-1);
  return(word);
end function;

StripString := function(S)
  word := "";
  for count in [1..#S] do
    currentLetter := S[count];
    if not ((currentLetter eq "$") or 
              (currentLetter eq ".") or 
              (currentLetter eq " "))then
       word := word*S[count];
    end if;
  end for;
  return(word);
end function;

Expand := function(S)
  print S;
  if S eq "" then return(S);
  end if;
  expLength := 0; 
  current := 1; //open paren
  final := 1;   //close paren
  index := 1; 
  while ((final eq 1) and (index lt #S)) do
    if S[index] eq "(" then
       current := index;
    end if;
    if S[index] eq ")" then
       final := index;
    end if;
    index := index + 1;
  end while;
  if index eq #S then
     return(S);
  end if;     
  if S[index] eq "^" then
     exp := GetExponent(S, index);
  else exp := 1;
  end if;
  if exp eq 1 then
     expLength := 0;
  else
     expLength := #(IntegerToString(exp));
  end if;
  head := Substring(S, 1, current-1);
  while  (index lt #S) and (not S[index] eq "*") and (not S[index] eq ")") do
    index := index+1;
  end while;
  if index lt #S then 
    tail :=  Substring(S, index, #S);
  else tail := "";
  end if;
  return (Expand(head*Exp((Substring(S,current+1, final-current-1)), exp)*tail));
end function;

Decaret := function(S)
   retval := "";
   i := 1;
   expLength := 0;
   while i le #S do
      if ((i+1 le #S) and
          (S[i] ne "^") and
          (S[i+1] eq "^")) then
         exp := GetExponent(S, i+1);
         retval := retval*(S[i]*"*")^GetExponent(S,i+1);
         retval := Substring(retval, 1, #retval-1);
         if exp eq 1 then expLength :=0;
         else expLength:=#(IntegerToString(exp));
         end if;
         i := i+expLength+1;
      else 
         if S[i] ne "*" and S[i] ne "^" then
            retval := retval*"*"*S[i];
         end if;
      end if;
      i:=i+1;
   end while; 
   return(retval);
end function;
         
StripStar:=function(S)
  retval := "";
  for i in [1..#S] do
    if S[i] ne "*" then
       retval := retval*S[i];
    end if;
  end for;
  return(retval);
end function;

pqrReplace:=function(S, p, q, r)
  pqr := "";
  word := "";
  for i in [1..#S] do  
      currentLetter := S[i]; 
      pqr := case< true |
           currentLetter eq "1" : p,
           currentLetter eq "2" : q,
           default      : r // element eq "3"
           >;
       word := word*pqr;
  end for;
  return (word);
end function;

pqrParse := function(S)
  if S eq "Id($)" or S eq " Id($)" then return(""); end if;
  word := StripString(S);
  word := Expand(word);
  word := Decaret(word);
  word := StripStar(word);
  retval := pqrReplace(word, "p", "q", "r");   
  return (retval);
end function;

abcParse := function(S)
  if S eq "Id($)" or S eq " Id($)" then return(""); end if;
  word := StripString(S);
  word := Expand(word);
//  word := Decaret(word);
//  word := StripStar(word);
  retval := pqrReplace(word, "A", "B", "C");
  Last := retval[#retval];
  lowerLast := case< true |
            Last eq "A" : "a",
            Last eq "B" : "b",
            default      : "c" // element eq "3"
            >;    
  retval := Substring(retval,1,(#retval)-1)*lowerLast;
  return (retval);
end function;

testStrings := ["1", "1^2", "$.1^2", "($.1)^2", "$.1*$.1", "$.1*($.1)^2", "($.1*$.2)^3", "$.1^2*($.2^3*($.2^2))^2", "($.1*$.2)^2*($.3*$.1)^2"];

      
TestRun:=function(testStrings, file)
   testString := "";
   PrintFile("testing parser", file);
   for i in [1..#testStrings] do 
     testString:= testStrings[i];
     PrintFile(file, testString);
     PrintFile(file,pqrParse(testString));
     PrintFile(file,abcParse(testString));
     PrintFile(file,"");
   end for;
   return ("done");
end function;

/*
parseexpr := procedure(S, ~index, ~retval)
  parseterm(S, ~index, ~term1);
  if index lt #S then 
     parseexpr(S, ~index, ~term2);
     retval := term1*"*"*term2;
  end if;
  return(retval);
end procedure;

parseterm := procedure(S, ~index, ~retval)
  parsemol(S, ~index, ~mol1, ~exp); // returns expanded molecule
  if index lt #S then
     parseterm(S, ~index, ~mol2)
     retval := mol1*mol2;
  end if;
  return(retval);
end procedure;

parsemol := procedure(S, ~index, ~retval, ~exp);
  done := false;
  retval := [];
  while not done do
*/