fmod SEXPSTR2QIDS is
  inc QID-LIST .
  inc NAT-LIST .

   var str : String .
   vars max len cur beg end : Nat .
   var toks : QidList .

**** tokens are separated by parens or by whitespace

  op isSep : Char -> Bool .
  eq isSep("(") = true .
  eq isSep(")") = true .
  eq isSep(" ") = true .
  eq isSep("\n") = true .
  eq isSep("\t") = true .
  eq isSep(str) = false [owise] .

  op isTok : Char -> Bool .
  eq isTok("(") = true .
  eq isTok(")") = true .
  eq isTok(str) = false [owise] .

****                  max cur
  op nextTok : String Nat Nat -> NatList .     **** len 2
  eq nextTok(str,max,cur) =
**** find first non-sep then the next sep
     (if cur >= max then (max max)
     else  (if isSep(substr(str,cur,1))
            then (if isTok(substr(str,cur,1))
                  then (cur (s cur))
                  else nextTok(str, max, s cur)
                  fi)
            else nextTok1(str,max,cur,s cur)
            fi ) fi) .

****                  max  beg next
  op nextTok1 : String Nat Nat Nat -> NatList .
  eq nextTok1(str,max,beg,cur) =
   (if cur >= max then (beg max)
     else  (if isSep(substr(str,cur,1))
            then (beg cur)
            else nextTok1(str,max,beg,s cur)
            fi ) fi) .


**********************
  op sexpstr2ql : String -> QidList .
  op sexpstr2ql1 : String Nat Nat QidList -> QidList .
  eq sexpstr2ql(str) = 
    (if str == "" then nil else sexpstr2ql1(str,length(str),0,nil) fi) .
  ceq sexpstr2ql1(str,len,cur,toks) = 
      (if beg >= end or beg >= len
       then toks
       else sexpstr2ql1(str,len,end, toks qid(substr(str,beg,sd(end,beg))) )  
       fi) 
   if (beg end) := nextTok(str,len,cur) .

endfm

fmod TEST-SEXPRSTR2QIDS is
  inc SEXPSTR2QIDS .

  ops sexpstr1 sexpstr2 : -> String .
  eq sexpstr1 =  "(Occurrence M2s211 (name Nck1)(class PROTEIN))" .
  eq sexpstr2 =   "(OList " + sexpstr1 + " " + sexpstr1 + ")" .

  ops ql1 ql2 : -> QidList .
  eq ql1 = sexpstr2ql(sexpstr1) .
  eq ql2 = sexpstr2ql(sexpstr2) .

endfm


fmod PARSE-PANTHER is
  inc SPLIT-PAREN .
***   inc META-LEVEL .
  inc QSTNOTES .
  inc META-PETRI .

***(
Need new declarations in theops and extensions of occT manipulations
  op newC : String  -> Thing .
  op newL : String  -> LocName .
)
*****************  Summary of opdecls
***(
****                     spacer accum
  op qidl2strx : QidList String String -> String .

****             modname toks      tkb
****       (Pathway id occlist rxlist)
  op parsePathway : Qid QidList -> TVal .  **** tm(modname,pntlT )
****         modname toks       onotes
****        (OccurrenceList toks)
  op parseOccs : Qid QidList -> Notes .    **** "occid" := tm(modname,occT)

****               modname toks   cnotes onotes
****  cnotes are partially parsed complexes 
****        "occid" := ql(compartment,position,components)
****  ...   (Occurrence id toks) ...
  op parseSimpleOccs : Qid QidList Notes Notes -> Notes .


****  makes complex occ when all components are defined in onotes
****                       onotes filling pend new?
****  iterate because some components may be complexes.  stop when nothing new
   op parseComplexOccs : Qid Notes Notes Notes Bool -> Notes .

****         modname toks   onotes   pntlT
****        (ReactionList rtoks)
   op parseRx : Qid QidList Notes -> Term .
**** (Reaction tok id (Reactants rtoks)(Products ptoks)(Modifiers mtoks)) 
**** splits off reaction items 
  op parseRx1 : Qid QidList Notes TermList -> Term .
**** parses one reaction item 
  op parseRx2 : Qid QidList Notes -> TermList .          **** 0 or 1   


)

   vars tok tag id modname class name activity : Qid .
   vars position compartment modification : Qid .
   vars toks otoks rtoks ptoks mtoks toks0 toks1 toks2 components : QidList .
   vars notes onotes anotes cnotes notes' : Notes .   
   vars occT occsT locT thingT pntT pntlT : Term .
   vars tl otl pntTL : TermList .
   vars spacer str idstr : String .
   vars b b0 : Bool .
   vars res0?? res1?? : [ResultPair?] .

