public static object ConditionPredicate(object rtd) { RecordTypeDescriptor t = RequiresNotNull <RecordTypeDescriptor>(rtd); if (!t.type.IsSubclassOf(typeof(Condition))) { return(AssertionViolation("condition-predicate", "not a valid condition", rtd)); } CallTarget1 p = delegate(object cond) { CallTarget1 recp = Delegate.CreateDelegate(typeof(CallTarget1), t.predicate) as CallTarget1; if (cond is CompoundCondition) { CompoundCondition cc = (CompoundCondition)cond; foreach (object ic in cc.conds) { if (IsTrue(recp(ic))) { return(TRUE); } } return(FALSE); } else { return(recp(cond)); } }; return(Closure.Create(p)); }
public static Callable RecordAccessor(object rtd, object k) { RecordTypeDescriptor t = RequiresNotNull <RecordTypeDescriptor>(rtd); int i = RequiresNotNull <int>(k); if (i >= t.Fields.Length) { AssertionViolation("record-accessor", "invalid field index", rtd, k); } return(t.fields[i].Accessor); }
public static object RecordMutator(object rtd, object k) { RecordTypeDescriptor t = RequiresNotNull<RecordTypeDescriptor>(rtd); int i = RequiresNotNull<int>(k); if (i >= t.Fields.Length) { AssertionViolation("record-mutator", "invalid field index", rtd, k); } return t.fields[i].Mutator; }
public static object ConditionAccessor(object rtd, object proc) { RecordTypeDescriptor t = RequiresNotNull <RecordTypeDescriptor>(rtd); if (!t.type.IsSubclassOf(typeof(Condition))) { return(AssertionViolation("condition-accessor", "not a valid condition", rtd)); } Callable c = RequiresNotNull <Callable>(proc); CallTarget1 p = delegate(object cond) { if (cond is CompoundCondition) { CompoundCondition cc = (CompoundCondition)cond; if (cc.conds.Length == 0) { // error? return(FALSE); } else { foreach (object e in cc.conds) { if (t.type.IsInstanceOfType(e)) { return(c.Call(e)); } } return(FALSE); } } else { if (t.type.IsInstanceOfType(cond)) { return(c.Call(cond)); } else { return(FALSE); } } }; return(Closure.Create(p)); }
public static object MakeRecordConstructorDescriptor(object rtd, object parent_constructor_descriptor, object protocol) { RecordTypeDescriptor t = RequiresNotNull<RecordTypeDescriptor>(rtd); RecordConstructorDescriptor rcd = new RecordConstructorDescriptor(); rcd.cg = t.cg; rcd.type = t; rcd.protocol = protocol as Callable; rcd.parent = parent_constructor_descriptor as RecordConstructorDescriptor; if (t.type.IsSubclassOf(typeof(Condition))) { SetSymbolValueFast(SymbolTable.StringToObject(t.Name + "-rcd"), rcd); } return rcd; }
static void GeneratePredicate(string n, RecordTypeDescriptor rtd, TypeGen tg) { // predicate MethodBuilder pb = tg.TypeBuilder.DefineMethod(n + "?", MethodAttributes.Public | MethodAttributes.Static, typeof(object), new Type[] { typeof(object) }); pb.DefineParameter(1, ParameterAttributes.None, "obj"); ILGenerator pgen = pb.GetILGenerator(); pgen.Emit(OpCodes.Ldarg_0); pgen.Emit(OpCodes.Isinst, tg.TypeBuilder); pgen.Emit(OpCodes.Ldnull); pgen.Emit(OpCodes.Cgt_Un); pgen.Emit(OpCodes.Call, typeof(RuntimeHelpers).GetMethod("BooleanToObject")); pgen.Emit(OpCodes.Ret); rtd.predicate = pb; }
public static Callable RecordPredicate(object rtd) { RecordTypeDescriptor t = RequiresNotNull <RecordTypeDescriptor>(rtd); return(Closure.Create(Delegate.CreateDelegate(typeof(CallTarget1), t.predicate))); }
static void GenerateConstructor(RecordTypeDescriptor rtd, TypeGen tg, Type parenttype) { // constructor logic { List <Type> paramtypes = new List <Type>(); List <FieldDescriptor> allfields = new List <FieldDescriptor>(rtd.GetAllFields()); int diff = allfields.Count - rtd.Fields.Length; foreach (FieldDescriptor var in allfields) { paramtypes.Add(var.Type); } List <Type> parenttypes = new List <Type>(); for (int i = 0; i < diff; i++) { parenttypes.Add(typeof(object)); //TODO: fix this, it looks broken } if (paramtypes.Count < 9) { CodeGen cg = tg.DefineConstructor(paramtypes.ToArray()); CodeGen mk = tg.DefineMethod(MethodAttributes.Public | MethodAttributes.Static, "make", tg.TypeBuilder, paramtypes.ToArray(), allfields.ConvertAll(x => x.Name).ToArray()); for (int i = 0; i < allfields.Count; i++) { cg.DefineParameter(i + 1, ParameterAttributes.None, allfields[i].Name); } int fi = 0; cg.EmitThis(); for (fi = 0; fi < diff; fi++) { cg.EmitArgGet(fi); mk.EmitArgGet(fi); } cg.Emit(OpCodes.Call, (rtd.Parent == null ? parenttype.GetConstructor(Type.EmptyTypes) : rtd.Parent.DefaultConstructor)); foreach (FieldDescriptor fd in rtd.Fields) { cg.EmitThis(); cg.EmitArgGet(fi); cg.EmitFieldSet(fd.field); mk.EmitArgGet(fi); fi++; } mk.EmitNew(cg.MethodBase as ConstructorInfo); mk.EmitReturn(); cg.EmitReturn(); rtd.cg = cg; } else { CodeGen cg = tg.DefineConstructor(paramtypes.ToArray()); CodeGen mk = tg.DefineMethod(MethodAttributes.Public | MethodAttributes.Static, "make", tg.TypeBuilder, new Type[] { typeof(object[]) }, new string[] { "args" }); for (int i = 0; i < allfields.Count; i++) { cg.DefineParameter(i + 1, ParameterAttributes.None, allfields[i].Name); } int fi = 0; cg.EmitThis(); for (fi = 0; fi < diff; fi++) { cg.EmitArgGet(fi); mk.EmitArgGet(0); mk.EmitConstant(fi); mk.Emit(OpCodes.Ldelem, typeof(object)); } cg.Emit(OpCodes.Call, (rtd.Parent == null ? typeof(object).GetConstructor(Type.EmptyTypes) : rtd.Parent.DefaultConstructor)); foreach (FieldDescriptor fd in rtd.Fields) { cg.EmitThis(); cg.EmitArgGet(fi); cg.EmitFieldSet(fd.field); mk.EmitArgGet(0); mk.EmitConstant(fi); mk.Emit(OpCodes.Ldelem, typeof(object)); fi++; } mk.EmitNew(cg.MethodBase as ConstructorInfo); mk.EmitReturn(); cg.EmitReturn(); rtd.cg = cg; } } }
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 RecordTypeDescriptor Create(Type type, string name, string uid, RecordTypeDescriptor parentrtd) { var rtd = new RecordTypeDescriptor { type = type, Name = name, predicate = type.GetMethod(name + "?"), uid = uid, @sealed = type.IsSealed, Parent = parentrtd }; Records.typedescriptors[type] = rtd; MethodInfo ci = type.GetMethod("make"); var pari = ci.GetParameters(); int pcount = pari.Length; if (pcount < 9 && !(pcount == 1 && pari[0].ParameterType == typeof(object[]))) { rtd.Constructor = CreateCallable(ci); } else { rtd.Constructor = Closure.Create(Delegate.CreateDelegate(typeof(CallTargetN), ci)) as Callable; } rtd.Predicate = Closure.Create(Delegate.CreateDelegate(typeof(CallTarget1), rtd.predicate)) as Callable; var flds = new List <FieldDescriptor>(); foreach (FieldInfo fi in type.GetFields(BindingFlags.Public | BindingFlags.Instance | BindingFlags.DeclaredOnly)) { var fd = new FieldDescriptor { Name = fi.Name }; fd.field = fi; var pi = type.GetProperty(fi.Name); fd.accessor = pi.GetGetMethod(); fd.Accessor = CreateCallable(fd.accessor); if (pi.CanWrite) { fd.mutator = pi.GetSetMethod(); fd.Mutator = CreateCallable(fd.mutator); } else { fd.Mutator = Builtins.FALSE; } flds.Add(fd); } rtd.fields = flds.ToArray(); return(rtd); }
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; }
static void GenerateConstructor(RecordTypeDescriptor rtd, TypeGen tg, Type parenttype) { // constructor logic { List<Type> paramtypes = new List<Type>(); List<FieldDescriptor> allfields = new List<FieldDescriptor>(rtd.GetAllFields()); int diff = allfields.Count - rtd.Fields.Length; foreach (FieldDescriptor var in allfields) { paramtypes.Add(var.Type); } List<Type> parenttypes = new List<Type>(); for (int i = 0; i < diff; i++) { parenttypes.Add(typeof(object)); //TODO: fix this, it looks broken } if (paramtypes.Count < 9) { CodeGen cg = tg.DefineConstructor(paramtypes.ToArray()); CodeGen mk = tg.DefineMethod(MethodAttributes.Public | MethodAttributes.Static, "make", tg.TypeBuilder, paramtypes.ToArray(), allfields.ConvertAll(x => x.Name).ToArray()); for (int i = 0; i < allfields.Count; i++) { cg.DefineParameter(i + 1, ParameterAttributes.None, allfields[i].Name); } int fi = 0; cg.EmitThis(); for (fi = 0; fi < diff; fi++) { cg.EmitArgGet(fi); mk.EmitArgGet(fi); } cg.Emit(OpCodes.Call, (rtd.Parent == null ? parenttype.GetConstructor(Type.EmptyTypes) : rtd.Parent.DefaultConstructor)); foreach (FieldDescriptor fd in rtd.Fields) { cg.EmitThis(); cg.EmitArgGet(fi); cg.EmitFieldSet(fd.field); mk.EmitArgGet(fi); fi++; } mk.EmitNew(cg.MethodBase as ConstructorInfo); mk.EmitReturn(); cg.EmitReturn(); rtd.cg = cg; } else { CodeGen cg = tg.DefineConstructor(paramtypes.ToArray()); CodeGen mk = tg.DefineMethod(MethodAttributes.Public | MethodAttributes.Static, "make", tg.TypeBuilder, new Type[] { typeof(object[]) }, new string[] { "args" }); for (int i = 0; i < allfields.Count; i++) { cg.DefineParameter(i + 1, ParameterAttributes.None, allfields[i].Name); } int fi = 0; cg.EmitThis(); for (fi = 0; fi < diff; fi++) { cg.EmitArgGet(fi); mk.EmitArgGet(0); mk.EmitConstant(fi); mk.Emit(OpCodes.Ldelem, typeof(object)); } cg.Emit(OpCodes.Call, (rtd.Parent == null ? typeof(object).GetConstructor(Type.EmptyTypes) : rtd.Parent.DefaultConstructor)); foreach (FieldDescriptor fd in rtd.Fields) { cg.EmitThis(); cg.EmitArgGet(fi); cg.EmitFieldSet(fd.field); mk.EmitArgGet(0); mk.EmitConstant(fi); mk.Emit(OpCodes.Ldelem, typeof(object)); fi++; } mk.EmitNew(cg.MethodBase as ConstructorInfo); mk.EmitReturn(); cg.EmitReturn(); rtd.cg = cg; } } }
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(); }
static CodeGen MakeInitMethod(RecordTypeDescriptor rtd, TypeGen tg) { var initTypes = new List <Type>(); initTypes.Add(tg.TypeBuilder); initTypes.AddRange(Array.ConvertAll(rtd.Fields, f => f.Type)); var initNames = new List <string>(); initNames.Add("$this"); initNames.AddRange(Array.ConvertAll(rtd.Fields, f => f.Name)); CodeGen init = null; if (rtd.Fields.Length == 0) { init = tg.DefineMethod(MethodAttributes.Public | MethodAttributes.Static, "$init", tg.TypeBuilder, initTypes.ToArray(), initNames.ToArray()); init.EmitArgGet(0); } else if (initTypes.Count < 9) { init = tg.DefineMethod(MethodAttributes.Public | MethodAttributes.Static, "$init", tg.TypeBuilder, initTypes.ToArray(), initNames.ToArray()); int ii = 1; foreach (FieldDescriptor fd in rtd.Fields) { init.EmitArgGet(0); init.EmitArgGet(ii); init.EmitFieldSet(fd.field); ii++; } init.EmitArgGet(0); } else { init = tg.DefineMethod(MethodAttributes.Public | MethodAttributes.Static, "$init", tg.TypeBuilder, new Type[] { typeof(object[]) }, new string[] { "args" }); var local = init.DeclareLocal(tg.TypeBuilder); init.EmitArgGet(0); init.EmitConstant(0); init.Emit(OpCodes.Ldelem, typeof(object)); init.Emit(OpCodes.Castclass, tg.TypeBuilder); init.Emit(OpCodes.Stloc, local); int ii = 1; foreach (FieldDescriptor fd in rtd.Fields) { init.Emit(OpCodes.Ldloc, local); init.EmitArgGet(0); init.EmitConstant(ii); init.Emit(OpCodes.Ldelem, typeof(object)); init.EmitFieldSet(fd.field); ii++; } init.Emit(OpCodes.Ldloc, local); } init.EmitReturn(); return(init); }
public static RecordTypeDescriptor Create(Type type, string name, string uid, RecordTypeDescriptor parentrtd) { var rtd = new RecordTypeDescriptor { type = type, Name = name, predicate = type.GetMethod(name + "?"), uid = uid, @sealed = type.IsSealed, Parent = parentrtd }; Records.typedescriptors[type] = rtd; MethodInfo ci = type.GetMethod("make"); var pari = ci.GetParameters(); int pcount = pari.Length; if (pcount < 9 && !(pcount == 1 && pari[0].ParameterType == typeof(object[]))) { rtd.Constructor = CreateCallable(ci); } else { rtd.Constructor = Closure.Create(Delegate.CreateDelegate(typeof(CallTargetN), ci)) as Callable; } rtd.Predicate = Closure.Create(Delegate.CreateDelegate(typeof(CallTarget1), rtd.predicate)) as Callable; var flds = new List<FieldDescriptor>(); foreach (FieldInfo fi in type.GetFields(BindingFlags.Public | BindingFlags.Instance | BindingFlags.DeclaredOnly)) { var fd = new FieldDescriptor { Name = fi.Name }; fd.field = fi; var pi = type.GetProperty(fi.Name); fd.accessor = pi.GetGetMethod(); fd.Accessor = CreateCallable(fd.accessor); if (pi.CanWrite) { fd.mutator = pi.GetSetMethod(); fd.Mutator = CreateCallable(fd.mutator); } else { fd.Mutator = Builtins.FALSE; } flds.Add(fd); } rtd.fields = flds.ToArray(); return rtd; }