zOs/REXX.O08/COMP

/* copy comp begin *****************************************************
    the shell compiler
         syntax and semantics of the shell language see javaDoc
***********************************************************************/
/*--- module initialisation ------------------------------------------*/
compIni: procedure expose m.
    if m.compIni = 1 then
        return
    m.compIni = 1
    call envIni
    call scanReadIni
    cc = oNewClass('Compiler')
    return
endProcedure compIni

/*--- constructor of Compiler ----------------------------------------*/
comp: procedure expose m.
parse arg src
    nn = oNew('Compiler')
    m.nn.scan = scanRead(src)
    return compReset(nn, src)
endProcedure comp

compReset: procedure expose m.
parse arg m, src
    call scanReadReset m.m.scan, src, , ,'$*'
    m.m.chDol = '$'
    m.m.chSpa = ' '
    m.m.chNotWord = '${}=£:' || m.m.chSpa
    m.m.stack = 0
    return m
endProceduere compReset

/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
    m.m.stack = m.m.stack + 1
    pp = m'.STACK'm.m.stack
    m.pp.0 = 0
    return pp
endProcedure compPushStem

/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
    if pp ^== m'.STACK'm.m.stack then
        call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
    m.m.stack = m.m.stack - 1
    return m
endProcedure compPop

/*--- compile the source and return an oRunner with the code ---------*/
compile: procedure expose m.
parse arg m, type
    if type == 's' then do
        what = "shell"
        expec = "pipe or $;";
        call compSpNlComment m
        src = compShell(m)
        end
    else if type == 'd' then do
        what = "data";
        expec = "sExpression or block";
        src = compData(m, 0)
        end
    else do
       call err "bad type " type
       end
    if ^ scanAtEnd(m.m.scan) then
       call scanErr m.m.scan, expec  "expected: compile" what ,
                               " stopped before end of input"
    call scanClose m.m.scan
    r = oRunner(src)
    return r
endProcedure compile

/*--- compile data lines return stmts or expr ------------------------*/
compData: procedure expose m.
parse arg m, makeExpr
    s = m.m.scan
    exprs = compPushStem(m)
    do forever
        aftEol = 0
        do forever
            text = "";
            do forever
                if scanVerify(s, m.m.chDol, 'm') then
                    text = text || m.s.tok
                if ^ compComment(m) then
                    leave
                end
            nd = compExpr(m, 'd')
            befEol = scanReadNL(s)
            if nd <> '' | (aftEol & befEol) ,
                     | verify(text, m.m.chSpa) > 0 then do
                if text ^== '' then
                    text = quote(text)
                if text ^== '' & nd ^= '' then
                    text = text '|| '
                call mAdd exprs, 'e' compNull2EE(text || nd)
                end
            if ^ befEol then
                 leave
            aftEol = 1
            end
        one = compStmt(m)
        if one == '' then
            one = compRedirIO(m, 0)
        if one == '' then
            leave
        call mAdd exprs, 's' one
        end
    if m.exprs.0 < 1 then do
        if makeExpr then
            res = '""'
        else
            res = ';'
        end
    else do
        do x=1 to m.exprs.0 while left(m.exprs.x, 1) = 'e'
            end
        res = ''
        if makeExpr & x > m.exprs.0 then do
            res = substr(m.exprs.1, 3)
            do x=2 to m.exprs.0
                res = res substr(m.exprs.x, 3)
                end
            end
        else do
            do x=1 to m.exprs.0
                if left(m.exprs.x, 1) = 'e' then
                    res = res 'call jOut'
                res = res substr(m.exprs.x, 3)';'
                end
            if makeExpr then
                res = "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
            end
        end
    call compPop m, exprs
    return res
endProcedure compData

/*--- compile shell and return code ----------------------------------*/
compShell: procedure expose m.
parse arg m
    res = ''
    do forever
        one = compPipe(m)
        if one ^== '' then
            res = res one
        if ^ scanLit(m.m.scan, '$;') then
            return strip(res)
        call compSpNlComment m
        end
endProcedure compShell

/*--- compile an expression, type d=data, w=word, s=strip ------------*/
compExpr: procedure expose m.
parse arg m, type
    res = ''
    if type == 'w' then
        charsNot = m.m.chNotWord
    else
        charsNot = m.m.chDol
    s = m.m.scan
    if pos(type, 'sw') > 0 then
        call compSpComment m
    do forever
        txt = ''
        do forever
            if scanVerify(s, charsNot, 'm') then
                txt = txt || m.s.tok
            if ^ compComment(m) then
                leave
            end
        pr = compPrimary(m)
        if pr = '' & pos(type, 'sw') > 0 then
            txt = strip(txt, 't')
        if txt ^== '' then
            res = res '||' quote(txt)
        if pr = '' then do
            if pos(type, 'sw') > 0 then
                call compSpComment m
            if res == '' then
                return ''
            return substr(res, 5)
            end
        res = res '||' pr
        end
    return ''
endProcedure compExpr

/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
    m.m.stack = m.m.stack + 1
    pp = m'.STACK'm.m.stack
    m.pp.0 = 0
    return pp
