Time for an 2014 update…
This commit is contained in:
parent
372c577f83
commit
09687c4926
2520 changed files with 34227 additions and 7318 deletions
|
|
@ -31,10 +31,11 @@ final class XP {
|
|||
this(string s=")", int p = -1) nothrow {
|
||||
str = s;
|
||||
pos = p;
|
||||
type = Type.Num;
|
||||
auto localType = Type.Num;
|
||||
foreach_reverse (immutable t; [EnumMembers!Type[1 .. $]])
|
||||
if (opChar[t] == s)
|
||||
type = t;
|
||||
localType = t;
|
||||
this.type = localType;
|
||||
}
|
||||
|
||||
override int opCmp(Object other) pure {
|
||||
|
|
|
|||
|
|
@ -1,285 +1,302 @@
|
|||
#define std'dictionary'*.
|
||||
#define std'basic'*.
|
||||
#define std'patterns'*.
|
||||
#define ext'io'*.
|
||||
#define ext'convertors'*.
|
||||
#define system.
|
||||
#define extensions.
|
||||
|
||||
#subject parse_order.
|
||||
// --- Token ---
|
||||
|
||||
#class Token
|
||||
{
|
||||
#field theValue.
|
||||
|
||||
#initializer
|
||||
#constructor new
|
||||
[
|
||||
theValue := String.
|
||||
theValue := String new.
|
||||
]
|
||||
|
||||
#method parse_order'get = 0.
|
||||
#constructor new : aValue
|
||||
[
|
||||
theValue := String new:aValue.
|
||||
]
|
||||
|
||||
#method += aChar
|
||||
#method ParseOrder = 0.
|
||||
|
||||
#method append : aChar
|
||||
[
|
||||
theValue += aChar.
|
||||
]
|
||||
|
||||
#method + aNode
|
||||
#method add : aNode
|
||||
[
|
||||
^ aNode += self.
|
||||
]
|
||||
|
||||
#method numeric = Real64Value &&literal:theValue &:erealformatter.
|
||||
#method Number = convertor toReal:theValue.
|
||||
}
|
||||
|
||||
// --- Node ---
|
||||
|
||||
#class Node
|
||||
{
|
||||
#field theLeft.
|
||||
#field theRight.
|
||||
#field theState.
|
||||
|
||||
#role LeftAssigned
|
||||
{
|
||||
#method += aNode
|
||||
[
|
||||
theRight := aNode.
|
||||
|
||||
#shift.
|
||||
]
|
||||
}
|
||||
#role Empty
|
||||
{
|
||||
#method += aNode
|
||||
[
|
||||
theLeft := aNode.
|
||||
|
||||
#shift LeftAssigned.
|
||||
]
|
||||
}
|
||||
#initializer
|
||||
#method setRight : aNode
|
||||
[
|
||||
#shift Empty.
|
||||
theRight := aNode.
|
||||
|
||||
theState := %appendRight.
|
||||
]
|
||||
|
||||
#method + aNode
|
||||
#method setLeft : aNode
|
||||
[
|
||||
#if (self parse_order > aNode parse_order)?
|
||||
[
|
||||
self += aNode.
|
||||
]
|
||||
| [
|
||||
aNode += self.
|
||||
theLeft := aNode.
|
||||
|
||||
^ aNode.
|
||||
].
|
||||
theState := %setRight.
|
||||
]
|
||||
|
||||
#method += aNode
|
||||
#constructor new
|
||||
[
|
||||
#if (theRight parse_order > aNode parse_order)?
|
||||
[
|
||||
theState := %setLeft.
|
||||
]
|
||||
|
||||
#method add : aNode
|
||||
= (self ParseOrder > aNode ParseOrder)
|
||||
? [
|
||||
self += aNode.
|
||||
|
||||
^ self.
|
||||
]
|
||||
! [
|
||||
aNode += self.
|
||||
|
||||
^ aNode.
|
||||
].
|
||||
|
||||
#method appendRight : aNode
|
||||
[
|
||||
(theRight ParseOrder > aNode ParseOrder)
|
||||
? [
|
||||
theRight += aNode.
|
||||
]
|
||||
| [
|
||||
! [
|
||||
theRight := aNode += theRight.
|
||||
].
|
||||
]
|
||||
|
||||
#method append : anObject
|
||||
= $self~theState eval:anObject.
|
||||
|
||||
#method => theState.
|
||||
}
|
||||
|
||||
#class SummaryNode (Node)
|
||||
// --- SummaryNode
|
||||
|
||||
#class SummaryNode : Node
|
||||
{
|
||||
#method parse_order'get = 2.
|
||||
#method ParseOrder = 2.
|
||||
|
||||
#method numeric = theLeft numeric + theRight numeric.
|
||||
#method Number = theLeft Number + theRight Number.
|
||||
}
|
||||
#class DifferenceNode (Node)
|
||||
|
||||
// --- DifferenceNode ---
|
||||
|
||||
#class DifferenceNode : Node
|
||||
{
|
||||
#method parse_order'get = 2.
|
||||
#method ParseOrder = 2.
|
||||
|
||||
#method numeric = theLeft numeric - theRight numeric.
|
||||
#method Number = theLeft Number - theRight Number.
|
||||
}
|
||||
#class ProductNode (Node)
|
||||
|
||||
// --- ProductNode ---
|
||||
|
||||
#class ProductNode : Node
|
||||
{
|
||||
#method parse_order'get = 1.
|
||||
#method ParseOrder = 1.
|
||||
|
||||
#method numeric = theLeft numeric * theRight numeric.
|
||||
#method Number = theLeft Number * theRight Number.
|
||||
}
|
||||
#class FractionNode (Node)
|
||||
|
||||
// --- FractionNode ---
|
||||
|
||||
#class FractionNode : Node
|
||||
{
|
||||
#method parse_order'get = 1.
|
||||
#method ParseOrder = 1.
|
||||
|
||||
#method numeric = theLeft numeric / theRight numeric.
|
||||
#method Number = theLeft Number / theRight Number.
|
||||
}
|
||||
|
||||
// --- SubExpression ---
|
||||
|
||||
#class SubExpression
|
||||
{
|
||||
#field theParser.
|
||||
#field theCounter.
|
||||
|
||||
#role EOF
|
||||
{
|
||||
#method available'is [ control fail. ]
|
||||
|
||||
#method += aChar [ $self fail. ]
|
||||
}
|
||||
|
||||
#initializer
|
||||
#constructor new
|
||||
[
|
||||
theParser := arithmeval'Parser.
|
||||
theCounter := Integer << 1.
|
||||
theParser := arithmeval'Parser new.
|
||||
theCounter := Integer new:1.
|
||||
]
|
||||
|
||||
#method available'is []
|
||||
#method ParseOrder = 0.
|
||||
|
||||
#method parse_order'get = 0.
|
||||
|
||||
#method + aNode
|
||||
#method add : aNode
|
||||
[
|
||||
^ aNode += self.
|
||||
]
|
||||
|
||||
#method append : aChar
|
||||
#method validate
|
||||
[
|
||||
#if control if:(aChar == 41)
|
||||
[
|
||||
theCounter -= 1.
|
||||
]
|
||||
| if:(aChar == 40)
|
||||
[
|
||||
theCounter += 1.
|
||||
].
|
||||
(theCounter < 0)
|
||||
? [ #throw Exception new:"Invalid expression". ].
|
||||
|
||||
#if (theCounter == 0)?
|
||||
[ #shift EOF. ^ $self. ].
|
||||
|
||||
theParser evaluate:aChar.
|
||||
^ (0 == theCounter).
|
||||
]
|
||||
|
||||
#method numeric = theParser numeric.
|
||||
#method append : aChar
|
||||
[
|
||||
aChar =>
|
||||
41 ? [
|
||||
theCounter -= 1.
|
||||
]
|
||||
40 ? [ theCounter += 1 ]
|
||||
! [ theParser evaluate:aChar ].
|
||||
]
|
||||
|
||||
#method Number
|
||||
= $self validate
|
||||
? [ theParser Number ]
|
||||
! [ #throw Exception new:"Invalid expression". ].
|
||||
}
|
||||
#class Parser
|
||||
|
||||
// ---- Parser ----
|
||||
|
||||
#class Parser : system'routines'BasePattern
|
||||
{
|
||||
#field theToken.
|
||||
#field theTopNode.
|
||||
#field theState.
|
||||
|
||||
#role Brackets
|
||||
{
|
||||
#method evaluate : aChar
|
||||
[
|
||||
theToken += aChar.
|
||||
#method onBrackets : aChar
|
||||
[
|
||||
theToken += aChar.
|
||||
|
||||
#if theToken available'is
|
||||
| [
|
||||
#shift.
|
||||
].
|
||||
]
|
||||
}
|
||||
#role Start
|
||||
{
|
||||
#method evaluate : aChar
|
||||
[
|
||||
#if (40 == aChar)?
|
||||
[
|
||||
theToken := SubExpression.
|
||||
(theToken validate)
|
||||
? [
|
||||
theState := %onDigit.
|
||||
].
|
||||
]
|
||||
|
||||
#method onStart : aChar
|
||||
[
|
||||
aChar =>
|
||||
40 ? [ // (
|
||||
theToken := SubExpression new.
|
||||
theTopNode := theToken.
|
||||
|
||||
#shift Brackets.
|
||||
theState := %onBrackets.
|
||||
]
|
||||
| [
|
||||
theToken := Token.
|
||||
45 ? [ // -
|
||||
theToken := DifferenceNode new add:(Token new:"0").
|
||||
|
||||
theTopNode := theToken.
|
||||
|
||||
theToken += aChar.
|
||||
theState := %onOperator.
|
||||
]
|
||||
! [
|
||||
theToken := Token new.
|
||||
theTopNode := theToken.
|
||||
theState := %onDigit.
|
||||
|
||||
#shift.
|
||||
$self appendDigit:aChar.
|
||||
].
|
||||
]
|
||||
}
|
||||
#role Operator
|
||||
{
|
||||
#method evaluate : aChar
|
||||
[
|
||||
#if Control if:(48 < aChar) if:(58 > aChar)
|
||||
[
|
||||
theToken := (Token += aChar).
|
||||
|
||||
theTopNode += theToken.
|
||||
|
||||
#shift.
|
||||
]
|
||||
| if:(40 == aChar)
|
||||
[
|
||||
theToken := SubExpression.
|
||||
theTopNode += theToken.
|
||||
|
||||
#shift Brackets.
|
||||
]
|
||||
| [ $self fail. ].
|
||||
]
|
||||
}
|
||||
|
||||
#initializer
|
||||
[
|
||||
#shift Start.
|
||||
]
|
||||
|
||||
#method numeric = theTopNode numeric.
|
||||
|
||||
#method evaluate : aChar
|
||||
#method onOperator : aChar
|
||||
[
|
||||
#if Control if:(48 < aChar) if:(58 > aChar)
|
||||
[
|
||||
aChar =>
|
||||
40 ? [
|
||||
theToken := SubExpression new.
|
||||
theTopNode += theToken.
|
||||
theState := %onBrackets.
|
||||
]
|
||||
! [
|
||||
theToken := Token new.
|
||||
theTopNode += theToken.
|
||||
theState := %onDigit.
|
||||
|
||||
$self appendDigit:aChar.
|
||||
].
|
||||
]
|
||||
|
||||
#constructor new
|
||||
[
|
||||
theState := %onStart.
|
||||
]
|
||||
|
||||
#method Number = theTopNode Number.
|
||||
|
||||
#method appendDigit : aChar
|
||||
[
|
||||
(aChar >= 48) and:(aChar < 58)
|
||||
? [
|
||||
theToken += aChar.
|
||||
]
|
||||
| if:(42 == aChar) // *
|
||||
[
|
||||
theTopNode := theTopNode + ProductNode.
|
||||
|
||||
#shift Operator.
|
||||
! [
|
||||
#throw Exception new:"Invalid expression".
|
||||
]
|
||||
| if:(47 == aChar) // /
|
||||
[
|
||||
theTopNode := theTopNode + FractionNode.
|
||||
|
||||
#shift Operator.
|
||||
]
|
||||
| if:(43 == aChar) // +
|
||||
[
|
||||
theTopNode := theTopNode + SummaryNode.
|
||||
|
||||
#shift Operator.
|
||||
]
|
||||
| if:(45 == aChar) // -
|
||||
[
|
||||
theTopNode := theTopNode + DifferenceNode.
|
||||
|
||||
#shift Operator.
|
||||
]
|
||||
| if:(40 == aChar)
|
||||
[
|
||||
theToken := SubExpression.
|
||||
theTopNode := theToken.
|
||||
|
||||
#shift Brackets.
|
||||
]
|
||||
| [ $self fail. ].
|
||||
]
|
||||
|
||||
#method start : aProcess
|
||||
#method onDigit : aChar
|
||||
[
|
||||
aProcess run:self.
|
||||
aChar =>
|
||||
40 ? [ // (
|
||||
theToken := SubExpression new.
|
||||
theTopNode := theToken.
|
||||
theState := %onBrackets.
|
||||
]
|
||||
42 ? [ // *
|
||||
theTopNode := theTopNode + ProductNode new.
|
||||
|
||||
^ self numeric.
|
||||
theState := %onOperator.
|
||||
]
|
||||
43 ? [ // +
|
||||
theTopNode := theTopNode + SummaryNode new.
|
||||
|
||||
theState := %onOperator.
|
||||
]
|
||||
45 ? [ // -
|
||||
theTopNode := theTopNode + DifferenceNode new.
|
||||
|
||||
theState := %onOperator.
|
||||
]
|
||||
47 ? // /
|
||||
[
|
||||
theTopNode := theTopNode + FractionNode new.
|
||||
|
||||
theState := %onOperator.
|
||||
]
|
||||
! [
|
||||
$self appendDigit:aChar.
|
||||
].
|
||||
]
|
||||
|
||||
#method eval : aChar = $self~theState eval:aChar.
|
||||
}
|
||||
|
||||
#symbol Program =
|
||||
#symbol program =
|
||||
[
|
||||
#var aText := String.
|
||||
#var aText := String new.
|
||||
|
||||
#while ((Console >> aText) length > 0)?
|
||||
control while:(consoleEx readLine:aText length > 0) &do:
|
||||
[
|
||||
#var aParser := Parser.
|
||||
#var aParser := Parser new.
|
||||
|
||||
Console << "=" << aParser start:Scan::aText | ^^"Invalid Expression".
|
||||
|
||||
Console << "%n".
|
||||
consoleEx writeLine:"=" :(aParser foreach:aText Number)
|
||||
| ifFailed:
|
||||
[
|
||||
consoleEx writeLine:"Invalid Expression".
|
||||
].
|
||||
].
|
||||
].
|
||||
|
|
|
|||
|
|
@ -0,0 +1,235 @@
|
|||
'[RC] Arithmetic evaluation.bas
|
||||
'Buld the tree (with linked nodes, in array 'cause LB has no pointers)
|
||||
'applying shunting yard algorythm.
|
||||
'Then evaluate tree
|
||||
|
||||
global stack$ 'operator/brakets stack
|
||||
stack$=""
|
||||
|
||||
maxStack = 100
|
||||
dim stack(maxStack) 'nodes stack
|
||||
global SP 'stack pointer
|
||||
SP = 0
|
||||
|
||||
'-------------------
|
||||
global maxNode,curFree
|
||||
global FirstOp,SecondOp,isNumber,NodeCont
|
||||
global opList$
|
||||
opList$ = "+-*/^"
|
||||
|
||||
maxNode=100
|
||||
FirstOp=1 'pointers to other nodes; 0 means no pointer
|
||||
SecondOp=2
|
||||
isNumber=3 'like, 1 is number, 0 is operator
|
||||
NodeCont=4 'number if isNumber; or mid$("+-*/^", i, 1) for 1..5 operator
|
||||
|
||||
dim node(NodeCont, maxNode)
|
||||
'will be used from 1, 0 plays null pointer (no link)
|
||||
|
||||
curFree=1 'first free node
|
||||
'-------------------
|
||||
|
||||
in$ = " 1 + 2 ^ 3 * 4 - 12 / 6 "
|
||||
print "Input: "
|
||||
print in$
|
||||
|
||||
'read tokens
|
||||
token$ = "#"
|
||||
while 1
|
||||
i=i+1
|
||||
token$ = word$(in$, i)
|
||||
if token$ = "" then i=i-1: exit while
|
||||
|
||||
select case
|
||||
case token$ = "("
|
||||
'If the token is a left parenthesis, then push it onto the stack.
|
||||
call stack.push token$
|
||||
|
||||
case token$ = ")"
|
||||
'If the token is a right parenthesis:
|
||||
'Until the token at the top of the stack is a left parenthesis, pop operators off the stack onto the output queue.
|
||||
'Pop the left parenthesis from the stack, but not onto the output queue.
|
||||
'If the stack runs out without finding a left parenthesis, then there are mismatched parentheses.
|
||||
while stack.peek$() <> "("
|
||||
'if stack is empty
|
||||
if stack$="" then print "Error: no matching '(' for token ";i: end
|
||||
'add operator node to tree
|
||||
child2=node.pop()
|
||||
child1=node.pop()
|
||||
call node.push addOpNode(child1,child2,stack.pop$())
|
||||
wend
|
||||
discard$=stack.pop$() 'discard "("
|
||||
|
||||
case isOperator(token$)
|
||||
'If the token is an operator, o1, then:
|
||||
'while there is an operator token, o2, at the top of the stack, and
|
||||
'either o1 is left-associative and its precedence is equal to that of o2,
|
||||
'or o1 has precedence less than that of o2,
|
||||
' pop o2 off the stack, onto the output queue;
|
||||
'push o1 onto the stack
|
||||
op1$=token$
|
||||
while(isOperator(stack.peek$()))
|
||||
op2$=stack.peek$()
|
||||
if (op2$<>"^" and precedence(op1$) = precedence(op2$)) _
|
||||
OR (precedence(op1$) < precedence(op2$)) then
|
||||
'"^" is the only right-associative operator
|
||||
'add operator node to tree
|
||||
child2=node.pop()
|
||||
child1=node.pop()
|
||||
call node.push addOpNode(child1,child2,stack.pop$())
|
||||
else
|
||||
exit while
|
||||
end if
|
||||
wend
|
||||
call stack.push op1$
|
||||
|
||||
case else 'number
|
||||
'actually, wrohg operator could end up here, like say %
|
||||
'If the token is a number, then
|
||||
'add leaf node to tree (number)
|
||||
call node.push addNumNode(val(token$))
|
||||
end select
|
||||
|
||||
wend
|
||||
|
||||
'When there are no more tokens to read:
|
||||
'While there are still operator tokens in the stack:
|
||||
' If the operator token on the top of the stack is a parenthesis, then there are mismatched parentheses.
|
||||
' Pop the operator onto the output queue.
|
||||
while stack$<>""
|
||||
if stack.peek$() = "(" then print "no matching ')'": end
|
||||
'add operator node to tree
|
||||
child2=node.pop()
|
||||
child1=node.pop()
|
||||
call node.push addOpNode(child1,child2,stack.pop$())
|
||||
wend
|
||||
|
||||
root = node.pop()
|
||||
'call dumpNodes
|
||||
print "Tree:"
|
||||
call drawTree root, 1, 0, 3
|
||||
locate 1, 10
|
||||
print "Result: ";evaluate(root)
|
||||
|
||||
end
|
||||
|
||||
'------------------------------------------
|
||||
function isOperator(op$)
|
||||
isOperator = instr(opList$, op$)<>0 AND len(op$)=1
|
||||
end function
|
||||
|
||||
function precedence(op$)
|
||||
if isOperator(op$) then
|
||||
precedence = 1 _
|
||||
+ (instr("+-*/^", op$)<>0) _
|
||||
+ (instr("*/^", op$)<>0) _
|
||||
+ (instr("^", op$)<>0)
|
||||
end if
|
||||
end function
|
||||
|
||||
'------------------------------------------
|
||||
sub stack.push s$
|
||||
stack$=s$+"|"+stack$
|
||||
end sub
|
||||
|
||||
function stack.pop$()
|
||||
'it does return empty on empty stack or queue
|
||||
stack.pop$=word$(stack$,1,"|")
|
||||
stack$=mid$(stack$,instr(stack$,"|")+1)
|
||||
end function
|
||||
|
||||
function stack.peek$()
|
||||
'it does return empty on empty stack or queue
|
||||
stack.peek$=word$(stack$,1,"|")
|
||||
end function
|
||||
|
||||
'---------------------------------------
|
||||
sub node.push s
|
||||
stack(SP)=s
|
||||
SP=SP+1
|
||||
end sub
|
||||
|
||||
function node.pop()
|
||||
'it does return -999999 on empty stack
|
||||
if SP<1 then pop=-999999: exit function
|
||||
SP=SP-1
|
||||
node.pop=stack(SP)
|
||||
end function
|
||||
|
||||
'=======================================
|
||||
sub dumpNodes
|
||||
for i = 1 to curFree-1
|
||||
print i,
|
||||
for j = 1 to 4
|
||||
print node(j, i),
|
||||
next
|
||||
print
|
||||
next
|
||||
print
|
||||
end sub
|
||||
|
||||
function evaluate(node)
|
||||
if node=0 then exit function
|
||||
if node(isNumber, node) then
|
||||
evaluate = node(NodeCont, node)
|
||||
exit function
|
||||
end if
|
||||
'else operator
|
||||
op1 = evaluate(node(FirstOp, node))
|
||||
op2 = evaluate(node(SecondOp, node))
|
||||
select case node(NodeCont, node) 'opList$, "+-*/^"
|
||||
case 1
|
||||
evaluate = op1+op2
|
||||
case 2
|
||||
evaluate = op1-op2
|
||||
case 3
|
||||
evaluate = op1*op2
|
||||
case 4
|
||||
evaluate = op1/op2
|
||||
case 5
|
||||
evaluate = op1^op2
|
||||
end select
|
||||
end function
|
||||
|
||||
sub drawTree node, level, leftRight, offsetY
|
||||
if node=0 then exit sub
|
||||
call drawTree node(FirstOp, node), level+1, leftRight-1/2^level, offsetY
|
||||
|
||||
'print node
|
||||
'count on 80 char maiwin
|
||||
x = 40*(1+leftRight)
|
||||
y = level+offsetY
|
||||
locate x, y
|
||||
'print x, y,">";
|
||||
if node(isNumber, node) then
|
||||
print node(NodeCont, node)
|
||||
else
|
||||
print mid$(opList$, node(NodeCont, node),1)
|
||||
end if
|
||||
|
||||
call drawTree node(SecondOp, node), level+1, leftRight+1/2^level, offsetY
|
||||
end sub
|
||||
|
||||
function addNumNode(num)
|
||||
'returns new node
|
||||
newNode=curFree
|
||||
curFree=curFree+1
|
||||
node(isNumber,newNode)=1
|
||||
node(NodeCont,newNode)=num
|
||||
|
||||
addNumNode = newNode
|
||||
end function
|
||||
|
||||
function addOpNode(firstChild, secondChild, op$)
|
||||
'returns new node
|
||||
'FirstOrSecond ignored if parent is 0
|
||||
newNode=curFree
|
||||
curFree=curFree+1
|
||||
node(isNumber,newNode)=0
|
||||
node(NodeCont,newNode)=instr(opList$, op$)
|
||||
|
||||
node(FirstOp,newNode)=firstChild
|
||||
node(SecondOp,newNode)=secondChild
|
||||
|
||||
addOpNode = newNode
|
||||
end function
|
||||
Loading…
Add table
Add a link
Reference in a new issue