一年ほど前逆ポーランドの解説用に適当に作ったHSP3のサンプルですが
ActiveBasicではスタックなども楽に扱えそうなので参考になれば幸いです。
コード:
;==============================================================================
sdim Sinp
screen 0,320,200
ss="" :objsize 40,19
pos 10,10 :input Sinp,260,20 :pos 270,09 :button "CALC",*Scalc
pos 10,30 :input ss ,260,20 :pos 10,50 :input ss ,260,20
stop
;------------------------------------------------------------------------------
*Scalc
gosub *Chrpn :ss=""
foreach Sout :if Sout(cnt) != "" {ss+=Sout(cnt)+" "} :loop :objprm 2,ss
gosub *Rcalc :ss=str(double(refstr))
if ss == "9999999999.999998" {ss="[0] 除算"} :objprm 3,ss
stop
;==============================================================================
*Chrpn
sdim Sout :dim pn :sdim Stak :dim sn :sdim Tken :dim pp :jj=0 :sw=0
repeat strlen(Sinp)
ss=strmid(Sinp,cnt,1) :ii=peek(ss,0)
if (ii == 46) | ((ii >= 48) & (ii <= 57)) {
Tken(jj )+=ss :sw=0}
else {if ss != " " {if sw=0 {Tken(jj+1) =ss :jj+=2 :sw=1}
else {Tken(jj ) =ss :jj++ :sw=1}}}
loop
foreach Tken
ss=Tken(cnt) :gosub *Ckpri :pp(0)=stat:
switch pp(0)
case 5 :Sout(pn)=Tken(cnt) :pn++ :swbreak
case 2 :Stak(sn)=Tken(cnt) :sn++ :swbreak
case 1 :if sn == 0 {break}
For jj,sn-1,-1,-1
if Stak(jj) == "(" {_break}
Sout(pn)=Stak(jj) :Stak(jj)="" :pn++ :sn-- :next
:Stak(jj)="" :sn-- :swbreak
default :sw=0
For jj,sn-1,-1,-1
if (sn == 0) | (sw == 1) {_break}
ss=Tken(cnt) :gosub *Ckpri :pp(1)=stat
ss=Stak(jj ) :gosub *Ckpri :pp(2)=stat
if (pp(1) > pp(2)){sw=1}
else {Sout(pn)=Stak(jj) :pn++
Stak(jj)="" :sn--}:next
sn++:Stak(sn)=Tken(cnt) :sn++ :swbreak
swend
loop
repeat sn-1 :Sout(pn+cnt+1)=Stak(((sn-1)-cnt)) :loop
return
;------------------------------------------------------------------------------
*Ckpri
switch peek(ss,0)
case 46 : ;.
case 48 :case 49 :case 50 :case 51 :case 52
case 53 :case 54 :case 55 :case 56 :case 57 :kk=5 :swbreak ;0-9
case 42 :case 47 :kk=4 :swbreak ;*/
case 43 :case 45 :kk=3 :swbreak ;+/
case 40 :kk=2 :swbreak ;(
case 41 :kk=1 :swbreak ;)
default :kk=0
swend
return kk
;------------------------------------------------------------------------------
*Rcalc
foreach Sout
ss=Sout(cnt)
switch ss
case "*"
gosub *Pop
Sout(cnt-ii)=str(double(Sout(cnt-ii))*double(Sout(cnt-jj)))
Sout(cnt )="" :Sout(cnt-jj)="" :swbreak
case "/"
gosub *Pop
if double(Sout(cnt-jj)) == 0 {
Sout(0)="9999999999.999998" :break}
Sout(cnt-ii)=str(double(Sout(cnt-ii))/double(Sout(cnt-jj)))
Sout(cnt )="" :Sout(cnt-jj)="" :swbreak
case "+"
gosub *Pop
Sout(cnt-ii)=str(double(Sout(cnt-ii))+double(Sout(cnt-jj)))
Sout(cnt )="" :Sout(cnt-jj)="" :swbreak
case "-"
gosub*Pop
Sout(cnt-ii)=str(double(Sout(cnt-ii))-double(Sout(cnt-jj)))
Sout(cnt )="" :Sout(cnt-jj)="" :swbreak
default
swend
loop
return str(double(Sout(0)))
*Pop
for ii,1 ,cnt+1 :if Sout(cnt-ii) != "" {_break} :next :jj=ii
for ii,jj+1,cnt+1 :if Sout(cnt-ii) != "" {_break} :next
return