Rosetta Code

Arithmetic evaluation: Difference between revisions

Page Discussion

Arithmetic evaluation (view source)

Revision as of 22:08, 5 December 2011

331 bytes removed ,  12 years ago
→‎{{header|TXR}}: New implementation with AST construction and evaluation.
(→‎{{header|TXR}}: Works with released functionality.)
(→‎{{header|TXR}}: New implementation with AST construction and evaluation.)
Line 2,984:
=={{header|TXR}}==
 
Use TXR text pattern matching to parse expression to a Lisp AST, then evaluate with <code>eval</code>:
This implementation flouts the requirement to build an AST, and goes straight to code generation. The handlers for the grammar are endowed with semantic actions. Each element must parse the expression and produce two semantic values: the code, and the output register of that code. The target language is the Unix shell, so we can just <code>eval</code> the output in the shell to run the "machine code".
 
<lang txr>@(next :args)
@(define genregspace)@/ */@(r)end)▼
@(bind nl "\n")
@(binddefine genmulop "0"(nod))@\
@(local nop)@\▼
▲@(define genreg (r))
@(casesspace)@\▼
@ (local ngen)
@(cases)@\▼
@ (next `!echo $((1 + @gen))`)
@{op /[*]/}@(bind nod @(intern op *user-package*))@\
@ ngen
@ (set gen ngen@(or)@\
@ @{op /\//}@(bind r(nod) `R@gen`(list 'trunc))@\
@(end)@\▼
@(orspace)@\▼
@(end)
@(define wsaddop (nod))@/[ \t]*/@(end)
@(definelocal mulop (o)op)@(wsspace)@{oop /[+\/*-]/}@(wsspace)@(end)\
@(bind nod @(intern op *user-package*))@\
@(define addop (o))@(ws)@{o /[\-+]/}@(ws)@(end)
@(define number (reg code))@\
▲ @(local n)@\
@(ws)@{n /[0-9]+/}@(ws)@\▼
@(genreg reg)@\
@(bind code `@reg=@n@nl`)@\▼
@(end)
@(define factornumber (reg codenod))@\
▲ @(wslocal n)@(space)@{n /[0-9]+/}@(wsspace)@\
▲ @(cases)@\
@(bind nod (@(exprint-str regn code10))@\
▲ @(or)@\
@(number reg code)@\
▲ @(end)@\
@(end)
@(define termfactor (regnod))@(cases)(@(expr codenod))@\(or)@(number nod)@(end)@(end)
@(localdefine r1term c1 op r2 c2(nod))@\
@(factorlocal r1op c1nod1 nod2)@\
@(cases)@\
@(mulopfactor op)@(term r2 c2nod1)@\
@(cases)@(mulop op)@(term nod2)@(bind nod (op nod1 nod2))@\
@(genreg reg)@\▼
@(bind code `or)@c1@c2@reg=$((@r1bind @opnod @r2))@nl`nod1)@\
▲ @(genreg regend)@\
@(or)@\
@(bindaddop (reg codeop) @(r1factor c1)nod1)@\
▲ @(bind codenod `@reg=@n@nl`(op nod1))@\
@(end)@\
@(end)
@(define expr (reg codenod))@\
@(local r1 c1 op r2nod1 c2nod2)@\
@(term r1 c1nod1)@\
@(cases)@(addop op)@(expr nod2)@(bind nod (op nod1 nod2))@\
▲ @(cases)@\
@(addop opor)@(exprbind r2nod c2nod1)@\
@(genreg reg)@\
@(bind code `@c1@c2@reg=$((@r1 @op @r2))@nl`)@\
@(or)@\▼
@(bind (reg code) (r1 c1))@\
@(end)@\
@(end)
@(cases)
@(expr reg code)
@ {source (expr e)}
@ (output)
@code
source: @source
echo $@reg
AST: @(format nil "~s" e)
value: @(eval e nil)
@ (end)
▲ @(or)@\
@ (maybe)@(expr e)@(end)@bad
@ (output)
erroneous suffix "@bad"
@ (end)
@(end)</lang>
 
Run:
 
<lang bashpre>$ ./ txr exprtranexpr-ast.txr '3 + 3/4 * (2 + 2) + (4*4)'
source: 3 + 3/4 * (2 + 2) + (4*4)
R1=3
AST: (+ 3 (+ (trunc 3 (* 4 (+ 2 2))) (* 4 4)))
R2=3
value: 19</pre>
R3=4
R4=2
R5=2
R6=$((R4 + R5))
R7=$((R3 * R6))
R8=$((R2 / R7))
R9=4
R10=4
R11=$((R9 * R10))
R12=$((R8 + R11))
R13=$((R1 + R12))
 
echo $R13</lang>
 
<lang bash>$ eval "$(./txr exprtran.txr '3 + 3/4 * (2 + 2) + (4*4)')"
19</lang>
 
 
 
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/50615"