bool MatchNumber::ArgumentMatches(LispEnvironment& aEnvironment,
LispPtr& aExpression,
LispPtr* arguments) const
{
if (aExpression->Number(aEnvironment.Precision()))
return iNumber->Equals(*aExpression->Number(aEnvironment.Precision()));
return false;
}
bool InternalIsList(const LispEnvironment& env, const LispPtr& aPtr)
{
if (!aPtr)
return false;
if (!aPtr->SubList())
return false;
if (!(*aPtr->SubList()))
return false;
if ((*aPtr->SubList())->String() != env.iList->String())
return false;
return true;
}
bool MatchAtom::ArgumentMatches(LispEnvironment& aEnvironment,
LispPtr& aExpression,
LispPtr* arguments) const
{
// If it is a floating point, don't even bother comparing
if (!!aExpression)
if (aExpression->Number(0))
if (!aExpression->Number(0)->IsInt())
return false;
return (iString == aExpression->String());
}
void InternalApplyPure(LispPtr& oper,LispPtr& args2,LispPtr& aResult,LispEnvironment& aEnvironment)
{
LispPtr * chk1 = oper->SubList();
if (!chk1)
throw LispErrInvalidArg();
LispPtr oper2((*chk1)->Nixed());
if (!oper2)
throw LispErrInvalidArg();
LispPtr body(oper2->Nixed());
if (!body)
throw LispErrInvalidArg();
LispPtr * chk2 = oper2->SubList();
if (!chk2 || !*chk2)
throw LispErrInvalidArg();
oper2 = ((*chk2)->Nixed());
LispLocalFrame frame(aEnvironment,false);
while (!!oper2) {
if (!args2)
throw LispErrInvalidArg();
const LispString* var = oper2->String();
if (!var)
throw LispErrInvalidArg();
LispPtr newly(args2->Copy());
aEnvironment.NewLocal(var,newly);
oper2 = (oper2->Nixed());
args2 = (args2->Nixed());
}
if (args2)
throw LispErrInvalidArg();
aEnvironment.iEvaluator->Eval(aEnvironment, aResult, body);
}
void CheckArgIsString(LispPtr arg, int arg_idx, LispEnvironment& env, int stack_top)
{
if (!InternalIsString(arg->String())) {
ShowArgTypeErrorInfo(arg_idx, env.iStack[stack_top], env);
throw LispErrNotString();
}
}
bool MatchSubList::ArgumentMatches(LispEnvironment& aEnvironment,
LispPtr& aExpression,
LispPtr* arguments) const
{
if (!aExpression->SubList())
return false;
LispIterator iter(aExpression);
LispObject * pObj = iter.getObj();
if (!pObj)
throw LispErrInvalidArg();
LispPtr * pPtr = pObj->SubList();
if (!pPtr)
throw LispErrNotList();
iter = *pPtr;
const LispInt iNrMatchers = iMatchers.size();
for (LispInt i=0;i<iNrMatchers;i++,++iter)
{
if (!iter.getObj())
return false;
if (!iMatchers[i]->ArgumentMatches(aEnvironment,*iter,arguments))
return false;
}
if (iter.getObj())
return false;
return true;
}
void InternalTail(LispPtr& aResult, const LispPtr& aArg)
{
if (!aArg)
throw LispErrInvalidArg();
LispPtr* iter = aArg->SubList();
if (!iter || !*iter)
throw LispErrInvalidArg();
aResult = (LispSubList::New((*iter)->Nixed()));
}
void InternalNth(LispPtr& aResult, const LispPtr& aArg, LispInt n)
{
if (n < 0 || !aArg || !aArg->SubList())
throw LispErrInvalidArg();
LispIterator iter(*aArg->SubList());
while (n>0)
{
if (!iter.getObj())
throw LispErrInvalidArg();
++iter;
n--;
}
if (!iter.getObj())
throw LispErrInvalidArg();
aResult = (iter.getObj()->Copy());
}
void DoInternalLoad(LispEnvironment& aEnvironment,LispInput* aInput)
{
LispLocalInput localInput(aEnvironment, aInput);
// TODO make "EndOfFile" a global thing
// read-parse-eval to the end of file
const LispString* eof = aEnvironment.HashTable().LookUp("EndOfFile");
bool endoffile = false;
LispTokenizer tok;
InfixParser parser(tok,
*aEnvironment.CurrentInput(),
aEnvironment,
aEnvironment.PreFix(),
aEnvironment.InFix(),
aEnvironment.PostFix(),
aEnvironment.Bodied());
while (!endoffile)
{
LispPtr readIn;
// Read expression
parser.Parse(readIn);
if (!readIn)
throw LispErrReadingFile();
// Check for end of file
if (readIn->String() == eof)
{
endoffile = true;
}
// Else evaluate
else
{
LispPtr result;
aEnvironment.iEvaluator->Eval(aEnvironment, result, readIn);
}
}
}
void ReturnUnEvaluated(LispPtr& aResult,LispPtr& aArguments,
LispEnvironment& aEnvironment)
{
LispPtr full(aArguments->Copy());
aResult = (LispSubList::New(full));
LispIterator iter(aArguments);
++iter;
while (iter.getObj())
{
LispPtr next;
aEnvironment.iEvaluator->Eval(aEnvironment, next, *iter);
full->Nixed() = (next);
full = (next);
++iter;
}
full->Nixed() = (nullptr);
}
void InfixPrinter::Print(
const LispPtr& aExpression,
std::ostream& aOutput,
LispInt iPrecedence)
{
assert(aExpression);
const LispString* string = aExpression->String();
if (string) {
LispInt bracket = 0;
if (iPrecedence < KMaxPrecedence &&
(*string)[0] == '-' &&
(std::isdigit((*string)[1]) || (*string)[1] == '.')
) {
bracket = 1;
}
if (bracket) WriteToken(aOutput, "(");
WriteToken(aOutput, *string);
if (bracket) WriteToken(aOutput, ")");
return;
}
if (const GenericClass* g = aExpression->Generic()) {
if (const AssociationClass* a = dynamic_cast<const AssociationClass*>(g)) {
WriteToken(aOutput, "Association");
WriteToken(aOutput, "(");
Print(a->ToList(), aOutput, KMaxPrecedence);
WriteToken(aOutput, ")");
} else if (const ArrayClass* a = dynamic_cast<const ArrayClass*>(g)) {
WriteToken(aOutput, "Array");
WriteToken(aOutput, "(");
WriteToken(aOutput, "{");
const std::size_t n = a->Size();
for (std::size_t i = 1; i <= n; ++i) {
Print(LispPtr(a->GetElement(i)), aOutput, KMaxPrecedence);
if (i != n)
WriteToken(aOutput, ",");
}
WriteToken(aOutput, "}");
WriteToken(aOutput, ")");
} else {
WriteToken(aOutput, g->TypeName());
}
return;
}
LispPtr* subList = aExpression->SubList();
if (!subList) {
throw LispErrUnprintableToken();
} else {
LispInt length = InternalListLength(*subList);
string = (*subList)->String();
const LispOperators::const_iterator prefix =
length != 2
? iPrefixOperators.end()
: iPrefixOperators.find(string);
const LispOperators::const_iterator infix =
length != 3
? iInfixOperators.end()
: iInfixOperators.find(string);
const LispOperators::const_iterator postfix =
length != 2
? iPostfixOperators.end()
: iPostfixOperators.find(string);
const LispOperators::const_iterator bodied =
iBodiedOperators.find(string);
const LispInFixOperator* op = nullptr;
if (prefix != iPrefixOperators.end())
op = &prefix->second;
if (postfix != iPostfixOperators.end())
op = &postfix->second;
if (infix != iInfixOperators.end())
op = &infix->second;
if (op) {
LispPtr* left = nullptr;
LispPtr* right = nullptr;
if (prefix != iPrefixOperators.end()) {
right = &(*subList)->Nixed();
} else if (infix != iInfixOperators.end()) {
left = &(*subList)->Nixed();
right = &(*subList)->Nixed()->Nixed();
} else if (postfix != iPostfixOperators.end()) {
left = &(*subList)->Nixed();
}
if (iPrecedence < op->iPrecedence) {
WriteToken(aOutput, "(");
} else {
//Vladimir? aOutput.Write(" ");
}
if (left)
Print(*left, aOutput, op->iLeftPrecedence);
WriteToken(aOutput, *string);
if (right)
Print(*right, aOutput, op->iRightPrecedence);
if (iPrecedence < op->iPrecedence)
WriteToken(aOutput, ")");
} else {
LispIterator iter((*subList)->Nixed());
if (string == iCurrentEnvironment->iList->String()) {
WriteToken(aOutput, "{");
for (int ii = 0; iter.getObj(); ii++, ++iter) {
if (ii) WriteToken(aOutput, ",");
Print(*iter, aOutput, KMaxPrecedence);
}
WriteToken(aOutput, "}");
} else if (string == iCurrentEnvironment->iProg->String()) {
WriteToken(aOutput, "[");
while (iter.getObj()) {
Print(*iter, aOutput, KMaxPrecedence);
++iter;
WriteToken(aOutput, ";");
}
WriteToken(aOutput, "]");
} else if (string == iCurrentEnvironment->iNth->String()) {
Print(*iter, aOutput, 0);
++iter;
WriteToken(aOutput, "[");
Print(*iter, aOutput, KMaxPrecedence);
WriteToken(aOutput, "]");
} else {
LispInt bracket = false;
if (bodied != iBodiedOperators.end()) {
//printf("%d > %d\n",iPrecedence, bodied->iPrecedence);
if (iPrecedence < bodied->second.iPrecedence)
bracket = true;
}
if (bracket) WriteToken(aOutput, "(");
if (string) {
WriteToken(aOutput, *string);
} else {
Print(*subList, aOutput, 0);
}
WriteToken(aOutput, "(");
LispIterator counter(*iter);
LispInt nr = 0;
while (counter.getObj()) {
++counter;
nr++;
}
if (bodied != iBodiedOperators.end())
nr--;
while (nr--) {
Print(*iter, aOutput, KMaxPrecedence);
++iter;
if (nr)
WriteToken(aOutput, ",");
}
WriteToken(aOutput, ")");
if (iter.getObj()) {
assert(bodied != iBodiedOperators.end());
Print(*iter, aOutput, bodied->second.iPrecedence);
}
if (bracket)
WriteToken(aOutput, ")");
}
}
}
}
bool InternalEquals(const LispEnvironment& aEnvironment,
const LispPtr& aExpression1,
const LispPtr& aExpression2)
{
// Handle pointers to same, or nullptr
if (aExpression1.ptr() == aExpression2.ptr()) // compare pointers to LispObject
return true;
if (!aExpression1.ptr() || !aExpression2.ptr())
return false;
/*TODO This code would be better, if BigNumber::Equals works*/
BigNumber *n1 = aExpression1->Number(aEnvironment.Precision());
BigNumber *n2 = aExpression2->Number(aEnvironment.Precision());
if (!(!n1 && !n2) )
{
if (n1 == n2)
{
return true;
}
if (!n1) return false;
if (!n2) return false;
if (n1->Equals(*n2)) return true;
//this should be enabled
return false;
}
//Pointers to strings should be the same
if (aExpression1->String() != aExpression2->String())
{
return false;
}
// Handle same sublists, or nullptr
if (aExpression1->SubList() == aExpression2->SubList())
{
return true;
}
// Now check the sublists
if (aExpression1->SubList())
{
if (!aExpression2->SubList())
{
return false;
}
LispIterator iter1(*aExpression1->SubList());
LispIterator iter2(*aExpression2->SubList());
while (iter1.getObj() && iter2.getObj())
{
// compare two list elements
if (!InternalEquals(aEnvironment, *iter1, *iter2))
{
return false;
}
// Step to next
++iter1;
++iter2;
}
// Lists don't have the same length
if (iter1.getObj() != iter2.getObj())
return false;
// Same!
return true;
}
// expressions sublists are not the same!
return false;
}
bool InternalStrictTotalOrder(
const LispEnvironment& env,
const LispPtr& e1,
const LispPtr& e2)
{
if (e1.ptr() == e2.ptr())
return false;
if (!e1.ptr() && e2.ptr())
return true;
if (e1.ptr() && !e2.ptr())
return false;
BigNumber* n1 = e1->Number(env.Precision());
BigNumber* n2 = e2->Number(env.Precision());
if (n1 && !n2)
return true;
if (!n1 && n2)
return false;
if (n1 && n2) {
if (n1->LessThan(*n2))
return true;
if (!n1->Equals(*n2))
return false;
return InternalStrictTotalOrder(env, e1->Nixed(), e2->Nixed());
}
const LispString* s1 = e1->String();
const LispString* s2 = e2->String();
if (s1 && !s2)
return true;
if (!s1 && s2)
return false;
if (s1 && s2) {
const int c = s1->compare(*s2);
if (c)
return c < 0;
return InternalStrictTotalOrder(env, e1->Nixed(), e2->Nixed());
}
LispPtr* l1 = e1->SubList();
LispPtr* l2 = e2->SubList();
if (!l1 && l2)
return true;
if (l1 && !l2)
return false;
if (l1 && l2) {
LispIterator i1(*l1);
LispIterator i2(*l2);
while (i1.getObj() && i2.getObj()) {
const LispPtr& p1 = *i1;
const LispPtr& p2 = *i2;
if (InternalEquals(env, p1, p2)) {
++i1;
++i2;
continue;
}
return InternalStrictTotalOrder(env, p1, p2);
}
if (i1.getObj())
return false;
if (i2.getObj())
return true;
return false;
}
// FIXME: deal with generics
// GenericClass* g1 = e1->Generic();
// GenericClass* g2 = e2->Generic();
//
return false;
}
void ShowFunctionError(LispPtr& aArguments,
LispEnvironment& aEnvironment)
{
if (const LispString * string = aArguments->String())
aEnvironment.iErrorOutput << "In function \"" << *string << "\" : \n";
}
void BranchingUserFunction::Evaluate(LispPtr& aResult,LispEnvironment& aEnvironment,
LispPtr& aArguments)
{
const LispInt arity = Arity();
LispInt i;
if (Traced()) {
LispPtr tr(LispSubList::New(aArguments));
TraceShowEnter(aEnvironment, tr);
tr = nullptr;
}
LispIterator iter(aArguments);
++iter;
// unrollable arguments
std::unique_ptr<LispPtr[]> arguments(arity == 0 ? nullptr : new LispPtr[arity]);
// Walk over all arguments, evaluating them as necessary
for (i = 0; i < arity; i++, ++iter) {
if (!iter.getObj())
throw LispErrWrongNumberOfArgs();
if (iParameters[i].iHold) {
arguments[i] = iter.getObj()->Copy();
} else {
//Check(iter.getObj(), KLispErrWrongNumberOfArgs); // checked above
InternalEval(aEnvironment, arguments[i], *iter);
}
}
if (Traced()) {
LispIterator iter(aArguments);
for (i = 0; i < arity; i++)
TraceShowArg(aEnvironment, *++iter, arguments[i]);
}
// declare a new local stack.
LispLocalFrame frame(aEnvironment, Fenced());
// define the local variables.
for (i = 0; i < arity; i++) {
const LispString* variable = iParameters[i].iParameter;
// set the variable to the new value
aEnvironment.NewLocal(variable, arguments[i]);
}
// walk the rules database, returning the evaluated result if the
// predicate is true.
const std::size_t nrRules = iRules.size();
UserStackInformation &st = aEnvironment.iEvaluator->StackInformation();
for (std::size_t i = 0; i < nrRules; i++) {
BranchRuleBase* thisRule = iRules[i];
assert(thisRule);
st.iRulePrecedence = thisRule->Precedence();
bool matches = thisRule->Matches(aEnvironment, arguments.get());
if (matches) {
st.iSide = 1;
InternalEval(aEnvironment, aResult, thisRule->Body());
goto FINISH;
}
// If rules got inserted, walk back
while (thisRule != iRules[i] && i > 0)
i--;
}
// No predicate was true: return a new expression with the evaluated
// arguments.
{
LispPtr full(aArguments->Copy());
if (arity == 0) {
full->Nixed() = nullptr;
} else {
full->Nixed() = arguments[0];
for (i = 0; i < arity - 1; i++)
arguments[i]->Nixed() = arguments[i + 1];
}
aResult = LispSubList::New(full);
}
FINISH:
if (Traced()) {
LispPtr tr(LispSubList::New(aArguments));
TraceShowLeave(aEnvironment, aResult, tr);
tr = nullptr;
}
}
