// 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");
}
}
static ZilObject MakeDefstructAccessMacro([NotNull] Context ctx, [NotNull] ZilAtom structName, DefStructDefaults defaults,
DefStructField field)
{
// {0} = field name
// {1} = struct name
// {2} = PUT atom
// {3} = NTH atom
// {4} = offset
// {5} = field decl
const string SFullCheckTemplate = @"
<DEFMAC {0} ('S ""OPT"" 'NV)
<COND (<ASSIGNED? NV>
<FORM {2} <CHTYPE [.S {1}] ADECL> {4} <CHTYPE [.NV <QUOTE {5}>] ADECL>>)
(T
<CHTYPE [<FORM {3} <CHTYPE [.S {1}] ADECL> {4}> <QUOTE {5}>] ADECL>)>>
";
const string SFieldCheckTemplate = @"
<DEFMAC {0} ('S ""OPT"" 'NV)
<COND (<ASSIGNED? NV>
<FORM {2} .S {4} <CHTYPE [.NV <QUOTE {5}>] ADECL>>)
(T
<CHTYPE [<FORM {3} .S {4}> <QUOTE {5}>] ADECL>)>>
";
const string SNoCheckTemplate = @"
<DEFMAC {0} ('S ""OPT"" 'NV)
<COND (<ASSIGNED? NV>
<FORM {2} .S {4} .NV>)
(T
<FORM {3} .S {4}>)>>
";
string template;
if (defaults.SuppressDecl)
{
template = SNoCheckTemplate;
}
else if (defaults.SuppressType)
{
template = SFieldCheckTemplate;
}
else
{
template = SFullCheckTemplate;
}
return(Program.Parse(
ctx,
template,
field.Name,
structName,
field.PutFunc,
field.NthFunc,
new ZilFix(field.Offset),
field.Decl)
.Single());
}
static DefStructField ParseDefStructField(DefStructDefaults defaults, ref int offset, DefStructParams.FieldSpecList fieldSpec)
{
var result = new DefStructField
{
Decl = fieldSpec.Decl,
Name = fieldSpec.Name,
NthFunc = defaults.NthFunc,
Offset = offset,
PutFunc = defaults.PutFunc
};
bool gotDefault = false, gotOffset = false;
foreach (var part in fieldSpec.Parts)
{
switch (part)
{
case DefStructParams.AtomFieldSequence af:
switch (af.ClauseType)
{
case StdAtom.NTH:
result.NthFunc = af.Atom;
break;
case StdAtom.PUT:
result.PutFunc = af.Atom;
break;
default:
throw UnhandledCaseException.FromEnum(af.ClauseType, "atom clause type");
}
break;
case DefStructParams.FixFieldSequence ff:
switch (ff.ClauseType)
{
case StdAtom.OFFSET:
result.Offset = ff.Fix;
gotOffset = true;
break;
default:
throw UnhandledCaseException.FromEnum(ff.ClauseType, "FIX clause type");
}
break;
case DefStructParams.NullaryFieldSequence nf:
switch (nf.ClauseType)
{
case StdAtom.NONE:
if (gotDefault)
{
throw new InterpreterError(InterpreterMessages._0_NONE_Is_Not_Allowed_After_A_Default_Field_Value, "DEFSTRUCT");
}
result.NoDefault = true;
gotDefault = true;
break;
default:
throw UnhandledCaseException.FromEnum(nf.ClauseType, "nullary clause type");
}
break;
case ZilObject zo when !gotDefault:
result.Default = zo;
gotDefault = true;
break;
default:
throw new InterpreterError(InterpreterMessages._0_Unrecognized_1_2, "DEFSTRUCT", "object in field definition", part);
}
}
if (!gotOffset)
{
offset++;
}
return(result);
}
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);
}
