infix reader macro from clisp to newLisp?

[HPW]

In the common lisp world there is a reader makro to evaluate mathematical expressions in clisp:



http://www-2.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/syntax/infix/0.html">http://www-2.cs.cmu.edu/afs/cs/project/ ... fix/0.html">http://www-2.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/syntax/infix/0.html



Would it be possible to port this to newLisp?



Why did I asked? Because in my real worlds project in the alisp world I use a autodesk runtime extension called "geomcalc.arx" to evaluate such expressions from a oracle database. When I want to port it to the outside world of acad, it has to be replaced with something other. The best I found until now, was the infix-reader macro.

[Lutz]

There are no reader macros in newLISP as it parses/compiles LISP source in to internal memory structures on loading (which makes newLISP so fast).



But still, a newLISP macro-function could surely be written to parse and evaluate infix expressions. There is an example of how to do this in "Artificial Intelligence Programming" from Peter Norvig, but his function is only translates fully parenthesized infix expressions into prefix (LISP) expressions.



A better solution would be to write a stack parser, where you push operators and parameters/results on 2 different stacks and only pop and evaluate when an operator with equal or lower priority comes on the op stack. The operator is then poppped and pops the arguments needed from the parameters/result stack. The evaluated result is then pushed back on the parameters/result stack. Parenthesis are traeted differently such that an opening parentesis only can be resolved by a closing one, popping/evaluating all operators in between.



These parsers are sometimes called "priority grammatik" parsers. I have written several of those in 'C' and one in Java. The nice thing about them is, that they also can parse 'reversed polish postfix- rpn' expressions at the same time. The hard thing is how to treat operators, which can be unary or binary. I.e. + and - can be binary or unary in different situations.



Such a parser/evaluator could be written in half a page of newLISP source. I could do one for the Tips&Tricks section on http://newlisp.org/news">http://newlisp.org/news , (but not this weekend).



Lutz

[HPW]

I would like to see something like that in the Tips and Tricks section. Another good offer for learning lispy thinking. I will keep an eye on the section. Thanks again!

[Ryon]

Two stacks? RPN? You're dangerously close to a description of Forth. Implement that just half as well as you have written newLISP, and I'm sure you would have another fan club with REALLY fanatic followers!

[Lutz]

Actually I did this already about 3 years ago it's called 'Goku' (after the Japanese cartoon character) and it a a 32bit Forth written in assembler for the x86 instruction set. I never have published it but you can read the documentation here: http://nuevatec.com/gokumanual.html">http://nuevatec.com/gokumanual.html . It's a nice Forth with 32bit integers (most Forth's because they are older only operate on 16bit integers).



Here is a code example for Hanoi: http://nuevatec.com/hanoi.goku.txt">http://nuevatec.com/hanoi.goku.txt



The graphics where done using imported Win32 SDK graphics functions. There is also a version for Linux compiled with NASM, but without graphics.



I eventually abandoned the project, realizing that the whole thing was just kind of insane. Forth code is hard to read and debugging this stuff is hell (although Goku has provisions for a tracing facility). It sure was fast!



I remember Sun workstations had Forth in their bootroms (or still have?) for configuring your boot process on these machines.



Lutz

[Ryon]

There is a simplicity in Goku that I like. I can look at the code and understand at least generally what the machine is going to do. I am still struggling with Lisp.



You use variables and locals in your Goku examples that I am sure you would not use in production code. This complicates the code somewhat, especially in the Towers of Hanoi example where in nearly every word you declare a local, pop the value off the stack, store it into the variable, then immediately access the value. This obscures the elegance of the language and makes the code unnessarily hard to read. And slow. And Hell to debug. There is almost no need for variables in traditional Forth coding, which is good. Therefore the issues of creating, initializing, checking, using, destroying, and reclaiming the variables just don't exist, leaving lots of white space to see the logic of the program instead. Gnarly concepts such as scoping and object orientation become useful extensions to the language, rather than basic requirements for mastery.



But I am not picking on your code. In fact I think it is great that you understand the same languages that I do. I would never be able to converse with you in C++, or in German.



There have been many stack-oriented RPN languages written, but most have no user interface beyond the command line of a cp/m, ms-dos, or unix. The consumer market for the last fifteen years or so has been graphic, and it has been Windows. The world is not waiting for a new Forth, but it is waiting for an ANS Forth that networks and does Windows. Why this has never been done puzzles and frustrates me. The prospect of creating a Forth using the great Windows native calls of your earlier newLISP, or with a GUI toolkit such as the present Tk, is very appealing. The clean way you are able to to work the language onto the Byzantine Windows system is very impressive.

[Lutz]

I remember the first programmable HP calculator, I think it was HP-45, you could cram ton's of stuff into the less than 100 programming step space.



Perhaps one day I'll dig out Goku again, and work on it. Originally I had in 68k assembler developing with an emulator running on a PC. The thought was to publish it for the Palm handlheld, but than I ported it to x86 assembler, which also facilitated debugging tremendously using the Borland Turboassembler and debugger.



Lutz

[HPW]

Hello Lutz,

Such a parser/evaluator could be written in half a page of newLISP source. I could do one for the Tips&Tricks section on http://newlisp.org/news">http://newlisp.org/news , (but not this weekend).

Is there any chance that you come back to this infix parser?

Of cource not this weekend, but in a near future? :-)

I am still searching such one and it sounds that you have yet the idea how to do it and that it might be easy for you.

Would be a another wellcomed package.

[Lutz]

I will put it on my to-do list. The Tips&Tricks section needs some articles new anyway.



Lutz

[HPW]

Some operators are missing:

Code Select Expand

(set 'operators '(
  ("=" set! 2 2)
  ("+" add 2 3)
  ("-" sub 2 3)
  ("*" mul 2 4)
  ("/" div 2 4)
  ("^" pow 2 5)
  ("asin" asin 1 9)
  ("acos" acos 1 9)
  ("atan" atan 1 9)
  ("sin" sin 1 9)
  ("cos" cos 1 9)
  ("tan" tan 1 9)
  ("sqrt" sqrt 1 9)
  ("^" pow 1 6)))


PS: Why is 'pow' 2 times in the list?

[Lutz]

The last one can be deleted, the other once can be added, wanted to keep the example short, but have some functions with only 1 arg.



Lutz

[HPW]

With the info about basic operators from the other thread, it make me thinking about infix-reader output. It works for me right now, but I could imagine that other want to parse the formula to integer arithmethic.



So this would do that I think:

Code Select Expand


(set 'operators '(
  ("+" + 2 3)
  ("-" - 2 3)
  ("*" * 2 4)
  ("/" / 2 4)))


So may be it would be good to make a flag to INFIX:xlate to tell it what output is needed.

[Lutz]

Yes, basically the idea is, that the operators table gets tailored to the specific needs of the environment , where you use the parser.



What also could be changed or made configurable, is the kind of tokenizer used to break up the incoming expression string. The example uses newLISP's internal parser, but of course you could plug in something customized.



Lutz

[nigelbrown]

To make an infix evaluator I've worked through enough of Crenshaw's Compiler Tutorial

http://compilers.iecc.com/crenshaw/">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)

[Lutz]

very nice!



Lutz