Paste: infix math

USING: ascii assocs fry kernel math math.parser multiline
namespaces parser peg.ebnf sequences strings words locals.parser
locals.types quotations summary ;
IN: math-parser

: prepare-operand ( term -- quot )
    dup callable? [ '[ _ call ] ] [ '[ _ ] ] if ;

: construct-op ( l r quot -- result/quot )
    2over [ number? ] both? [ call ] [ 
        [ [ prepare-operand ] bi@ ] dip compose compose
    ] if 
    ; inline

: +op ( l r -- result/quot ) [ + ] construct-op ; inline
: -op ( l r -- result/quot ) [ - ] construct-op ; inline
: *op ( l r -- result/quot ) [ * ] construct-op ; inline
: /op ( l r -- result/quot ) [ / ] construct-op ; inline

ERROR: local-not-defined name ;
M: local-not-defined summary
    drop "local is not defined" ;

: at? ( key assoc -- value/key ? ) dupd at* [ nip t ] [ drop f ] if ;

: >local-word ( string -- word )
    locals get at? [ local-not-defined ] unless ;

EBNF: math-parser
ident = [a-zA-z] [a-zA-Z_0-9]* => [[ first2 swap prefix >string >local-word ]]

num = ("-"|"+")? [0-9]+ "."? [0-9]* => [[ concat >string string>number ]]

sum-term = (sum-term ("-"|"+"))? product-term =>
    [[ first2 over [ [ first2 ] dip swap "+" = [ +op ] [ -op ] if ] [ nip ] if ]]

product-term = (product-term ("*"|"/"))? (paren-exp|terminal) =>
    [[ first2 over [ [ first2 ] dip swap "*" = [ *op ] [ /op ] if ] [ nip ] if ]]

paren-exp = "(" expression ")" => [[ second ]]
terminal = num | ident
expression = sum-term | terminal
;EBNF

: [math-parse ( end -- result/quot )
    parse-multiline-string [ blank? not ] filter math-parser
    dup number? [ '[ _ ] ] when ;

DEFER: math]
: [math
    "math]" [math-parse parsed \ call parsed ; parsing

: parse-math-locals ( assoc end -- quot )
    [
        in-lambda? on
        [ dup [ locals set ] [ push-locals ] bi ] dip
        [math-parse [ call ] curry swap pop-locals
    ] with-scope ;

: [math|
    "|" parse-bindings "math]" parse-math-locals <let>
    parsed-lambda ; parsing