static Type GetGenericType(string typename, Type[] types)
{
int l = types.Length;
var functype = ClrGenerator.GetTypeFast(typename + "`" + l).MakeGenericType(types);
return(functype);
}
public static object GetClrType(object name, params object[] typeargs)
{
SymbolId s = RequiresNotNull <SymbolId>(name);
string tn = SymbolTable.IdToString(s);
var t = ClrGenerator.GetTypeFast(tn);
if (t == null)
{
return(FALSE);
}
if (typeargs.Length == 0)
{
return(t);
}
return(t.MakeGenericType(Array.ConvertAll(typeargs, x => (Type)x)));
}
static void GenerateFields(object fields, string n, RecordTypeDescriptor rtd, TypeGen tg, object fieldtypes)
{
object[] f = RequiresNotNull <object[]>(fields);
object[] ftypes = RequiresNotNull <object[]>(fieldtypes);
List <FieldDescriptor> rtd_fields = new List <FieldDescriptor>();
for (int i = 0; i < f.Length; i++)
{
Cons c = (Cons)f[i];
Type t = ClrGenerator.ExtractTypeInfo(List(SymbolTable.StringToObject("quote"), ftypes[i]));
if (t == null)
{
ClrGenerator.ClrSyntaxError("GenerateFields", "type not found", ftypes[i]);
}
string fname = SymbolTable.IdToString(RequiresNotNull <SymbolId>(Second(c)));
// we use standard names here, they will be mapped to the given names
string aname = n + "-" + fname;
string mname = n + "-" + fname + "-set!";
var fd = new FieldDescriptor {
Name = fname
};
FieldAttributes fattrs = FieldAttributes.Public | FieldAttributes.InitOnly;
if (c.car == SymbolTable.StringToObject("mutable"))
{
fd.mutable = true;
fattrs &= ~FieldAttributes.InitOnly;
}
FieldSlot s = tg.AddField(t, fname, fattrs) as FieldSlot;
fd.field = s.Field;
PropertyBuilder pi = tg.TypeBuilder.DefineProperty(fname, PropertyAttributes.None, t, new Type[0]);
// accesor
MethodBuilder ab = tg.TypeBuilder.DefineMethod(aname, MethodAttributes.Public | MethodAttributes.Static,
t, new Type[] { tg.TypeBuilder });
ab.DefineParameter(1, ParameterAttributes.None, n);
ILGenerator agen = ab.GetILGenerator();
agen.Emit(OpCodes.Ldarg_0);
//agen.Emit(OpCodes.Castclass, tg.TypeBuilder);
agen.Emit(OpCodes.Ldfld, fd.field);
agen.Emit(OpCodes.Ret);
fd.accessor = ab;
pi.SetGetMethod(ab);
// mutator
if (fd.mutable)
{
MethodBuilder mb = tg.TypeBuilder.DefineMethod(mname, MethodAttributes.Public | MethodAttributes.Static,
typeof(object), new Type[] { tg.TypeBuilder, t });
mb.DefineParameter(1, ParameterAttributes.None, n);
ILGenerator mgen = mb.GetILGenerator();
mgen.Emit(OpCodes.Ldarg_0);
//mgen.Emit(OpCodes.Castclass, tg.TypeBuilder);
mgen.Emit(OpCodes.Ldarg_1);
mgen.Emit(OpCodes.Stfld, fd.field);
mgen.Emit(OpCodes.Ldsfld, Compiler.Generator.Unspecified);
mgen.Emit(OpCodes.Ret);
fd.mutator = mb;
pi.SetSetMethod(mb);
}
rtd_fields.Add(fd);
}
rtd.fields = rtd_fields.ToArray();
}
public static RecordTypeDescriptor GenerateRecordTypeDescriptor(AssemblyGen ag, object name, object parent, object uid, object issealed, object isopaque, object fields, object fieldtypes)
{
string n = SymbolTable.IdToString(RequiresNotNull <SymbolId>(name));
string id = uid is SymbolId?SymbolTable.IdToString(RequiresNotNull <SymbolId>(uid)) : uid as string;
if (id != null)
{
RecordTypeDescriptor ngrtd;
if (nongenerative.TryGetValue(n + id, out ngrtd))
{
return(ngrtd);
}
var type = ClrGenerator.GetTypeFast("record." + id + "." + n.Replace("&", "$"));
if (type != null)
{
return(RecordTypeDescriptor.Create(type, n, id, parent as RecordTypeDescriptor));
}
}
bool @sealed = RequiresNotNull <bool>(issealed);
bool opaque = RequiresNotNull <bool>(isopaque);
RecordTypeDescriptor prtd = parent as RecordTypeDescriptor; // can be #f
Type parenttype = typeof(object);
if (prtd != null)
{
parenttype = prtd.type;
}
else if (n == "&condition")
{
parenttype = typeof(Condition);
}
TypeAttributes attrs = TypeAttributes.Public | TypeAttributes.Serializable;
var rtd = new RecordTypeDescriptor
{
Name = n,
@sealed = @sealed,
opaque = opaque,
ag = ag,
Parent = prtd,
uid = uid,
generative = id == null || uid is string,
};
if (@sealed)
{
attrs |= TypeAttributes.Sealed;
}
object gid = (object)id ?? Guid.NewGuid();
var ns = "record." + gid;
var typename = ns + "." + n.Replace("&", "$");
TypeGen tg = ag.DefinePublicType(typename, parenttype, attrs);
rtd.tg = tg;
rtd.type = tg.TypeBuilder;
if (id != null)
{
nongenerative[n + id] = rtd;
}
if (parenttype.IsSubclassOf(typeof(Condition)))
{
SetSymbolValueFast(SymbolTable.StringToObject(n + "-rtd"), rtd);
}
GeneratePredicate(n, rtd, tg);
GenerateFields(fields, n, rtd, tg, fieldtypes);
GenerateConstructor(rtd, tg, parenttype);
return(rtd);
}
public static Expression MakeRecordTypeDescriptor(Expression[] obj)
{
if ((obj.Length == 6 || obj.Length == 7) && IronScheme.Compiler.Generator.VarHint != SymbolId.Empty)
{
try
{
var name = Unwrap(obj[0]);
var parent = Unwrap(obj[1]);
var uid = Unwrap(obj[2]);
var issealed = Unwrap(obj[3]);
var isopaque = Unwrap(obj[4]);
var fields = obj[5];
if (fields is BoundExpression)
{
return(null);
}
if (name is BoundExpression)
{
return(null);
}
var rname = ((ConstantExpression)name).Value;
var ruid = ((ConstantExpression)uid).Value;
var rsealed = ((ConstantExpression)issealed).Value;
var ropaque = ((ConstantExpression)isopaque).Value;
object[] rfields = { };
if (fields is NewArrayExpression)
{
var ff = ((NewArrayExpression)fields).Expressions;
var dfields = new Expression[ff.Count];
ff.CopyTo(dfields, 0);
rfields = Array.ConvertAll(dfields, x => ((ConstantExpression)x).Value);
}
object[] tfields = Array.ConvertAll(rfields, x => SymbolTable.StringToObject("Object"));
if (obj.Length == 7)
{
var ftypes = obj[6];
if (ftypes is NewArrayExpression)
{
var ff = ((NewArrayExpression)ftypes).Expressions;
var dfields = new Expression[ff.Count];
ff.CopyTo(dfields, 0);
tfields = Array.ConvertAll(dfields, x => ((ConstantExpression)((UnaryExpression)x).Operand).Value);
}
}
if (!Builtins.IsTrue(ruid))
{
ruid = Guid.NewGuid().ToString(); //TODO: recall why this was done :\ Change to gensym if possible
obj[2] = Ast.Convert(Ast.Constant(ruid), typeof(object));
}
object par = null;
if (parent is BoundExpression)
{
par = ((BoundExpression)parent).Variable.Name;
}
var rtdc = new RecordTypeDescriptorConstant
{
RecordName = rname,
Uid = ruid,
Sealed = rsealed,
Opaque = ropaque,
Parent = par,
Fields = rfields,
FieldTypes = tfields,
NameHint = IronScheme.Compiler.Generator.VarHint,
};
var at = rtdc.Generate();
if (at != null)
{
ClrGenerator.AddCompileTimeType(at);
}
var e = Ast.Constant(rtdc);
return(Ast.Comma(e, Ast.Call(typeof(Records).GetMethod("MakeRecordTypeDescriptor"), obj)));
}
catch
{
throw;
//kaboom, redirect to runtime
}
}
return(null);
}
