public static ObList FromList([NotNull][ProvidesContext] Context ctx, [NotNull] ZilListoidBase list)
{
var result = new ObList(ctx.IgnoreCase);
while (list.IsCons(out var first, out var rest))
{
switch (first)
{
case ZilList pair when pair.Matches(out ZilString key, out ZilAtom value):
result[key.Text] = value;
break;
case ZilList pair when !pair.HasLength(2):
throw new InterpreterError(InterpreterMessages._0_In_1_Must_Have_2_Element2s, "elements", "OBLIST", 2);
case ZilList _:
throw new InterpreterError(InterpreterMessages._0_In_1_Must_Be_2, "elements", "OBLIST",
"string-atom pairs");
}
list = rest;
}
return(result);
}
IOperand CompileClauseBody([NotNull] IRoutineBuilder rb, [NotNull] ZilListoidBase clause, bool wantResult,
[CanBeNull] IVariable resultStorage)
{
if (clause.IsEmpty)
{
return(Game.One);
}
IOperand result = null;
do
{
var(first, rest) = clause;
// only want the result of the last statement (if any)
bool wantThisResult = wantResult && rest.IsEmpty;
var stmt = first.Unwrap(Context);
switch (stmt)
{
case ZilForm form:
MarkSequencePoint(rb, form);
result = CompileForm(
rb,
form,
wantThisResult,
wantThisResult ? resultStorage : null);
break;
case ZilList _:
throw new CompilerError(stmt, CompilerMessages.Expressions_Of_This_Type_Cannot_Be_Compiled)
.Combine(new CompilerError(CompilerMessages.Misplaced_Bracket_In_COND_Or_Loop));
default:
if (wantThisResult)
{
result = CompileConstant(stmt);
if (result == null)
{
// TODO: show "expressions of this type cannot be compiled" warning even if wantResult is false?
throw new CompilerError(stmt,
CompilerMessages.Expressions_Of_This_Type_Cannot_Be_Compiled);
}
}
break;
}
clause = rest;
} while (!clause.IsEmpty);
return(result);
}
public static ZilObject PUTREST(Context ctx, [NotNull] ZilListoidBase list, [NotNull] ZilListoidBase newRest)
{
if (list.IsEmpty)
{
throw new InterpreterError(InterpreterMessages._0_Writing_Past_End_Of_Structure, "PUTREST");
}
if (newRest is ZilList newRestList)
{
list.Rest = newRestList;
}
else
{
list.Rest = new ZilList(newRest);
}
return(list);
}
static bool CheckElements([NotNull] Context ctx, [NotNull] IStructure structure,
[NotNull] ZilListoidBase elements, bool segment, bool ignoreErrors)
{
foreach (var subpattern in elements)
{
ZilObject first;
if (subpattern is ZilVector vector)
{
var len = vector.GetLength();
if (len > 0 && vector[0] is ZilAtom atom)
{
int i;
// ReSharper disable once SwitchStatementMissingSomeCases
switch (atom.StdAtom)
{
case StdAtom.REST:
i = 1;
while (!structure.IsEmpty)
{
first = structure.GetFirst();
Debug.Assert(first != null);
if (!Check(ctx, first, vector[i]))
{
return(false);
}
i++;
if (i >= len)
{
i = 1;
}
structure = structure.GetRest(1);
Debug.Assert(structure != null);
}
// !<FOO [REST A B C]> must repeat A B C a whole number of times
// (ZILF extension)
if (segment && i != 1)
{
return(false);
}
return(true);
case StdAtom.OPT:
case StdAtom.OPTIONAL:
// greedily match OPT elements until the structure ends or a match fails
for (i = 1; i < len; i++)
{
if (structure.IsEmpty)
{
break;
}
first = structure.GetFirst();
Debug.Assert(first != null);
if (!Check(ctx, first, vector[i]))
{
break;
}
structure = structure.GetRest(1);
Debug.Assert(structure != null);
}
// move on to the next subpattern, if any
continue;
}
}
else if (len > 0 && vector[0] is ZilFix fix)
{
var count = fix.Value;
for (int i = 0; i < count; i++)
{
for (int j = 1; j < vector.GetLength(); j++)
{
if (structure.IsEmpty)
{
return(false);
}
first = structure.GetFirst();
Debug.Assert(first != null);
if (!Check(ctx, first, vector[j]))
{
return(false);
}
structure = structure.GetRest(1);
Debug.Assert(structure != null);
}
}
// move on to the next subpattern, if any
continue;
}
if (ignoreErrors)
{
return(false);
}
throw new InterpreterError(
InterpreterMessages.Unrecognized_0_1,
"vector in DECL pattern",
vector.ToStringContext(ctx, false));
}
if (structure.IsEmpty)
{
return(false);
}
first = structure.GetFirst();
Debug.Assert(first != null);
if (!Check(ctx, first, subpattern))
{
return(false);
}
structure = structure.GetRest(1);
Debug.Assert(structure != null);
}
return(!segment || structure.IsEmpty);
}
internal IOperand CompileDO([NotNull] IRoutineBuilder rb, [NotNull] ZilListoidBase args, [NotNull] ISourceLine src, bool wantResult,
[CanBeNull] IVariable resultStorage)
{
return(CompileBoundedLoop(rb, DoLoop.Builder, args, src, wantResult, resultStorage));
}
private IOperand CompileBoundedLoop(
[NotNull] IRoutineBuilder rb, [NotNull] IBoundedLoopBuilder builder,
[NotNull] ZilListoidBase args, [NotNull] ISourceLine src,
bool wantResult, [CanBeNull] IVariable resultStorage)
{
// extract loop spec ("binding list", although we don't care about the bindings here)
// TODO: allow activation atoms in bounded loops?
if (!args.IsCons(out var first, out var rest) || !(first is ZilList spec))
{
throw new CompilerError(CompilerMessages.Expected_Binding_List_At_Start_Of_0, builder.Name);
}
// instantiate the loop and let it check binding syntax
var blc = new BoundedLoopContext(this, spec, src);
using (var loop = builder.MakeLoop(blc))
{
// look for the optional end statements
ZilListoidBase body;
if (rest.StartsWith(out ZilList endStmts))
{
(_, body) = rest;
}
else
{
body = rest;
}
// create block
resultStorage = wantResult ? (resultStorage ?? rb.Stack) : null;
var block = new Block
{
AgainLabel = rb.DefineLabel(),
ResultStorage = resultStorage,
ReturnLabel = rb.DefineLabel(),
Flags = wantResult ? BlockFlags.WantResult : 0
};
Blocks.Push(block);
try
{
var exhaustedLabel = rb.DefineLabel();
// let the loop initialize counters, etc.
loop.BeforeBlock(rb, block, exhaustedLabel);
// mark the top of the block ("again" label) and let the loop add prechecks, etc.
rb.MarkLabel(block.AgainLabel);
loop.BeforeBody();
// compile the body
CompileClauseBody(rb, body, false, null);
// let the loop add postchecks, etc., and mark the end of the block ("exhausted" label)
loop.AfterBody();
rb.MarkLabel(exhaustedLabel);
// compile the end statements if present, and provide a return value if requested
if (endStmts != null)
{
CompileClauseBody(rb, endStmts, false, null);
}
if (wantResult)
{
rb.EmitStore(resultStorage, Game.One);
}
// if <RETURN> was used inside the loop, mark the return label
if ((block.Flags & BlockFlags.Returned) != 0)
{
rb.MarkLabel(block.ReturnLabel);
}
}
finally
{
Blocks.Pop();
}
return(wantResult ? resultStorage : null);
}
}
internal IOperand CompilePROG([NotNull] IRoutineBuilder rb, [NotNull] ZilListoidBase args,
[NotNull] ISourceLine src,
bool wantResult, [CanBeNull] IVariable resultStorage, [NotNull] string name, bool repeat, bool catchy)
{
if (!args.IsCons(out var first, out var rest))
{
throw new CompilerError(CompilerMessages._0_Argument_1_2, name, 1, "argument must be an activation atom or binding list");
}
if (first is ZilAtom activationAtom)
{
args = rest;
}
else
{
activationAtom = null;
}
if (!args.IsCons(out var bindings, out var body) || !(bindings is ZilList bindingList))
{
throw new CompilerError(CompilerMessages._0_Missing_Binding_List, name);
}
if (!wantResult)
{
/* Recognize the "deferred return" pattern:
*
* <PROG (... var ...)
* ...
* <SET var expr>
* ...
* <LVAL var>>
*
* In this pattern, the PROG (or BIND) binds an atom and references it exactly twice:
* with SET anywhere in the body, and with LVAL as the last expression in the PROG.
*
* In void context, since the variable value is discarded anyway, we can eliminate the
* store and the binding, transforming it to this:
*
* <PROG (...)
* ...
* expr
* ...>
*/
TransformProgArgsIfImplementingDeferredReturn(ref bindingList, ref body);
}
// add new locals, if any
var innerLocals = new Queue <ZilAtom>();
void AddLocal(ZilAtom atom)
{
innerLocals.Enqueue(atom);
PushInnerLocal(rb, atom, LocalBindingType.ProgAuxiliary, src);
}
void AddLocalWithDefault(ZilAtom atom, ZilObject value)
{
innerLocals.Enqueue(atom);
var lb = PushInnerLocal(rb, atom, LocalBindingType.ProgAuxiliary, src);
var loc = CompileAsOperand(rb, value, src, lb);
if (loc != lb)
{
rb.EmitStore(lb, loc);
}
// setting any default value counts as a write
MarkVariableAsWritten(lb);
}
foreach (var obj in bindingList)
{
switch (obj)
{
case ZilAtom atom:
AddLocal(atom);
break;
case ZilAdecl adecl when adecl.First is ZilAtom atom:
AddLocal(atom);
break;
case ZilList list when !list.HasLength(2):
throw new CompilerError(CompilerMessages._0_Expected_1_Element1s_In_Binding_List, name, 2);
case ZilList list when list.Matches(out ZilAtom atom, out ZilObject value):
AddLocalWithDefault(atom, value);
break;
case ZilList list when list.Matches(out ZilAdecl adecl, out ZilObject value) && adecl.First is ZilAtom atom:
AddLocalWithDefault(atom, value);
break;
case ZilAdecl _:
case ZilList _:
throw new CompilerError(CompilerMessages.Invalid_Atom_Binding);
default:
throw new CompilerError(CompilerMessages.Elements_Of_Binding_List_Must_Be_Atoms_Or_Lists);
}
}
if (wantResult && resultStorage == null)
{
resultStorage = rb.Stack;
}
var block = new Block
{
Name = activationAtom,
AgainLabel = rb.DefineLabel(),
ReturnLabel = rb.DefineLabel(),
ResultStorage = resultStorage
};
if (wantResult)
{
block.Flags |= BlockFlags.WantResult;
}
if (!catchy)
{
block.Flags |= BlockFlags.ExplicitOnly;
}
rb.MarkLabel(block.AgainLabel);
Blocks.Push(block);
try
{
// generate code for prog body
IOperand result;
if (wantResult)
{
var clauseResult = CompileClauseBody(rb, body, !repeat, resultStorage);
/* The resultStorage we pass to CompileClauseBody (like any other method) is just
* a hint, so clauseResult might be different if the result is easily accessible.
* For example:
*
* <SET R <PROG () <SET X 123>>> ;"clauseResult is X"
*
* SET 'X,123 ;inner SET
* SET 'R,X ;outer SET
*
* But we can't always use it as-is, because there might be RETURNs inside that store
* a value and branch to the end of the PROG.
*
* RETURN always stores the value in our desired resultStorage, so we need to move
* the clause body result there too:
*
* <SET R <PROG () <COND (.F <RETURN 123>)> 456>>
*
* ZERO? F /L1
* SET 'R,123 ;RETURN
* JUMP L2
* L1: SET 'R,456 ;move clauseResult to resultStorage
* L2: ...
*/
if (repeat)
{
result = resultStorage;
}
else if (clauseResult != resultStorage && (block.Flags & BlockFlags.Returned) != 0)
{
rb.EmitStore(resultStorage, clauseResult);
result = resultStorage;
}
else
{
result = clauseResult;
}
}
else
{
CompileClauseBody(rb, body, false, null);
result = null;
}
if (repeat)
{
rb.Branch(block.AgainLabel);
}
if ((block.Flags & BlockFlags.Returned) != 0)
{
rb.MarkLabel(block.ReturnLabel);
}
return(result);
}
finally
{
while (innerLocals.Count > 0)
{
PopInnerLocal(innerLocals.Dequeue());
}
Blocks.Pop();
}
}
static void TransformProgArgsIfImplementingDeferredReturn([NotNull] ref ZilList bindingList, [NotNull] ref ZilListoidBase body)
{
// ends with <LVAL atom>?
if (!(body.EnumerateNonRecursive().LastOrDefault() is ZilForm lastExpr) || !lastExpr.IsLVAL(out var atom))
{
return;
}
// atom is bound in the prog?
if (!GetUninitializedAtomsFromBindingList(bindingList).Contains(atom))
{
return;
}
// atom is set earlier in the prog?
var setExpr = body.OfType <ZilForm>()
.FirstOrDefault(
form => form.HasLength(3) &&
(form.First as ZilAtom)?.StdAtom == StdAtom.SET &&
form.Rest?.First == atom);
if (setExpr == null)
{
return;
}
// atom is not referenced anywhere else?
if (!body.All(zo =>
ReferenceEquals(zo, setExpr) || ReferenceEquals(zo, lastExpr) || !RecursivelyContains(zo, atom)))
{
return;
}
// we got a winner!
bindingList = new ZilList(
bindingList.Where(zo => GetUninitializedAtomFromBindingListItem(zo) != atom));
body = new ZilList(
body
.Where(zo => !ReferenceEquals(zo, lastExpr))
.Select(zo => ReferenceEquals(zo, setExpr) ? ((IStructure)zo)[2] : zo));
}
internal IOperand CompileIFFLAG([NotNull] IRoutineBuilder rb, [NotNull] ZilListoidBase clauses, [NotNull] ISourceLine src,
bool wantResult, [CanBeNull] IVariable resultStorage)
{
resultStorage = resultStorage ?? rb.Stack;
while (!clauses.IsEmpty)
{
ZilObject clause;
(clause, clauses) = clauses;
if (!(clause is ZilListoidBase list) || list.IsEmpty)
{
throw new CompilerError(CompilerMessages.All_Clauses_In_0_Must_Be_Lists, "IFFLAG");
}
var(flag, body) = list;
ZilObject value;
bool match, isElse = false;
ZilAtom shadyElseAtom = null;
switch (flag)
{
case ZilAtom atom when(value = Context.GetCompilationFlagValue(atom)) != null:
case ZilString str when(value = Context.GetCompilationFlagValue(str.Text)) != null:
// name of a defined compilation flag
match = value.IsTrue;
break;
case ZilForm form:
form = Subrs.SubstituteIfflagForm(Context, form);
match = ((ZilObject)form.Eval(Context)).IsTrue;
break;
case ZilAtom atom when atom.StdAtom != StdAtom.ELSE && atom.StdAtom != StdAtom.T:
shadyElseAtom = atom;
goto default;
default:
match = isElse = true;
break;
}
// does this clause match?
if (!match)
{
continue;
}
// emit code for clause
var clauseResult = CompileClauseBody(rb, body, wantResult, resultStorage);
// warn if this is an else clause and there are more clauses below
if (!isElse || clauses.IsEmpty)
{
return(wantResult ? clauseResult : null);
}
var warning = new CompilerError(src, CompilerMessages._0_Clauses_After_Else_Part_Will_Never_Be_Evaluated, "IFFLAG");
if (shadyElseAtom != null)
{
// if the else clause wasn't introduced with ELSE or T, it might not have been meant as an else clause
warning = warning.Combine(new CompilerError(
flag.SourceLine,
CompilerMessages.Undeclared_Compilation_Flag_0,
shadyElseAtom));
}
Context.HandleError(warning);
return(wantResult ? clauseResult : null);
}
// no matching clauses
if (wantResult)
{
rb.EmitStore(resultStorage, Game.Zero);
}
return(wantResult ? resultStorage : null);
}
internal IOperand CompileVERSION_P([NotNull] IRoutineBuilder rb, [NotNull] ZilListoidBase clauses, [NotNull] ISourceLine src,
bool wantResult, [CanBeNull] IVariable resultStorage)
{
resultStorage = resultStorage ?? rb.Stack;
while (!clauses.IsEmpty)
{
ZilObject clause;
(clause, clauses) = clauses;
if (!(clause is ZilListoidBase list) || list.IsEmpty)
{
throw new CompilerError(CompilerMessages.All_Clauses_In_0_Must_Be_Lists, "VERSION?");
}
var(condition, body) = list;
// check version condition
int condVersion;
switch (condition)
{
case ZilAtom atom:
// ReSharper disable once SwitchStatementMissingSomeCases
switch (atom.StdAtom)
{
case StdAtom.ZIP:
condVersion = 3;
break;
case StdAtom.EZIP:
condVersion = 4;
break;
case StdAtom.XZIP:
condVersion = 5;
break;
case StdAtom.YZIP:
condVersion = 6;
break;
case StdAtom.ELSE:
case StdAtom.T:
condVersion = 0;
break;
default:
throw new CompilerError(CompilerMessages.Unrecognized_Atom_In_VERSION_Must_Be_ZIP_EZIP_XZIP_YZIP_ELSET);
}
break;
case ZilFix fix:
condVersion = fix.Value;
if (condVersion < 3 || condVersion > 8)
{
throw new CompilerError(CompilerMessages.Version_Number_Out_Of_Range_Must_Be_38);
}
break;
default:
throw new CompilerError(CompilerMessages.Conditions_In_In_VERSION_Clauses_Must_Be_Atoms);
}
// does this clause match?
if (condVersion != Context.ZEnvironment.ZVersion && condVersion != 0)
{
continue;
}
// emit code for clause
var clauseResult = CompileClauseBody(rb, body, wantResult, resultStorage);
if (condVersion == 0 && !clauses.IsEmpty)
{
Context.HandleError(new CompilerError(src, CompilerMessages._0_Clauses_After_Else_Part_Will_Never_Be_Evaluated, "VERSION?"));
}
return(wantResult ? clauseResult : null);
}
// no matching clauses
if (wantResult)
{
rb.EmitStore(resultStorage, Game.Zero);
}
return(wantResult ? resultStorage : null);
}
internal IOperand CompileCOND([NotNull] IRoutineBuilder rb, [NotNull] ZilListoidBase clauses, [NotNull] ISourceLine src,
bool wantResult, [CanBeNull] IVariable resultStorage)
{
var nextLabel = rb.DefineLabel();
var endLabel = rb.DefineLabel();
bool elsePart = false;
resultStorage = resultStorage ?? rb.Stack;
while (!clauses.IsEmpty)
{
ZilObject clause, origCondition, condition;
ZilListoidBase body;
(clause, clauses) = clauses;
clause = clause.Unwrap(Context);
switch (clause)
{
case ZilFalse _:
// previously, FALSE was only allowed when returned by a macro call, but now we expand macros before generating any code
continue;
case ZilListoidBase list when list.IsEmpty:
default:
throw new CompilerError(CompilerMessages.All_Clauses_In_0_Must_Be_Lists, "COND");
case ZilListoidBase list:
(origCondition, body) = list;
condition = origCondition.Unwrap(Context);
break;
}
// if condition is always true (i.e. not a FORM or a FALSE), this is the "else" part
switch (condition)
{
case ZilForm _:
// must be evaluated
MarkSequencePoint(rb, condition);
CompileCondition(rb, condition, condition.SourceLine, nextLabel, false);
break;
case ZilFalse _:
// never true
if (!(origCondition is ZilMacroResult))
{
Context.HandleError(new CompilerError(condition, CompilerMessages._0_Condition_Is_Always_1,
"COND", "false"));
}
continue;
case ZilAtom atom when atom.StdAtom == StdAtom.T || atom.StdAtom == StdAtom.ELSE:
// non-shady else part
elsePart = true;
break;
default:
// shady else part (always true, but not T or ELSE)
Context.HandleError(new CompilerError(condition, CompilerMessages._0_Condition_Is_Always_1, "COND", "true"));
elsePart = true;
break;
}
// emit code for clause
var clauseResult = CompileClauseBody(rb, body, wantResult, resultStorage);
if (wantResult && clauseResult != resultStorage)
{
rb.EmitStore(resultStorage, clauseResult);
}
// jump to end
if (!clauses.IsEmpty || wantResult && !elsePart)
{
rb.Branch(endLabel);
}
rb.MarkLabel(nextLabel);
if (elsePart)
{
if (!clauses.IsEmpty)
{
Context.HandleError(new CompilerError(src, CompilerMessages._0_Clauses_After_Else_Part_Will_Never_Be_Evaluated, "COND"));
}
break;
}
nextLabel = rb.DefineLabel();
}
if (wantResult && !elsePart)
{
rb.EmitStore(resultStorage, Game.Zero);
}
rb.MarkLabel(endLabel);
return(wantResult ? resultStorage : null);
}
internal IOperand CompileBoolean([NotNull] IRoutineBuilder rb, [NotNull] ZilListoidBase args, [NotNull] ISourceLine src,
bool and, bool wantResult, [CanBeNull] IVariable resultStorage)
{
if (!args.IsCons(out var first, out var rest))
{
return(and ? Game.One : Game.Zero);
}
if (rest.IsEmpty)
{
if (wantResult)
{
return(CompileAsOperand(rb, first, src, resultStorage));
}
CompileStmt(rb, first, false);
return(Game.Zero);
}
ILabel lastLabel;
if (!wantResult)
{
// easy path - don't need to preserve the values
lastLabel = rb.DefineLabel();
while (!rest.IsEmpty)
{
var nextLabel = rb.DefineLabel();
CompileCondition(rb, first, src, nextLabel, and);
rb.Branch(lastLabel);
rb.MarkLabel(nextLabel);
(first, rest) = rest;
}
CompileStmt(rb, first, false);
rb.MarkLabel(lastLabel);
return(Game.Zero);
}
// hard path - need to preserve the values and return the last one evaluated
var tempAtom = ZilAtom.Parse("?TMP", Context);
lastLabel = rb.DefineLabel();
IVariable tempVar = null;
ILabel trueLabel = null;
resultStorage = resultStorage ?? rb.Stack;
var nonStackResultStorage = resultStorage == rb.Stack ? null : resultStorage;
IVariable TempVarProvider()
{
if (tempVar != null)
{
return(tempVar);
}
PushInnerLocal(rb, tempAtom, LocalBindingType.CompilerTemporary, src);
tempVar = Locals[tempAtom].LocalBuilder;
return(tempVar);
}
ILabel TrueLabelProvider()
{
return(trueLabel ?? (trueLabel = rb.DefineLabel()));
}
IOperand result;
while (!rest.IsEmpty)
{
var nextLabel = rb.DefineLabel();
/* TODO: use "value or predicate" context here - if the expr is naturally a predicate,
* branch to a final label and synthesize the value without using a temp var,
* otherwise use the returned value */
if (and)
{
// for AND we only need the result of the last expr; otherwise we only care about truth value
CompileCondition(rb, first, src, nextLabel, true);
rb.EmitStore(resultStorage, Game.Zero);
rb.Branch(lastLabel);
}
else
{
// for OR, if the value is true we want to return it; otherwise discard it and try the next expr
// however, if the expr is a predicate anyway, we can branch out of the OR if it's true;
// otherwise fall through to the next expr
if (first.IsPredicate(Context.ZEnvironment.ZVersion))
{
CompileCondition(rb, first, src, TrueLabelProvider(), true);
// fall through to nextLabel
}
else
{
result = CompileAsOperandWithBranch(rb, first, nonStackResultStorage, nextLabel, false,
TempVarProvider);
if (result != resultStorage)
{
rb.EmitStore(resultStorage, result);
}
rb.Branch(lastLabel);
}
}
rb.MarkLabel(nextLabel);
(first, rest) = rest;
}
result = CompileAsOperand(rb, first, src, resultStorage);
if (result != resultStorage)
{
rb.EmitStore(resultStorage, result);
}
if (trueLabel != null)
{
rb.Branch(lastLabel);
rb.MarkLabel(trueLabel);
rb.EmitStore(resultStorage, Game.One);
}
rb.MarkLabel(lastLabel);
if (tempVar != null)
{
PopInnerLocal(tempAtom);
}
return(resultStorage);
}