endProcedure compPushStem

/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
    if pp ^== m'.STACK'm.m.stack then
        call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
    m.m.stack = m.m.stack - 1
    return m
endProcedure compPop

/*--- compile a primary and return code ------------------------------*/
compPrimary: procedure expose m.
parse arg m
    s = m.m.scan
    if ^ scanLit(s, '$') then
        return ''
    if scanString(s) then
        return m.s.tok
    if scanLit(s, '(') then do
        one = compCheckNN(m, compLang(m, 0), 'rexx expexted after $(')
        if ^ scanLit(s, '$)') then
            call scanErr s, 'closing $) missing after $(...'
        return '('one')'
        end
    if scanLit(s, '-[') then do
        res  = compData(m, 1)
        if ^scanLit(s, '$]') then
            call scanErr s, 'closing $] missing after $-[ data'
        return res
        end
    if scanLit(s, '-{') then do
        res  = compShell(m)
        if ^scanLit(s, '$}') then
            call scanErr s, 'closing $} missing after $-{ shell'
        return "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
        end
    if scanLit(s, '-cmpShell', '-cmpData') then do
        return 'compile(comp(envRead2Buf()),' ,
               '"'substr('ds', 1+(m.s.tok == '-cmpShell'), 1)'")'
        end
    if scanLit(s, '{') then do
        if scanLit(s, '?') then
            f = 'envIsDefined'
        else if scanLit(s, '>') then
            f = 'envRead'
        else
            f = 'envGet'
        nm = compExpr(m, 'w')
        if ^scanLit(s, '}') then
            call scanErr s, 'closing } missing after ${'
        return f'('nm')'
        end
    if scanName(s) then
        return 'envGet('quote(m.s.tok)')'
    call scanBack s, '$'
    return ''
endProcedure compPrimary

/*--- compile a pipe and return code ---------------------------------*/
compPipe: procedure expose m.
parse arg m
    s = m.m.scan
    ios = ''
    stmts = ''
    stmtLast = ''
    do forever
        io1 = compRedirIO(m, 1)
        if io1 ^== '' then do
            ios = ios',' io1
            call compSpNlComment m
            end
        else do
            if stmtLast ^== '' then do
                if ^ scanLit(s, '$!') then
                    leave
                call compSpNlComment m
                end
            one = compStmts(m)
            if one == '' then do
                if stmtLast ^== '' then
                    call scanErr s, 'stmts expected afte $!'
                if ios == '' then
                    return ''
                leave
                end
            if stmtLast ^== '' then
                stmts = stmts 'call envBar;' stmtLast
            stmtLast = one
            end
        end
    if stmts ^== '' then
        stmtLast = insert('Begin', stmts, pos('envBar;', stmts)+5) ,
                  'call envBarLast;' stmtLast 'call envBarEnd;'
    if ios ^== '' then do
        if stmtLast == '' then
            stmtLast = 'call envReadWrite;'
        stmtLast = 'call envPush env('substr(ios, 3)');' stmtLast ,
                   'call envPop;'
        end
    return stmtLast
endProcedure compPipe

/*--- compile an io redirection, return
        if makeExpr then "option", expr
                    else code write inut to standard out -------------*/
compRedirIO: procedure expose m.
parse arg m, makeExpr
    s = m.m.scan
    if ^ scanLit(s, '$&', '$<<', '$<', '$>>', '$>') then
        return ''
    opt = substr(m.s.tok, 2)
    call scanVerify s, '+-£#[{'
    opt = opt || m.s.tok
  /* ????  call compSpComment m */
    if left(opt, 2) ^== '<<' then do
        if verify(opt, '[{', 'm') > 0 ,
                | (left(opt, 1) == '&' & pos('£', opt) > 0) then
            call scanErr s, 'inconsistent io redirection option' opt
        ex = compCheckNN(m, compExpr(m, 's'),
                      , 'expression expected after $'opt)
        end
    else do
        if verify(opt, '-£#', 'm') > 0 then
            call scanErr s, 'inconsistent io redirection option' opt
        if ^ scanName(s) then
            call scanErr s, 'stopper expected in heredata after $'opt
        stopper = m.s.tok
        call scanVerify s, m.m.chSpa
        if ^ scanReadNl(s) then
            call scanErr s,
                , 'space nl expected in heredata after $'opt||stopper
        buf = jOpen(jBuf(), 'w')
        do while ^ scanLit(s, stopper)
            call jWrite buf, m.s.src
            if ^ scanReadNl(s, 1) then
                call scanErr s, 'eof in heredata after $'opt||stopper
            end
        call jClose buf
        if verify(opt, '[{', 'm') > 0 then do
            if pos('[', opt) > 0 then
                ex = compile(comp(buf), 'd')
            else
                ex = compile(comp(buf), 's')
            if makeExpr then
                return "'<£', envRun("quote(ex)")"
            else
                return "call oRun" quote(ex)";"
            end
        opt = '<£'
        ex = quote(buf)
        end
    if makeExpr then
        return "'"opt"'," ex
    else if left(opt, 1) = '>' then
        call scanErr s, 'cannot write ioRedir $'opt
    else
        return "call envReadWrite '"opt"'," ex
