/* ** 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;