infix expression evaluator in sed (integers in decimal base only)

calc.sed

#!/bin/sed -nf
x ; s/^$/\n/ ; x ; t scan_unop
:scan_unop
/^[ 	]*[-+][ 	]*)/{i\
unary op expected an operand, got ')'
    x ; b hold_bailout
}
/^[ 	]*[-+][ 	]*$/{i\
unary op expected an operand, got EOF
    x ; b hold_bailout
}
s/^[ 	]*-// ; t push_neg
s/^[ 	]*+// ; t push_pos
:scan
s/^[ 	]*// ; t scan2
:scan2
s/^0$// ; t zero_end
/^0[^0-9]/b token_digit
/^[1-9][0-9]*/{
    :token_digit
    H ; x ; s/^\([0-9A-Za-z]*\)\n\(.*\)\n\([0-9]\{1,\}\)\([^0-9]\(	*[^[:cntrl:]]*\)*\)\{0,1\}$/\1\n\3\n\2/
    t num_discard ; i\
input contains invalid characters
    b hold_bailout
    :num_discard
    x ; s/^[0-9]\{1,\}// ; t scan_op ; i\
assertion failure: remove integer token from pattern
    b reset
}
:scan_op
s/^[ 	]*// ; t scan3
:scan3
/^[ 	]*([ 	]*)/{i\
'(' expected an operand, got ')'
    x ; b hold_bailout
}
/^[ 	]*([ 	]*$/{i\
'(' expected an operand, got EOF
    x ; b hold_bailout
}
s/^(// ; t opn
/^$/{
    x ; b loop1
}
/^[-+/*)]/{x
    :loop1
    /^[NP]/{
        s/^[NP][NP]*\([^NP][0-9A-Za-z]*\)\{0,1\}\n\(00*\)\n/\1\n0\n/ ; t loop2
        s/^P*\(NP*NP*\)*NP*\([0-9A-MOQ-Za-z][0-9A-Za-z]*\)\{0,1\}\n\([0-9]*\)\n/\2\n-\3\n/ ; t loop2
        s/^P*\(NP*NP*\)*NP*\([0-9A-MOQ-Za-z][0-9A-Za-z]*\)\{0,1\}\n-\([0-9]*\)\n/\2\n\3\n/ ; t loop2
        s/^P*\(NP*NP*\)*\([0-9A-MOQ-Za-z][0-9A-Za-z]*\)\{0,1\}\n\([0-9]*\)\n/\2\n\3\n/ ; t loop2
        s/^P*\(NP*NP*\)*\([0-9A-MOQ-Za-z][0-9A-Za-z]*\)\{0,1\}\n-\([0-9]*\)\n/\2\n-\3\n/ ; t loop2
        /^N/{
            i\
operand missing for - (unary op)
            x ; b hold_bailout
        }
        /^P/{
            i\
operand missing for + (unary op)
            x ; b hold_bailout
        }
        x ; b assert
    }
    :loop2
    :op_mul
    /^D[0-9A-Za-z]*\n0*\n/{
        i\
division by zero
        b hold_bailout
    }
    /^D/{
        # special case |divisor| = 10^n (n is in N_1) AND dividend / divisor < 0
        s/^D\([0-9A-Za-z]*\)\n1\(0*\)\n-\([0-9]\{1,\}\)\2\n/\1\n-\3\n/ ; t op_mul
        s/^D\([0-9A-Za-z]*\)\n-1\(0*\)\n\([0-9]\{1,\}\)\2\n/\1\n-\3\n/ ; t op_mul
        # special case |divisor| = 10^n AND dividend / divisor > 0
        s/^D\([0-9A-Za-z]*\)\n\(-\{0,1\}\)1\(0*\)\n\2\([0-9]\{1,\}\)\3\n/\1\n\4\n/ ; t op_mul
        # special case dividend = 0
        s/^D\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]\{1,\}\)\n00*\n/\1\n0\n/ ; t op_mul
        # special case divisor * 10^n = dividend
        s/^D\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*[1-9]\)\n\2\(0*\)\n/\1\n1\3\n/ ; t op_mul
        # special case divisor * 10^n = -dividend (n is in N_1) AND divisor > 0
        s/^D\([0-9A-Za-z]*\)\n\([0-9]*[1-9]\)\n-\2\(0*\)\n/\1\n-1\3\n/ ; t op_mul
        # special case divisor * 10^n = -dividend (n is in N_1) AND divisor < 0
        s/^D\([0-9A-Za-z]*\)\n-\([0-9]*[1-9]\)\n\2\(0*\)\n/\1\n-1\3\n/ ; t op_mul
        # normalize signs
        s/^D\([0-9A-Za-z]*\)\n\([0-9]\{1,\}\)\n-\([0-9]\{1,\}\)\n/&/ ; t do_div
        s/^D\([0-9A-Za-z]*\)\n-\([0-9]\{1,\}\)\n\([0-9]\{1,\}\)\n/&/ ; t do_div
        s/^D\([0-9A-Za-z]*\)\n\(-\{0,1\}\)\([0-9]\{1,\}\)\n\2\([0-9]\{1,\}\)\n/&/ ; t do_div
        i\
operands missing for /
        b hold_bailout

        :do_div
        i\
division is not implemented
        b hold_bailout
    }
    /^M/{
        # special case zero operand
        s/^M\([0-9A-Za-z]*\)\n-\{0,1\}[0-9]\{1,\}\n0\{1,\}\n/\1\n0\n/ ; t op_mul
        s/^M\([0-9A-Za-z]*\)\n0\{1,\}\n-\{0,1\}[0-9]\{1,\}\n/\1\n0\n/ ; t op_mul
        # special case (|A| = 1 OR |B| = 1) AND A * B > 0
        s/^M\([0-9A-Za-z]*\)\n\(-\{0,1\}\)\([0-9]\{1,\}\)\n\21\n/\1\n\3\n/ ; t op_mul
        s/^M\([0-9A-Za-z]*\)\n\(-\{0,1\}\)1\n\2\([0-9]\{1,\}\)\n/\1\n\3\n/ ; t op_mul
        # special case (|A| = 1 OR |B| = 1) AND A * B < 0
        s/^M\([0-9A-Za-z]*\)\n-1\n\([0-9]\{1,\}\)\n/\1\n-\2\n/ ; t op_mul
        s/^M\([0-9A-Za-z]*\)\n1\n-\([0-9]\{1,\}\)\n/\1\n-\2\n/ ; t op_mul
        s/^M\([0-9A-Za-z]*\)\n-\([0-9]\{1,\}\)\n1\n/\1\n-\2\n/ ; t op_mul
        s/^M\([0-9A-Za-z]*\)\n\([0-9]\{1,\}\)\n-1\n/\1\n-\2\n/ ; t op_mul
        # normalize signs (-?<multiplicand> <multiplier>)
        s/^M\([0-9A-Za-z]*\)\n-\([0-9]*[1-9]\)\(0*\)\n\([0-9]\{1,\}\)\n/S\4\3 \2\n\1\n0\n/ ; t do_mul
        s/^M\([0-9A-Za-z]*\)\n\([0-9]*[1-9]\)\(0*\)\n-\([0-9]\{1,\}\)\n/S\4\3 \2\n\1\n0\n/ ; t do_mul
        s/^M\([0-9A-Za-z]*\)\n\(-\{0,1\}\)\([0-9]*[1-9]\)\(0*\)\n\2\([0-9]\{1,\}\)\n/A\5\4 \3\n\1\n0\n/ ; t do_mul
        i\
operands missing for *
        b hold_bailout

        # decompose into series of addition
        :do_mul
        #  1sign   2mult.nd    3 4multiplier    5zeroes      6stack   7accumulator
        s/^\([SA]\)\([0-9]*\) \(\([0-9]*[1-9]\)\(0*\)\)\{0,1\}1\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\6\n\2\n\7\n\1\2\50\n\4\n/ ; t op_add_1
        #  1sign   2mult.nd    3multiplier  4stack   5accumulator
        s/^\([SA]\)\([0-9]*\) \([0-9]*\)2\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\4\n\2\n\5\n\1\2\n\31\n/ ; t op_add_1
        s/^\([SA]\)\([0-9]*\) \([0-9]*\)3\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\4\n\2\n\5\n\1\2\n\32\n/ ; t op_add_1
        s/^\([SA]\)\([0-9]*\) \([0-9]*\)4\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\4\n\2\n\5\n\1\2\n\33\n/ ; t op_add_1
        s/^\([SA]\)\([0-9]*\) \([0-9]*\)5\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\4\n\2\n\5\n\1\2\n\34\n/ ; t op_add_1
        s/^\([SA]\)\([0-9]*\) \([0-9]*\)6\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\4\n-\2\n\5\n\1\2\n\37\n/ ; t op_add_1
        s/^\([SA]\)\([0-9]*\) \([0-9]*\)7\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\4\n-\2\n\5\n\1\2\n\38\n/ ; t op_add_1
        s/^\([SA]\)\([0-9]*\) \([0-9]*\)8\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/\1Rm\4\n-\2\n\5\n\1\2\n\39\n/ ; t op_add_1
        #  1sign   2mult.nd    3 4multiplier    5zeroes      6stack   7accumulator
        s/^\([SA]\)\([0-9]*\) \(\([0-9]*[1-9]\)\(0*\)\)\{0,1\}9\n\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]*\)\n/S\1Rm\6\n\2\n\20\n\7\n\1\2\50\n\4\n/ ; t op_add_1

        # aaa * 9 = aaa0 - aaa
        i\
assertion failure: no match for do_mul
        x ; b reset
    }
    :loop3
    x
    s/^\/// ; t push_div
    s/^\*// ; t push_mul
    x
    :op_add
    # subroutine return
    #    1stack   2accumulator
    s/^Rm\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]\{1,\}\)\n[SA][0-9]\{1,\}\n\n/\1\n\2\n/ ; t op_mul
    #    1stack   2accumulator 3multiplicand    4multiplier
    s/^Rm\([0-9A-Za-z]*\)\n\(-\{0,1\}[0-9]\{1,\}\)\n\([SA][0-9]\{1,\}\)\n\([0-9]\{1,\}\)\n/\3 \4\n\1\n\2\n/ ; t do_mul
    /^[SA]/{
        :op_add_1
        # normalize signs
        s/^S\([0-9A-Za-z]*\)\n-\([0-9]*\)\n-\([0-9]*\)\n/\3  \2\n\3q\1\n/ ; t do_dec
        s/^A\([0-9A-Za-z]*\)\n\([0-9]*\)\n-\([0-9]*\)\n/\3  \2\n\3q\1\n/ ; t do_dec
        s/^S\([0-9A-Za-z]*\)\n\([0-9]*\)\n\([0-9]*\)\n/\2  \3\n\2q\1\n/ ; t do_dec
        s/^A\([0-9A-Za-z]*\)\n-\([0-9]*\)\n\([0-9]*\)\n/\2  \3\n\2q\1\n/ ; t do_dec
        s/^S\([0-9A-Za-z]*\)\n\([0-9]*\)\n-\([0-9]*\)\n/ \2 \3\ny\1\n/ ; t do_inc
        s/^A\([0-9A-Za-z]*\)\n-\([0-9]*\)\n-\([0-9]*\)\n/ \2 \3\ny\1\n/ ; t do_inc
        s/^S\([0-9A-Za-z]*\)\n-\([0-9]*\)\n\([0-9]*\)\n/ \2 \3\nz\1\n/ ; t do_inc
        s/^A\([0-9A-Za-z]*\)\n\([0-9]*\)\n\([0-9]*\)\n/ \2 \3\nz\1\n/ ; t do_inc
        /^A/i\
operands missing for +
        /^S/i\
operands missing for -
        b hold_bailout

        :do_dec
        s/^ /c / ; t do_inc
        s/^\([0-9]*[0-9]\) /\1;0123456789876543210;/ ; t do_dec_2 ; x ; b assert

        :do_dec_2
        s/^\([0-9]*\)\([0-9]\);[0-9]\{0,9\}\2[0-9]\{8\}\([0-9]\)[0-9]\{0,10\};/\1 \3/ ; t do_dec
        i\
assertion failure: 10's complement
        x ; b reset

        :do_inc
        s/^c\([0-9]*\)  \n/1\1\n/ ; t cse_fin
        s/^\([0-9]*\) \([0-9]*\) \n/\2\1\n/ ; t cse_fin
        s/^\([0-9]*\)  \([0-9]\{1,\}\)\n/\2\1\n/ ; t cse_fin

        #    1      2           3         4 (extract digits, pad left)
        s/^\(c\{0,1\}\)\([0-9]*\)  \([0-9]*\)\([0-9]\)\n/\10\4\2  \3\n/ ; t cse_2
        #    1      2          3         4       (extract digits, pad right)
        s/^\(c\{0,1\}\)\([0-9]*\) \([0-9]*\)\([0-9]\) \n/\1\40\2 \3 \n/ ; t cse_2
        #    1      2          3         4         5         6 (extract digits)
        s/^\(c\{0,1\}\)\([0-9]*\) \([0-9]*\)\([0-9]\) \([0-9]*\)\([0-9]\)\n/\1\4\6\2 \3 \5\n/ ; t cse_2
        i\
assertion failure: digit extraction
        x ; b reset

        :cse_2
        s/^c\([0-9]\{2\}\)/\10123456789;/ ; t cse_3
        s/^\([0-9]\{2\}\)/\10123456789 ;/ ; t cse_3
        i\
assertion failure: table insertion
        x ; b reset

        :cse_3
        s/^\([0-9]\)\([0-9]\)[0-9 ]\{0,9\}\1\([0-9 ]\{0,10\}\);/\20123456789;\3;/ ; t cse_4
        i\
assertion failure: 1st operand
        x ; b reset

        :cse_4
        s/^\([0-9]\)[0-9]\{0,9\}\1\([0-9]\{0,9\}\);\([0-9 ]*\);/\2\3,01234567890123456789;/ ; t cse_5
        i\
assertion failure: 2nd operand
        x ; b reset

        :cse_5
        /^[0-9 ]\{0,9\},/{
            s/^[0-9 ,]\{20\}\([0-9]\)[0-9]\{0,19\};/c\1/ ; t do_inc
            i\
assertion failure: carry
            x ; b reset
        }

        s/^[0-9 ,]\{20\}\([0-9]\)[0-9]\{0,19\};/\1/ ; t do_inc
        i\
assertion failure: no carry
        x ; b reset

        :cse_fin
        s/^\([0-9]\{1,\}\)\nz\([0-9A-Za-z]*\)\n/\2\n\1\n/ ; t op_add
        s/^\([0-9]\{1,\}\)\ny\([0-9A-Za-z]*\)\n/\2\n-\1\n/ ; t op_add
        s/^\([0-9]\{1,\}\)\n\([0-9]\{1,\}\)q/\1 \2 \n/ ; t cse_post
        i\
assertion failure: addition post-process
        x ; b reset

        # Given N = (number of characters preceding 'q'), subtract 10^N
        :cse_post
            # divide by 10^N - that is, <quo><space><space><rem>
            s/^\([0-9]*\)\([0-9]\) \([0-9]*\)[0-9] /\1 \3 \2/
            s/^ \([0-9]*\)[0-9] / \1 0/
            t cse_post

        s/^0* // ; t cse_neg

        # subtract by 1 - that is, <space><quo-1><space><rem>
        :cse_pos
        s/^k 0* 0*\n\([0-9A-Za-z]*\)\n/\1\n0\n/ ; t op_add
        s/^k 0* 0*\([1-9][0-9]*\)\n\([0-9A-Za-z]*\)\n/\2\n\1\n/ ; t op_add
        s/^k 0*\([1-9][0-9]*\) \([0-9]*\)\n\([0-9A-Za-z]*\)\n/\3\n\1\2\n/ ; t op_add
        s/^\([0-9]*\)0 \([0-9]*\)/\1 9\2/ ; t cse_pos ; s/^\([0-9]*\)\([0-9]\)k \([0-9]*\)/\1k \2\3/ ; t cse_pos
        s/^/9876543210 / ; t cse_pos_2
        x ; b assert

        :cse_pos_2
        s/^[0-9]*\([0-9]\)\([0-9]\)[0-9]* \([0-9]*\)\1 /\3k \2/ ; t cse_pos
        x ; b assert

        i\
assertion failure: positive outcome on subtraction
        x ; b reset

        :cse_neg
        # hold: <space><rem>
        # If quo == 0, evaluate -(10^N - rem) - that is, <absval><space>b?
        s/^\([0-9]*\) \n\([0-9A-Za-z]*\)\n/\2\n-1\1\n/ ; t op_add
        s/^0* b\n\([0-9A-Za-z]*\)\n/\1\n0\n/ ; t op_add
        s/^0*\([1-9][0-9]*\) b\n\([0-9A-Za-z]*\)\n/\2\n-\1\n/ ; t op_add
        s/^\([0-9]*\) \([0-9]*\)0\n/0\1 \2\n/ ; t cse_neg

        s/^\([0-9]*\) \([0-9]*\)b\n/\1 \2 0123456789876543210\n/ ; t cse_neg_2
        s/^\([0-9]*\) \([0-9]*\)\n/\1 \2 0123456789987654321\n/ ; t cse_neg_2
        x ; b assert

        :cse_neg_2
        s/^\([0-9]*\) \([0-9]*\)\([0-9]\) [0-9]\{0,9\}\3[0-9]\{8\}\([0-9]\)[0-9]\{0,10\}\n/\4\1 \2b\n/ ; t cse_neg
        i\
assertion failure: negative outcome on subtraction
        x ; b reset
    }
    x
    s/^+// ; t push_add
    s/^-// ; t push_sub
    s/^)// ; t cse
    /^$/{
        x ; s/^\n\(-\{0,1\}[0-9]\{1,\}\)\n$/\1/ ; t eof_ok ; i\
unexpected EOF
        b hold_bailout
        :eof_ok ; p ; b hold_bailout
    }
    i\
