Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,20 +1,20 @@
|
|||
MODULE COMPILER !At least of arithmetic expressions.
|
||||
INTEGER KBD,MSG !I/O units.
|
||||
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 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 "**".
|
||||
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."),
|
||||
|
|
@ -28,190 +28,190 @@
|
|||
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*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.
|
||||
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 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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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 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.
|
||||
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.
|
||||
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?
|
||||
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.
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,21 +1,21 @@
|
|||
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.
|
||||
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.
|
||||
|
|
@ -43,6 +43,6 @@ C SYMB(":=", 6,0,"marks an on-the-fly assignment of a result"), Identified
|
|||
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!
|
||||
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.")/))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue