Time for an 2014 update…

This commit is contained in:
Ingy döt Net 2014-01-17 05:32:22 +00:00
parent 372c577f83
commit 09687c4926
2520 changed files with 34227 additions and 7318 deletions

View file

@ -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 {

View file

@ -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".
].
].
].

View file

@ -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