zOs/REXX/COMP
/* copy comp begin ****************************************************
the shell compiler
syntax and semantics of the shell language see javaDoc
**********************************************************************/
/***** initialisation ************************************************/
/*--- module initialisation -----------------------------------------*/
compIni: procedure expose m.
if m.compIni = 1 then
return
m.compIni = 1
call pipeIni
call scanReadIni
cc = classNew('n Compiler u')
call mNewArea 'COMP.AST', '='
m.comp_chOp = '.-<@|?%^'
m.comp_chKind = '.-=#@:%^'
m.comp_chKindDesc = 'Obj Str Skel Text Exe Wsh Call Fun'
m.comp_chKiNO = '=:#'
m.comp_chKiNBOE = '=<#:' /* nonBLock only expression not Primary*/
m.comp_chDol = '$'
m.comp_chSpa = m.ut_space
call mPut 'COMP_EXTYPE.b', m.comp_chDol'{}' /* braces */
call mPut 'COMP_EXTYPE.d', m.comp_chDol /* data */
call mPut 'COMP_EXTYPE.s', m.comp_chDol /* strip */
call mPut 'COMP_EXTYPE.w', m.comp_chDol||m.comp_chSpa /* word */
m.comp_idChars = m.ut_alfNum'@_'
m.comp_wCatC = 'compile'
m.comp_wCatS = 'do withNew with for forWith ct proc arg if else'
m.comp_astOps = m.comp_chOp'])&'
m.comp_astOut = '.-@<^' /*ast kind for call out */
m.comp_astStats = ''
return
endProcedure compIni
compKindDesc: procedure expose m.
parse arg ki
kx = pos(ki, m.comp_chKind)
if length(ki) == 1 & kx > > 0 then
return "kind"word(m.comp_chKindDesc, kx)"'"ki"'"
else
return "badKind'"ki"'"
endProcedure compKindDesc
/*--- constructor of Compiler ---------------------------------------*/
comp: procedure expose m.
parse arg src
nn = oNew('Compiler')
m.nn.cmpRdr = in2File(src)
return nn
endProcedure comp
/*--- compile one unit of the source with kind ki
and return oRunner with the code -------------------------*/
compile: procedure expose m.
parse arg m, ki, hook
s = m.m.scan
m.m.comp_assVars = 0
call compSpComment m
a = ''
if m.m.end \== '' then
call scanNlUntil s, '$#out'
else if ki == '*' then
call scanNlUntil s, '$#'
else
a = compUnit(m, ki, '$#')
if compIsEmpty(m, a, 0) then
return ''
cd = compAst2Rx(m, ']', a)
if 0 then
say cd
return oRunner(cd)
endProcedure compile
compBegin: procedure expose m.
parse arg m, spec
m.m.scan = m'.scan'
m.m.out = ''
m.m.end = ''
s = m.m.scan
if m.m.cmpRdr == '' then
call scanOpt scanSrc(s, spec), , '0123456789'
else
call scanReadOpen scanReadReset(scanOpt(s, , '0123456789'),
, m.m.cmpRdr), spec' '
return m
endProcedure compBegin
compEnd: procedure expose m.
parse arg m, erKi
s = m.m.scan
if erKi \== '' then
if \ scanEnd(s) then
return scanErr(s, 'wsh' compKindDesc(erKi),
"expected: compile stopped before end of input")
call scanClose s
return m
endProcedure compEnd
/*--- parse the whole syntax of a unit ------------------------------*/
compUnit: procedure expose m.
parse arg m, ki, stopper
s = m.m.scan
if pos(ki, m.comp_chKind) < 1 then
return scanErr(s, 'bad kind' ki 'in compUnit(...'stopper')')
else if ki <> '#' then do
a = compAst(m, '[')
do forever
one = compPipe(m, ki)
if one \== '' then
call mAdd a, one
if \ scanLit(m.m.scan, '$;', '<>', '$<>') then
return compUnNest(a)
end
end
else do
res = compAST(m, '[')
call scanChar s
if verify(m.s.tok, m.comp_chSpa) > 0 then
call mAdd res, compAst(m, '=', strip(m.s.tok, 't'))
do while scanNL(s, 1) & \ abbrev(m.s.src, stopper)
call mAdd res, compAst(m, '=', strip(m.s.src, 't'))
end
return res
end
endProcedure compUnit
compUnnest: procedure expose m.
parse arg a
do while m.a.0 = 1 & pos(m.a.kind, '[-.;') > 0
n = m.a.1
if m.a.kind \== m.n.kind then
return a
call mFree a
a = n
end
return a
endProcedure compUnnest
/*--- compile an expression, type d=data, b=block w=word, s=strip ---*/
compExpr: procedure expose m.
parse arg m, type, ki, textEnd
s = m.m.scan
if symbol('m.comp_exType.type') \== 'VAR' then
call err s, 'bad type' type 'in compExpr'
if ki == '#' then do
if textEnd == '' then
call scanChar(s)
else if textEnd <= m.s.pos then
return ''
else
call scanChar s, textEnd - m.s.pos
if type == 's' then
res = compAst(m, '=', strip(m.s.tok))
else
res = compAst(m, '=', , m.s.tok)
res = compAST(m, '-', , res)
m.res.containsC = 1
m.res.containsD = 1
return res
end
else if ki == '%' | ki == '^' then do
call compSpComment m
vr = compVar(m, left('c', ki == '^'))
if vr == '' then
return ''
if m.vr.var == 'c' then
res = compAst(m, 'M')
else
res = compAst(m, ki, , compASTAddOp(m, vr, '&'))
call compSpComment m
if textEnd == '' | textEnd < m.s.pos then do
ex = compOpBE(m, '=', 1, , textEnd)
if ex \== '' then do
call mAdd res, ex
call compSpComment m
end
end
m.res.containsC = 1
m.res.containsD = 1
return res
end
if length(ki) \== 1 | pos(ki, '.-=@') < 1 then
return scanErr(s, 'bad kind' ki 'in compExpr')
res = compAST(m, translate(ki, '-;', '=@'))
m.res.containsC = 0
txtKi = translate(ki, '++=+', '.-=@')
laPrim = 0
gotTxt = 0
if pos(type, 'sb') > 0 then
m.res.containsC = compSpComment(m) >= 2
do forever
if textEnd \== '' then
if m.s.pos >= textEnd then
leave
if scanVerify(s, m.comp_exType.type, 'm') then do
if textEnd \== '' then
if m.s.pos > textEnd then do
m.s.tok = left(m.s.tok, length(m.s.tok) ,
+ textEnd - m.s.pos)
m.s.pos = textEnd
end
one = compAST(m, txtKi, m.s.tok)
if verify(m.s.tok, m.comp_chSpa) > 0 then
gotTxt = 1
end
else do
old = scanPos(s)
if \ scanLit(s, m.comp_chDol) then
leave
if pos(scanLook(s, 1), '.-') > 0 then
one = compCheckNN(m, compOpBE(m, , 1, 0),
, 'primary block or expression expected')
else
one = compPrimary(m)
if one = '' then do
call scanBackPos s, old
leave
end
laPrim = m.res.0 + 1
end
call mAdd res, one
if compComment(m) then
m.res.containsC = 1
end
if pos(type, 'bs') > 0 then do
do rx=m.res.0 by -1 to laPrim+1
one = m.res.rx
m.one.text = strip(m.one.text, 't')
if length(m.one.text) <> 0 then
leave
call mFree one
end
m.res.0 = rx
end
m.res.containsD = laPrim > 0 | gotTxt
return compAstFree0(res, '')
endProcedure compExpr
/*--- compile a primary and return code -----------------------------*/
compPrimary: procedure expose m.
parse arg m, ops
s = m.m.scan
if scanString(s) then
return compASTAddOp(m, compAST(m, '=', m.s.val), ops)
r = compVar(m, left('c', right(ops, 1) == '^'))
if r == '' then
return ''
if m.r.var \== 'c' then
return compASTAddOp(m, compAst(m, '&', m.r.var, r), ops)
else
return compASTAddOp(m, compAst(m, 'M'),
, left(ops, length(ops)-1))
endProcedure compPrimary
/*--- oPBE ops (primary or block or expression)
oDef = default Kind, oPre = opPrefix,
uniq=1 extract unique, uniq='<' prefix <
withEx <> 0: expression allowed ------------------------------*/
compOpBE: procedure expose m.
parse arg m, oDef, uniq, withEx, textEnd
s = m.m.scan
old = scanPos(s)
op = compOpKind(m, oDef)
if uniq == '<' & left(op, 1) \== '<' then
op = left('<', uniq == '<') || op
if pos(scanLook(s, 1), '/[') > 0 then do
if uniq == 1 & length(op) == 1 then
if op == '.' then
op = '|.'
else if op == '=' then
op = '-='
else if pos(op, '-@<') > 0 then
op = op || op
return compBlock(m, op)
end
if compSpComment(m) == 0 ,
& pos(right(op, 1), m.comp_chKiNBOE) <= 0 then
return compPrimary(m, op)
if withEx \== 0 then do
res = compExpr(m, 's', right(op, 1), textEnd)
if res \== '' then
return compASTAddOp(m, res, left(op, length(op)-1))
end
call scanBackPos s, old
return ''
endProcedure compOPBE
/*--- compile var of ^or % clause -----------------------------------*/
compCallVar: procedure expose m.
parse arg m, ki
call compSpComment m
vr = compVar(m, left('c', ki == '^'))
if vr == '' then
call scanErr m.m.scan, 'var expected after' ki
call compSpComment m
if m.vr.var == 'c' then
return compAst(m, 'M')
else
return compAst(m, ki, , compASTAddOp(m, vr, '&'))
endProcedure compCallVar
/*--- compile a pipe and return code --------------------------------*/
compPipe: procedure expose m.
parse arg m, ki
s = m.m.scan
res = compAST(m, 'P', ' ', '', '')
do forever
one = compExprStmts(m, ki)
if one \== '' then do
if m.res.0 > 2 then
call scanErr s, '$| before statements needed'
call mAdd res, one
end
pre = left(m.comp_chDol, scanLit(s, m.comp_chDol))
if scanLook(s, 2) == '<>' then
leave
if scanLit(s, '<') then do
if m.res.2 == '' then
m.res.2 = compAst(m, '.')
else
call mAdd m.res.2, compAst(m, '+', ', ')
call mAdd m.res.2, compOpBE(m, '<', '<')
m.res.text = m.res.text'f'
end
else if scanLit(s, '>>', '>') then do
if m.res.1 <> '' then
call scanErr s, 'duplicate output'
m.res.text = if(m.s.tok == '>', 'F', 'A') ,
||substr(m.res.text, 2)
m.res.1 = compOpBE(m, '<', '<')
end
else if scanLit(s, '|') then do
if m.res.0 < 3 then
call scanErr s, 'stmts expected before |'
call compSpNlComment m
call mAdd res, compCheckNE(m, compExprStmts(m, ki),
, 'stmts or expressions after | expected')
end
else
leave
end
call scanBack s, pre
if m.res.0 > 3 | m.res.1 \== '' | m.res.2 \== '' then
return res
one = if(m.res.0 = 3, m.res.3)
call mFree res
return one
endProcedure compPipe
/*--- compile expressions and stmts ---------------------------------*/
compExprStmts: procedure expose m.
parse arg m, ki
s = m.m.scan
res = compAst(m, '[')
nlLe = 0 /* sophisticated logic using left and right NLs*/
do forever
one = compExprStm1(m, ki, nlLe)
if one == '' then
return compAstFree0(res)
call mAdd res, one
nlLe = scanNl(s)
end
endProcedure compExprStmts
/*--- scan over space comm nl until next
expression or statement and compile it --------------------*/
compExprStm1: procedure expose m.
parse arg m, ki, nlLe
s = m.m.scan
if pos(ki, ':%^') > 0 then do /* statements with $ are ok */
call compSpNlComment m, '*'
if ki \== ':' then do
one = compExpr(m, 's', ki)
if one \== '' then
return one
end
end
else if ki == '@' then do /* rexx statements */
call compSpNlComment m
one = compExpr(m, 's', ki)
if one\ == '' then do
if m.one.0 < 1 then
call scanErr s, 'assert not empty' m.one.0
do forever /* scan all continued rexx lines */
la = m.one.0
la = m.one.la
if m.la.kind \== '+' then
leave
m.la.text = strip(m.la.text, 't')
if right(m.la.text, 1) \== ',' then
leave
m.la.text = strip(left(m.la.text,
, length(m.la.text)-1), 't')' '
call compSpNlComment m
cont = compExpr(m, 's', '@')
if cont == '' | m.cont.kind \== m.one.kind then
call scanErr s, 'bad rexx continuation'
call mAddSt one, cont
call mFree cont
end
return compAstFree0(one)
end
end
else do /* statemens need $, nl logic for expr */
do forever /* tricky logic for empty lines */
do forever
sx = m.s.pos
call scanSpaceOnly s
if \ compComment(m) then
leave
nlLe = 0
end
m.s.pos = sx
one = compExpr(m, 'd', ki)
nlRi = scanNL(s, '?')
if one == '' then do
if nlLe & nlRi then
return compAst(m, translate(ki, ';-', '@=') ,
, ,compAst(m,'='))
end
else if m.one.containsD then
return one
if \ nlRi then
leave
nlLe = scanNL(s)
end
end
return compStmt(m, ki)
endProcedure compExprStm1
/*--- compile a single statement ------------------------------------*/
compStmt: procedure expose m.
parse arg m, ki
s = m.m.scan
res = compAss(m)
if res \== '' then
return res
pre = ''
old = scanPos(s)
if scanLit(s,m.comp_chDol'$',m.comp_chDol'@',m.comp_chDol,'@') then
pre = m.s.tok
if pre == m.comp_chDol'$' then
return compCheckNN(m, compOpBE(m,'=', 1),
, 'block or expression expected after $$')
if right(pre, 1) == '@' then do
one = compOpBE(m, '@')
if one \== '' then
return compAstAddOp(m, one, ')')
end
wCat = compName(m, 'sv')
fu = m.s.tok
if right(pre, 1) == '@' & wCat \== 's' then
call scanErr s, 'primary, block or expression expected'
if fu == 'arg' then do
res = compAst(m, 'R')
do forever
call compSpComment m
if scanLit(s, ',') then
a1 = compAst(m, '+', ',')
else do
gotV = 1
a1 = compVar(m, 'v')
end
if a1 \== '' then
call mAdd res, a1
else if gotV == 1 then
return res
else
call scanErr s, 'empty arg'
end
end
if fu == 'ct' then do
call compSpComment m
return compAst(m, 'C', , compCheckNN(m, compExprStm1(m, ki, 0),
, 'ct statement'))
end
if fu == 'do' then do
call compSpComment m
pre = compExpr(m, 's', '@')
res = compAst(m, 'D', , pre)
p1 = m.pre.1
if pre \== '' then do
txt = ''
do px=1 to m.pre.0
pC = m.pre.px
if m.pC.kind \== '+' then
leave
txt = txt m.pC.text
cx = pos('=', txt)
if cx > 0 then do
m.res.text = strip(left(txt, cx-1))
leave
end
end
end
call compSpComment m
call mAdd res, compCheckNN(m, compExprStm1(m, ki, 0),
, 'stmt after do')
return res
end
if wordPos(fu, 'for forWith with') > 0 then do
res = compAst(m, 'F', fu)
call compSpComment m
if fu \== 'with' then do
b = compVar(m)
end
else do
b = compAss(m)
if b == '' then
b = compCheckNE(m, compExpr(m, 's', '.'),
, "assignment or expression after with")
end
call compSpComment m
st = compCheckNN(m, compExprStm1(m, ki, 0),
, "var? statement after" fu)
if b = '' then do
b = compBlockName(m, st)
if b \== '' then
b = compAst(m, '=', b)
else if \ abbrev(fu, 'for') then
call scanErr s, "variable or named block after" fu
end
call mAdd res, b, st
return res
end
if fu == 'withNew' then do
oldVars = m.m.comp_assVars
m.m.comp_assVars = ''
one = compCheckNN(m, compExprStm1(m, ki, 0), 'after withNew')
r = compAst(m, 'F', 'withNew', '', one,
, compAst(m, '*', '].'))
m.r.class = classNew('n* CompTable u' ,
substr(m.m.comp_assVars, 3))
m.r.1 = compAst(m, '.', ,
, compAst(m, '+', "oNew('"m.r.class"')"))
m.m.comp_assVars = oldVars
return r
end
if fu == 'proc' then do
call compSpComment m
nm = ''
if compName(m, 'v') == 'v' then do
nm = m.s.tok
call compSpComment m
end
st = compCheckNN(m, compExprStm1(m, ki, 0), 'proc statement')
if nm == '' then do
nm = compBlockName(m, st)
if nm == '' then
call scanErr s, 'var or namedBlock expected after proc'
end
return compAst(m, 'B', '', compAst(m, '=', nm), st)
end
if fu == 'if' | fu == 'else' then do /* unchanged rexx */
call scanBack s, fu
return compExpr(m, 's', '@')
end
call scanBack s, pre || fu
return ''
endProcedure compStmt
compBlockName: procedure expose m.
parse arg m, a
a1 = m.a.1
if m.a.kind == '[' then
return m.a.text
else if m.a.kind == '*' & m.a1.kind == '[' then
return m.a1.text
return ''
endProcedure compBlockName
compVar: procedure expose m.
parse arg m, vk
if pos('o', vk) > 0 then call err(sdf)/0
s = m.m.scan
ty = compName(m, 'v' || vk)
if ty \== '' then do
r = compAst(m, '=', m.s.tok)
m.r.var = ty
return r
end
if \ scanLit(s, '{') then
return ''
call scanLit s, '?', '>'
f = m.s.tok
r = compCheckNE(m, compExpr(m, 'b', '='), 'var name')
if \scanLit(s, '}') then
call scanErr s, 'closing } missing after {'
m.r.var = f
return r
endProcedure compVar
compAss: procedure expose m.
parse arg m, vk
s = m.m.scan
old = scanPos(s)
call scanLit s, m.comp_chDol'=', '='
pr = m.s.tok
if pr \== '' then
call compSpComment m
v = compVar(m, vk)
if v \== '' then do
call compSpComment m
if \ scanLit(s, '=') then do
call scanBackPos s, old
return ''
end
end
else if pr == '' then
return ''
else
oldInfo = scanInfo(s)
eb = compCheckNE(m, compOpBE(m, '=', 1),
, 'block or expression in assignment after' pr)
if m.eb.kind == '[' then
eb = compAstAddOp(m, eb, '-')
if v == '' then do
v = compBlockName(m, eb)
if v == '' then
call scanEr3 s, 'var or namedBlock expected',
'in assignment after' pr, oldInfo
v = compAst(m, '=', v)
m.v.var = 'v'
end
if m.m.comp_assVars \== 0 then
if m.v.kind == '=' & m.v.var == 'v' then do
if words(m.v.text) \= 1 then
call compAstErr v, 'bad var'
if m.eb.kind == '*' then
ki = left(m.eb.text, 1)
else
ki = m.eb.kind
if pos(ki, '-=s') > 0 then
f = ', f' m.v.text 'v'
else if pos(ki, '.<@o') > 0 then
f = ', f' m.v.text 'r'
else
call compAstErr eb, 'string or object'
if pos(f, m.m.comp_assVars) < 1 then
m.m.comp_assVars = m.m.comp_assVars || f
end
return compAst(m, 'A', , v, eb)
endProcedure compAss
/*--- block deals with the correct kind and operators
the content is parsed by compUnit -----------------------------*/
compBlock: procedure expose m.
parse arg m, ops
s = m.m.scan
if \ scanLit(s, '[', '/') then
return ''
start = m.s.tok
if ops == '' | pos(right(ops, 1), m.comp_chKind) < 1 then
return scanErr(s, 'bad kind' ops 'for block')
ki = right(ops, 1)
ops = left(ops, length(ops)-1)
starter = start
if start == '[' then
stopper = m.comp_chDol']'
else do
call scanVerify s, '/', 'm'
starter = '/'m.s.tok'/'
stopper = m.comp_chDol || starter
if \scanLit(s, '/') then
call scanErr s, 'ending / after stopper' stopper 'expected'
end
res = compUnit(m, ki, stopper)
if \ scanLit(s, stopper, substr(stopper, 2)) then
call scanErr s, 'ending' stopper 'expected after' starter
if abbrev(starter, '/') then
m.res.text = substr(starter, 2, length(starter)-2)
return compAstAddOp(m, res, ops)
endProcedure compBlock
/**** lexicals *******************************************************/
/*--- skip a comment. return 0 if there is none ---------------------*/
compComment: procedure expose m.
parse arg m
s = m.m.scan
got = 0
do forever
if scanLit(s, m.comp_chDol'**') then
m.s.pos = 1 + length(m.s.src) /* before next nl */
else if scanLit(s, m.comp_chDol'*+') then
call scanNL s, 1
else if scanLit(s, m.comp_chDol'*(') then do
do forever
if scanVerify(s, m.comp_chDol, 'm') then iterate
if scanNL(s) then iterate
if compComment(m) then iterate
if \ scanLit(s, m.comp_chDol) then
call scanErr s, 'source end in comment'
if scanLit(s, '*)') then
return 1
if scanLit(s, m.comp_chDol) then iterate
if scanString(s) then iterate
end
end
else
return got
got = 1
end
endProcedure compComment
/*--- skip spaces and comments --------------------------------------*/
compSpComment: procedure expose m.
parse arg m, xtra
s = m.m.scan
got = 0
do forever
if scanVerify(s, m.comp_chSpa) then
got = bitOr(got, 1)
else if compComment(m) then
got = bitOr(got, 2)
else if xtra == '' then
return got
else if \ scanLit(s, xtra) then
return got
else do
got = bitOr(got, 4)
m.s.pos = 1+length(m.s.src)
end
end
endProcedure compSpComment
/*--- skip spaces, NLs and comments ---------------------------------*/
compSpNlComment: procedure expose m.
parse arg m, xtra
found = 0
do forever
if compSpComment(m, xtra) < 1 then
if \ scanNL(m.m.scan) then
return found
found = 1
end
endProcedure compSpNlComment
/*--- scan a name in one of the categories
v=var, c=compile, s=stmt ----------------------------------*/
compName: procedure expose m.
parse arg m, cats
s = m.m.scan
if \ scanName(s) then
return ''
if wordPos(m.s.tok, m.comp_wCatS) > 0 then do
if pos('s', cats) > 0 then
return 's'
end
else if wordPos(m.s.tok, m.comp_wCatC) > 0 then do
if pos('c', cats) > 0 then
return 'c'
end
else if pos('v', cats) > 0 then do
return 'v'
end
call scanBack s, m.s.tok
return ''
endProcedure compName
compOpKind: procedure expose m.
parse arg m, op
s = m.m.scan
if scanVerify(s, m.comp_chOp || m.comp_chKiNO) then
op = m.s.tok
else if op == '' then
return ''
/* ??????? temporary until old syntax vanished ????? */
x = verify(op, '%^', 'm')
if x > 0 & x < length(op) then
call scanErr s, 'old syntax? run not at end'
if right(op, 1) == '<' then
op = op'='
kx = verify(op, m.comp_chKiNO, 'm')
if kx \== 0 & kx \== length(op) then
call scanErr s, 'kind' substr(op, kx, 1) 'not after ops'
if pos(right(op, 1), m.comp_chKind) == 0 then
call scanErr s, 'no kind after ops' op
return op
endProcedure compOpKind
compSpNlComment: procedure expose m.
/**** small helper routines ******************************************/
/*--- if va == null then issue an error with msg --------------------*/
compCheckNN: procedure expose m.
parse arg m, va, msg
if va == '' then
call scanErr m.m.scan, msg 'expected'
return va
endProcedure compCheckNN
/*--- return true iff expression is empty ---------------------------*/
compIsEmpty: procedure expose m.
parse arg m, a, block0
do forever
if a == '' then
return 1
else if m.a.kind == '*' then
a = m.a.1
else if m.a.kind \== '[' then
return 0
else if block0 then
return 0
else if m.a.0 = 1 then
a = m.a.1
else
return m.a.0 < 1
end
endProcedure compIsEmpty
/*--- if va == null or empty then issue an error with msg -----------*/
compCheckNE: procedure expose m.
parse arg m, ex, msg
e1 = left(ex, 1)
if compIsEmpty(m, ex, 1) then
call scanErr m.m.scan, msg 'expected'
return ex
endProcedure compCheckNE
/**** AST = Astract Syntax Tree ***************************************
------- atoms, no children
= string constant
+ rexx fragment
------- containers (any number of children)
- string expression
. object expression
; rexx statements
[ block
------- molecules
* operand chain ==> 1 operands in text, as in syntax plus
) run ($@ stmt), & variable access, ] execute
& variable access==> 1
A assignment ==> 2
B proc ==> 2
C ct ==> 1
D do ==> 2
F for + with ==> 2
P Pipe ==> * 1=input 2=output , 3..* piped stmtBlocks
R aRg * list of arguments/separators
T Table
M compile
% RunOut ==> 1,2 (Run, arguments)
^ RunRet ==> 1,2 (Run, arguments)
**********************************************************************/
/*--- create a new AST ----------------------------------------------*/
compAST: procedure expose m.
parse arg m, ki, txt
n = mNew('COMP.AST')
if length(ki) <> 1 then
return err('compAST bad kind' ki) / 0
m.n.kind = ki
m.n.text = txt
if pos(ki, '[;-.*&ABCDFPRTM%^') > 0 then do
do cx=1 to arg()-3
m.n.cx = arg(cx+3)
end
m.n.0 = cx-1
if ki == '*' then do
if verify(txt, m.comp_astOps) > 0 then
return err('compAst ki=* bad ops:' txt) / 0
end
else if txt \== '' & pos(ki, '&*FPT') < 1 then
return err('kind' ki 'text='txt'|')/0
end
else if pos(ki, '=+') > 0 then do
m.n.0 = 'kind'ki
end
else do
return err( "compAst kind '"ki"' not supported") / 0
end
return n
endProcedure compAST
/*--- free AST if empty ---------------------------------------------*/
compASTFree0: procedure expose m.
parse arg a, ret
if m.a.0 > 0 then
return a
call mFree a
return ret
endProcedure compAstFree0
/*--- add operandands to an AST -------------------------------------*/
compASTAddOp: procedure expose m.
parse arg m, a, ops
if verify(ops, m.comp_astOps) > 0 then
return err('addOp bad ops:' ops) / 0
k = if(m.a.kind=='*', left(m.a.text, 1), m.a.kind)
do while right(ops, 1) == k
ops = left(ops, length(ops)-1)
end
if ops == '' then
return a
if ki \== '*' then
return compAst(m, '*', ops, a)
m.a.text = ops || m.a.text
return a
endProcedure compAstAddOp
/*--- return the kind of an AST -------------------------------------*/
compASTKind: procedure expose m.
parse arg m, a
m.m.astOps = ''
if \ abbrev(a, 'COMP.AST.') then
return left(a, 1)
c = a
do while m.c.kind == 'ops'
if m.c.text \== '' then
return left(m.c.text, 1)
c = m.c.1
end
if a == c then
return '?'
return compAstKind(m, c)
endProcedure compASTKind
compAstSay: procedure expose m.
parse arg a, lv
if \ abbrev(a, 'COMP.AST.') then do
if a \== '' then
return err('bad ast' a)
say left('', 19)': * empty ast'
return
end
say lefPad(left('', lv) m.a.kind, 10) ,
|| rigPad(if(dataType(m.a.0, 'n'), m.a.0), 3),
'@'rigPad(substr(a, 10), 4)':' m.a.text'|'
if dataType(m.a.0, 'n') then do cx=1 to m.a.0
call compAstSay m.a.cx, lv+1
end
return
endProcedure compAstSay
compAstErr: procedure expose m.
parse arg a, txt
call errSay txt
call compAstSay a, 0
return err(txt)
endProcedure compAstErr
/*--- return the code for an AST with operand chain trg -------------*/
compCode2rx: procedure expose m.
parse arg m, ops, f
if ops == '' then
return f
o1 = right(ops, 1)
oR = left(ops, length(ops)-1)
if pos(o1, ')]') > 0 then
return compCode2rx(m, oR, strip(f))
if pos(o1, '-.<|?@') > 0 then
return compRun2rx(m, ops, quote(oRunner(f)))
call err 'compCode2rx bad ops' ops 'code='f
endProcedure compCode2rx
compCon2rx: procedure expose m.
parse arg m, ops, f, a
do ox=length(ops) by -1 to 1 while pos(substr(ops,ox,1), '.-')>0
end
if substr(ops, ox+1, 1) == '.' then
f = s2o(f)
if length(f) < 20 then
v = quote(f, "'")
else if a \== '' & m.a.text == f then
v = 'm.'a'.text'
else
v = 'm.'compAst(m, '=', f)'.text'
if substr(ops, ox+1, 1) == '.' then
return compObj2rx(m, left(ops, ox), v)
else
return compString2rx(m, left(ops, ox), v)
endProcedure compCon2rx
compString2rx: procedure expose m.
parse arg m, ops, f
if ops == '' then
return f
o1 = right(ops, 1)
oR = left(ops, length(ops)-1)
if pos(o1, ']') then
return compCode2rx(m, oR, 'call out' f)
if o1 == '-' then
return compString2rx(m, oR, f)
if o1 == '.' then
return compObj2rx(m, oR, 's2o('f')')
if o1 == '&' then do
o2 = substr('1'ops, length(ops), 1)
if pos(o2, '.<^%@)') < 1 then
return compString2rx(m, oR, 'vGet('f')')
else
return compObj2rx(m, oR, 'vGet('f')')
end
if o1 == '<' then
return compFile2rx(m, oR, 'file('f')')
call err 'compString2rx bad ops' ops
endProcedure compString2rx
compObj2rx: procedure expose m.
parse arg m, ops, f
if ops == '' then
return f
o1 = right(ops, 1)
oR = left(ops, length(ops)-1)
if o1 == '.' then
return compObj2rx(m, oR, f)
if o1 == '-' then
return compString2rx(m, oR, 'o2string('f')')
if o1 == ']' then
return compCode2rx(m, oR, 'call out' f)
if o1 == '<' then
return compFile2rx(m, oR, 'o2file('f')')
if o1 == '@' then
return compRun2Rx(m, oR, f)
if pos(o1, ')%^') > 0 then
return compRun2rx(m, ops, f)
call err 'compObj2rx bad ops' ops 'for' f
endProcedure compObj2rx
compRun2rx: procedure expose m.
parse arg m, ops, f
if ops == '' then
return f
o1 = right(ops, 1)
oR = left(ops, length(ops)-1)
if o1 == '@' then
return compRun2Rx(m, oR, f)
if pos(o1, ')%') > 0 then
return compCode2Rx(m, oR, 'call oRun' f)
if o1 == '^' then
if pos(right(oR, 1), '.<^%') < 1 then
return compString2Rx(m, oR, 'oRun('f')')
else
return compObj2Rx(m, oR, 'oRun('f')')
return compObj2rx(m, ops, f)
endProcedure compRun2rx
compFile2rx: procedure expose m.
parse arg m, ops, f
if ops == '' then
return f
o1 = right(ops, 1)
oR = left(ops, length(ops)-1)
if pos(o1, '<.@') > 0 then
return compFile2rx(m, oR, f)
if o1 == '|' | o1 == '?' then
return compObj2Rx(m, oR, 'jSingle('f ||if(o1=='?', ", ''")')')
return compRun2rx(m, ops, f)
endProcedure compFile2rx
compAst2rx: procedure expose m.
parse arg m, ops, a
ki = m.a.kind
/* astStats ausgeschaltet
if pos(ki, m.comp_astStats) < 1 then do
m.comp_astStats = m.comp_astStats ki
m.comp_astStats.ki = 0
m.comp_astStatT.ki = 0
end
m.comp_astStats.ki = m.comp_astStats.ki + 1
if m.a.text \== '' then
m.comp_astStatT.ki = m.comp_astStatT.ki + 1
if ki == '*' then do
k2 = vGet(a'.1>>KIND')
if symbol('m.comp_astStat1.k2') \== 'VAR' then
m.comp_astStat1.k2 = 1
else
m.comp_astStat1.k2 = m.comp_astStat1.k2 + 1
end */
if ki == '+' & ops == '' then
return m.a.text
if ki == '=' then
return compCon2Rx(m, ops, m.a.text, a)
if ki == '*' then
return compAst2Rx(m, ops || m.a.text, m.a.1)
o1 = right(ops, 1)
oR = left(ops, max(0, length(ops)-1))
if ki == '-' then
return compString2rx(m, ops, compCatRexxAll(m, a,,, ' || '))
if ki == '.' then
return compObj2Rx(m, ops, compCatRexxAll(m, a,,, ' || '))
if ki == ';' then
return compCode2Rx(m, ops, compCatRexxAll(m, a,,,' || '))
if ki == '[' then do
a1 = m.a.1
if m.a.0 == 1 & m.a1.kind == '[' then
return compAst2Rx(m, ops, a1)
if o1 == '-' then do
res = compAst2CatStr(m, a)
if res \== '' then /* () necessary if part of expression */
return compString2rx(m, oR, '('strip(res)')')
end
if o1 == '.' then
return compAst2Rx(m, ops'|', a)
if pos(o1, '|?') > 0 then
if m.a.0 = 1 & compAstOut(a1) then
return compAst2Rx(m, oR, a1)
res = ''
do ax=1 to m.a.0
res = res';' compAst2rx(m, ']', m.a.ax)
end
if verify(res, '; ') = 0 then
res = 'nop'
else
res = 'do'res'; end'
if pos(o1, '-@])') > 0 then
return compCode2Rx(m, ops, res)
if pos(o1, '|?<') > 0 then
return compCode2Rx(m, ops'<@', res)
end
if ki == '&' then do
nm = compAst2Rx(m, '-', m.a.1)
if m.a.text=='' | m.a.text=='v' then
return compString2rx(m, ops'&', nm)
else if m.a.text == '?' then
return compString2rx(m, ops, 'vIsDefined('nm')')
else if m.a.text == '>' then
return compString2rx(m, ops, 'vIn('nm')')
else
call compAstErr a, 'bad text' m.a.text 'in ast &'
end
if ki == '%' | ki == '^' then do
c1 = compAst2Rx(m, '.', m.a.1)
if m.a.0 > 1 then
c1 = c1',' compAst2Rx(m, '', m.a.2)
return compRun2Rx(m, ops || ki, c1)
end
if ki == 'A' then do /* assignment */
nm = compAst2Rx(m, '-', m.a.1)
vl = m.a.2
if m.vl.kind == '=' | m.vl.kind == '-' ,
| (m.vl.kind == '*' & right(m.vl.text, 1) == '-') then
return compCode2Rx(m, ops,
, 'call vPut' nm',' compAst2Rx(m, '-', vl))
else
return compCode2Rx(m, ops,
, 'call vPut' nm',' compAst2Rx(m, '.', vl))
end
if ki == 'B' then do /* proc */
call vPut utInter('return' compAst2Rx(m, '-', m.a.1)),
, oRunner(compAst2Rx(m ,']', m.a.2))
return ''
end
if ki == 'C' then do /* ct */
call utInter compAst2Rx(m, ']', m.a.1)
return ''
end
if ki == 'D' then do /* do */
res = 'do' compAst2rx(m, '', m.a.1)
if m.a.text \== '' then
res = res"; call vPut '"m.a.text"'," m.a.text
return compCode2Rx(m, ops, res';' compAst2Rx(m, ']', m.a.2),
|| "; end")
end
if ki == 'F' then do /* for... */
a1 = m.a.1
st = compAst2Rx(m, ']', m.a.2)
if abbrev(m.a.text, 'for') then do
if m.a.1 == '' then
v = "''"
else
v = compAst2Rx(m, '-', m.a.1)
if m.a.text == 'for' then
s1 = 'do while vIn('v')'
else if m.a.text \== 'forWith' then
call compAstErr a, 'bad for...'
else
s1 = 'call vWith "+"; do while vForWith('v')'
return compCode2Rx(m, ops, s1';' st'; end')
end
else if \ abbrev(m.a.text, 'with') then
call compAstErr a, 'bad with...'
if m.a1.kind \== 'A' then do
v = compAst2Rx(m, '.', a1)
end
else do
v = compAst2Rx(m, ,a1)
if \ abbrev(v, 'call vPut ') | pos(';', v) > 0 then
call scanErr s, 'bad vPut' v
v = 'vPut('substr(v, 11)')'
end
ret1 = 'call vWith "+",' v';' st
if m.a.0 <= 2 then
return ret1"; call vWith '-'"
a3 = m.a.3
if m.a3.kind \== '*' then
call compAstErr a, 'for/with a.3 not *'
return ret1';' compObj2Rx(m, m.a3.text, "vWith('-')")
end
if ki == 'P' then do /* pipe */
if ((left(m.a.text, 1) == ' ') \== (m.a.1 == '')) ,
| ((substr(m.a.text, 2) == '') \== (m.a.2 == '')) ,
| (m.a.0 <= 3 & m.a.text == '') then
call compAstErr a, 'bad/trivial astPipe'
res = ''
do ax=3 to m.a.0
a1 = ''
if ax < m.a.0 then /* handle output */
t1 = 'N'
else if m.a.1 == '' then
t1 = 'P'
else do
t1 = left(m.a.text, 1)
a1 = compAst2Rx(m, '.', m.a.1)
end
if ax == 3 then do /* handle input */
t1 = '+'t1 || substr(m.a.text, 2)
if m.a.2 \== '' then
a1 = a1',' compAst2Rx(m, '.', m.a.2)
end
else
t1 = t1'|'
res = res"; call pipe '"t1"'," a1 ,
";" compAst2Rx(m, ']', m.a.ax)
end
return compCode2Rx(m, ops, substr(res, 3)"; call pipe '-'")
end
if ki == 'R' then do /* aRg statement */
prs = 'parse arg ,'
pts = ''
do ax=1 to m.a.0
a1 = m.a.ax
if m.a1.kind = '+' & m.a1.text == ',' then
prs = prs','
else do
prs = prs 'ggAA'ax
pts = pts'; call vPut' compAst2Rx(m, '-', a1)', ggAA'ax
end
end
return compCode2rx(m, ops, prs pts)
end
if ki == 'M' then do
if m.a.0 = 0 then
args = ''
else
args = compAst2Rx(m, , m.a.1)
return compRun2rx(m, ops, 'wshHookComp( ,'args ',in2Buf())')
end
return compAstErr(a, 'compAst2rx bad ops='ops 'kind='ki 'ast='a)
endProcedure compAst2rx
compAstOut: procedure expose m.
parse arg a
if m.a.kind \== '*' then
return pos(m.a.kind, m.comp_astOut) > 0
return pos(left(m.a.text, 1), m.comp_astOut) > 0
endProcedure compAstOut
compAst2CatStr: procedure expose m.
parse arg m, a
res = ''
if compAstOut(a) then
res = compCatRexx(res, compAst2rx(m, , a), ' ')
else if m.a.kind \== '[' then
return ''
else do ax=1 to m.a.0
b = compAst2CatStr(m, m.a.ax)
if b == '' then
return ''
res = compCatRexx(res, b, ' ')
end
return res
endProcedure compAst2CatStr
compCatRexxAll: procedure expose m.
parse arg m, a, ops, mi, sep
res = ''
do ax=1 to m.a.0
a1 = m.a.ax
res = compCatRexx(res, compAst2rx(m, ops, m.a.ax), mi , sep)
end
return strip(res)
endProcedure compCatRexxAll
/*--- cat two rexx parts, avoid strange effects ---------------------*/
compCatRexx: procedure expose m.
parse arg le, ri, mi, sep
if mi \== '' then
return le || mi || ri
lr = right(le, 1)
rl = left(ri, 1)
if (lr == "'" | lr == '"') then do
if rl == lr then /* "a","b" -> "ab" */
return left(le, length(le)-1) || substr(ri, 2)
else if rl == '(' then /* "a",( -> "a" || ( */
return le||sep||ri /* avoid function call */
end
else if pos(lr, m.comp_idChars) > 0 then
if pos(rl, m.comp_idChars'(') > 0 then
return le || sep || ri /* a,b -> a || b */
return le || ri
endProcedure compCatRexx
/* copy comp end *****************************************************/