sys sttw 'word position
sys ascb 'word ascii code actual
sys ascw 'word ascii code presented
sys lenw 'word length
sys opw 'operator token
function instrword(sys i,string s,k) as sys
===========================================
sys lk=len k,lb,rb
byte b at strptr(s)
if not k then return 0
if i=0 then i=1
do
i=instr(i,s,k)
if i=0 then
return 0
end if
lb=i-1
rb=i+lk
if b[rb]<33 then
if i=1 or b[lb]<33
return i
end if
end if
i+=lk
end do
end function
function lookupindex(string s,k) as sys
=======================================
sys a
a=instrword(1,s,k)
if a then
return valat a+len(k)+strptr s
end if
end function
function instrb(byte*bb,*bk) as sys
===================================
sys b
do
b=bb
select bk
case 0 : return 1
case b : 'match chars
case else : return 0
end select
@bk++
@bb++
end do
end function
function instrev(sys i,string s,k) as sys
=========================================
sys a=asc k
sys lk=len k
sys ls=len s
if i=0 then
i=ls
elseif i>ls then
i=ls
end if
byte b at strptr s
byte c at strptr k
do
if i<1 then exit do
select b[i]
case a : if instrb(b[i],c) then exit do
end select
i--
end do
return i
end function
'DEFAULT EQUATES
================
%% SymbolTerm 40,41
%% SymbolQuote 34,39,96
%% SymbolComment 59
%% SymbolEndLine 13,10,11,12
%% SymbolEndState 41
function skipspace(string s, sys*i)
===================================
byte b at strptr s
do
ascb=b[i]
ascw=ascb
select ascb
case 0 : exit do
case SymbolEndState : ascw=0 : exit do
case 33 to 255 : : exit do
end select
i++
end do
end function
function skiplspace(string s, sys*i)
====================================
byte b at strptr s
do
ascb=b[i]
ascw=ascb
select ascb
case 0 : exit do
case SymbolEndLine : exit do
case SymbolEndState : ascw=0 : exit do
case 33 to 255 : exit do
end select
i++
end do
end function
function endline(string s, sys*i)
=================================
byte b at strptr s
do
select b[i]
case 0 : exit do
case SymbolEndLine : exit do
end select
i++
end do
end function
function nextline(string s, sys*i)
==================================
byte b at strptr s
do
select b[i]
case 0 : exit do 'END OF STRING
case 10,11,12 : i++ : exit do
case 13 : i++
if b[i]=10 then i++
exit do
case else : i++
end select
end do
end function
macro posword(s,i)
==================
byte b at strptr s
'
rwordpos:
'
skipspace s,i
sttw=i
select ascb 'FIRST CHAR
case SymbolTerm
i++ : jmp fwd nwordpos 'normally brackets ( )
case 0
jmp fwd nwordpos 'END
case SymbolQuote
do
i++
select b[i]
case 0 : jmp fwd nwordpos
case ascw : i++ : jmp fwd nwordpos
end select
end do
jmp fwd nwordpos
case SymbolComment
endline(s,i) : jmp rwordpos ' ; comment ;
case 255
i++ : opw=b[i] : i++ : jmp fwd nwordpos 'EMBEDDED TOKEN
end select
do 'MOVE TO WORD BOUNDARY
select b[i]
case 0 to 32
exit do
case SymbolTerm
exit do
case SymbolQuote
exit do
case SymbolComment
exit do
case 255
exit do ' embedded token marker
end select
i++
end do
nwordpos:
lenw=i-sttw
end macro
function stepword(string s,sys*i) as sys
========================================
posword(s,i)
end function
function getword(string s, sys*i) as string
===========================================
posword(s,i)
return mid s,sttw,lenw
end function
function maygetword(string s, sys*i) as string
==============================================
skiplspace s,i
if ascb>32 then return mid s,sttw,lenw
end function
function isnumber() as sys
==========================
select ascb
case 47
case 45 to 57 :return -1
end select
end function
function isalpha() as sys
=========================
select ascb
case 0x41 to 0x5a : return -1
case 0x61 to 0x7a : return -1
case "_" : return -1
end select
end function
function stepitem(string sr, sys*i)
===================================
string wr
sys bc
stepword(sr,i)
if ascw<>40 then return 'skip the word only
'otherwiwise skip block including any nested blocks
bc++
do 'STEP OVER NESTED BRACKETS
stepword(sr,i)
select ascw
case 0 :
if ascb = 41 then
if bc <= 0 then exit do
bc--
else
exit do
end if
case 40 : bc++
case 41 : bc--
end select
if bc=0 then exit do
end do
end function
function getitem(string sr, sys*i) as string
============================================
sys b,c
skipspace(sr,i)
b=i
c=ascw
stepitem(sr,i)
sttw=b
ascw=c
return mid sr, b, i-b
end function
function unquote(string s) as string
====================================
ascw=asc s
select ascw
case SymbolQuote :
if asc(s,-1)=ascw then
ascw=asc s,2
return mid s, 2, len(s)-2
end if
end select
return s
end function
function inner(string s) as string
==================================
sys i=1, le
'EFFECTIVE LEFT TRIM
skipspace(s,i)
'EFFECTIVE RIGHT TRIM
le=len(s)
byte b at le+strptr s
le=le-i+1
do
if le<=0 then exit do
@b--
if b>32 then exit do
le--
end do
le-=2
i++
if le>0 then return mid s,i,le
end function