public static T Requires <T>(object obj)
{
if (obj != null && !(obj is T))
{
// no way pass a box op :(
object o = ConvertFromSchemeObject <T>(obj);
if (o != null)
{
return((T)o);
}
Builtins.AssertionViolation(GetCaller(), "expected type: " + typeof(T).Name, obj);
}
if (obj == null && typeof(T).IsValueType)
{
Builtins.AssertionViolation(GetCaller(), "value type cannot be null", typeof(T).Name);
}
return((T)obj);
}
public static T ConvertToDelegate <T>(object proc)
{
if (!(proc is Callable))
{
Builtins.AssertionViolation("ConvertToDelegate", "not a procedure", proc);
}
MethodInfo meth = typeof(T).GetMethod("Invoke");
ParameterInfo[] pars = meth.GetParameters();
if (meth.ReturnType == typeof(void))
{
Delegate d = MakeVoidTypedCallable(Array.ConvertAll(pars, x => x.ParameterType), proc as Callable);
return((T)(object)Delegate.CreateDelegate(typeof(T), d.Target, d.Method));
}
else
{
Delegate d = MakeTypedCallable(meth.ReturnType, Array.ConvertAll(pars, x => x.ParameterType), proc as Callable);
return((T)(object)Delegate.CreateDelegate(typeof(T), d.Target, d.Method));
}
}
public static object FFIConvertFrom <T>(T value)
{
var tc = Type.GetTypeCode(typeof(T));
switch (tc)
{
case TypeCode.Int32:
case TypeCode.Double:
return(value);
case TypeCode.UInt32:
case TypeCode.Int64:
case TypeCode.UInt64:
return(Builtins.ToIntegerIfPossible(GetValue(value)));
case TypeCode.Int16:
case TypeCode.UInt16:
case TypeCode.Byte:
case TypeCode.SByte:
return(Convert.ToInt32(value));
case TypeCode.Single:
return(Convert.ToDouble(value));
case TypeCode.String:
return(Convert.ToString(value));
default:
if (typeof(T) == typeof(IntPtr) ||
typeof(T) == typeof(UIntPtr))
{
return(value);
}
return(Builtins.AssertionViolation("FFIConvertTo", "not a known ffi type", value, typeof(T)));
}
}
static void UnsafeSyntaxError(object who, string msg, object form)
{
Builtins.SyntaxError(who, msg, form, Builtins.FALSE);
}
static object ConvertFromSchemeObject <T>(object o)
{
try
{
switch (Type.GetTypeCode(o.GetType()))
{
case TypeCode.Boolean:
case TypeCode.Char:
case TypeCode.DateTime:
case TypeCode.DBNull:
case TypeCode.Object:
return((T)o);
default:
switch (Type.GetTypeCode(typeof(T)))
{
case TypeCode.Boolean:
return(Builtins.IsTrue(o));
case TypeCode.Byte:
return(Convert.ToByte(o));
case TypeCode.Char:
return(Convert.ToChar(o));
case TypeCode.DateTime:
return(Convert.ToDateTime(o));
case TypeCode.Decimal:
return(Convert.ToDecimal(o));
case TypeCode.Double:
return(Convert.ToDouble(o));
case TypeCode.Int16:
return(Convert.ToInt16(o));
case TypeCode.Int32:
return(Convert.ToInt32(o));
case TypeCode.Int64:
return(Convert.ToInt64(o));
case TypeCode.SByte:
return(Convert.ToSByte(o));
case TypeCode.Single:
return(Convert.ToSingle(o));
case TypeCode.String:
return(Convert.ToString(o));
case TypeCode.UInt16:
return(Convert.ToUInt16(o));
case TypeCode.UInt32:
return(Convert.ToUInt32(o));
case TypeCode.UInt64:
return(Convert.ToUInt64(o));
default:
return((T)o);
}
}
}
catch
{
// nothing i can do now :\
return(null);
}
}
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);
}
// helper
public static object LongToBignum(long l)
{
return(Builtins.ToIntegerIfPossible(new BigInteger(l)));
}
public override object Call(object[] args)
{
try
{
object ppo;
if (Builtins.cc.Scope.TryLookupName(SymbolTable.StringToId("trace-printer"), out ppo))
{
ppo = (ppo as Callable).Call();
}
else
{
ppo = "write".Eval();
}
Callable pp = ppo as Callable;
depth++;
Cons c = Runtime.Cons.FromArray(args), u = c;
if (filter != null)
{
while (c != null)
{
c.car = filter.Call(c.car);
c = c.cdr as Cons;
}
}
object a = args.Length == 1 ? Builtins.Car(u) : u;
StringWriter pre = new StringWriter();
pp.Call(a, pre);
string prefix = new string('|', depth);
if ((Console.LargestWindowWidth | Console.LargestWindowHeight) == 0)
{
Console.WriteLine("{0} -> {1}", prefix, name);
Console.WriteLine(pre.GetBuffer().TrimEnd(Environment.NewLine.ToCharArray()));
object result = realtarget.Call(args);
StringWriter p = new StringWriter();
pp.Call(filter == null ? result : filter.Call(result), p);
Console.WriteLine("{0} <- {1}", prefix, name);
Console.WriteLine(p.GetBuffer().TrimEnd(Environment.NewLine.ToCharArray()));
return(result);
}
else
{
Console.ForegroundColor = ConsoleColor.Yellow;
Console.WriteLine("{0} -> {1}", prefix, name);
Console.ForegroundColor = ConsoleColor.White;
Console.WriteLine(pre.GetBuffer().TrimEnd(Environment.NewLine.ToCharArray()));
Console.ForegroundColor = ConsoleColor.Gray;
object result = realtarget.Call(args);
StringWriter p = new StringWriter();
pp.Call(filter == null ? result : filter.Call(result), p);
Console.ForegroundColor = ConsoleColor.Cyan;
Console.WriteLine("{0} <- {1}", prefix, name);
Console.ForegroundColor = ConsoleColor.White;
Console.WriteLine(p.GetBuffer().TrimEnd(Environment.NewLine.ToCharArray()));
Console.ForegroundColor = ConsoleColor.Gray;
return(result);
}
}
finally
{
depth--;
}
}