endProcedure compRedirIO

/*--- compile stmts (stmt or java) -----------------------------------*/
compStmts: procedure expose m.
parse arg m
    res = ''
    do forever
       one = compStmt(m)
       if one == '' then
           one = compLang(m, 1)
       if one == '' then
           return res
       res = res strip(one)
       call compSpNlComment m
       end
endProcedure compStmts

/*--- compile a single statement -------------------------------------*/
compStmt: procedure expose m.
parse arg m
    s = m.m.scan
    if scanLit(s, "$=") then do
        nm = compCheckNN(m, compExpr(m, 'w'), "variable name")
        if scanLit(s, "=") then
            vl = compExpr(m, 's')
        else if scanLit(s, "£") then
            vl = compCheckNN(m, compLang(m, 0),
                   , 'java expression after $= .. £')
        else
            call scanErr s, '= or £ expected after $= name'
        return 'call envPut' nm',' vl';'
        end
    else if scanLit(s, '$@{') then do
        call compSpNlComment m
        one = compShell(m)
        if ^ scanLit(s, "$}") then
            call scanErr s, "closing $} missing for $@{ shell"
        return "do;" one "end;"
        end
    else if scanLit(s, '$@[') then do
        call compSpNlComment m
        one = compData(m, 0)
        if ^ scanLit(s, "$]") then
            call scanErr s, "closing $] missing for $@] data"
        return "do;" one "end;"
        end
    else if scanLit(s, '$$') then do
        return 'call jOut' compExpr(m, 's')';'
        end
    else if scanLit(s, '$£') then do
        return 'call jOut' compCheckNN(m, compLang(m, 0),
                  , 'language expression after $£')';'
        end
    else if scanLit(s, '$@for') then do
        v = compCheckNN(m, compExpr(m, 'w') ,
               , "variable name after $@for")
        call compSpNlComment m
        return 'do while envRead('v');',
             compCheckNN(m, compStmt(m),
                 , "statement after $@for variable") 'end;'
        end
    else if scanLit(s, '$@run') then do
        return 'call oRun' compCheckNN(m, compExpr(m, 's'),
                 , 'expression after $@run') ';'
        end
    return ''
endProcedure compStmt

/*--- compile a language clause
           multi=0 a single line for a rexx expression
           multi=1 mulitple lines for rexx statements
                 (with rexx line contiunation) -----------------------*/
compLang: procedure expose m.
parse arg m, multi
    s = m.m.scan
    res = ''
    do forever
       if scanVerify(s, m.m.chDol, 'm') then do
           res = res || m.s.tok
           end
       else do
           one = compPrimary(m)
           if one ^== '' then
               res = res || one
           else if compComment(m) then
               res = res || ' '
           else if ^multi then
               return res
           else if ^ scanReadNl(s) then do
               if res == '' then
                   return res
               else
                   return strip(res)';'
               end
           else do
               res = strip(res)
               if right(res, 1) = ',' then
                   res = strip(left(res, length(res)-1))
               else
                   res = res';'
               end
           end
       end
endProcedure compLang

/*--- convert stmts to an expression yielding the output ------------*/
compStmts2ExprBuf: procedure expose m.
parse arg stmts
    rr = oRunner(stmts)
    return "envRun('"rr"')"
endProcedure compStmts2ExprBuf

/*--- convert '' to an empty expression ------------------------------*/
compNull2EE: procedure
parse arg e
    if e = '' then
        return '""'
    return e
endProcedure compNull2EE

/*--- if va == '' 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

/*--- skip a comment. return 0 if there is none ----------------------*/
compComment: procedure expose m.
parse arg m
    s = m.m.scan
    if scanLit(s, '$**') then
        m.s.pos = 1 + length(m.s.src) /* before next nl */
    else if scanLit(s, '$*+') then
        call scanReadNl s, 1
    else if scanLit(s, '$*(') then do
        do forever
            if scanVerify(s, m.m.chDol, 'm') then iterate
            if scanReadNl(s) then iterate
            if compComment(m) then iterate
            if ^ scanLit(s, '$') then
                call scanErr s, 'source end in comment'
            if scanLit(s, '*)') then
                return 1
            if scanLit(s, '$') then iterate
            if scanString(s) then iterate
            end
        end
    else
        return 0
    return 1
endProcedure compComment

/*--- skip spaces and comments ---------------------------------------*/
compSpComment: procedure expose m.
parse arg m
    found = 0
    do forever
        if scanVerify(m.m.scan, m.m.chSpa) then
            found = 1
        else if compComment(m) then
            found = 1
        else
            return found
        end
endProcedure compSpComment

/*--- skip spaces, NLs and comments ----------------------------------*/
compSpNlComment: procedure expose m.
parse arg m
    found = 0
    do forever
        if compSpComment(m) then
            found = 1
        else if scanReadNl(m.m.scan) then
            found = 1
        else
            return found
        end
endProcedure compSpComment
/* copy comp end ******************************************************/