
fmod PL-PRINT is 
  inc MY-META-ALL .
  inc STRING .
  inc CONVERSION .
  inc META-PETRI .
***()
  inc SEXP-AUX .
  inc STRING-LIST .


*********************   original pl-print opdecls  ************************ 
**** printing rule ids
*** print  up to first dot in ddd, or all if no dot
  op printRid : Qid -> String .

**** ridT has form ''ddd.Qid  maybe ddd has no dot
*** print  up to first dot in ddd, or all if no dot
*** if PNRidSuffix occurs, then what follows is rule instance index n
*** add -n to printed id
  op printRidT : Term -> String .

**** print the full id (just drop the single quote)
  op printRidTAll : Term -> String .

**** applies printRidTall to each term in the list (with blank separator)
  op printRidTL : TermList -> String .

**** printing an occ termlist, space separated, full occ name (occ2label)
  op printOccTL : Module TermList -> String .

**** prints occ as  thing - loc
  op occ2label : Module Term -> String .
**** prints occ without loc
  op occ2labelx : Module Term -> String .

**** prints location name -- assume constants, ow print as "?"
  op printLoc : Module Term -> String .

******** printing things
  op printThing : Module Term -> String .

**** separator for rule instance count, currently #
  op PNRidSuffix : -> String .


*********************   occ2chatty opdecls  ************************ 

***(
  op locsepchar : -> String .
  op modsepchar : -> String .
  op thingsepchar : -> String .
  op sitesepchar : -> String .
  op isComplexThing : Term ->  Bool . *** to meta?
  ops soccT2ename soccT2mnames : Term -> String .
  op locT2label : Term -> String .
  op occT2chatty : Term -> String .
  op occT2chatty : Term Term -> String .
   op thingT2label : Term -> String .
	op flattenThingTL : TermList Qid -> TermList .
	op thingTL2label : TermList String -> String .
	op thingTL2labels : TermList StringList -> StringList .
  op thingSoup2label : Term -> String .
  op modsT2modTL : Term TermList -> TermList .
  op modsTL2modTL : TermList TermList -> TermList .
  op modsT2suffix : Term -> String .
  op modT2label : Term -> String .
**** 16apr09
***  op modTL2mnames : TermList StringList -> StringList .
***  op siteModTemplate : -> String .
***  op modT2mname : Term String -> String .
  op prntOpTerm : Qid TermList -> String .
  op prntTerm : Term -> String .
  op prntTermList : TermList -> String .
)

  vars t locnameT modT occT tsoupT msT thT pT locT nT : Term .
  vars tl tl1 tl0 occTL : TermList .
  vars netl0 netl1 : NeTermList .
  vars opid : Qid .
  var strl : StringList .
  var sepchar : String .
  var bindings : TBinds .

  vars rid : Qid .
  vars ridT thC : Constant .
  var mod : Module .
  vars rn prn sfx : String .
  vars res res1 : FindResult .


***(  from pl-print
  var thV : Variable .
  vars occT thT lT pT msT t thT0 thT1 thT2 tsoupT : Term .
  var occTL tl : TermList .
  vars res?? res0?? res1?? : [ResultPair?] .
)
  op locsepchar : -> String .
  eq locsepchar = "@" .

  op modsepchar : -> String .
  eq modsepchar = "-" .

  op thingsepchar : -> String .
  eq thingsepchar = ":" .

  op sitesepchar : -> String .
  eq sitesepchar = "!" .

