void LispLocalSymbols(LispEnvironment& aEnvironment, LispInt aStackTop)
{
LispInt nrArguments = InternalListLength(ARGUMENT(0));
LispInt nrSymbols = nrArguments-2;
std::vector<const LispString*> names(nrSymbols);
std::vector<const LispString*> localnames(nrSymbols);
LispInt uniquenumber = aEnvironment.GetUniqueId();
LispInt i;
for (i=0;i<nrSymbols;i++)
{
const LispString* atomname = Argument(ARGUMENT(0), i+1)->String();
CheckArg(atomname, i + 1, aEnvironment, aStackTop);
names[i] = atomname;
std::string newname = "$";
newname.append(*atomname);
newname.append(std::to_string(uniquenumber));
localnames[i] = aEnvironment.HashTable().LookUp(newname);
}
LocalSymbolBehaviour behaviour(aEnvironment, std::move(names), std::move(localnames));
LispPtr result;
InternalSubstitute(result, Argument(ARGUMENT(0), nrArguments-1), behaviour);
InternalEval(aEnvironment, RESULT, result);
}
bool MatchNumber::ArgumentMatches(LispEnvironment& aEnvironment,
LispPtr& aExpression,
LispPtr* arguments) const
{
if (aExpression->Number(aEnvironment.Precision()))
return iNumber->Equals(*aExpression->Number(aEnvironment.Precision()));
return false;
}
void ParseExpression(LispPtr& aResult, const LispChar* aString,LispEnvironment& aEnvironment)
{
LispString full(aString);
full.push_back(';');
StringInput input(full,aEnvironment.iInputStatus);
aEnvironment.iInputStatus.SetTo("String");
LispTokenizer &tok = *aEnvironment.iCurrentTokenizer;
InfixParser parser(tok,
input,
aEnvironment,
aEnvironment.PreFix(),
aEnvironment.InFix(),
aEnvironment.PostFix(),
aEnvironment.Bodied());
parser.Parse(aResult);
}
void InternalUse(LispEnvironment& aEnvironment, const std::string& aFileName)
{
LispDefFile* def = aEnvironment.DefFiles().File(aFileName);
if (!def->IsLoaded())
{
def->SetLoaded();
for (const LispString* s: def->symbols)
aEnvironment.UnProtect(s);
InternalLoad(aEnvironment,aFileName);
for (const LispString* s: def->symbols)
aEnvironment.Protect(s);
}
}
void YacasPatternPredicateBase::SetPatternVariables(LispEnvironment& aEnvironment,
LispPtr* arguments)
{
const std::size_t n = iVariables.size();
for (std::size_t i = 0; i < n; ++i)
aEnvironment.NewLocal(iVariables[i],arguments[i]);
}
void PrintExpression(LispString& aResult,
LispPtr& aExpression,
LispEnvironment& aEnvironment,
std::size_t aMaxChars)
{
std::ostringstream stream;
InfixPrinter infixprinter(aEnvironment.PreFix(),
aEnvironment.InFix(),
aEnvironment.PostFix(),
aEnvironment.Bodied());
infixprinter.Print(aExpression, stream, aEnvironment);
aResult.assign(stream.str());
if (aMaxChars > 0 && aResult.size()>aMaxChars)
{
aResult.resize(aMaxChars - 3);
aResult += "...";
}
}
void InternalEvalString(LispEnvironment& aEnvironment, LispPtr& aResult,
const LispChar* aString)
{
LispString full(aString);
full.push_back(';');
StringInput input(full,aEnvironment.iInputStatus);
LispPtr lispexpr;
LispTokenizer &tok = *aEnvironment.iCurrentTokenizer;
InfixParser parser(tok, input,
aEnvironment,
aEnvironment.PreFix(),
aEnvironment.InFix(),
aEnvironment.PostFix(),
aEnvironment.Bodied());
parser.Parse(lispexpr);
aEnvironment.iEvaluator->Eval(aEnvironment, aResult, lispexpr);
}
static void DoLoadDefFile(
LispEnvironment& aEnvironment,
LispInput* aInput,
LispDefFile* def)
{
LispLocalInput localInput(aEnvironment, aInput);
const LispString* eof = aEnvironment.iEndOfFile->String();
const LispString* end = aEnvironment.iListClose->String();
bool endoffile = false;
LispTokenizer tok;
while (!endoffile)
{
// Read expression
const LispString* token =
tok.NextToken(*aEnvironment.CurrentInput(), aEnvironment.HashTable());
// Check for end of file
if (token == eof || token == end)
{
endoffile = true;
}
// Else evaluate
else
{
LispMultiUserFunction* multiUser = aEnvironment.MultiUserFunction(token);
if (multiUser->iFileToOpen != nullptr) {
aEnvironment.CurrentOutput() << '[' << *token << "]\n";
if (multiUser->iFileToOpen)
throw LispErrDefFileAlreadyChosen();
}
multiUser->iFileToOpen = def;
def->symbols.insert(token);
aEnvironment.Protect(token);
}
}
}
void LispDebugFile(LispEnvironment& aEnvironment, LispInt aStackTop)
{
#ifndef YACAS_DEBUG
throw LispErrGeneric("Cannot call DebugFile in non-debug version of Yacas");
#else
const LispChar * file = ARGUMENT(1)->iFileName;
if (!file) file = "";
LispString * str = aEnvironment.HashTable().LookUpStringify(file);
RESULT = LispAtom::New(aEnvironment, *str);
#endif
}
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 LoadDefFile(LispEnvironment& aEnvironment, const std::string& aFileName)
{
const std::string flatfile = InternalUnstringify(aFileName) + ".def";
LispDefFile* def = aEnvironment.DefFiles().File(aFileName);
InputStatus oldstatus = aEnvironment.iInputStatus;
aEnvironment.iInputStatus.SetTo(flatfile);
LispLocalFile localFP(aEnvironment, flatfile, true,
aEnvironment.iInputDirectories);
if (!localFP.stream.is_open())
throw LispErrFileNotFound();
StdFileInput newInput(localFP,aEnvironment.iInputStatus);
DoLoadDefFile(aEnvironment, &newInput,def);
aEnvironment.iInputStatus.RestoreFrom(oldstatus);
}
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);
}
}
}
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 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;
}
}