To make an infix evaluator I've worked through enough of Crenshaw's Compiler Tutorial
http://compilers.iecc.com/crenshaw/
to create an evaluator. It handles variables(an alpha follows by alphas/digits, floats, +-*/, (), and functions of 1 parameter (which may be an expression). Power x^y can be done as exp(y*log(x)).
The string must be in the form of an assignment (this would be easy to change)
variable=expression.
Any single valued function can be called.
Whitespace is allowed between ops and vars -not between funct name and (.
The code analyses the string and generates lisp that mirrors the 6800 instructions generated by the 'compiler' in the tutorial. This lisp is then evaled.
The generated code is not efficient but works (I think) - comments are welcome.
Examples:
> (MYINFIX:doinfix "avar = 3.4/ 2.7 + sqrt(2)* 8")
12.57296776
> (MYINFIX:doinfix "avar = exp(3*log(2))")
8
> (MYINFIX:doinfix "avar = -2*(3+(4.5/ (3.4 -8)))*exp(3*log(2))")
-32.34782609
> avar
-32.34782609
>
The code:
;infix evaluator from pascal of crenshaw compiler tutorial text to newlisp
;program MYINFIX;
(context 'MYINFIX)
;{ Constant Declarations }
(constant 'TAB "\t")
;{ Variable Declarations }
; { Lookahead Character }
(setq Look nil)
;{ Read New Character From Input Stream }
(define (GetChar) (setq Look (pop inputchars)))
;{ Report an Error }
(define (Error s) (push (append "\n Error: " s) emitted -1))
;{ Report Error and Halt }
(define (Abort s) (begin (Error s) (throw "exit")))
;{ Report What Was Expected }
(define (Expected s) (Abort (append s " Expected")))
;{ Match a Specific Input Character }
(define (Match x) (if (= Look x) (begin
(GetChar)
(SkipWhite))
;else
(Expected (append {Found "} Look {" but "} x {" }))))
;{ Recognize an Alpha Character }
(define (IsAlpha c) (integer? (find c "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" )))
;{ Recognize a Decimal Digit }
(define (IsDigit c) (integer? (find c "0123456789")))
(define (IsAddop c) (integer? (find c "+-")))
;{ Get an Identifier }
(define (GetName , Token) (begin
(setq Token '())
(if (not (IsAlpha Look)) (Expected "Name"))
(while (IsAlphaNum Look) (begin
(push Look Token -1)
(GetChar)))
(SkipWhite)
(join Token)))
(define (IsAlphaNum c)
(or (IsAlpha c) (IsDigit c)))
(define (IsWhite c) (integer? (find c " \t")))
(define (SkipWhite) (while (IsWhite Look) (GetChar)))
;{ Get a Number }
(define (GetNum , Value) (begin
(setq Value '())
(if (not (IsDigit Look)) (Expected "Number"))
(while (IsFloat Look) (begin
(push Look Value -1)
(GetChar)))
(SkipWhite)
(setq Value (join Value))
(if (!= 0 (find "^[0-9]+$|^[0-9]+\.$|^[0-9]+\.[0-9]*$" Value 0))
(Expected "float"))
Value))
(define (IsFloat c) (integer? (find c "0123456789.")))
;{ Output a String with Tab }
(define (Emit s) (push (append TAB s) emitted -1))
;{ Output a String with Tab and CRLF }
(define (EmitLn s) (if (string? s) (push (append TAB s "\n") emitted -1)
(push s emitted -1)))
;{ Initialize }
(define (Init) (begin
(setq emitted '())
(GetChar)
(SkipWhite)))
;{ Parse and Translate a Math Expression }
(define (Factor) (begin
(if (= Look "(") (begin
(Match "(")
(Expression)
(Match ")"))
;else
(if (IsAlpha Look)
(Ident)
;else
(EmitLn (append '(setq D0) (list (float (GetNum))))))))) ; MOV #n,D0
; get Identifier alpha followed by alpha/digits + handle function
(define (Ident , Name Param) (begin
(setq Name (GetName))
(setq Param '())
(if (= Look "(") (begin
(Match "(")
(if (!= Look ")") (begin (Expression) (setq Param 'D0)))
(Match ")")
(EmitLn (append '(setq D0) (list (list (symbol Name) Param)))))
;else
(EmitLn (append '(setq D0) (list (symbol Name))))))) ; MOVE X(PC),D0
(define (Multiply) (begin
(Match "*")
(Factor)
(EmitLn '(setq D0 (mul D0 (pop stk)))))) ;MULS (SP)+,D0
(define (Divide) (begin
(Match "/")
(Factor)
(EmitLn '(setq D1 (pop stk)))) ; MOV (SP)+, D1
(EmitLn '(setq D0 (div D1 D0)))) ; DIVS D1,D0
(define (Term) (begin
(Factor)
(while (integer? (find Look "*/"))
(EmitLn '(push D0 stk)) ; MOVE D0,-(SP)
(case Look
("*" (Multiply))
("/" (Divide))
(true (Expected "Mulop"))))))
(define (Add) (begin
(Match "+")
(Term)
(EmitLn '(setq D0 (add D0 (pop stk)))))) ; Add (SP)+,D0
(define (Subtract) (begin
(Match "-")
(Term)
(EmitLn '(setq D0 (sub D0 (pop stk)))) ; SUB (SP)+, D0
(EmitLn '(setq D0 (sub D0))))) ; NEG D0
(define (Expression) (begin
(if (IsAddop Look)
(EmitLn '(setq D0 0))
;else
(Term))
(while (IsAddop Look)
(EmitLn '(push D0 stk)) ; MOVE D0,-(SP)
(case Look
("+" (Add))
("-" (Subtract))
(true (Expected "Addop"))))))
(define (Assignment, Name) (begin
(setq Name (GetName))
(Match "=")
(Expression)
(EmitLn (append '(setq ) (list (symbol Name)) '(D0))))) ; LEA X(PC),A0
; Move D0,(A0)
(define (Main) (begin
(Init)
(Assignment)
(if (!= Look "\n") (Expected "Newline"))))
;; drive for Main from tutorial - sets up input,
;; catches error message if throw
;; echoes output
;; instr in input program
(define (DoMain instr) (begin (setq inputchars (explode instr))
(if (not (catch (Main) 'result)) (push result emitted -1))
emitted))
;; fn to evaluate over emitted compilation
(define (execute e , stk D0) (eval (append '(begin (setq stk '())) e)))
(define (doinfix s) (execute (DoMain (append s "\n"))))
(context 'MAIN)