/*
** ARexx REPL
** © 2021 Carl Svensson
** $VER: 1.2
**
** This program is free software: you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation, either version 3 of the License, or
** (at your option) any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program. If not, see .
*/
/** Handle breaks (ctrl-c, ctrl-d, etc.) */
signal on break_c
signal on break_d
signal on break_e
signal on break_f
/*
** Immediate mode will execute a code buffer directly after
** it's been entered. This is disabled by default.
*/
__repl.immediate = 0
/** Parse command line arguments */
arg arg1
if arg1 == "?" then do
options prompt "IMMEDIATE/S: "
pull arg1
end
/** Set immediate mode depending on arg1 */
select
when arg1 == "IMMEDIATE" then __repl.immediate = 1
when arg1 == "" then __repl.immediate = 0
otherwise do
say "unknown argument"
exit;
end
end
drop arg1
/** Prompt setup */
__repl.def_prompt = "» "
__repl.buf_prompt = "] "
__repl.prompt = __repl.def_prompt
/** Other arexx keywords */
__repl.kw_rexx = " ADDRESS CALL DROP ECHO INTERPRET NOP NUMERIC OPTIONS ",
" PARSE PULL PUSH QUEUE SAY SHELL SIGNAL TRACE UPPER IF "
/*
** Internal Keywords
** For handling buffers:
** .lbuf ............ list buffers
** .dbuf ............ delete buffers
** .ebuf ........ execute buffer
** .pbuf ........ print buffer
** .mode ... toggle immediate mode ON or OFF."
** Others:
** .gpl3 ............ show GPL info
** exit ............. Exit REPL
** cls, clear ....... Clear screen
*/
__repl.kw_internal = " .LBUF .DBUF .EBUF .PBUF .GPL3 .MODE EXIT CLEAR CLS "
/** Invalid var names to avoid confusion in REPL */
__repl.vn_invalid = __repl.kw_rexx || __repl.kw_internal || " DO SELECT "
/** initialise current buffer to add to */
__repl.buf = ""
/** will be set to 1 if in buffer mode */
__repl.inbuf = 0
/** contains previous successfully executed (saved) buffers */
__repl.bufs.count = 0
/** Let's get going! */
say "== ARexx REPL "__repl_get_ver()" © 2021 Carl Svensson =="
call __repl_mode()
say "Use 'exit' to quit."
say "Use '?' for help."
say "Use 'clear' or 'cls' to clear screen."
say "Use '.gpl3' for licensing information."
call __repl_out_gpl()
signal __repl__main
exit;
__repl__main:
signal on syntax
do forever /** Main loop. */
/** Set the prompt for parse pull. */
options prompt __repl.prompt
/** Read user input. */
parse pull __repl.inp
if __repl.inp == "?" then do
call __repl_show_help()
iterate;
end
__repl.kwcheck = upper(subword(__repl.inp, 1, 1))
if right(__repl.kwcheck, 1) == ":" then do
say "Labels not allowed."
__repl.inp = ""
iterate;
end
/** Handle REPL-specific keywords */
if pos(" "__repl.kwcheck" ", __repl.kw_internal) > 0 & ~__repl.inbuf
then do
__repl.arg2 = subword(__repl.inp, 2, 1)
select
when __repl.kwcheck == ".MODE" then
call __repl_mode(__repl.arg2)
when __repl.kwcheck == ".PBUF" then
call __repl_buf_print(__repl.arg2)
when __repl.kwcheck == ".DBUF" then
call __repl_buf_del()
when __repl.kwcheck == ".EBUF" then
call __repl_buf_exec(__repl.arg2)
when __repl.kwcheck == ".LBUF" then
call __repl_buf_list()
when __repl.kwcheck == ".GPL3" then
call __repl_show_license()
when __repl.kwcheck == "EXIT" then
exit
when __repl.kwcheck == "CLEAR" then
echo d2c(12)
when __repl.kwcheck == "CLS" then
echo d2c(12)
otherwise nop
end
iterate;
end
/** == Buffer mode == */
__repl.wordcount = words(__repl.inp)
__repl.lkwcheck = ""
if(__repl.wordcount > 0) then do
__repl.lkwcheck = upper(subword(__repl.inp, __repl.wordcount, 1))
end
/*
** If we're not already in buffer mode, check if the line initiates
** buffer mode.
** - Lines beginning with "DO" or "SELECT" initiates buffer mode.
** - Lines ending with "DO" initiates buffer mode.
*/
if (__repl.kwcheck == "DO" |,
__repl.lkwcheck == "DO" |,
__repl.kwcheck == "SELECT") & ~__repl.inbuf
then do
if ~__repl_is_multi_statement(__repl.inp) then do
__repl.inbuf = 1
__repl.prompt = __repl.buf_prompt
end
end
if __repl.inbuf == 1 & length(__repl.inp) == 0 then do
/** Terminate buffer mode on blank line input */
__repl.inp = __repl.buf
__repl.buf = ""
__repl.inbuf = 0
__repl.prompt = __repl.def_prompt
__repltmpbufcount = __repl.bufs.count + 1
__repl.bufs.__repltmpbufcount = __repl.inp
__repl.bufs.count = __repltmpbufcount
say "(Buffer "__repltmpbufcount")"
if __repl.immediate then do
/** Execute buffer at once if in immediate mode. */
interpret __repl.bufs.__repltmpbufcount
end
iterate;
end
if __repl.inbuf then do
/** In buffer mode - append to current buffer */
if length(__repl.buf) > 0 then do
__repl.buf = __repl.buf || d2c(10) || __repl.inp
end
else do
__repl.buf = __repl.inp
end
iterate;
end
/** == Normal mode == */
/** Passthrough for various instructions */
if pos(" "upper(subword(__repl.inp, 1, 1))" ", __repl.kw_rexx) > 0 then do
interpret __repl.inp
iterate;
end
if symbol(__repl.inp) == "VAR" then do
/** Expression evaluates to variable - print its value. */
interpret "say "__repl.inp
iterate;
end
if length(__repl.inp) < 1 then do
/** No input */
iterate;
end
if __repl_is_multi_statement(__repl.inp) then do
/** Multi statement, E.G. 'a=12; b=3; say a>b' */
interpret __repl.inp
iterate;
end
if pos("=",__repl.inp) > 0 then do
/** Variable assignment or logical comparison */
parse var __repl.inp __repl._l"="__repl._r
__repl._var = strip(__repl._l)
__repl._rest = strip(__repl._r)
/** Check for "not equals" */
__repl._ng = pos("~", __repl._var)
/** Check for comparison */
__repl._eq = pos("=", __repl._rest)
if __repl._ng == length(__repl._var) | __repl._eq == 1 then do
/** Logical comparison. Eval and print. */
interpret "say "__repl.inp
end
else if datatype(__repl._var) == "CHAR" then do
/** Variable assignment. */
__repl._varc = upper(" "__repl._var" ")
if pos(__repl._varc, __repl.vn_invalid) > 0
then do
say "Illegal variable name '"__repl._var"'."
iterate;
end
/** Eval assignment. */
interpret __repl.inp
/** Print the resulting variable value (if any). */
if symbol(__repl._var) == "VAR" then do
interpret "say "__repl._var
end
end
iterate;
end
/** Normal eval + print. */
interpret "say "__repl.inp
end /** Main loop. */
exit;
syntax:
/** Syntax error encountered! */
/** Reset address to default */
address REXX
/** Print information abot the offending code. */
if " interpret __repl.bufs.__repl_bufnum" == sourceline(sigl) then do
say " Syntax Error In Buffer: "
say "==============================="
call __repl_buf_print(__repl.arg2)
end
else if pos(" interpret ", sourceline(sigl)) > 0 then do
say " Syntax Error In Input: "
say "==============================="
say __repl.inp
end
else do
say "Syntax Error (Unknown Source): "
end
say "==============================="
/** Continue the REPL */
signal __repl__main
exit;
__repl_show_help: procedure expose __repl.
say "== GENERAL USAGE =="
say " Use 'exit' to quit."
say " Use '?' for help."
say " Use 'clear' or 'cls' to clear screen."
say " Use '.gpl3' for licensing information."
say ""
say "== REPL USAGE =="
say " Assign the value 4096 to the variable MyVar:"
say " » MyVar = 4096"
say " 4096"
say " Print datatype of MyVar:"
say " » Datatype(MyVar)"
say " NUM"
say " Use eqeq (==) for comparisons:"
say " » MyVar == 4095"
say " 0"
say ""
say "== BUFFERS =="
say " Buffers are opened using blocks, for example 'do', 'select',"
say " 'do forever', 'if x then do'. Buffers are closed with a blank line."
say " When immediate mode is on, buffers will be executed as soon as they"
say " are closed, otherwise only when called with the .ebuf command."
say " Buffer management commands:"
say " .lbuf ............ list buffers"
say " .dbuf ............ delete buffers"
say " .ebuf ........ execute buffer "
say " .pbuf ........ print buffer "
say " .mode [ON|OFF] ... toggle or display status of immediate mode."
return;
__repl_buf_list: procedure expose __repl.
if __repl.bufs.count < 1 then
say "No buffers available."
else do i = 1 to __repl.bufs.count
endl = pos(d2c(10), __repl.bufs.i)
if endl = 0 then do
endl = length(__repl.bufs.i) + 1
end
say i") [ "substr(__repl.bufs.i, 1, endl-1)" ]"
end
return;
__repl_buf_del: procedure expose __repl.
if __repl.bufs.count < 1 then
say "No buffers available."
else do
do i = 1 to __repl.bufs.count
__repl.bufs.i = ""
end
__repl.bufs.count = 0
say "All buffers cleared."
end
return;
__repl_buf_exec:
/** Cannot be procedure in order to keep REPL scope! */
arg __repl_bufnum
if __repl_check_valid_buf(__repl_bufnum, __repl.bufs.count) then do
interpret __repl.bufs.__repl_bufnum
end
return;
__repl_buf_print: procedure expose __repl.
arg bufnum
if __repl_check_valid_buf(bufnum, __repl.bufs.count) then
say __repl.bufs.bufnum
return;
__repl_check_valid_buf: procedure
arg bufnum, bufc
success = 0
select
when bufc == 0 then say "No buffers available."
when bufnum == "" then say "No buffer supplied."
when datatype(bufnum) ~= "NUM" then say "Buffer indexes must be numeric."
when bufnum < 1 then say "Min buffer index is 1."
when bufnum > bufc then say "Max buffer index is "bufc"."
otherwise success = 1
end
return success;
__repl_mode:
arg toggle
select
when toggle == "ON" then __repl.immediate = 1
when toggle == "OFF" then __repl.immediate = 0
otherwise nop
end
if __repl.immediate then
say "Immediate mode is ON"
else
say "Immediate mode is OFF"
return;
__repl_is_multi_statement: procedure
/*
** Returns 1 if the supplied string is a multi statement
** (several statements separated by semicolons), otherwise 0.
** Handles comments plus single- and double quoted strings.
** This is quite slow. Optimize how?
*/
arg str
in_double = 0
in_single = 0
commcount = 0
/** Trim possible leading and trailing semicolons */
if substr(str, length(str), 1) == ";" then
str = delstr(str, length(str), 1)
if substr(str, 1, 1) == ";" then
str = delstr(str, 1, 1)
if pos(";", str) == 0 then
return 0
/** Chars significant for parsing */
chrs = '"'||"';/*"
l = length(str)
do p = 1 to l
cc = substr(str, p, 1)
/** Not a significant char -- skip! */
if pos(cc, chrs) == 0 then
iterate;
if commcount > 0 then do
if cc == '*' then do
/** Peek next char (for comment parsing) */
nc = substr(str, p+1, 1)
if nc == '/' then
commcount = commcount - 1
end
iterate;
end
if in_single then do
if cc == "'" then
in_single = 0
iterate;
end
if in_double then do
if cc == '"' then
in_double = 0
iterate;
end
if cc == ';' then
return 1; /** Multi statement encountered */
if cc == "'" then do
in_single = 1
iterate;
end
if cc == '"' then do
in_double = 1
iterate;
end
if cc == '/' then do
/** Peek next char (for comment parsing) */
nc = substr(str, p+1, 1)
if nc == '*' then do
commcount = commcount + 1
iterate;
end
end
end
return 0;
__repl_out_gpl:
say "This program comes with ABSOLUTELY NO WARRANTY and is"
say "free software, and you are welcome to redistribute it"
say "under certain conditions; type '.gpl3' for details."
return;
__repl_show_license: procedure
say "ARexx REPL "__repl_get_ver()" © 2021 Carl Svensson"
say "==============================="
do i = 6 to 17
say(substr(sourceline(i), 4))
end
return;
__repl_get_ver: procedure
sl = sourceline(4)
parse var sl '** $VER: 'progver
return progver;
break_c: break_d: break_e: break_f:
say "Aborted."
exit;