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 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 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 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";
}