**** string without white space  
****                  spacer    accum
  op qidl2strx : QidList String String -> String .
  eq qidl2strx(nil,spacer,str) = str .
  eq qidl2strx(tok toks,spacer,str) = 
       qidl2strx(toks,spacer,str + spacer + string(tok)) . 

  
   op parsePathway : Qid QidList -> TVal .
   ceq parsePathway(modname, '`( 'Pathway id toks '`)) = tm(modname, pntlT) 
   if {b,otoks,toks1} := splitParen(toks)       **** the occurrence list
   /\ {b0,rtoks,toks2} := splitParen(toks1)     **** the reaction list
   /\ onotes := (if b then parseOccs(modname,otoks) else mt fi)
   /\ pntlT := (if b0 and b 
                 then parseRx(modname,rtoks,onotes)  
                 else 'nil.PNTransList fi) .

   eq parsePathway(modname, toks) = tm(modname, 'nil.PNTransList) [owise]  .

   op parseOccs : Qid QidList -> Notes .    *** "occid" := tm(modname,occT)
   op parseSimpleOccs : Qid QidList Notes Notes -> Notes .

****                       occs   tofill pend  new?
   op parseComplexOccs : Qid Notes Notes Notes Bool -> Notes .
 
   eq parseOccs(modname,'`( 'OccurrenceList toks '`)) = 
        parseSimpleOccs(modname,toks,mt,mt) .
   eq parseOccs(modname,toks) = mt [owise] .

  ceq  parseSimpleOccs(modname,toks,cnotes,onotes) =
      (if b 
       then (if class == 'COMPLEX 
             then parseSimpleOccs(modname,toks1,(cnotes, notes), onotes)
             else parseSimpleOccs(modname,toks1,cnotes, (onotes, notes))
             fi)
       else parseComplexOccs(modname,onotes,cnotes,mt,false) 
       fi)
**** splits off first atom or balanced paren group from toks
     if {b,otoks,toks1} := splitParen(toks) 
     /\ anotes := occtoks2notes(otoks)
     /\ ql(class) := lookupd(anotes,"class",ql('unknown))
     /\ notes := (if class == 'COMPLEX
                  then parseComplex(modname,anotes) 
                  else parseOcc(modname,anotes) 
                  fi) .


****                      occs  tofill pend  new?
****                  Qid Notes Notes Notes Bool -> Notes .
   eq parseComplexOccs(modname,onotes,mt,notes,b) =
        (if b
         then parseComplexOccs(modname,onotes,notes,mt,false) 
         else onotes fi) .
           
   ceq parseComplexOccs(modname,onotes,
                       ((idstr := ql(compartment position components)), cnotes),
                       notes,b) =
       (if b0 
        then parseComplexOccs(modname,(onotes,anotes),cnotes,notes,true)
        else parseComplexOccs(modname,onotes,cnotes,
                         (notes,(idstr := ql(compartment position components))),b)
        fi)
   if b0 := defined(onotes,components)
   /\ anotes :=
      (if b0
       then  (idstr := tm(modname,'<_`,_>[mkComplexT(onotes,components,empty), 
                                      mkLocT(modname,compartment,position)]))
      else mt
      fi) .

  op defined : Notes QidList -> Bool .
  eq defined(notes,nil) = true .
  eq defined(notes,tok components) =
      (if lookupd(notes,string(tok),dumTv) == dumTv
       then false 
       else defined(notes,components) fi) .


**** use new complex for now
  op mkComplexT : Notes QidList TermList -> Term .
  eq mkComplexT(notes,nil,tl) = 
        '<_>[(if tl == empty then 'empty.Soup else
             (if tl :: Term then tl else '__[tl] fi) fi)] .
  ceq mkComplexT(notes,tok components,tl) =
     (if otl :: Term
      then mkComplexT(notes,components,(tl,otl))
      else mkComplexT(notes,components,tl)
      fi)
  if tm(modname,occT) := lookupd(notes,string(tok),dumTv)
  /\ otl := (if modname == 'BOOL then empty else occT2thT(occT) fi) .
  

**** Helper 
**** assumes toks have form (tag val)*  
**** val is tok or (modification modAlist) or (components toks)

  op occtoks2notes : QidList -> Notes .
  op atoks2notes : QidList Notes -> Notes .
  op atoks2note : QidList -> Notes .
  op modtoks2note : QidList -> Notes .

  eq occtoks2notes('`( 'Occurrence id toks '`)) = 
         atoks2notes(toks,("occid" := ql(id))) .
  eq occtoks2notes(toks) = mt [owise] .

  ceq atoks2notes(toks,anotes) =
      (if b 
       then atoks2notes(toks1, (anotes, atoks2note(toks0)))
       else anotes
       fi)
  if {b,toks0,toks1} := splitParen(toks) .
  
  eq atoks2note('`( tag toks '`)) = 
       (if tag == 'modification 
        then modtoks2note(toks) 
        else (string(tag) := ql(toks)) fi) .
  eq atoks2note(toks) = mt [owise] .

  eq modtoks2note('`( 'modifier tok '`)) = (string('mod) := ql(tok)) .
  eq modtoks2note(toks) = mt [owise] .

  op parseComplex : Qid Notes -> Notes .
  ceq parseComplex(modname,onotes) = 
        (string(id) := ql(compartment position components))
  if ql(id) :=  lookupd(onotes,"occid",ql('unknown))
  /\ ql(class)  := lookupd(onotes,"class",ql('unknown))
  /\ ql(components) := lookupd(onotes,"components",ql('unknown))
  /\ ql(compartment) := lookupd(onotes,"compartment",ql('unknown))
  /\ ql(position) := lookupd(onotes,"position",ql('unknown)) .

  op parseOcc : Qid Notes -> Notes .
  ceq parseOcc(modname,onotes) =
         ( string(id) := tm(modname,'<_`,_>[thingT,locT]) )
  if ql(id) :=  lookupd(onotes,"occid",ql('unknown))
  /\ ql(class)  := lookupd(onotes,"class",ql('unknown))
  /\ locT := mkLocT(modname,
                   qvalQidList(lookupd(onotes,"compartment",ql('unknown))),
                   qvalQidList(lookupd(onotes,"position",ql('unknown))))
  /\ thingT := mkThingT(modname, id,
                      class,
                      qvalQidList(lookupd(onotes,"name",ql('unknown))),
                      qvalQidList(lookupd(onotes,"mod",ql('none))),
                      qvalQidList(lookupd(onotes,"activity",ql('unknown)))) .

  op modToks : Qid Qid -> QidList .
  eq modToks('none,'inactive) = 'none .
  eq modToks('none,'active) = 'act .
  eq modToks('phosphorylated,activity) = 'phos .
  eq modToks(modification,activity) = '??? [owise] .  **** should not parse

****        modname,id,class,name,mod,activity
  op mkThingT : Qid Qid Qid Qid Qid Qid -> Term .
  op mkLocT : Qid Qid Qid -> Term .

  ceq mkThingT(modname,id,class,name,modification,activity) =
     (if res0?? :: ResultPair and res1?? :: ResultPair
      then (if getTerm(res1??) == 'none.ModSet
            then getTerm(res0??)
            else '`[_-_`][getTerm(res0??),getTerm(res1??)]
            fi)
      else 'newC[upTerm(qidl2strx('id: id 'class: class 'name: name
                                   'mod: modification
                                    'activity: activity,"~",""))]
      fi )
  if res0?? := (if class == 'PROTEIN
                then metaParse([modname],name,'Protein)
                else (if class == 'SIMPLE_MOLECULE
                then metaParse([modname],name,'Chemical)
                else (if class == 'RNA  **** Is this right??
                then metaParse([modname],name,'DNA)
                else (if (class == 'PHENOTYPE and name == 'Translation)
                then metaParse([modname],'PROTEIN-SYNTHESIS-ON, 'Signature)
                else noParse(0) fi) fi) fi) fi)
  /\ toks := modToks(modification,activity)
  /\ res1?? := metaParse([modname],toks,'ModSet) .

  eq  mkLocT(modname,'default,position) = 'Out.LocName .
  eq  mkLocT(modname,'CLc,'inside)  = 'CLc.LocName . 
  eq  mkLocT(modname,'CLc,'innerSurface) = 'CLi.LocName .
  eq  mkLocT(modname,'CLc,'transmembrane) = 'CLm.LocName .
  eq  mkLocT(modname,compartment,position) =
       'newL[upTerm(qidl2strx(compartment position,"~",""))] .

****   /\ pntlT := parseRx(modname,rtoks,onotes) .
  op parseRx : Qid QidList Notes -> Term .
  op parseRx1 : Qid QidList Notes TermList -> Term .
  op parseRx2 : Qid QidList Notes -> TermList .          **** 0 or 1   


  eq parseRx(modname,'`( 'ReactionList toks '`),onotes) =
       parseRx1(modname,toks,onotes,empty) .
  eq parseRx(modname,toks,onotes) = 'nil.PNTransList [owise] .

  ceq parseRx1(modname,toks,onotes,tl) =
      (if b 
       then parseRx1(modname,toks1,onotes, (tl,pntTL))
       else pntTL2pntlT(tl)
       fi)
  if {b,toks0,toks1} := splitParen(toks)
  /\ pntTL := parseRx2(modname,toks0,onotes) .

  eq parseRx2(modname,'`( 'Reaction tok id 
                         '`( 'Reactants rtoks '`)
                         '`( 'Products ptoks '`)
                         '`( 'Modifiers mtoks '`)  '`),  onotes) =
      'pnTrans[mkQidConst(id),toks2occsT(rtoks,onotes,empty),
                  toks2occsT(ptoks,onotes,empty),
                  toks2occsT(mtoks,onotes,empty)] .

  eq parseRx2(modname,toks,onotes) = empty [owise] .

  op toks2occsT :  QidList Notes TermList -> Term .
  eq toks2occsT(nil,notes,tl)  = occTL2occsT(tl) .
  ceq toks2occsT(tok toks, notes,tl) =
       toks2occsT(toks,notes,
                  (if occT == tvalTerm(dumTv)
                   then tl
                   else (tl, occT) fi))
  if occT := tvalTerm(lookupd(notes,string(tok),dumTv)) .
   
endfm


