2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,32 +1,38 @@
|
|||
Given the operator characteristics and input from the [[wp:Shunting-yard_algorithm|Shunting-yard algorithm]] page and tables
|
||||
Use the algorithm to show the changes in the operator stack and RPN output
|
||||
;Task:
|
||||
Given the operator characteristics and input from the [[wp:Shunting-yard_algorithm|Shunting-yard algorithm]] page and tables, use the algorithm to show the changes in the operator stack and RPN output
|
||||
as each individual token is processed.
|
||||
|
||||
* Assume an input of a correct, space separated, string of tokens representing an infix expression
|
||||
* Generate a space separated output string representing the RPN
|
||||
* Test with the input string <code>'3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3'</code> then print and display the output here.
|
||||
* Test with the input string:
|
||||
:::: <big><big><code> 3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3 </code></big></big>
|
||||
* print and display the output here.
|
||||
* Operator precedence is given in this table:
|
||||
:{| class="wikitable"
|
||||
|
||||
! operator !! precedence !! associativity
|
||||
! operator !! [[wp:Order_of_operations|precedence]] !! [[wp:Operator_associativity|associativity]] !! operation
|
||||
|- || align="center"
|
||||
| ^ || 4 || Right
|
||||
| <big><big> ^ </big></big> || 4 || right || exponentiation
|
||||
|- || align="center"
|
||||
| * || 3 || Left
|
||||
| <big><big> * </big></big> || 3 || left || multiplication
|
||||
|- || align="center"
|
||||
| / || 3 || Left
|
||||
| <big><big> / </big></big> || 3 || left || division
|
||||
|- || align="center"
|
||||
| + || 2 || Left
|
||||
| <big><big> + </big></big> || 2 || left || addition
|
||||
|- || align="center"
|
||||
| - || 2 || Left
|
||||
| <big><big> - </big></big> || 2 || left || subtraction
|
||||
|}
|
||||
|
||||
;Extra credit:
|
||||
* Add extra text explaining the actions and an optional comment for the action on receipt of each token.
|
||||
<br>
|
||||
;Extra credit
|
||||
Add extra text explaining the actions and an optional comment for the action on receipt of each token.
|
||||
|
||||
|
||||
;Note
|
||||
The handling of functions and arguments is not required.
|
||||
|
||||
;Note:
|
||||
* the handling of functions and arguments is not required.
|
||||
|
||||
;See also:
|
||||
* [[Parsing/RPN calculator algorithm]] for a method of calculating a final value from this output RPN expression.
|
||||
* [[Parsing/RPN to infix conversion]].
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,89 @@
|
|||
;;;; Parsing/infix to RPN conversion
|
||||
(defconstant operators "^*/+-")
|
||||
(defconstant precedence '(-4 3 3 2 2))
|
||||
|
||||
(defun operator-p (op)
|
||||
"string->integer|nil: Returns operator precedence index or nil if not operator."
|
||||
(and (= (length op) 1) (position (char op 0) operators)))
|
||||
|
||||
(defun has-priority (op2 op1)
|
||||
"(string,string)->boolean: True if op2 has output priority over op1."
|
||||
(defun prec (op) (nth (operator-p op) precedence))
|
||||
(or (and (plusp (prec op1)) (<= (prec op1) (abs (prec op2))))
|
||||
(and (minusp (prec op1)) (< (- (prec op1)) (abs (prec op2))))))
|
||||
|
||||
(defun string-split (expr)
|
||||
"string->list: Tokenize a space separated string."
|
||||
(let* ((p (position #\Space expr))
|
||||
(tok (if p (subseq expr 0 p) expr)))
|
||||
(if p (append (list tok) (string-split (subseq expr (1+ p)))) (list tok))))
|
||||
|
||||
(defun classify (tok)
|
||||
"nil|string->symbol: Classify a token."
|
||||
(cond
|
||||
((null tok) 'NOL)
|
||||
((operator-p tok) 'OPR)
|
||||
((string= tok "(") 'LPR)
|
||||
((string= tok ")") 'RPR)
|
||||
(t 'LIT)))
|
||||
|
||||
;;; transitions when op2 is dont care
|
||||
(defconstant trans1D '((LIT GO) (LPR ENTER)))
|
||||
;;; transitions when we check op2 also
|
||||
(defconstant trans2D
|
||||
'((OPR ((NOL ENTER)
|
||||
(LPR ENTER)
|
||||
(OPR (lambda (op1 op2) (if (has-priority op2 op1) 'LEAVE 'ENTER)))))
|
||||
(RPR ((NOL "mismatched parentheses")
|
||||
(LPR CLEAR)
|
||||
(OPR LEAVE)))
|
||||
(NOL ((NOL nil)
|
||||
(LPR "mismatched parentheses")
|
||||
(OPR LEAVE)))))
|
||||
|
||||
(defun do-signal (op1 op2)
|
||||
"(nil|string,nil|string)->symbol|string|nil: Emit a signal based on state of inputq and opstack.
|
||||
A nil return is a successful lookup (on nil,nil) because all input combinations are specified."
|
||||
(let ((sig (or (cadr (assoc (classify op1) trans1D))
|
||||
(cadr (assoc (classify op2) (cadr (assoc (classify op1) trans2D)))))))
|
||||
(if (or (null sig) (symbolp sig) (stringp sig)) sig
|
||||
(funcall (coerce sig 'function) op1 op2))))
|
||||
|
||||
(defun rpn (expr)
|
||||
"string->string: Parse infix expression into rpn."
|
||||
(format t "TOKEN TOS SIGNAL OPSTACK OUTPUTQ~%")
|
||||
|
||||
;; iterate until both stacks empty
|
||||
(do* ((input (string-split expr)) (opstack nil) (outputq "")
|
||||
(sig (do-signal (first input) (first opstack)) (do-signal (first input) (first opstack))))
|
||||
((null sig) ; until
|
||||
;; print last closing frame
|
||||
(format t "~A~7,T~A~14,T~A~25,T~A~38,T~A~%" nil nil nil opstack outputq)
|
||||
(subseq outputq 1)) ; return final infix expression
|
||||
|
||||
;; print opening frame
|
||||
(format t "~A~7,T~A~14,T" (first input) (first opstack))
|
||||
(format t (if (stringp sig) "\"~A\"" "~A") sig)
|
||||
|
||||
;; switch state
|
||||
(let ((output (case sig
|
||||
(GO (pop input))
|
||||
(ENTER (push (pop input) opstack) nil)
|
||||
(LEAVE (pop opstack))
|
||||
(CLEAR (pop input) (pop opstack) nil)
|
||||
(otherwise (pop input) (pop opstack)
|
||||
(if (stringp sig) sig "unknown signal")))))
|
||||
(when output (setf outputq (concatenate 'string outputq " " output))))
|
||||
|
||||
;; print closing frame
|
||||
(format t "~25,T~A~38,T~A~%" opstack outputq))) ; end-do
|
||||
|
||||
(defun main (&optional (xtra nil))
|
||||
"nil->[printed rpn expressions]: Main function."
|
||||
(let ((expressions '("3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3"
|
||||
"( ( 1 + 2 ) ^ ( 3 + 4 ) ) ^ ( 5 + 6 )"
|
||||
"( ( 3 ^ 4 ) ^ 2 ^ 9 ) ^ 2 ^ 5"
|
||||
"3 + 4 * ( 5 - 6 ) ) 4 * 9")))
|
||||
(dolist (expr (if xtra expressions (list (car expressions))))
|
||||
(format t "~%INFIX:\"~A\"~%" expr)
|
||||
(format t "RPN:\"~A\"~%" (rpn expr)))))
|
||||
|
|
@ -0,0 +1,234 @@
|
|||
MODULE COMPILER !At least of arithmetic expressions.
|
||||
INTEGER KBD,MSG !I/O units.
|
||||
|
||||
INTEGER ENUFF !How long s a piece of string?
|
||||
PARAMETER (ENUFF = 66) !This long.
|
||||
CHARACTER*(ENUFF) RP !Holds the Reverse Polish Notation.
|
||||
INTEGER LR !And this is its length.
|
||||
|
||||
INTEGER OPSYMBOLS !Recognised operator symbols.
|
||||
PARAMETER (OPSYMBOLS = 11) !There are also some associates.
|
||||
TYPE SYMB !To recognise symbols and carry associated information.
|
||||
CHARACTER*1 IS !Its text. Careful with the trailing space and comparisons.
|
||||
INTEGER*1 PRECEDENCE !Controls the order of evaluation.
|
||||
CHARACTER*48 USAGE !Description.
|
||||
END TYPE SYMB !The cross-linkage of precedences is tricky.
|
||||
TYPE(SYMB) SYMBOL(0:OPSYMBOLS) !Righto, I'll have some.
|
||||
PARAMETER (SYMBOL =(/ !Note that "*" is not to be seen as a match to "**".
|
||||
o SYMB(" ", 0,"Not recognised as an operator's symbol."),
|
||||
1 SYMB(" ", 1,"separates symbols and aids legibility."),
|
||||
2 SYMB(")", 4,"opened with ( to bracket a sub-expression."),
|
||||
3 SYMB("]", 4,"opened with [ to bracket a sub-expression."),
|
||||
4 SYMB("}", 4,"opened with { to bracket a sub-expression."),
|
||||
5 SYMB("+",11,"addition, and unary + to no effect."),
|
||||
6 SYMB("-",11,"subtraction, and unary - for neg. numbers."),
|
||||
7 SYMB("*",12,"multiplication."),
|
||||
8 SYMB("×",12,"multiplication, if you can find this."),
|
||||
9 SYMB("/",12,"division."),
|
||||
o SYMB("÷",12,"division for those with a fancy keyboard."),
|
||||
C 13 is used so that stacked ^ will have lower priority than incoming ^, thus delivering right-to-left evaluation.
|
||||
1 SYMB("^",14,"raise to power. Not recognised is **.")/))
|
||||
CHARACTER*3 BRAOPEN,BRACLOSE !Three types are allowed.
|
||||
PARAMETER (BRAOPEN = "([{", BRACLOSE = ")]}") !These.
|
||||
INTEGER BRALEVEL !In and out, in and out. That's the game.
|
||||
INTEGER PRBRA,PRPOW !Special double values.
|
||||
PARAMETER (PRBRA = SYMBOL( 3).PRECEDENCE) !Bracketing
|
||||
PARAMETER (PRPOW = SYMBOL(11).PRECEDENCE) !And powers refer leftwards.
|
||||
|
||||
CHARACTER*10 DIGIT !Numberish is a bit more complex.
|
||||
PARAMETER (DIGIT = "0123456789") !But this will do for integers.
|
||||
|
||||
INTEGER STACKLIMIT !How high is a stack?
|
||||
PARAMETER (STACKLIMIT = 66) !This should suffice.
|
||||
TYPE DEFERRED !I need a siding for lower-precedence operations.
|
||||
CHARACTER*1 OPC !The operation code.
|
||||
INTEGER*1 PRECEDENCE !Its precedence in the siding may differ.
|
||||
END TYPE DEFERRED !Anyway, that's enough.
|
||||
TYPE(DEFERRED) OPSTACK(0:STACKLIMIT) !One siding, please.
|
||||
INTEGER OSP !The operation stack pointer.
|
||||
|
||||
INTEGER INCOMING,TOKENTYPE,NOTHING,ANUMBER,OPENBRA,HUH !Some mnemonics.
|
||||
PARAMETER (NOTHING = 0, ANUMBER = -1, OPENBRA = -2, HUH = -3) !The ordering is not arbitrary.
|
||||
CONTAINS !Now to mess about.
|
||||
SUBROUTINE EMIT(STUFF) !The objective is to produce some RPN text.
|
||||
CHARACTER*(*) STUFF !The term of the moment.
|
||||
INTEGER L !A length.
|
||||
WRITE (MSG,1) STUFF !Announce.
|
||||
1 FORMAT ("Emit ",A) !Whatever it is.
|
||||
IF (STUFF.EQ."") RETURN !Ha ha.
|
||||
L = LEN(STUFF) !So, how much is there to append?
|
||||
IF (LR + L.GE.ENUFF) STOP "Too much RPN for RP!" !Perhaps too much.
|
||||
IF (LR.GT.0) THEN !Is there existing stuff?
|
||||
LR = LR + 1 !Yes. Advance one,
|
||||
RP(LR:LR) = " " !And place a space.
|
||||
END IF !So much for separators.
|
||||
RP(LR + 1:LR + L) = STUFF !Place the stuff.
|
||||
LR = LR + L !Count it in.
|
||||
END SUBROUTINE EMIT !Simple enough, if a bit finicky.
|
||||
|
||||
SUBROUTINE STACKOP(C,P) !Push an item into the siding.
|
||||
CHARACTER*1 C !The operation code.
|
||||
INTEGER P !Its precedence.
|
||||
OSP = OSP + 1 !Stacking up...
|
||||
IF (OSP.GT.STACKLIMIT) STOP "OSP overtopped!" !Perhaps not.
|
||||
OPSTACK(OSP).OPC = C !Righto,
|
||||
OPSTACK(OSP).PRECEDENCE = P !The deed is simple.
|
||||
WRITE (MSG,1) C,OPSTACK(1:OSP) !Announce.
|
||||
1 FORMAT ("Stack ",A1,9X,",OpStk=",33(A1,I2:","))
|
||||
END SUBROUTINE STACKOP !So this is more for mnemonic ease.
|
||||
|
||||
LOGICAL FUNCTION COMPILE(TEXT) !A compiler confronts a compiler!
|
||||
CHARACTER*(*) TEXT !To be inspected.
|
||||
INTEGER L1,L2 !Fingers for the scan.
|
||||
CHARACTER*1 C !Character of the moment.
|
||||
INTEGER HAPPY !Ah, shades of mood.
|
||||
LR = 0 !No output yet.
|
||||
OSP = 0 !Nothing stacked.
|
||||
OPSTACK(0).OPC = "" !Prepare a bouncer.
|
||||
OPSTACK(0).PRECEDENCE = 0 !So that loops won't go past.
|
||||
BRALEVEL = 0 !None seen.
|
||||
HAPPY = +1 !Nor any problems.
|
||||
L2 = 1 !Syncopation: one past the end of the previous token.
|
||||
Chew into an operand, possibly obstructed by an open bracket.
|
||||
100 CALL FORASIGN !Find something to inspect.
|
||||
IF (TOKENTYPE.EQ.NOTHING) THEN !Run off the end?
|
||||
IF (OSP.GT.0) CALL GRUMP("Another operand or one of " !E.g. "1 +".
|
||||
1 //BRAOPEN//" is expected.") !Give a hint, because stacked stuff awaits.
|
||||
ELSE IF (TOKENTYPE.EQ.ANUMBER) THEN !If a number,
|
||||
CALL EMIT(TEXT(L1:L2 - 1)) !Roll all its digits.
|
||||
ELSE IF (TOKENTYPE.EQ.OPENBRA) THEN !Starting a sub-expression?
|
||||
CALL STACKOP(C,PRBRA - 1) !Thus ( has less precedence than ).
|
||||
GO TO 100 !And I still want an operand.
|
||||
C ELSE IF (TOKENTYPE.EQ.ANAME) THEN !Name of something?
|
||||
C CALL EMIT(TEXT(L1:L2 - 1)) !Roll it.
|
||||
ELSE !No further options.
|
||||
CALL GRUMP("Huh? Unexpected "//C) !Probably something like "1 + +"
|
||||
END IF !Righto, finished with operands.
|
||||
Chase after an operator, possibly interrupted by a close bracket,.
|
||||
200 CALL FORASIGN !Find something to inspect.
|
||||
IF (TOKENTYPE.LT.0) THEN !But, have I an operand-like token instead?
|
||||
CALL GRUMP("Operator expected, not "//C) !It seems so.
|
||||
ELSE !Normally, an operator is to hand. Possibly a NOTHING, though.
|
||||
WRITE (MSG,201) C,INCOMING,OPSTACK(1:OSP) !Document it.
|
||||
201 FORMAT ("Oprn=>",A1,"< Prec=",I2, !Try to align with other output.
|
||||
1 ",OpStk=",33(A1,I2:",")) !So as not to clutter the display.
|
||||
DO WHILE(OPSTACK(OSP).PRECEDENCE .GE. INCOMING) !Shunt higher-precedence stuff out.
|
||||
IF (OPSTACK(OSP).PRECEDENCE .EQ. PRBRA - 1) !Only opening brackets have this precedence.
|
||||
1 CALL GRUMP("Unbalanced "//OPSTACK(OSP).OPC) !And they vanish only when meeting their closing bracket.
|
||||
CALL EMIT(OPSTACK(OSP).OPC) !Otherwise we have an operator.
|
||||
OSP = OSP - 1 !It has gone forth.
|
||||
END DO !On to the next.
|
||||
IF (TOKENTYPE.GT.NOTHING) THEN !Now, only lower-precedence items are still in the stack.
|
||||
IF (INCOMING.EQ.PRBRA) THEN !And this is a special arrival.
|
||||
CALL BALANCEBRA(C) !It should match an earlier entry.
|
||||
BRALEVEL = BRALEVEL - 1 !Count it out.
|
||||
GO TO 200 !And I still haven't got an operator.
|
||||
ELSE !All others are normal operators.
|
||||
IF (C.EQ."^") INCOMING = PRPOW - 1 !Special trick to cause leftwards association of x^2^3.
|
||||
CALL STACKOP(C,INCOMING) !Shunt aside, to await the next arrival.
|
||||
END IF !So much for that operator.
|
||||
END IF !Providing it was not just an end-of-input flusher.
|
||||
END IF !And not a misplaced operand.
|
||||
Carry on?
|
||||
IF (HAPPY .GT. 0) GO TO 100 !No problems, and not a nothing from the end of the text.
|
||||
Completed.
|
||||
COMPILE = HAPPY.GE.0 !One hopes so.
|
||||
CONTAINS !Now for some assistants.
|
||||
SUBROUTINE GRUMP(GROWL) !There might be a problem.
|
||||
CHARACTER*(*) GROWL !The fault.
|
||||
WRITE (MSG,1) GROWL !Say it.
|
||||
IF (L1.GT. 1) WRITE (MSG,1) "Tasty:",TEXT( 1:L1 - 1) !Now explain the context.
|
||||
IF (L2.GT.L1) WRITE (MSG,1) "Nasty:",TEXT(L1:L2 - 1) !This is the token when trouble was found.
|
||||
IF (L2.LE.LEN(TEXT)) WRITE (MSG,1) "Misty:",TEXT(L2:) !And this remains to be seen.
|
||||
1 FORMAT (4X,A,1X,A) !A simple layout works nicely for reasonable-length texts.
|
||||
HAPPY = -1 . !Just so.
|
||||
END SUBROUTINE GRUMP !Enuogh said.
|
||||
|
||||
SUBROUTINE BALANCEBRA(B) !Perhaps a happy meeting.
|
||||
CHARACTER*1 B !The closer.
|
||||
CHARACTER*1 O !The putative opener.
|
||||
INTEGER IT,L !Fingers.
|
||||
CHARACTER*88 GROWL !A scratchpad.
|
||||
O = OPSTACK(OSP).OPC !This should match B.
|
||||
WRITE (MSG,1) O,B !Perhaps.
|
||||
1 FORMAT ("Match ",2A) !Show what I've got, anyway.
|
||||
IT = INDEX(BRAOPEN,O) !So, what sort did I save?
|
||||
IF (IT .EQ. INDEX(BRACLOSE,B)) THEN !A friend?
|
||||
OSP = OSP - 1 !Yes. They vanish together.
|
||||
ELSE !Otherwise, something is out of place.
|
||||
GROWL = "Unbalanced {[(...)]} bracketing! The closing " !Alas.
|
||||
1 //B//" is unmatched." !So, a mess.
|
||||
IF (IT.GT.0) GROWL(62:) = "A "//BRACLOSE(IT:IT) !Perhaps there had been no opening bracket.
|
||||
1 //" would be better." !But if there had, this would be its friend.
|
||||
CALL GRUMP(GROWL) !Take that!
|
||||
END IF !So much for discrepancies.
|
||||
END SUBROUTINE BALANCEBRA !But, hopefully, amity prevails.
|
||||
|
||||
SUBROUTINE FORASIGN !See what comes next.
|
||||
INTEGER I !A stepper.
|
||||
L1 = L2 !Pick up where the previous scan left off.
|
||||
10 IF (L1.GT.LEN(TEXT)) THEN !Are we off the end yet?
|
||||
C = "" !Yes. Scrub the marker.
|
||||
L2 = L1 !TEXT(L1:L2 - 1) will be null.
|
||||
TOKENTYPE = NOTHING !But this is to be checked first.
|
||||
INCOMING = SYMBOL(1).PRECEDENCE !For flushing sidetracked operators.
|
||||
HAPPY = 0 !Fading away.
|
||||
ELSE !Otherwise, there is grist.
|
||||
Check for spaces and move past them.
|
||||
C = TEXT(L1:L1) !Grab the first character of the prospective token.
|
||||
IF (C.LE." ") THEN !Boring?
|
||||
L1 = L1 + 1 !Yes. Step past it.
|
||||
GO TO 10 !And look afresh.
|
||||
END IF !Otherwise, L1 now fingers the start.
|
||||
Caught something to inspect.
|
||||
L2 = L1 + 1 !This is one beyond. Just for digit strings.
|
||||
IF (INDEX(DIGIT,C).GT.0) THEN !So, has one started?
|
||||
TOKENTYPE = ANUMBER !Yep.
|
||||
20 IF (L2.LE.LEN(TEXT)) THEN !Probe ahead.
|
||||
IF (INDEX(DIGIT,TEXT(L2:L2)).GT.0) THEN !Another digit?
|
||||
L2 = L2 + 1 !Yes. Leaving L1 fingering its start,
|
||||
GO TO 20 !Chase its end.
|
||||
END IF !So much for another digit.
|
||||
END IF !And checking against the end.
|
||||
C ELSE IF (INDEX(LETTERS,C).GT.0) THEN !Some sort of name?
|
||||
C advance L2 while in NAMEISH.
|
||||
ELSE IF (INDEX(BRAOPEN,C).GT.0) THEN !An open bracket?
|
||||
TOKENTYPE = OPENBRA !Yep.
|
||||
ELSE !Otherwise, anything else.
|
||||
DO I = OPSYMBOLS,1,-1 !Scan backwards, to find ** before *, if present.
|
||||
IF (SYMBOL(I).IS .EQ. C) EXIT !Found?
|
||||
END DO !On to the next. A linear search will do.
|
||||
IF (I.LE.0) THEN !Is it identified?
|
||||
TOKENTYPE = HUH !No.
|
||||
INCOMING = SYMBOL(0).PRECEDENCE !And this might provoke a flush.
|
||||
ELSE !If it is identified,
|
||||
TOKENTYPE = I !Then this is a positive number.
|
||||
INCOMING = SYMBOL(I).PRECEDENCE !And this is of interest.
|
||||
END IF !Righto, anything has been identified, possibly as HUH.
|
||||
END IF !So much for classification.
|
||||
END IF !If there is something to see.
|
||||
WRITE (MSG,30) C,INCOMING,TOKENTYPE !Announce.
|
||||
30 FORMAT ("Next=>",A1,"< Prec=",I2,",Ttype=",I2) !C might be blank.
|
||||
END SUBROUTINE FORASIGN !I call for a sign, and I see what?
|
||||
END FUNCTION COMPILE !That's the main activity.
|
||||
END MODULE COMPILER !So, enough of this.
|
||||
|
||||
PROGRAM POKE
|
||||
USE COMPILER
|
||||
CHARACTER*66 TEXT
|
||||
LOGICAL HIC
|
||||
MSG = 6
|
||||
KBD = 5
|
||||
WRITE (MSG,1)
|
||||
1 FORMAT ("Produce RPN from infix...",/)
|
||||
|
||||
10 WRITE (MSG,11)
|
||||
11 FORMAT("Infix: ",$)
|
||||
READ(KBD,12) TEXT
|
||||
12 FORMAT (A)
|
||||
IF (TEXT.EQ."") STOP "Enough."
|
||||
HIC = COMPILE(TEXT)
|
||||
WRITE (MSG,13) HIC,RP(1:LR)
|
||||
13 FORMAT (L6," RPN: >",A,"<")
|
||||
GO TO 10
|
||||
END
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
Caution! The apparent gaps in the sequence of precedence values in this table are *not* unused!
|
||||
Cunning ploys with precedence allow parameter evaluation, and right-to-left order as in x**y**z.
|
||||
INTEGER OPSYMBOLS !Recognised operator symbols.
|
||||
PARAMETER (OPSYMBOLS = 25) !There are also some associates.
|
||||
TYPE SYMB !To recognise symbols and carry associated information.
|
||||
CHARACTER*2 IS !Its text. Careful with the trailing space and comparisons.
|
||||
INTEGER*1 PRECEDENCE !Controls the order of evaluation.
|
||||
INTEGER*1 POPCOUNT !Stack activity: a+b means + requires two in.
|
||||
CHARACTER*48 USAGE !Description.
|
||||
END TYPE SYMB !The cross-linkage of precedences is tricky.
|
||||
CHARACTER*5 IFPARTS(0:4) !These appear when an operator would otherwise be expected.
|
||||
PARAMETER (IFPARTS = (/"IF","THEN","ELSE","OWISE","FI"/)) !So, bend the usage of "operator".
|
||||
TYPE(SYMB) SYMBOL(-4:OPSYMBOLS) !Righto, I'll have some.
|
||||
PARAMETER (SYMBOL =(/ !Note that "*" is not to be seen as a match to "**".
|
||||
4 SYMB("FI", 2,0,"the FI that ends an IF-statement."), !These negative entries are not for name matching
|
||||
3 SYMB("Ow", 3,0,"the OWISE part of an IF-statement."), !Which is instead done via IFPARTS
|
||||
2 SYMB("El", 3,0,"the ELSE part of an IF-statement."), !But are here to take advantage of the structure in place.
|
||||
1 SYMB("Th", 3,0,"the THEN part of an IF-statement."), !The IF is recognised separately, when expecting an operand.
|
||||
o SYMB(" ", 0,0,"Not recognised as an operator's symbol."),
|
||||
1 SYMB(" ", 1,0,"separates symbols and aids legibility."),
|
||||
C 2 and 3 are used for the parts of an IF-statement. See PRIF.
|
||||
C 3 These precedences ensure the desired order of evaluation.
|
||||
2 SYMB(") ", 4,0,"opened with ( to bracket a sub-expression."),
|
||||
3 SYMB("] ", 4,0,"opened with [ to bracket a sub-expression."),
|
||||
4 SYMB("} ", 4,0,"opened with { to bracket a sub-expression."),
|
||||
5 SYMB(", ", 5,0,"continues a list of parameters to a function."),
|
||||
C SYMB(":=", 6,0,"marks an on-the-fly assignment of a result"), Identified differently... see PRREF.
|
||||
6 SYMB("| ", 7,2,"logical OR, similar to addition."),
|
||||
7 SYMB("& ", 8,2,"logical AND, similar to multiplication."),
|
||||
8 SYMB("¬ ", 9,0,"logical NOT, similar to negation."),
|
||||
9 SYMB("= ",10,2,"tests for equality (beware decimal fractions)"),
|
||||
o SYMB("< ",10,2,"tests strictly less than."),
|
||||
1 SYMB("> ",10,2,"tests strictly greater than."),
|
||||
2 SYMB("<>",10,2,"tests not equal (there is no 'not' key!)"),
|
||||
3 SYMB("¬=",10,2,"tests not equal if you can find a ¬ !"),
|
||||
4 SYMB("<=",10,2,"tests less than or equal."),
|
||||
5 SYMB(">=",10,2,"tests greater than or equal."),
|
||||
6 SYMB("+ ",11,2,"addition, and unary + to no effect."),
|
||||
7 SYMB("- ",11,2,"subtraction, and unary - for neg. numbers."),
|
||||
8 SYMB("* ",12,2,"multiplication."),
|
||||
9 SYMB("× ",12,2,"multiplication, if you can find this."),
|
||||
o SYMB("/ ",12,2,"division."),
|
||||
1 SYMB("÷ ",12,2,"division for those with a fancy keyboard."),
|
||||
2 SYMB("\ ",12,2,"remainder a\b = a - truncate(a/b)*b; 11\3 = 2"),
|
||||
C 13 is used so that stacked ** will have lower priority than incoming **, thus delivering right-to-left evaluation.
|
||||
3 SYMB("^ ",14,2,"raise to power: also recognised is **."), !Uses the previous precedence level also!
|
||||
4 SYMB("**",14,2,"raise to power: also recognised is ^."),
|
||||
5 SYMB("! ",15,1,"factorial, sortof, just for fun.")/))
|
||||
|
|
@ -36,7 +36,7 @@ var o1, o2;
|
|||
|
||||
for (var i = 0; i < infix.length; i++) {
|
||||
token = infix[i];
|
||||
if (token > "0" && token < "9") { // if token is operand (here limited to 0 <= x <= 9)
|
||||
if (token >= "0" && token <= "9") { // if token is operand (here limited to 0 <= x <= 9)
|
||||
postfix += token + " ";
|
||||
}
|
||||
else if (ops.indexOf(token) != -1) { // if token is an operator
|
||||
|
|
|
|||
|
|
@ -1,48 +1,52 @@
|
|||
/*REXX pgm converts infix arith. expressions to Reverse Polish notation.*/
|
||||
parse arg x; if x='' then x = '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3'; ox=x
|
||||
showSteps=1 /*set to 0 (zero) if working steps not wanted.*/
|
||||
x='(' space(x) ') '; tokens=words(x) /*force stacking for expression. */
|
||||
do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/
|
||||
L=max(20,length(x)) /*use 20 for the min show width. */
|
||||
say 'token' center('input',L,'─') center('stack',L%2,'─') center('output',L,'─') center('action',L,'─')
|
||||
pad=left('',5); op=')(-+/*^'; rOp=substr(op,3); p.=; s.=; n=length(op); RPN=; stack=
|
||||
/*REXX pgm converts infix arith. expressions to Reverse Polish notation (shunting─yard).*/
|
||||
parse arg x /*obtain optional argument from the CL.*/
|
||||
if x='' then x= '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3' /*Not specified? Then use the default.*/
|
||||
ox=x
|
||||
x='(' space(x) ") " /*force stacking for the expression. */
|
||||
#=words(x) /*get number of tokens in expression. */
|
||||
do i=1 for #; @.i=word(x, i) /*assign the input tokens to an array. */
|
||||
end /*i*/
|
||||
tell=1 /*set to 0 if working steps not wanted.*/
|
||||
L=max( 20, length(x) ) /*use twenty for the minimum show width*/
|
||||
|
||||
do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/
|
||||
/*[↑] assign operator priorities.*/
|
||||
do #=1 for tokens; ?=@.# /*process each token from @. list*/
|
||||
select /*@.# is: (, operator, ), operand*/
|
||||
when ?=='(' then do; stack='(' stack; call show 'moving' ? "──► stack"; end
|
||||
when isOp(?) then do /*is token an operator?*/
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
do while !\==')' & s.!>=p.?; RPN=RPN ! /*add*/
|
||||
stack=subword(stack,2); /*del token from stack.*/
|
||||
call show 'unstacking:' !
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
end /*while ···)*/
|
||||
stack=? stack /*add token to stack.*/
|
||||
call show 'moving' ? "──► stack"
|
||||
end
|
||||
when ?==')' then do; !=word(stack,1) /*get token from stack.*/
|
||||
do while !\=='('; RPN=RPN ! /*add to RPN.*/
|
||||
stack=subword(stack,2) /*del token from stack.*/
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
call show 'moving stack' ! '──► RPN'
|
||||
end /*while ···( */
|
||||
stack=subword(stack,2) /*del token from stack.*/
|
||||
call show 'deleting ( from the stack'
|
||||
end
|
||||
otherwise RPN=RPN ? /*add operand to RPN. */
|
||||
call show 'moving' ? '──► RPN'
|
||||
say 'token' center("input" , L, '─') center("stack" , L%2, '─'),
|
||||
center("output", L, '─') center("action", L, '─')
|
||||
op= ")(-+/*^"; Rop=substr(op,3); p.=; n=length(op); RPN= /*some handy-dandy vars.*/
|
||||
s.=
|
||||
do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/
|
||||
$= /* [↑] assign the operator priorities.*/
|
||||
do k=1 for #; ?=@.k /*process each token from the @. list.*/
|
||||
select /*@.k is: (, operator, ), operand*/
|
||||
when ?=='(' then do; $="(" $; call show 'moving' ? "──► stack"; end
|
||||
when isOp(?) then do; !=word($, 1) /*get token from stack*/
|
||||
do while ! \==')' & s.!>=p.?
|
||||
RPN=RPN ! /*add token to RPN.*/
|
||||
$=subword($, 2) /*del token from stack*/
|
||||
call show 'unstacking:' !
|
||||
!=word($, 1) /*get token from stack*/
|
||||
end /*while*/
|
||||
$=? $ /*add token to stack*/
|
||||
call show 'moving' ? "──► stack"
|
||||
end
|
||||
when ?==')' then do; !=word($, 1) /*get token from stack*/
|
||||
do while !\=='('; RPN=RPN ! /*add token to RPN. */
|
||||
$=subword($, 2) /*del token from stack*/
|
||||
!= word($, 1) /*get token from stack*/
|
||||
call show 'moving stack' ! "──► RPN"
|
||||
end /*while*/
|
||||
$=subword($, 2) /*del token from stack*/
|
||||
call show 'deleting ( from the stack'
|
||||
end
|
||||
otherwise RPN=RPN ? /*add operand to RPN. */
|
||||
call show 'moving' ? "──► RPN"
|
||||
end /*select*/
|
||||
end /*#*/
|
||||
|
||||
RPN=space(RPN stack)
|
||||
say; say 'input:' ox; say 'RPN──►' RPN /*show input and the RPN.*/
|
||||
parse source upper . y . /*invoked via C.L. or REXX pgm?*/
|
||||
if y=='COMMAND' then exit /*stick a fork in it, we're done.*/
|
||||
else return RPN /*return RPN to invoker (RESULT).*/
|
||||
/*──────────────────────────────────ISOP subroutine─────────────────────*/
|
||||
isOp: return pos(arg(1),rOp)\==0 /*is argument1 a "real" operator?*/
|
||||
/*──────────────────────────────────SHOW subroutine─────────────────────*/
|
||||
show: if showSteps then say center(?,length(pad)) left(subword(x,#),L),
|
||||
left(stack,L%2) left(space(RPN),L) arg(1); return
|
||||
end /*k*/
|
||||
say
|
||||
RPN=space(RPN $) /*elide any superfluous blanks in RPN. */
|
||||
say ' input:' ox; say " RPN──►" RPN /*display the input and the RPN. */
|
||||
parse source upper . y . /*invoked via the C.L. or REXX pgm? */
|
||||
if y=='COMMAND' then exit /*stick a fork in it, we're all done. */
|
||||
else return RPN /*return RPN to invoker (the RESULT). */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────────*/
|
||||
isOp: return pos(arg(1),rOp) \== 0 /*is the first argument a "real" operator? */
|
||||
show: if tell then say center(?,5) left(subword(x,k),L) left($,L%2) left(RPN,L) arg(1); return
|
||||
|
|
|
|||
|
|
@ -1,57 +1,57 @@
|
|||
/*REXX pgm converts infix arith. expressions to Reverse Polish notation.*/
|
||||
parse arg x; if x='' then x = '3 + 4 * 2 / ( ( 1 - 5 ) ) ^ 2 ^ 3'; ox=x
|
||||
g=0 /* G is a counter of ( and ) */
|
||||
do p=1 for words(x); _=word(x,p) /*catches unbalanced () and )( */
|
||||
if _=='(' then g=g+1
|
||||
else if _==')' then do; g=g-1; if g<0 then g=-1e9; end
|
||||
end /*p*/
|
||||
good=(g==0) /*indicate expression is good | ¬*/
|
||||
showSteps=1 /* 0: action steps not wanted.*/
|
||||
x='(' space(x) ') '; tokens=words(x) /*force stacking for expression. */
|
||||
do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/
|
||||
L=max(20,length(x)) /*use 20 for the min show width. */
|
||||
if good then say 'token' center('input' ,L,'─') center('stack' ,L%2,'─'),
|
||||
center('output',L,'─') center('action',L ,'─')
|
||||
pad=left('',5); op=')(-+/*^'; rOp=substr(op,3); stack=
|
||||
p.=; n=length(op); s.=; RPN=
|
||||
|
||||
do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/
|
||||
/*[↑] assign operator priorities.*/
|
||||
do #=1 for tokens*good; ?=@.# /*process each token from @. list*/
|
||||
select /*@.# is: (, operator, ), operand*/
|
||||
when ?=='(' then do; stack='(' stack; call show 'moving' ? "──► stack"; end
|
||||
when isOp(?) then do /*is token an operator?*/
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
do while !\==')' & s.!>=p.?; RPN=RPN ! /*add*/
|
||||
stack=subword(stack,2); /*del token from stack.*/
|
||||
call show 'unstacking:' !
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
end /*while ···)*/
|
||||
stack=? stack /*add token to stack.*/
|
||||
call show 'moving' ? "──► stack"
|
||||
end
|
||||
when ?==')' then do; !=word(stack,1) /*get token from stack.*/
|
||||
do while !\=='('; RPN=RPN ! /*add to RPN.*/
|
||||
stack=subword(stack,2) /*del token from stack.*/
|
||||
!=word(stack,1) /*get token from stack.*/
|
||||
call show 'moving stack' ! '──► RPN'
|
||||
end /*while ···( */
|
||||
stack=subword(stack,2) /*del token from stack.*/
|
||||
call show 'deleting ( from the stack'
|
||||
end
|
||||
otherwise RPN=RPN ? /*add operand to RPN. */
|
||||
call show 'moving' ? '──► RPN'
|
||||
end /*select*/
|
||||
end /*#*/
|
||||
|
||||
RPN=space(RPN stack)
|
||||
if \good then RPN = '─────── error in expression ───────'
|
||||
say; say ' input:' ox; say ' RPN──►' RPN /*show input and the RPN.*/
|
||||
parse source upper . y . /*invoked via C.L. or REXX pgm?*/
|
||||
if y=='COMMAND' then exit /*stick a fork in it, we're done.*/
|
||||
else return RPN /*return RPN to invoker (RESULT).*/
|
||||
/*──────────────────────────────────ISOP subroutine─────────────────────*/
|
||||
isOp: return pos(arg(1),rOp)\==0 /*is argument1 a "real" operator?*/
|
||||
/*──────────────────────────────────SHOW subroutine─────────────────────*/
|
||||
show: if showSteps then say center(?,length(pad)) left(subword(x,#),L),
|
||||
left(stack,L%2) left(space(RPN),L) arg(1); return
|
||||
/*REXX pgm converts infix arith. expressions to Reverse Polish notation (shunting─yard).*/
|
||||
parse arg x /*obtain optional argument from the CL.*/
|
||||
if x='' then x= '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3' /*Not specified? Then use the default.*/
|
||||
g=0 /* G is a counter of ( and ) */
|
||||
do p=1 for words(x); _=word(x,p) /*catches unbalanced ( ) and ) ( */
|
||||
if _=='(' then g=g+1
|
||||
else if _==')' then do; g=g-1; if g<0 then g=-1e8; end
|
||||
end /*p*/
|
||||
ox=x
|
||||
x='(' space(x) ") " /*force stacking for the expression. */
|
||||
#=words(x) /*get number of tokens in expression. */
|
||||
good= (g==0) /*indicate expression is good or bad.*/
|
||||
do i=1 for #; @.i=word(x, i) /*assign the input tokens to an array. */
|
||||
end /*i*/
|
||||
tell=1 /*set to 0 if working steps not wanted.*/
|
||||
L=max( 20, length(x) ) /*use twenty for the minimum show width*/
|
||||
if good then say 'token' center("input" , L, '─') center("stack" , L%2, '─'),
|
||||
center("output", L, '─') center("action", L, '─')
|
||||
op= ")(-+/*^"; Rop=substr(op,3); p.=; n=length(op); RPN= /*some handy-dandy vars.*/
|
||||
s.=
|
||||
do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/
|
||||
$= /* [↑] assign the operator priorities.*/
|
||||
do k=1 for #*good; ?=@.k /*process each token from the @. list.*/
|
||||
select /*@.k is: ( operator ) operand.*/
|
||||
when ?=='(' then do; $="(" $; call show 'moving' ? "──► stack"; end
|
||||
when isOp(?) then do; !=word($, 1) /*get token from stack*/
|
||||
do while ! \==')' & s.!>=p.?
|
||||
RPN=RPN ! /*add token to RPN.*/
|
||||
$=subword($, 2) /*del token from stack*/
|
||||
call show 'unstacking:' !
|
||||
!=word($, 1) /*get token from stack*/
|
||||
end /*while*/
|
||||
$=? $ /*add token to stack*/
|
||||
call show 'moving' ? "──► stack"
|
||||
end
|
||||
when ?==')' then do; !=word($, 1) /*get token from stack*/
|
||||
do while !\=='('; RPN=RPN ! /*add token to RPN.*/
|
||||
$=subword($, 2) /*del token from stack*/
|
||||
!= word($, 1) /*get token from stack*/
|
||||
call show 'moving stack' ! "──► RPN"
|
||||
end /*while*/
|
||||
$=subword($, 2) /*del token from stack*/
|
||||
call show 'deleting ( from the stack'
|
||||
end
|
||||
otherwise RPN=RPN ? /*add operand to RPN.*/
|
||||
call show 'moving' ? "──► RPN"
|
||||
end /*select*/
|
||||
end /*k*/
|
||||
say
|
||||
RPN=space(RPN $); if \good then RPN= '─────── error in expression ───────' /*error? */
|
||||
say ' input:' ox; say " RPN──►" RPN /*display the input and the RPN. */
|
||||
parse source upper . y . /*invoked via the C.L. or REXX pgm? */
|
||||
if y=='COMMAND' then exit /*stick a fork in it, we're all done. */
|
||||
else return RPN /*return RPN to invoker (the RESULT). */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────────*/
|
||||
isOp: return pos(arg(1), Rop) \== 0 /*is the first argument a "real" operator? */
|
||||
show: if tell then say center(?,5) left(subword(x,k),L) left($,L%2) left(RPN,L) arg(1); return
|
||||
|
|
|
|||
|
|
@ -0,0 +1,110 @@
|
|||
structure Operator = struct
|
||||
datatype associativity = LEFT | RIGHT
|
||||
type operator = { symbol : char, assoc : associativity, precedence : int }
|
||||
|
||||
val operators : operator list = [
|
||||
{ symbol = #"^", precedence = 4, assoc = RIGHT },
|
||||
{ symbol = #"*", precedence = 3, assoc = LEFT },
|
||||
{ symbol = #"/", precedence = 3, assoc = LEFT },
|
||||
{ symbol = #"+", precedence = 2, assoc = LEFT },
|
||||
{ symbol = #"-", precedence = 2, assoc = LEFT }
|
||||
]
|
||||
|
||||
fun find (c : char) : operator option = List.find (fn ({symbol, ...} : operator) => symbol = c) operators
|
||||
|
||||
infix cmp
|
||||
fun ({precedence=p1, assoc=a1, ...} : operator) cmp ({precedence=p2, ...} : operator) =
|
||||
case a1 of
|
||||
LEFT => p1 <= p2
|
||||
| RIGHT => p1 < p2
|
||||
end
|
||||
|
||||
signature SHUNTING_YARD = sig
|
||||
type 'a tree
|
||||
type content
|
||||
|
||||
val parse : string -> content tree
|
||||
end
|
||||
|
||||
structure ShuntingYard : SHUNTING_YARD = struct
|
||||
structure O = Operator
|
||||
val cmp = O.cmp
|
||||
(* did you know infixity doesn't "carry out" of a structure unless you open it? TIL *)
|
||||
infix cmp
|
||||
fun pop2 (b::a::rest) = ((a, b), rest)
|
||||
| pop2 _ = raise Fail "bad input"
|
||||
|
||||
datatype content = Op of char
|
||||
| Int of int
|
||||
datatype 'a tree = Leaf
|
||||
| Node of 'a tree * 'a * 'a tree
|
||||
|
||||
fun parse_int' tokens curr = case tokens of
|
||||
[] => (List.rev curr, [])
|
||||
| t::ts => if Char.isDigit t then parse_int' ts (t::curr)
|
||||
else (List.rev curr, t::ts)
|
||||
|
||||
fun parse_int tokens = let
|
||||
val (int_chars, rest) = parse_int' tokens []
|
||||
in
|
||||
((Option.valOf o Int.fromString o String.implode) int_chars, rest)
|
||||
end
|
||||
|
||||
fun parse (s : string) : content tree = let
|
||||
val tokens = String.explode s
|
||||
(* parse': tokens operator_stack trees *)
|
||||
fun parse' [] [] [result] = result
|
||||
| parse' [] (opr::os) trees =
|
||||
if opr = #"(" orelse opr = #")" then raise Fail "bad input"
|
||||
else let
|
||||
val ((a,b), trees') = pop2 trees
|
||||
val trees'' = (Node (a, Op opr, b)) :: trees'
|
||||
in
|
||||
parse' [] os trees''
|
||||
end
|
||||
| parse' (t::ts) operators trees =
|
||||
if Char.isSpace t then parse' ts operators trees else
|
||||
if t = #"(" then parse' ts (t::operators) (trees : content tree list) else
|
||||
if t = #")" then let
|
||||
(* process_operators : operators trees *)
|
||||
fun process_operators [] _ = raise Fail "bad input"
|
||||
| process_operators (opr::os) trees =
|
||||
if opr = #"(" then (os, trees)
|
||||
else let
|
||||
val ((a, b), trees') = pop2 trees
|
||||
val trees'' = (Node (a, Op opr, b)) :: trees'
|
||||
in
|
||||
process_operators os trees''
|
||||
end
|
||||
val (operators', trees') = process_operators (operators : char list) (trees : content tree list)
|
||||
in
|
||||
parse' ts operators' trees'
|
||||
end else
|
||||
(case O.find (t : char) of
|
||||
SOME o1 => let
|
||||
(* process_operators : operators trees *)
|
||||
fun process_operators [] trees = ([], trees)
|
||||
| process_operators (o2::os) trees = (case O.find o2 of
|
||||
SOME o2 =>
|
||||
if o1 cmp o2 then let
|
||||
val ((a, b), trees') = pop2 trees
|
||||
val trees'' = (Node (a, Op (#symbol o2), b)) :: trees'
|
||||
in
|
||||
process_operators os trees''
|
||||
end
|
||||
else ((#symbol o2)::os, trees)
|
||||
| NONE => (o2::os, trees))
|
||||
val (operators', trees') = process_operators operators trees
|
||||
in
|
||||
parse' ts ((#symbol o1)::operators') trees'
|
||||
end
|
||||
| NONE => let
|
||||
val (n, tokens') = parse_int (t::ts)
|
||||
in
|
||||
parse' tokens' operators ((Node (Leaf, Int n, Leaf)) :: trees)
|
||||
end)
|
||||
| parse' _ _ _ = raise Fail "bad input"
|
||||
in
|
||||
parse' tokens [] []
|
||||
end
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue