// TODO: delete once SET-DEFSTRUCT-FILE-DEFAULTS is using ArgDecoder
static void ParseDefStructDefaults([NotNull] Context ctx, [NotNull] ZilList fileDefaults, ref DefStructDefaults defaults)
{
var quoteAtom = ctx.GetStdAtom(StdAtom.QUOTE);
foreach (var part in fileDefaults)
{
if (part is ZilForm partForm &&
partForm.First == quoteAtom &&
partForm.Rest.First is ZilAtom tag)
{
switch (tag.StdAtom)
{
case StdAtom.NODECL:
defaults.SuppressDecl = true;
break;
case StdAtom.NOTYPE:
defaults.SuppressType = true;
break;
case StdAtom.PRINTTYPE:
defaults.PrintFunc = null;
break;
case StdAtom.CONSTRUCTOR:
defaults.SuppressDefaultCtor = true;
break;
default:
throw UnhandledCaseException.FromEnum(tag.StdAtom, "tag in defaults section");
}
}
public static ZilObject SET_DEFSTRUCT_FILE_DEFAULTS([NotNull] Context ctx, [NotNull] ZilObject[] args)
{
var defaults = new ZilList(args);
ctx.CurrentFile.DefStructDefaults = defaults;
return(defaults);
}
static ZilObject PerformParse([NotNull][ProvidesContext] Context ctx, [NotNull] string text, int radix, ZilObject lookupObList,
[NotNull] string name, bool singleResult)
{
if (radix != 10)
{
throw new ArgumentOutOfRangeException(nameof(radix));
}
using (var innerEnv = ctx.PushEnvironment())
{
if (lookupObList != null)
{
if (lookupObList is ObList)
{
lookupObList = new ZilList(lookupObList, new ZilList(null, null));
}
innerEnv.Rebind(ctx.GetStdAtom(StdAtom.OBLIST), lookupObList);
}
var ztree = Program.Parse(ctx, text); // TODO: move into FrontEnd class
if (singleResult)
{
try
{
return(ztree.First());
}
catch (InvalidOperationException ex)
{
throw new InterpreterError(InterpreterMessages._0_No_Expressions_Found, name, ex);
}
}
return(new ZilList(ztree));
}
}
internal void ExpandInPlace([NotNull] Context ctx)
{
IEnumerable <ZilObject> RecursiveExpandWithSplice(ZilObject zo)
{
ZilObject result;
ZilObject SetSourceLine(ZilResult zr)
{
var newObj = (ZilObject)zr;
newObj.SourceLine = zo.SourceLine;
return(newObj);
}
switch (zo)
{
case ZilList list:
result = new ZilList(list.SelectMany(RecursiveExpandWithSplice));
break;
case ZilVector vector:
result = new ZilVector(vector.SelectMany(RecursiveExpandWithSplice).ToArray());
break;
case ZilForm form:
ZilObject expanded;
try
{
using (DiagnosticContext.Push(form.SourceLine))
{
expanded = (ZilObject)form.Expand(ctx);
}
}
catch (InterpreterError ex)
{
ctx.HandleError(ex);
return(new[] { ctx.FALSE });
}
if (expanded is IMayExpandAfterEvaluation expandAfter &&
expandAfter.ShouldExpandAfterEvaluation)
{
return(expandAfter.ExpandAfterEvaluation().AsResultSequence()
.Select(SetSourceLine)
.Select(xo => ReferenceEquals(xo, form) ? xo : new ZilMacroResult(xo)));
}
else if (!ReferenceEquals(expanded, form))
{
expanded.SourceLine = zo.SourceLine;
return(RecursiveExpandWithSplice(expanded)
.Select(xo => new ZilMacroResult(xo)));
}
else
{
result = new ZilForm(form.SelectMany(RecursiveExpandWithSplice));
}
break;
public static byte Parse([CanBeNull] ZilList list, [NotNull] Context ctx)
{
byte result = 0;
if (!(ctx.GetGlobalVal(ctx.GetStdAtom(StdAtom.NEW_SFLAGS)) is ZilVector sflagsVector))
{
// use default set of flags
if (list == null)
{
return(Original.Default);
}
foreach (var obj in list)
{
if (!(obj is ZilAtom atom))
{
throw new InterpreterError(InterpreterMessages._0_In_1_Must_Be_2, "object options", "SYNTAX", "atoms");
}
switch (atom.StdAtom)
{
case StdAtom.TAKE:
result |= Original.Take;
break;
case StdAtom.HAVE:
result |= Original.Have;
break;
case StdAtom.MANY:
result |= Original.Many;
break;
case StdAtom.HELD:
result |= Original.Held;
break;
case StdAtom.CARRIED:
result |= Original.Carried;
break;
case StdAtom.ON_GROUND:
result |= Original.OnGround;
break;
case StdAtom.IN_ROOM:
result |= Original.InRoom;
break;
default:
throw new InterpreterError(InterpreterMessages.Unrecognized_0_1, "object option", atom.ToString());
}
}
}
public void Test_ZilObjectArg()
{
var methodInfo = GetMethod(nameof(Dummy_ZilObjectArg));
var arg = new ZilList(null, null);
var decoder = ArgDecoder.FromMethodInfo(methodInfo, ctx);
var actual = decoder.Decode("dummy", ctx, new ZilObject[] { arg });
object[] expected = { ctx, arg };
CollectionAssert.AreEqual(expected, actual);
}
public void TestEVAL()
{
// most values eval to themselves
TestHelpers.EvalAndAssert("<EVAL 123>", new ZilFix(123));
TestHelpers.EvalAndAssert("<EVAL \"hello\">", ZilString.FromString("hello"));
var ctx = new Context();
TestHelpers.EvalAndAssert(ctx, "<EVAL +>", ctx.GetStdAtom(StdAtom.Plus));
TestHelpers.EvalAndAssert(ctx, "<EVAL <>>", ctx.FALSE);
// lists eval to new lists formed by evaluating each element
var list = new ZilList(new ZilObject[] {
new ZilFix(1),
new ZilForm(new ZilObject[] {
ctx.GetStdAtom(StdAtom.Plus),
new ZilFix(1),
new ZilFix(1)
}),
new ZilFix(3)
});
var expected = new ZilList(new ZilObject[] {
new ZilFix(1),
new ZilFix(2),
new ZilFix(3)
});
ctx.SetLocalVal(ctx.GetStdAtom(StdAtom.T), list);
var actual = TestHelpers.Evaluate(ctx, "<EVAL .T>");
TestHelpers.AssertStructurallyEqual(expected, actual);
// forms execute when evaluated
var form = new ZilForm(new ZilObject[] { ctx.GetStdAtom(StdAtom.Plus), new ZilFix(1), new ZilFix(2) });
ctx.SetLocalVal(ctx.GetStdAtom(StdAtom.T), form);
TestHelpers.EvalAndAssert(ctx, "<EVAL .T>", new ZilFix(3));
// must have 1-2 arguments
TestHelpers.EvalAndCatch <ArgumentCountError>("<EVAL>");
TestHelpers.EvalAndCatch <ArgumentCountError>("<EVAL FOO BAR BAZ>");
// 2nd argument must be an ENVIRONMENT
TestHelpers.EvalAndCatch <ArgumentTypeError>("<EVAL FOO BAR>");
TestHelpers.Evaluate(ctx, "<SET A 0>");
TestHelpers.Evaluate(ctx, "<DEFINE RIGHT (\"BIND\" E 'B \"AUX\" (A 1)) <EVAL .B .E>>");
TestHelpers.EvalAndAssert(ctx, "<RIGHT .A>", new ZilFix(0));
}
public static ZilObject DEFINITIONS([NotNull] Context ctx, [NotNull] string pname)
{
// external oblist
var externalAtom = ctx.PackageObList[pname];
var externalObList = ctx.GetProp(externalAtom, ctx.GetStdAtom(StdAtom.OBLIST)) as ObList ?? ctx.MakeObList(externalAtom);
// new oblist path
var newObPath = new ZilList(new ZilObject[] { externalObList, ctx.RootObList });
ctx.PushObPath(newObPath);
ctx.SetGlobalVal(externalAtom, newObPath);
// package type
ctx.PutProp(externalObList, ctx.GetStdAtom(StdAtom.PACKAGE), ctx.GetStdAtom(StdAtom.DEFINITIONS));
return(externalAtom);
}
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));
}
static ZilObject PerformDefine([NotNull][ProvidesContext] Context ctx, [NotNull] ZilAtom name,
[CanBeNull] ZilAtom activationAtom,
[NotNull] ZilList argList, ZilDecl decl, [NotNull] ZilObject[] body, [NotNull] string subrName)
{
if (!ctx.AllowRedefine && ctx.GetGlobalVal(name) != null)
{
throw new InterpreterError(InterpreterMessages._0_Already_Defined_1, subrName, name.ToStringContext(ctx, false));
}
var func = new ZilFunction(
subrName,
name,
activationAtom,
argList,
decl,
body);
ctx.SetGlobalVal(name, func);
return(name);
}
public static Syntax Parse(ISourceLine src, [NotNull] IEnumerable <ZilObject> definition, [NotNull] Context ctx)
{
int numObjects = 0;
ZilAtom verb = null, prep1 = null, prep2 = null;
ZilAtom action = null, preaction = null, actionName = null;
ZilList bits1 = null, find1 = null, bits2 = null, find2 = null, syns = null;
bool rightSide = false;
int rhsCount = 0;
// main parsing
foreach (var obj in definition)
{
if (verb == null)
{
if (obj is ZilAtom atom && atom.StdAtom != StdAtom.Eq)
{
verb = atom;
}
else
{
throw new InterpreterError(InterpreterMessages.Missing_0_In_1, "verb", "syntax definition");
}
}
public void TestEXPAND()
{
// most values expand to themselves
TestHelpers.EvalAndAssert("<EXPAND 123>", new ZilFix(123));
TestHelpers.EvalAndAssert("<EXPAND \"hello\">", ZilString.FromString("hello"));
var ctx = new Context();
TestHelpers.EvalAndAssert(ctx, "<EXPAND +>", ctx.GetStdAtom(StdAtom.Plus));
TestHelpers.EvalAndAssert(ctx, "<EXPAND <>>", ctx.FALSE);
// lists expand to copies of themselves
var list = new ZilList(new ZilObject[] { new ZilFix(1), new ZilFix(2), new ZilFix(3) });
ctx.SetLocalVal(ctx.GetStdAtom(StdAtom.T), list);
var actual = TestHelpers.Evaluate(ctx, "<EXPAND .T>");
TestHelpers.AssertStructurallyEqual(list, actual);
Assert.AreNotSame(list, actual);
// forms execute when evaluated
TestHelpers.Evaluate(ctx, "<DEFMAC FOO () <FORM BAR>>");
var expected = new ZilForm(new ZilObject[] { ZilAtom.Parse("BAR", ctx) });
TestHelpers.EvalAndAssert(ctx, "<EXPAND '<FOO>>", expected);
TestHelpers.EvalAndAssert(ctx, "<EXPAND <FORM ,FOO>>", expected);
// if the form doesn't contain a macro, it still executes
TestHelpers.Evaluate(ctx, "<DEFINE BAR () 123>");
TestHelpers.EvalAndAssert(ctx, "<EXPAND '<BAR>>", new ZilFix(123));
TestHelpers.EvalAndAssert(ctx, "<EXPAND <FORM ,BAR>>", new ZilFix(123));
// must have 1 argument
TestHelpers.EvalAndCatch <InterpreterError>("<EXPAND>");
TestHelpers.EvalAndCatch <InterpreterError>("<EXPAND FOO BAR>");
}
public static ZilObject DEFMAC([NotNull] Context ctx, [NotNull] ZilAtom name,
[CanBeNull][Optional] ZilAtom activationAtom, [ItemNotNull][NotNull] ZilList argList,
[CanBeNull][Optional] ZilDecl decl, [NotNull][Required] ZilObject[] body)
{
if (!ctx.AllowRedefine && ctx.GetGlobalVal(name) != null)
{
throw new InterpreterError(InterpreterMessages._0_Already_Defined_1, "DEFMAC", name.ToStringContext(ctx, false));
}
var func = new ZilFunction(
"DEFMAC",
name,
activationAtom,
argList,
decl,
body);
var macro = new ZilEvalMacro(func)
{
SourceLine = ctx.TopFrame.SourceLine
};
ctx.SetGlobalVal(name, macro);
return(name);
}
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 BoundedLoopContext([NotNull] Compilation cc, [NotNull] ZilList spec, [NotNull] ISourceLine src)
{
this.cc = cc;
this.spec = spec;
this.src = src;
}
static ZilObject MakeDefstructCustomCtorMacro([NotNull] Context ctx, ZilAtom ctorName, [NotNull] ZilAtom typeName, [NotNull] ZilAtom baseType,
[NotNull] List <DefStructField> fields, [NotNull] ZilList initArgs, int startOffset, [NotNull] ArgSpec argspec)
{
// {0} = constructor name
// {1} = type name
// {2} = argspec
// {3} = field count
// {4} = base constructor atom
// {5} = list of INIT-ARGS, or empty list
// {6} = list of PUT statements for fields
const string SMacroTemplate = @"
<DEFMAC {0} {2}
<BIND ((RESULT-INIT <IVECTOR {3} <>>))
{6:SPLICE}
<FORM CHTYPE <FORM {4} {5:SPLICE} !.RESULT-INIT> {1}>>>";
var remainingFields = fields.ToDictionary(f => f.Name);
var resultInitializers = new List <ZilObject>();
foreach (var arg in argspec)
{
// NOTE: we don't handle NoDefault ('NONE) here because this ctor allocates a new object
// {0} = offset
// {1} = arg name
// {2} = default value
const string SRequiredArgInitializer = "<PUT .RESULT-INIT {0} .{1}>";
const string SOptAuxArgInitializer = "<PUT .RESULT-INIT {0} <COND (<ASSIGNED? {1}> .{1}) (T {2})>>";
if (remainingFields.TryGetValue(arg.Atom, out var field))
{
remainingFields.Remove(arg.Atom);
}
else
{
continue;
}
// generate code
switch (arg.Type)
{
case ArgItem.ArgType.Required:
resultInitializers.Add(Program.Parse(
ctx,
SRequiredArgInitializer,
new ZilFix(field.Offset - startOffset + 1),
arg.Atom,
field.Default ?? DefaultForDecl(ctx, field.Decl))
.Single());
break;
case ArgItem.ArgType.Optional:
case ArgItem.ArgType.Auxiliary:
resultInitializers.Add(Program.Parse(
ctx,
SOptAuxArgInitializer,
new ZilFix(field.Offset - startOffset + 1),
arg.Atom,
field.Default ?? DefaultForDecl(ctx, field.Decl))
.Single());
break;
default:
throw UnhandledCaseException.FromEnum(arg.Type);
}
}
foreach (var field in remainingFields.Values)
{
if (field.Default == null)
{
continue;
}
// {0} = offset
// {1} = default value
const string SOmittedFieldInitializer = "<PUT .RESULT-INIT {0} {1}>";
resultInitializers.Add(Program.Parse(
ctx,
SOmittedFieldInitializer,
new ZilFix(field.Offset - startOffset + 1),
field.Default)
.Single());
}
return(Program.Parse(
ctx,
SMacroTemplate,
ctorName,
typeName,
argspec.ToZilList(),
new ZilFix(fields.Count),
baseType,
initArgs,
new ZilList(resultInitializers))
.Single());
}
public static ZilObject DEFINE20([NotNull] Context ctx, [NotNull] ZilAtom name,
[CanBeNull][Optional] ZilAtom activationAtom, [NotNull][ItemNotNull] ZilList argList,
[CanBeNull][Optional] ZilDecl decl, [ItemCanBeNull][NotNull][Required] ZilObject[] body)
{
return(PerformDefine(ctx, name, activationAtom, argList, decl, body, "DEFINE20"));
}
static ZilObject MakeDefstructCtorMacro([NotNull] Context ctx, [NotNull] ZilAtom name, [NotNull] ZilAtom baseType, [NotNull] List <DefStructField> fields,
[NotNull] ZilList initArgs, int startOffset)
{
// the MAKE-[STRUCT] macro can be called with a parameter telling it to stuff values into an existing object:
// <MAKE-FOO 'FOO .MYFOO 'FOO-X 123>
// in which case we want to return:
// <BIND ((RESULT .MYFOO)) <PUT .RESULT 1 123> .RESULT>
// but without that parameter, we stuff the values into a temporary vector now, and
// build a call to the base constructor:
// <CHTYPE <TABLE 123> FOO>
// {0} = name
// {1} = field count
// {2} = list of COND clauses for tags ("existing object" mode, returning a FORM that PUTs into .RESULT)
// {3} = list of COND clauses for tags ("new object" mode, PUTting into the temp vector .RESULT-INIT)
// {4} = base constructor atom
// {5} = list of INIT-ARGS, or empty list
// {6} = list of COND clauses for indices ("BOA constructor" mode, PUTting into the temp vector .RESULT-INIT)
// {7} = list of COND clauses for index defaults
// {8} = list of COND statements for tag defaults ("new object" mode)
// {9} = list of expressions returning a FORM or SPLICE for tag defaults ("existing object" mode)
const string SMacroTemplate = @"
<DEFMAC %<PARSE <STRING ""MAKE-"" <SPNAME {0}>>> (""ARGS"" A ""AUX"" RESULT-INIT SEEN)
;""expand segments""
<SET A <MAPF ,LIST
<FUNCTION (X)
<COND (<TYPE? .X SEGMENT> <MAPRET !<CHTYPE .X FORM>>)
(ELSE .X)>>
.A>>
<COND (<AND <NOT <EMPTY? .A>>
<=? <1 .A> '<QUOTE {0}>>>
<SET RESULT-INIT <2 .A>>
<SET SEEN '()>
<SET A <REST .A 2>>
<FORM BIND <LIST <LIST RESULT .RESULT-INIT>>
!<MAPF
,LIST
<FUNCTION (""AUX"" N V)
<COND (<LENGTH? .A 0> <MAPSTOP>)
(<LENGTH? .A 1> <ERROR NOT-ENOUGH-ARGS!-ERRORS .A>)>
<SET N <1 .A>>
<SET V <2 .A>>
<SET A <REST .A 2>>
<COND {2:SPLICE}
(T <ERROR INVALID-DEFSTRUCT-TAG!-ERRORS .N>)>>>
!<VECTOR {9:SPLICE}>
'.RESULT>)
(<OR <EMPTY? .A>
<NOT <TYPE? <1 .A> FORM>>
<N==? <1 <1 .A>> QUOTE>>
<SET RESULT-INIT <IVECTOR {1} <>>>
<BIND ((I 1))
<MAPF <>
<FUNCTION (V)
<COND {6:SPLICE}
(T <ERROR TOO-MANY-ARGS!-ERRORS .A>)>
<SET I <+ .I 1>>>
.A>
<REPEAT ()
<COND (<G? .I {1}> <RETURN>)
{7:SPLICE}>
<SET I <+ .I 1>>>>
<FORM CHTYPE <FORM {4} {5:SPLICE} !.RESULT-INIT> {0}>)
(T
<SET RESULT-INIT <IVECTOR {1} <>>>
<SET SEEN '()>
<REPEAT (N V)
<COND (<LENGTH? .A 0> <RETURN>)
(<LENGTH? .A 1> <ERROR NOT-ENOUGH-ARGS!-ERRORS .A>)>
<SET N <1 .A>>
<SET V <2 .A>>
<SET A <REST .A 2>>
<COND {3:SPLICE}
(T <ERROR INVALID-DEFSTRUCT-TAG!-ERRORS .N>)>>
{8:SPLICE}
<FORM CHTYPE <FORM {4} {5:SPLICE} !.RESULT-INIT> {0}>)>>
";
// {0} = tag name
// {1} = PUT atom
// {2} = offset in structure (for existing object) or RESULT-INIT (for others)
// {3} = definition order (1-based)
// {4} = default value
const string SExistingObjectCondClauseTemplate = "(<=? .N '<QUOTE {0}>> <SET SEEN <CONS {0} .SEEN>> <FORM {1} '.RESULT {2} .V>)";
const string SExistingObjectDefaultTemplate = "<COND (<MEMQ {0} .SEEN> #SPLICE ()) (T <FORM {1} '.RESULT {2} {4}>)>";
const string SExistingObjectDefaultTemplate_NoDefault = "#SPLICE ()";
const string SNewObjectCondClauseTemplate = "(<=? .N '<QUOTE {0}>> <SET SEEN <CONS {0} .SEEN>> <PUT .RESULT-INIT {2} .V>)";
const string SNewObjectDefaultTemplate = "<OR <MEMQ {0} .SEEN> <PUT .RESULT-INIT {2} {4}>>";
const string SBoaConstructorCondClauseTemplate = "(<=? .I {3}> <PUT .RESULT-INIT {2} .V>)";
const string SBoaConstructorDefaultClauseTemplate = "(<=? .I {3}> <PUT .RESULT-INIT {2} {4}>)";
var existingObjectClauses = new List <ZilObject>();
var existingObjectDefaults = new List <ZilObject>();
var newObjectClauses = new List <ZilObject>();
var newObjectDefaults = new List <ZilObject>();
var boaConstructorClauses = new List <ZilObject>();
var boaConstructorDefaultClauses = new List <ZilObject>();
int definitionOrder = 1;
foreach (var field in fields)
{
var defaultValue = field.Default ?? DefaultForDecl(ctx, field.Decl);
var actualOffset = new ZilFix(field.Offset);
var adjustedOffset = new ZilFix(field.Offset - startOffset + 1);
var orderFix = new ZilFix(definitionOrder);
existingObjectDefaults.Add(Program.Parse(
ctx,
field.NoDefault ? SExistingObjectDefaultTemplate_NoDefault : SExistingObjectDefaultTemplate,
field.Name, field.PutFunc, actualOffset, orderFix, defaultValue)
.Single());
newObjectDefaults.Add(Program.Parse(
ctx,
SNewObjectDefaultTemplate,
field.Name, field.PutFunc, adjustedOffset, orderFix, defaultValue)
.Single());
boaConstructorDefaultClauses.Add(Program.Parse(
ctx,
SBoaConstructorDefaultClauseTemplate,
field.Name, field.PutFunc, adjustedOffset, orderFix, defaultValue)
.Single());
existingObjectClauses.Add(Program.Parse(
ctx,
SExistingObjectCondClauseTemplate,
field.Name, field.PutFunc, actualOffset, orderFix, defaultValue)
.Single());
newObjectClauses.Add(Program.Parse(
ctx,
SNewObjectCondClauseTemplate,
field.Name, field.PutFunc, adjustedOffset, orderFix, defaultValue)
.Single());
boaConstructorClauses.Add(Program.Parse(
ctx,
SBoaConstructorCondClauseTemplate,
field.Name, field.PutFunc, adjustedOffset, orderFix, defaultValue)
.Single());
definitionOrder++;
}
return(Program.Parse(
ctx,
SMacroTemplate,
name,
new ZilFix(fields.Count),
new ZilList(existingObjectClauses),
new ZilList(newObjectClauses),
baseType,
initArgs,
new ZilList(boaConstructorClauses),
new ZilList(boaConstructorDefaultClauses),
new ZilList(newObjectDefaults),
new ZilList(existingObjectDefaults))
.Single());
}
public ZilObject ToZilObject()
{
ZilObject result;
StdAtom head;
switch (Type)
{
case OutputElementType.Length:
result = Fix ?? FALSE;
break;
case OutputElementType.Many:
result = ZilString.FromString("MANY");
break;
case OutputElementType.Adjective:
head = StdAtom.ADJ;
goto TwoElementForm;
case OutputElementType.Byte:
head = StdAtom.BYTE;
goto TwoElementForm;
case OutputElementType.Global:
head = StdAtom.GLOBAL;
goto TwoElementForm;
case OutputElementType.Noun:
head = StdAtom.NOUN;
goto TwoElementForm;
case OutputElementType.Object:
head = StdAtom.OBJECT;
goto TwoElementForm;
case OutputElementType.Room:
head = StdAtom.ROOM;
goto TwoElementForm;
case OutputElementType.String:
head = StdAtom.STRING;
goto TwoElementForm;
case OutputElementType.Word:
head = StdAtom.WORD;
TwoElementForm:
result = new ZilForm(new[] {
GetStdAtom(head),
(ZilObject)Fix ?? new ZilForm(new[] {
GetStdAtom(StdAtom.LVAL),
Variable
})
});
break;
case OutputElementType.Voc:
result = new ZilForm(new[] {
GetStdAtom(StdAtom.VOC),
(ZilObject)Fix ?? new ZilForm(new[] {
GetStdAtom(StdAtom.LVAL),
Variable
}),
PartOfSpeech
});
break;
default:
throw UnhandledCaseException.FromEnum(Type);
}
if (Constant != null)
{
result = new ZilList(new[] { Constant, result });
}
return(result);
}
public static ZilObject FUNCTION(Context ctx, [CanBeNull][Optional] ZilAtom activationAtom,
[NotNull] ZilList argList, [CanBeNull][Optional] ZilDecl decl, [NotNull][Required] ZilObject[] body)
{
return(new ZilFunction("FUNCTION", null, activationAtom, argList, decl, body));
}
public static ZilObject BLOCK([NotNull] Context ctx, [NotNull] ZilList list)
{
ctx.PushObPath(list);
return(list);
}