RosettaCodeData/Task/Abbreviations-simple/M2000-Interpreter/abbreviations-simple-2.m2000
2023-07-01 13:44:08 -04:00

66 lines
1.9 KiB
Text

Module Abbreviations_Simple_2 {
Function Lex$ {
a$={add 1 alter 3 backup 2 bottom 1 Cappend 2 change 1 Schange Cinsert 2 Clast 3
compress 4 copy 2 count 3 Coverlay 3 cursor 3 delete 3 Cdelete 2 down 1 duplicate
3 xEdit 1 expand 3 extract 3 find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2
forward 2 get help 1 hexType 4 input 1 powerInput 3 join 1 split 2 spltJOIN load
locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2 macro merge 2 modify 3 move 2
msg next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit read recover 3
refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left
2 save set shift 2 si sort sos stack 3 status 4 top transfer 3 type 1 up 1
}
const crlftab$={
}+chr$(9)
Lex$=""
Word$=""
dim part$()
part$()=piece$(trim$(filter$(a$, crlftab$)), " ")
for i=0 to len(part$())-1
if part$(i)<>"" then
k=val(part$(i))
if k=0 then
if Word$<>"" then Lex$+="#"+Word$+" 0"
Word$=ucase$(part$(i))
else
Lex$+="#"+ Word$+str$(k)
word$=""
end if
end if
next i
if Word$<>"" then Lex$+="#"+Word$+" 0"
=Lex$
}
Parse$=Lambda$ Lex$=Lex$() (a$) -> {
Dim part$()
Rep$=""
part$()=piece$(a$," ")
if len(part$())=0 then exit
for i=0 to len(part$())-1
if part$(i)<>"" then
j=1
do
j=instr(Lex$, "#"+ucase$(part$(i)), j)
if j=0 then exit
q=instr(Lex$, " ", j+1)
if Val(Mid$(lex$, q,10))=0 then
if Mid$(Lex$, j+1, q-j)=ucase$(part$(i))+" " then exit
else.if len(part$(i))>=Val(Mid$(lex$, q,10)) then
exit
end if
j++
Always
if j>0 then
Rep$+=if$(Rep$=""->"", " ")+Mid$(Lex$, j+1, q-j-1)
else
Rep$+=if$(Rep$=""->"", " ")+"*error*"
end if
end if
next i
=Rep$
}
Print Parse$("riG rePEAT copies put mo rest types fup. 6 poweRin")
Print Parse$("riG macro copies macr")
Print Parse$("")=""
}
Abbreviations_Simple_2