**** occT auxilliaries
**** put in meta petri/ meta occ library

  op isComplexThing : Term ->  Bool .
  eq isComplexThing('_:_[tl]) = true .
  eq isComplexThing('<_>[tsoupT]) = true .
  eq isComplexThing(thT) = false [owise] .


  op soccT2ename  : Term -> String .
  eq soccT2ename(thC:Constant) = string(getName(thC:Constant)) .
  eq soccT2ename('`[_-_`][pT,msT]) =  string(getName(pT)) .  
  eq soccT2ename(thT) = "???" + prntTerm(thT)  [owise] .

****16apr09
***(  op soccT2mnames : Term -> String .
	  eq soccT2mnames('`[_-_`][pT,msT]) =
****    strL2qstr(modTL2labels(modsT2modTL(msT,empty),nil), "") .
        strL2str(modTL2mnames(modsT2modTL(msT,empty),nil)," ") .
  eq soccT2mnames(thT) = ""  [owise] .
)


  op locT2label : Term -> String .
  eq locT2label(locnameT) =  string(getName(locnameT)) .
  
  op occT2chatty : Term -> String .
  op occT2chatty : Term Term -> String .
  eq occT2chatty(occT) = occT2chatty(occT2thT(occT),occT2locT(occT)) .
  eq occT2chatty(thT,locT) =
      thingT2label(thT)  + locsepchar + locT2label(locT) . 

  op thingT2label : Term -> String .

  eq thingT2label(thC:Constant) = string(getName(thC:Constant)) .
**** 17jan04 to export symbolic rules
  eq thingT2label(v:Variable) = "?" + string(getName(v:Variable))
                             + "::" + string(getType(v:Variable))  .
  eq thingT2label('_:_[tl]) =  thingTL2label(flattenThingTL(tl,'_:_),":")  . 
  eq thingT2label('<_>[tsoupT]) =  "<" + thingSoup2label(tsoupT) + ">" .
  eq thingT2label('`[_-_`][pT,msT]) = 
      thingT2label(pT) + modsT2suffix(msT) .
  eq thingT2label(thT) = "???" + prntTerm(thT)  [owise] .

	op flattenThingTL : TermList Qid -> TermList .
	eq flattenThingTL(empty,opid) = empty .
	eq flattenThingTL(opid[tl],opid) = flattenThingTL(tl,opid) .
	eq flattenThingTL((netl0,netl1),opid) =
	   (flattenThingTL(netl0,opid), flattenThingTL(netl1,opid)) .
	eq flattenThingTL(tl,opid) = tl [owise] . **** tl will be a singleton non opid

	op thingTL2label : TermList String -> String .
	op thingTL2labels : TermList StringList -> StringList .
	eq thingTL2label(tl,sepchar) = 
	     strL2str(lexSortStringL(thingTL2labels(tl,nil)),sepchar) .
	eq thingTL2labels(empty,strl) = strl .
	eq thingTL2labels((t,tl),strl) = thingTL2labels(tl,(strl thingT2label(t))) . 

  op thingSoup2label : Term -> String .
	eq thingSoup2label(tsoupT) = thingTL2label(flattenThingTL(tsoupT,'__),",") .


***(
Modification is
  constant
  op[site]
site is '__[aa,n] or constant
)
  op modsT2modTL : Term TermList -> TermList .
  op modsTL2modTL : TermList TermList -> TermList .
  eq modsT2modTL('__[tl],tl1) = modsTL2modTL(tl,tl1) .
  eq modsT2modTL(t,tl) = (t,tl) [owise] .
  eq modsTL2modTL(empty,tl) = tl .
  eq modsTL2modTL((t,tl),tl1) = modsTL2modTL(tl,modsT2modTL(t,tl1)) .

  op modsT2suffix : Term -> String .
  eq modsT2suffix(msT) = 
     strL2suffix(lexSortStringL(modTL2labels(modsT2modTL(msT,empty),nil)),
              modsepchar,"") .

  op modTL2labels : TermList StringList -> StringList .
  eq modTL2labels(empty,strl) = strl .
  eq modTL2labels((t,tl),strl) = modTL2labels(tl,(strl modT2label(t))) .

  op modT2label : Term -> String .
  eq modT2label(m:Constant) = string(getName(m:Constant)) .
**** 17jan04 to export symbolic rules
  eq modT2label(v:Variable) =   "?" + string(getName(v:Variable))
                         + "::" + string(getType(v:Variable))  .
**** sitemod
  ceq modT2label(opid[c:Constant]) =
       string(opid) + sitesepchar + string(getName(c:Constant)) 
    if opid =/= 'not	 .
  ceq modT2label(opid['__[aa:Constant,nT:Term]]) =
        string(opid) + sitesepchar 
        + string(getName(aa:Constant)) + string(downTerm(nT:Term,0),10)  
    if opid =/= 'not	 .
****16apr09
  eq modT2label('not[t]) =  notchar + modT2label(t) .
  op notchar : -> String .
  eq notchar = "not#" .

  eq modT2label(t) = "???" + prntTerm(t) [owise] .

****16apr09
***(
  op modTL2mnames : TermList StringList -> StringList .
  eq modTL2mnames(empty,strl) = strl .
  eq modTL2mnames((t,tl),strl) =
              modTL2mnames(tl,(strl modT2mname(t,modT2label(t)))) .


  op siteModTemplate : -> String .
  eq siteModTemplate = "(array java.lang.String %name %op %site)" .
  op modT2mname : Term String -> String .
  eq modT2mname(m:Constant,name:String) = squote(string(getName(m:Constant))) .
**** sitemods
  ceq modT2mname(opid[site:Constant],name:String) =
     fillTemplate(siteModTemplate,bindings)
   if  bindings := (("%name" :~ squote(name:String)),
                    ("%op" :~ squote(string(opid))),
                    ("%site" :~ squote(string(getName(site:Constant)))) ) .
  ceq modT2mname(opid['__[aa:Constant,nT]],name:String) =
     fillTemplate(siteModTemplate,bindings)
   if  bindings := (("%name" :~ squote(name:String)),
                    ("%op" :~ squote(string(getName(aa:Constant))
                                     + string(opid))),
                    ("%site" :~ squote(string(downTerm(nT:Term,0),10))) ) .
  eq modT2mname(t,name:String) = squote(name:String) .
)
**** From PL-PRINT -- renamed
  op prntOpTerm : Qid TermList -> String .
  op prntTerm : Term -> String .
  op prntTermList : TermList -> String .

  eq prntOpTerm(op:Qid, tl) = 
       string(op:Qid) + "(" + prntTermList(tl) + ")" .

  eq prntTerm(t) =
        (if (t :: Variable) 
         then "?" + string(getName(t))
         else (if (t :: Constant)
               then  string(getName(t))
               else prntOpTerm(getOp(t),getArgs(t))
               fi ) fi ) .

  eq prntTermList(empty) =  "" .
                
  eq prntTermList((t,tl)) =
      prntTerm(t) + (if tl == empty then "" else "," + prntTermList(tl) fi) . 


***** from original PL-PRINT
**** printing rule ids
**** print  up to first dot in ddd, or all if no dot
****  op printRid : Qid -> String .
  eq printRid(rid) =
       (if (find(string(rid) , ".",0) :: Nat) 
        then substr(string(rid) ,0,find(string(rid) , ".",0))  
        else string(rid) fi) .

****  op PNRidSuffix : -> String .
  eq PNRidSuffix = "#" .

**** ridT has form ''ddd.Qid  maybe ddd has no dot
**** print  up to first dot in ddd, or all if no dot
**** if PNRidSuffix occurs, then what follows is rule instance index n
**** add -n to printed id
****  op printRidT : Term -> String .
  ceq printRidT(ridT) =
       prn + sfx     
  if rn := string(getName(ridT)) 
  /\ res := find(rn, ".", 0) 
  /\ res1 := rfind(rn, PNRidSuffix, length(rn)) 
  /\ prn := substr(rn, 1, 
                   ( if res :: NzNat then sd(res,1) else
                   (if res1 :: NzNat then sd(res1,1) else length(rn) fi)fi))
  /\ res1 := rfind(rn, PNRidSuffix, length(rn)) 
  /\ sfx := (if res1 :: Nat
             then "-" + substr(rn,s res1, length(rn)) 
             else "" fi) .

**** print the full id (just drop the single quote)
****  op printRidTAll : Term -> String .
  eq printRidTAll(ridT) = 
       substr(string(getName(ridT)), 1,length(string(getName(ridT)))) .

****  op printRidTL : TermList -> String .
  eq printRidTL(empty) = "" .
  eq printRidTL((ridT, tl)) = printRidTAll(ridT) + " " + printRidTL(tl) .

*** turning occs into strings
*** module must include DISH-OPS  (define Occ, Loc)

****  op printOccTL : Module TermList -> String .
  eq printOccTL(mod,empty) = "" .
  eq printOccTL(mod,(occT,occTL)) = 
       occ2label(mod,occT) + " " + printOccTL(mod,occTL) .


**** prints occ as  thing - loc
****  op occ2label : Module Term -> String .
  eq occ2label(mod, occT) = occT2chatty(occT) .

**** prints occ without loc
****  op occ2labelx : Module Term -> String .
  eq occ2labelx(mod, occT) = thingT2label(occT)
        (if isOccT(occT) then thingT2label(occT2thT(occT)) else "" fi) .

**** prints location name -- assume constants, ow print as "?"
****  op printLoc : Module Term -> String .
  eq printLoc(mod,t) = locT2label(t) .
  eq printThing(mod,t) = thingT2label(t) .


***(
  op stringT2String : Term -> String .
  eq stringT2String(t) = 
     if (t :: Constant) and getType(t) == 'String
     then substr(string(getName(t)),1,sd(length(string(getName(t))),2))
     else "" fi .
)

endfm

fmod PL-PRINT-TEST is 
  inc PL-PRINT .
  ops m1T Y123T m2T lT  egfT egfRT cplxT oT ocT : -> Term .
  eq m1T = 'phos.AAMOD .
  eq Y123T = '__['Y.AminoAcid,'s_^123['0.Zero]] . 
  eq m2T = 'phos['__['Y.AminoAcid,'s_^123['0.Zero]]] .
  eq lT = 'CLm.LocName .
  eq egfT = 'Egf.BProtein .
  eq egfRT = '`[_-_`]['EgfR.BProtein,'__['Yphos.AAMOD,'Sphos.AAMOD]] .
  eq cplxT = '_:_[egfT,egfRT] .
  eq oT = '<_`,_>[egfRT,lT] .
  eq ocT = '<_`,_>[cplxT,lT] .

endfm

***( 

red modT2label(m1T) .
red site2label(Y123T) .
red modT2label(m2T) .
red locT2label(lT) .
red thingT2label(egfT) .
red thingT2label(egfRT) .
red thingT2label(cplxT) .
red occT2chatty(oT) .
red occT2chatty(ocT) .

)
