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 DEFSTRUCT([NotNull] Context ctx, [NotNull] ZilAtom name,
[NotNull][Either(typeof(ZilAtom), typeof(DefStructParams.DefaultsList), DefaultParamDesc = "base-type")]
object baseTypeOrDefaults,
[NotNull][Required]
DefStructParams.FieldSpecList[] fieldSpecs)
{
// new type name
if (ctx.IsRegisteredType(name))
{
throw new InterpreterError(InterpreterMessages._0_Already_Defined_1, "DEFSTRUCT", name);
}
// base type, and optional default field settings
ZilAtom baseType;
var defaults = new DefStructDefaults
{
NthFunc = ctx.GetStdAtom(StdAtom.NTH),
PutFunc = ctx.GetStdAtom(StdAtom.PUT),
StartOffset = 1
};
var fileDefaultList = ctx.CurrentFile.DefStructDefaults;
if (fileDefaultList != null)
{
ParseDefStructDefaults(ctx, fileDefaultList, ref defaults);
}
if (baseTypeOrDefaults is ZilAtom atom)
{
baseType = atom;
}
else
{
var defaultsParam = (DefStructParams.DefaultsList)baseTypeOrDefaults;
baseType = defaultsParam.BaseType;
ParseDefStructDefaults(defaultsParam, ref defaults);
}
if (!ctx.IsRegisteredType(baseType))
{
throw new InterpreterError(InterpreterMessages._0_Unrecognized_1_2, "DEFSTRUCT", "base type", baseType);
}
// field definitions
var fields = new List <DefStructField>();
var offset = defaults.StartOffset;
foreach (var fieldSpec in fieldSpecs)
{
fields.Add(ParseDefStructField(defaults, ref offset, fieldSpec));
}
if (!defaults.SuppressType)
{
// register the type
ctx.RegisterType(name, ctx.GetTypePrim(baseType));
if (!defaults.SuppressDecl)
{
var decl = MakeDefstructDecl(ctx, baseType, fields);
ctx.PutProp(name, ctx.GetStdAtom(StdAtom.DECL), decl);
}
}
var initArgs = defaults.InitArgs ?? new ZilList(null, null);
// define constructor macro
if (!defaults.SuppressDefaultCtor)
{
var ctorMacroDef = MakeDefstructCtorMacro(ctx, name, baseType, fields, initArgs, defaults.StartOffset);
using (ctx.PushFileContext($"<constructor for DEFSTRUCT {name}>"))
{
ctorMacroDef.Eval(ctx);
}
}
if (defaults.CustomCtorSpec != null)
{
if (defaults.CustomCtorSpec.IsEmpty || defaults.CustomCtorSpec.Rest != null && defaults.CustomCtorSpec.Rest.IsEmpty)
{
throw new InterpreterError(InterpreterMessages._0_Not_Enough_Elements_In_CONSTRUCTOR_Spec, "DEFSTRUCT");
}
if (!(defaults.CustomCtorSpec.First is ZilAtom ctorName))
{
throw new InterpreterError(InterpreterMessages._0_Expected_1_After_2, "DEFSTRUCT", "an atom", "'CONSTRUCTOR");
}
Debug.Assert(defaults.CustomCtorSpec.Rest != null);
if (!(defaults.CustomCtorSpec.Rest.First is ZilList argspecList))
{
throw new InterpreterError(InterpreterMessages._0_Second_Element_After_CONSTRUCTOR_Must_Be_An_Argument_List, "DEFSTRUCT");
}
var argspec = ArgSpec.Parse("DEFSTRUCT", ctorName, null, argspecList);
var ctorMacroDef = MakeDefstructCustomCtorMacro(ctx, ctorName, name, baseType, fields, initArgs, defaults.StartOffset, argspec);
using (ctx.PushFileContext($"<constructor {ctorName} for DEFSTRUCT {name}>"))
{
ctorMacroDef.Eval(ctx);
}
}
// define field access macros
foreach (var field in fields)
{
var accessMacroDef = MakeDefstructAccessMacro(ctx, name, defaults, field);
using (ctx.PushFileContext($"<accessor for field {field.Name} of DEFSTRUCT {name}>"))
{
accessMacroDef.Eval(ctx);
}
}
// ReSharper disable once PatternAlwaysOfType
if (defaults.PrintFunc is ZilAtom printFuncAtom)
{
var handler = ctx.GetGlobalVal(printFuncAtom);
// ReSharper disable once ConvertIfStatementToNullCoalescingExpression
if (handler == null)
{
// annoyingly, the argument can be an atom naming a function that hasn't been defined yet
handler = Program.Parse(
ctx,
@"#FUNCTION ((X ""AUX"" (D ,{0})) <PRINTTYPE {1} .D> <APPLY .D .X>)",
printFuncAtom,
name).Single();
}
ctx.SetPrintType(name, handler);
}
return(name);
}