internal ZilObject NewAddWord([NotNull] ZilAtom name, ZilAtom type, [CanBeNull] ZilObject value, [NotNull] ZilFix flags)
{
bool typeProvided;
if (type == null)
{
typeProvided = false;
type = ctx.GetStdAtom(StdAtom.TZERO);
}
else
{
typeProvided = true;
}
// find new CLASS by translating TYPE
var classification = TranslateType(ctx, type);
// create the word or merge into the existing one
NewParserWord word;
if (ctx.ZEnvironment.Vocabulary.TryGetValue(name, out var iword) == false)
{
// create it by calling user-provided <MAKE-VWORD name class flags>
var form = new ZilForm(new ZilObject[]
{
ctx.GetStdAtom(StdAtom.MAKE_VWORD),
ZilString.FromString(name.Text),
classification,
flags
});
var vword = (ZilObject)form.Eval(ctx);
if (vword.StdTypeAtom != StdAtom.VWORD)
{
throw new InterpreterError(InterpreterMessages._0_1_Must_Return_2, "NEW-ADD-WORD", "MAKE-VWORD", "a VWORD");
}
word = NewParserWord.FromVword(ctx, (ZilHash)vword);
ctx.ZEnvironment.Vocabulary.Add(name, word);
}
else
{
word = (NewParserWord)iword;
// if old and new CLASS differ in the high bit, error (word class conflict)
if ((word.Classification & 0x8000) != (classification.Value & 0x8000))
{
throw new InterpreterError(InterpreterMessages._0_New_Classification_1_Is_Incompatible_With_Previous_2, "NEW-ADD-WORD", classification, word.Classification);
}
// merge new CLASS into the word
var combinedClassification = word.Classification | classification.Value;
if (ctx.ZEnvironment.ZVersion >= 4)
{
if (typeProvided &&
(combinedClassification & (dirClass | verbClass)) == (dirClass | verbClass) &&
(word.SemanticStuff != null || word.DirId != null) &&
value != null)
{
throw new InterpreterError(InterpreterMessages._0_Word_Would_Be_Overloaded, "NEW-ADD-WORD");
}
}
word.Classification = combinedClassification;
// merge new FLAGS into the word
word.Flags |= flags.Value;
}
// store flags
if (flags.Value != 0)
{
var compFlag = ctx.GetCompilationFlagValue("WORD-FLAGS-IN-TABLE");
if (compFlag != null && compFlag.IsTrue)
{
// prepend .WORD .FLAGS to ,WORD-FLAGS-LIST
var wordFlagsList = ctx.GetGlobalVal(ctx.GetStdAtom(StdAtom.WORD_FLAGS_LIST)) ?? new ZilList(null, null);
if (wordFlagsList is ZilList list)
{
list = new ZilList(word.Inner, new ZilList(flags, list));
ctx.SetGlobalVal(ctx.GetStdAtom(StdAtom.WORD_FLAGS_LIST), list);
}
else
{
throw new InterpreterError(
InterpreterMessages._0_Value_Of_1_Must_Be_2,
"global",
"WORD-FLAGS-LIST",
"a list");
}
}
}
if (value != null)
{
if (classification.Value == adjClass)
{
// store VALUE as word's ADJ-ID (V3) or SEMANTIC-STUFF (V4+)
if (ctx.ZEnvironment.ZVersion >= 4)
{
word.SemanticStuff = value;
}
else
{
word.AdjId = value;
}
}
else if (classification.Value == dirClass)
{
// store VALUE as word's DIR-ID
word.DirId = value;
}
else
{
// store VALUE as word's SEMANTIC-STUFF
word.SemanticStuff = value;
}
}
return(word.Atom);
}
public override bool Allows(Context ctx, ZilObject arg)
{
return(arg.IsApplicable(ctx));
}
public override bool Allows(Context ctx, ZilObject arg)
{
return(Decl.Check(ctx, arg, Pattern));
}
public override bool Allows(Context ctx, ZilObject arg)
{
return(false);
}
public override bool Allows(Context ctx, ZilObject arg)
{
return(arg.PrimType == PrimType);
}
public static ZilResult MapLeave(ZilObject value)
{
return(new ZilResult(Outcome.MapLeave, value, null));
}
public static ArgSpec Parse([NotNull] string caller, [CanBeNull] ZilAtom targetName, [CanBeNull] ZilAtom activationAtom,
[NotNull] IEnumerable <ZilObject> argspec, [CanBeNull] ZilDecl bodyDecl = null)
{
var optArgsStart = -1;
var auxArgsStart = -1;
ZilAtom varargsAtom = null, environmentAtom = null, quoteAtom = null;
bool varargsQuoted = false;
ZilObject varargsDecl = null, valueDecl = null;
var argAtoms = new List <ZilAtom>();
var argDecls = new List <ZilObject>();
var argQuoted = new List <bool>();
var argDefaults = new List <ZilObject>();
const int OO_None = 0;
const int OO_Varargs = 1;
const int OO_Activation = 2;
const int OO_Value = 3;
const int OO_Environment = 4;
int cur = 0;
int oneOffMode = OO_None;
ZilObject oneOffTag = null;
foreach (var arg in argspec)
{
// check for arg clause separators: "OPT", "AUX", etc.
if (arg is ZilString sep)
{
switch (sep.Text)
{
case "OPT":
case "OPTIONAL":
if (optArgsStart != -1)
{
throw new InterpreterError(InterpreterMessages._0_Multiple_1_Clauses, caller, "\"OPT\"");
}
if (auxArgsStart != -1)
{
throw new InterpreterError(InterpreterMessages._0_OPT_After_AUX, caller);
}
optArgsStart = cur;
continue;
case "AUX":
case "EXTRA":
if (auxArgsStart != -1)
{
throw new InterpreterError(InterpreterMessages._0_Multiple_1_Clauses, caller, "\"AUX\"");
}
auxArgsStart = cur;
continue;
case "ARGS":
varargsQuoted = true;
goto case "TUPLE";
case "TUPLE":
if (varargsAtom != null)
{
throw new InterpreterError(InterpreterMessages._0_Multiple_1_Clauses, caller, "\"ARGS\" or \"TUPLE\"");
}
oneOffMode = OO_Varargs;
oneOffTag = arg;
continue;
case "NAME":
case "ACT":
if (activationAtom != null)
{
throw new InterpreterError(InterpreterMessages._0_Multiple_1_Clauses, caller, "\"NAME\" or activation atom");
}
oneOffMode = OO_Activation;
oneOffTag = arg;
continue;
case "BIND":
if (environmentAtom != null)
{
throw new InterpreterError(InterpreterMessages._0_Multiple_1_Clauses, caller, "\"BIND\"");
}
oneOffMode = OO_Environment;
oneOffTag = arg;
continue;
case "VALUE":
if (valueDecl != null)
{
throw new InterpreterError(InterpreterMessages._0_Multiple_1_Clauses, caller, "\"VALUE\"");
}
oneOffMode = OO_Value;
oneOffTag = arg;
continue;
default:
throw new InterpreterError(
InterpreterMessages._0_Unrecognized_1_2,
caller,
"clause in arg spec",
arg.ToString());
}
}
// handle one-offs
switch (oneOffMode)
{
case OO_Varargs:
switch (arg)
{
case ZilAtom atom:
varargsAtom = atom;
break;
case ZilAdecl adecl:
varargsDecl = adecl.Second;
varargsAtom = (ZilAtom)adecl.First;
break;
default:
throw new InterpreterError(InterpreterMessages._0_Expected_1_After_2, caller, "an atom", oneOffTag);
}
oneOffMode = OO_None;
continue;
case OO_Activation:
activationAtom = arg as ZilAtom;
if (activationAtom == null)
{
throw new InterpreterError(InterpreterMessages._0_Expected_1_After_2, caller, "an atom", oneOffTag);
}
oneOffMode = OO_None;
continue;
case OO_Environment:
environmentAtom = arg as ZilAtom;
if (environmentAtom == null)
{
throw new InterpreterError(InterpreterMessages._0_Expected_1_After_2, caller, "an atom", oneOffTag);
}
oneOffMode = OO_None;
continue;
case OO_Value:
valueDecl = arg;
oneOffMode = OO_None;
continue;
}
// it's a real arg
cur++;
bool quoted = false;
ZilObject argName, argValue, argDecl;
// could be an atom or a list: (atom defaultValue)
if (arg is ZilList al && !(arg is ZilForm))
{
if (al.IsEmpty)
{
throw new InterpreterError(InterpreterMessages._0_Empty_List_In_Arg_Spec, caller);
}
// TODO: report error if length != 2, or if in required args section
argName = al.First;
argValue = al.Rest.First;
}
public override void PutByte(Context ctx, int offset, ZilObject value)
{
if (initializer == null || repetitions > 1)
{
ExpandInitializer(ctx.FALSE);
}
var index = ByteOffsetToIndex(offset);
bool second = false;
switch (index)
{
case null:
// might be the second byte of a word
index = ByteOffsetToIndex(offset - 1);
if (index != null && IsWord(index.Value))
{
second = true;
}
else
{
throw new ArgumentException($"No element at offset {offset}");
}
break;
case -1:
ExpandLengthPrefix(ctx);
index = 0;
break;
}
if (IsWord(index.Value))
{
// split the word into 2 bytes
var newInitializer = new ZilObject[initializer.Length + 1];
Array.Copy(initializer, newInitializer, index.Value);
Array.Copy(initializer, index.Value + 1, newInitializer, index.Value + 2, initializer.Length - index.Value - 1);
initializer = newInitializer;
if (pattern != null)
{
ExpandPattern(ctx, index.Value, true);
}
elementToByteOffsets = null;
var zeroByte = ctx.ChangeType(ZilFix.Zero, ctx.GetStdAtom(StdAtom.BYTE));
if (second)
{
initializer[index.Value] = zeroByte;
initializer[index.Value + 1] = value;
// remember the index we actually used
index++;
}
else
{
initializer[index.Value] = value;
initializer[index.Value + 1] = zeroByte;
}
}
else
{
initializer[index.Value] = value;
}
if (IsWord(index.Value))
{
ExpandPattern(ctx, index.Value, false);
pattern[index.Value] = ctx.GetStdAtom(StdAtom.BYTE);
}
}
public override void PutByte(Context ctx, int offset, ZilObject value)
{
orig.PutByte(ctx, offset + byteOffset, value);
}
public override void PutWord(Context ctx, int offset, ZilObject value)
{
PutWordAtByte(ctx, offset * 2, value);
}
public void PutWordAtByte(Context ctx, int byteOffset, ZilObject value)
{
var index = ByteOffsetToIndex(byteOffset);
switch (index)
{
case null:
throw new ArgumentException($"No element at offset {byteOffset}");
case -1:
ExpandLengthPrefix(ctx);
index = 0;
break;
}
if (!IsWord(index.Value))
{
// we may be able to replace 2 bytes with a word
var index2 = ByteOffsetToIndex(byteOffset + 1);
if (index2 == null || IsWord(index2.Value))
{
throw new ArgumentException($"Element at byte offset {byteOffset} is not a word");
}
// remove one of the bytes from the initializer...
if (initializer == null || repetitions > 1)
{
ExpandInitializer(ctx.FALSE);
}
var newInitializer = new ZilObject[initializer.Length - 1];
Array.Copy(initializer, newInitializer, index.Value);
Array.Copy(initializer, index.Value + 2, newInitializer, index.Value + 1, initializer.Length - index.Value - 2);
initializer = newInitializer;
// ...and the pattern, if appropriate. then store the new value.
if (pattern != null)
{
ExpandPattern(ctx, index.Value, false);
var newPattern = new ZilObject[pattern.Length - 1];
Array.Copy(pattern, newPattern, index.Value);
Array.Copy(pattern, index.Value + 2, newPattern, index.Value + 1, pattern.Length - index.Value - 2);
pattern = newPattern;
initializer[index.Value] = value;
pattern[index.Value] = ctx.GetStdAtom(StdAtom.WORD);
}
else
{
initializer[index.Value] = new ZilWord(value);
}
elementToByteOffsets = null;
}
else
{
if (initializer == null || repetitions > 1)
{
ExpandInitializer(ctx.FALSE);
}
if (initializer[index.Value] is ZilWord)
{
initializer[index.Value] = new ZilWord(value);
}
else
{
initializer[index.Value] = value;
}
}
}
public static bool IsNonVariableForm(this ZilObject zo)
{
return(zo is ZilForm form &&
form.First is ZilAtom first &&
first.StdAtom != StdAtom.GVAL && first.StdAtom != StdAtom.LVAL);
}
public IOperand CompileConstant([NotNull] ZilObject expr, AmbiguousConstantMode mode)
{
switch (expr.Unwrap(Context))
{
case ZilFix fix:
return(Game.MakeOperand(fix.Value));
case ZilHash hash when hash.StdTypeAtom == StdAtom.BYTE && hash.GetPrimitive(Context) is ZilFix fix:
return(Game.MakeOperand(fix.Value));
case ZilWord word:
return(CompileConstant(word.Value));
case ZilString str:
return(Game.MakeOperand(TranslateString(str, Context)));
case ZilChar ch:
return(Game.MakeOperand((byte)ch.Char));
case ZilAtom atom:
if (atom.StdAtom == StdAtom.T)
{
return(Game.One);
}
if (Routines.TryGetValue(atom, out var routine))
{
return(routine);
}
if (Objects.TryGetValue(atom, out var obj))
{
return(obj);
}
if (Constants.TryGetValue(atom, out var operand))
{
return(operand);
}
if (mode == AmbiguousConstantMode.Optimistic && Globals.TryGetValue(atom, out var global))
{
Context.HandleError(new CompilerError((ISourceLine)null,
CompilerMessages.Bare_Atom_0_Interpreted_As_Global_Variable_Index, atom));
return(global);
}
return(null);
case ZilFalse _:
return(Game.Zero);
case ZilTable table:
if (Tables.TryGetValue(table, out var tb))
{
return(tb);
}
tb = Game.DefineTable(table.Name, true);
Tables.Add(table, tb);
return(tb);
case ZilConstant constant:
return(CompileConstant(constant.Value));
case ZilForm form:
return(form.IsGVAL(out var globalAtom) ? CompileConstant(globalAtom, AmbiguousConstantMode.Pessimistic) : null);
case ZilHash hash when hash.StdTypeAtom == StdAtom.VOC && hash.GetPrimitive(Context) is ZilAtom primAtom:
var wordAtom = ZilAtom.Parse("W?" + primAtom.Text, Context);
if (Constants.TryGetValue(wordAtom, out operand))
{
return(operand);
}
return(null);
default:
var primitive = expr.GetPrimitive(Context);
if (primitive != expr && primitive.GetTypeAtom(Context) != expr.GetTypeAtom(Context))
{
return(CompileConstant(primitive));
}
return(null);
}
}
public IOperand CompileConstant([NotNull] ZilObject expr)
{
return(CompileConstant(expr, AmbiguousConstantMode.Pessimistic));
}
public bool IsReturn(ZilActivation currentActivation, out ZilObject value)
{
value = this.value;
return(outcome == Outcome.Return && activation == currentActivation);
}
public abstract void PutByte([NotNull] Context ctx, int offset, [NotNull] ZilObject value);
private ZilResult(Outcome outcome, ZilObject value, ZilActivation activation)
{
this.outcome = outcome;
this.value = value;
this.activation = activation;
}
public static ZilObject COMPILATION_FLAG_DEFAULT([NotNull] Context ctx,
AtomParams.StringOrAtom name, [NotNull] ZilObject value)
{
var atom = name.GetAtom(ctx);
ctx.DefineCompilationFlag(atom, value);
return(atom);
}
public static ZilResult Return(ZilActivation activation, ZilObject value)
{
return(new ZilResult(Outcome.Return, value, activation));
}
public static ZilObject ID([NotNull] Context ctx, ZilObject arg)
{
return(arg);
}
public abstract bool Allows([ProvidesContext] Context ctx, ZilObject arg);
void BuildTable([NotNull] ZilTable zt, [NotNull] ITableBuilder tb)
{
if ((zt.Flags & TableFlags.Lexv) != 0)
{
var values = new IOperand[zt.ElementCount];
zt.CopyTo(values, (zo, isWord) => CompileConstant(zo), Game.Zero, Context);
tb.AddByte((byte)(zt.ElementCount / 3));
tb.AddByte(0);
for (int i = 0; i < values.Length; i++)
{
if (i % 3 == 0)
{
tb.AddShort(values[i]);
}
else
{
tb.AddByte(values[i]);
}
}
}
else
{
var values = new TableElementOperand?[zt.ElementCount];
TableElementOperand?ConvertElement(ZilObject zo, bool isWord)
{
// it's usually a constant value
var constVal = CompileConstant(zo);
if (constVal != null)
{
return(new TableElementOperand(constVal, isWord));
}
// but we'll also allow a global name if the global contains a table
if (zo is ZilAtom atom && Globals.TryGetValue(atom, out var global) && global.DefaultValue is ITableBuilder)
{
return(new TableElementOperand(global.DefaultValue, isWord));
}
return(null);
}
var defaultFiller = new TableElementOperand(Game.Zero, null);
zt.CopyTo(values, ConvertElement, defaultFiller, Context);
for (int i = 0; i < values.Length; i++)
{
if (values[i] == null)
{
var rawElements = new ZilObject[zt.ElementCount];
zt.CopyTo(rawElements, (zo, isWord) => zo, null, Context);
Context.HandleError(new CompilerError(
zt.SourceLine,
CompilerMessages.Nonconstant_Initializer_For_0_1_2,
"table element",
i,
rawElements[i]));
values[i] = defaultFiller;
}
}
bool defaultWord = (zt.Flags & TableFlags.Byte) == 0;
for (int i = 0; i < values.Length; i++)
{
Debug.Assert(values[i] != null);
if (values[i].Value.IsWord ?? defaultWord)
{
tb.AddShort(values[i].Value.Operand);
}
else
{
tb.AddByte(values[i].Value.Operand);
}
}
}
}
public override bool Allows(Context ctx, ZilObject arg)
{
return(arg.StdTypeAtom == TypeAtom);
}
/// <summary>
/// Creates a binding for an atom in this environment, or changes the assigned value if
/// it's already bound.
/// </summary>
/// <param name="atom">The atom.</param>
/// <param name="value">The new value, or <see langword="null"/> to unassign the value.</param>
/// <param name="decl">The new DECL, or <see langword="null"/> to leave it unchanged.</param>
/// <remarks>
/// <para>If the atom is bound in a parent environment, this will create a new binding
/// that shadows the inherited one; the parent's binding will not be changed.
/// If the atom is bound in this environment, that binding will be changed, and the
/// previously assigned value will be overwritten.</para>
/// <para>This method does not check <paramref name="value"/> against any DECL.</para>
/// </remarks>
public void Rebind([NotNull] ZilAtom atom, [CanBeNull] ZilObject value = null, [CanBeNull] ZilObject decl = null)
{
if (bindings.TryGetValue(atom, out var binding))
{
binding.Value = value;
}
else
{
binding = new Binding(value);
bindings.Add(atom, binding);
}
if (decl != null)
{
binding.Decl = decl;
}
}
public override bool Allows(Context ctx, ZilObject arg)
{
return(arg is IStructure);
}
public static void AssertNotStructurallyEqual([CanBeNull] ZilObject notExpected, [CanBeNull] ZilObject actual)
{
bool ok;
if (notExpected == null || actual == null)
{
ok = !ReferenceEquals(notExpected, actual);
}
else
{
ok = !notExpected.StructurallyEquals(actual);
}
if (!ok)
{
throw new AssertFailedException(
$"{nameof(TestHelpers)}.{nameof(AssertNotStructurallyEqual)} failed. Not expected:<{notExpected}>. Actual:<{actual}>.");
}
}
public DeclConstraint(ZilObject pattern)
{
Pattern = pattern;
}
internal static void EvalAndAssert([NotNull] string expression, [NotNull] ZilObject expected)
{
EvalAndAssert(null, expression, expected);
}
public override bool Allows(Context ctx, ZilObject arg)
{
return(Constraints.Any(c => c.Allows(ctx, arg)));
}
static bool IsVerbPointer([CanBeNull] ZilObject verbStuff)
{
return(verbStuff != null && verbStuff.StdTypeAtom == StdAtom.VERB_POINTER);
}