assertion failure: no tokens match
    b reset
}
s/^/unknown token: / ; p ; x
b hold_bailout

:assert ; i\
assertion failure
:reset
s/^.*$/pattern: &/ ; l ; x ; s/^.*$/hold: &/ ; l
b hold_bailout

:push_neg ; x ; s/^/N/ ; x ; t scan_unop ; b assert
:push_pos ; x ; s/^/P/ ; x ; t scan_unop ; b assert
:push_div ; x ; s/^/D/ ; x ; t scan_unop ; b assert
:push_mul ; x ; s/^/M/ ; x ; t scan_unop ; b assert
:push_sub ; x ; s/^/S/ ; x ; t scan_unop ; b assert
:push_add ; x ; s/^/A/ ; x ; t scan_unop ; b assert
:zero_end ; x ; s/^\([0-9A-Za-z]*\)\n/\1\n0\n/ ; t loop1 ; x ; b assert

# TODO handle functions
:opn ; x ; s/^/O/ ; x ; t scan_unop ; b assert
:cse ; x ; s/^O// ; x ; t scan ; i\
brackets mismatch
x
:hold_bailout
# There seem no portable way to clear pattern space
# with invalid multibyte sequence other than 'd' (GNU sed provides 'z').
s/^.*$/\n/ ; x ; d