public override Expression Generate(object args, CodeBlock c)
{
var refs = ClrGenerator.SaveReferences();
CodeBlock cb = Ast.CodeBlock(SpanHint, GetLambdaName(c));
NameHint = SymbolId.Empty;
cb.Filename = LocationHint;
cb.Parent = c;
cb.Source = new Cons(SymbolTable.StringToObject("lambda"), args);
object arg = Builtins.First(args);
Cons body = Builtins.Cdr(args) as Cons;
bool isrest = AssignParameters(cb, arg);
cb.IsRest = isrest;
List <Statement> stmts = new List <Statement>();
FillBody(cb, stmts, body, true);
Expression ex = MakeClosure(cb, isrest);
ClrGenerator.ResetReferences(refs);
return(ex);
}
//(import (ironscheme clr))
//(define f (ffi-callout int32 (void* uint16)))
public override Expression Generate(object args, CodeBlock cb)
{
Cons c = args as Cons;
Type returntype = GetFFIType(Unquote(c.car));
c = c.cdr as Cons;
List <Type> paramtypes = new List <Type>();
while (c != null)
{
paramtypes.Add(GetFFIType(Unquote(c.car)));
c = c.cdr as Cons;
}
CodeBlock outer = Ast.CodeBlock("outer");
outer.Parent = cb;
Variable ptr = Variable.Parameter(outer, SymbolTable.StringToId("ptr"), typeof(object));
outer.AddParameter(ptr);
CodeBlock inner = GenerateInvoke("ffi-callout",
a => MakePointerCall(ptr, returntype, paramtypes, a),
returntype,
paramtypes,
outer);
outer.Body = Ast.Return(MakeClosure(inner, false));
return(MakeClosure(outer, false));
}
static CodeBlock RewriteBody(CodeBlock cb)
{
CodeBlock ncb = Ast.CodeBlock("temp-inline:" + cb.Name, cb.ReturnType);
ncb.Parent = cb.Parent;
foreach (var item in cb.Parameters)
{
Variable newvar = ncb.CreateParameter(item.Name, item.Type);
newvar.Lift = item.Lift;
}
foreach (var item in cb.Variables)
{
Variable newvar = ncb.CreateLocalVariable(item.Name, item.Type);
newvar.Lift = item.Lift;
}
Expression body = ((ReturnStatement)cb.Body).Expression;
body = RewriteExpression(ncb, body);
ncb.Body = Ast.Return(body);
return(ncb);
}
public override Expression Generate(object args, CodeBlock c)
{
var refs = ClrGenerator.SaveReferences();
object arg = Builtins.First(args);
object typespec = (Builtins.Second(args));
Cons body = Builtins.Cdr(Builtins.Cdr(args)) as Cons;
var returntype = ClrGenerator.ExtractTypeInfo(Builtins.List(quote, Builtins.Second(typespec)));
CodeBlock cb = Ast.CodeBlock(SpanHint, GetLambdaName(c), returntype);
NameHint = SymbolId.Empty;
cb.Filename = LocationHint;
cb.Parent = c;
bool isrest = AssignParameters(cb, arg, Builtins.Car(typespec));
List <Statement> stmts = new List <Statement>();
FillBody(cb, stmts, body, true);
Type dt = GetDelegateType(cb);
Type ct = GetClosureType(cb);
Expression ex = Ast.New(ct.GetConstructor(new Type[] { dt }), Ast.CodeBlockExpression(cb, true, dt));
ClrGenerator.ResetReferences(refs);
return(ex);
}
internal static CodeBlock CompileExpr(Cons expr)
{
CodeBlock cb = Ast.CodeBlock("eval-core");
Compile(cb, expr);
return(cb);
}
internal static CodeBlock Compile(Cons expr)
{
CodeBlock cb = Ast.CodeBlock("__script__");
Compile(cb, expr);
return(cb);
}
internal static CodeBlock Compile(Cons expr)
{
CodeBlock cb = Ast.CodeBlock("__script__");
Compile(cb, expr);
Parser.sourcemap.Clear();
return(cb);
}
protected static CodeBlock GenerateCallback(string proc, PInvokeHandler pinvokecall, Type returntype, List <Type> paramtypes, CodeBlock cb)
{
CodeBlock call = Ast.CodeBlock(proc, returntype);
call.Parent = cb;
int count = 0;
List <Variable> pars = new List <Variable>();
foreach (Type t in paramtypes)
{
var name = SymbolTable.StringToId("arg" + count++);
Variable var = Variable.Parameter(call, name, t);
call.AddParameter(var);
pars.Add(var);
}
Variable ret = returntype == typeof(void) ? null : Create(SymbolTable.StringToId("ret"), call, typeof(object));
List <Statement> stmts = new List <Statement>();
Expression[] arguments = new Expression[pars.Count];
for (int i = 0; i < pars.Count; i++)
{
arguments[i] = MakeConvertFrom(Ast.Read(pars[i]), paramtypes[i]);
}
var fficall = pinvokecall(arguments);
if (ret == null)
{
stmts.Add(Ast.Statement(fficall));
}
else
{
stmts.Add(Ast.Write(ret, fficall));
stmts.Add(Ast.Return(MakeConvertTo(Ast.Read(ret), returntype)));
}
call.Body = Ast.Block(stmts);
return(call);
}
//(import (ironscheme clr))
//(define f (ffi-callback int32 (void* uint16)))
public override Expression Generate(object args, CodeBlock cb)
{
Cons c = args as Cons;
Type returntype = GetFFIType(Unquote(c.car));
c = c.cdr as Cons;
List <Type> paramtypes = new List <Type>();
while (c != null)
{
paramtypes.Add(GetFFIType(Unquote(c.car)));
c = c.cdr as Cons;
}
CodeBlock outer = Ast.CodeBlock("outer");
outer.Parent = cb;
Variable proc = Variable.Parameter(outer, SymbolTable.StringToId("proc"), typeof(object));
outer.AddParameter(proc);
Type sig = MakeDelegateType(returntype, paramtypes);
CodeBlock inner = GenerateCallback("ffi-callback",
a => MakeCallBack(proc, a),
returntype,
paramtypes,
outer);
var del = Ast.CodeBlockReference(inner, sig);
outer.Body = Ast.Block(
Ast.Statement(MakeClosure(inner, false)),
Ast.Return(Ast.Call(FFIFunctionPointer, Ast.Constant(sig), del, Ast.CodeContext())));
return(MakeClosure(outer, false));
}
public override Expression Generate(object args, CodeBlock c)
{
var ns = ClrGenerator.SaveReferences();
Cons name = (args as Cons).car as Cons;
bool isprogram = name == null;
string[] fullname = Array.ConvertAll <object, string>(Builtins.ListToVector(name), SymbolToString);
string n = string.Join(".", fullname);
NameHint = SymbolTable.StringToId(n);
CodeBlock cb = Ast.CodeBlock(SpanHint, GetLambdaName(c));
cb.IsGlobal = true;
List <SymbolId> vars = new List <SymbolId>();
List <Variable> locals = new List <Variable>();
List <Expression> assignments = new List <Expression>();
List <object> defs = new List <object>();
List <object> bodies = new List <object>();
List <object> sources = new List <object>();
args = (args as Cons).cdr;
Cons a = (args as Cons).car as Cons;
while (a != null)
{
Cons d = a.car as Cons;
SymbolId v = (SymbolId)d.car;
SymbolId l = (SymbolId)((Cons)d.cdr).car;
vars.Add(l);
locals.Add(Create(v, cb, typeof(object)));
defs.Add(((Cons)((Cons)d.cdr).cdr).car);
a = a.cdr as Cons;
}
#if DONE
// pass 0 - record defs
for (int i = 0; i < vars.Count; i++)
{
if (IsMakeRecord(defs[i]))
{
//Debugger.Break();
Type type = CreateRecordType(defs[i] as Cons);
if (type != null)
{
ClrGenerator.AddCompileTimeType(type);
}
}
}
#endif
List <Statement> stmts = new List <Statement>();
// pass 1
for (int i = 0; i < vars.Count; i++)
{
sources.Add(null);
bool annotated, typed;
if (IsLambda(defs[i], out annotated, out typed))
{
Cons cl = defs[i] as Cons;
sources[i] = Copy(cl);
int depth = GetDepth(sources[i]);
if (depth > 10)
{
sources[i] = null;
}
if (annotated)
{
cl = cl.cdr as Cons;
}
if (cl.cdr != null)
{
if (((Cons)cl.cdr).cdr == null)
{
Cons bh = (Cons)((Cons)cl.cdr).car;
if (typed)
{
bh = bh.cdr as Cons;
}
Cons b = bh.cdr as Cons;
bh.cdr = new Cons(Builtins.FALSE);
bodies.Add(b);
}
else
{
List <Cons> cbs = new List <Cons>();
Cons cc = cl.cdr as Cons;
while (cc != null)
{
Cons bh = (Cons)cc.car;
if (typed)
{
bh = bh.cdr as Cons;
}
Cons b = bh.cdr as Cons;
bh.cdr = new Cons(Builtins.FALSE);
cbs.Add(b);
cc = cc.cdr as Cons;
}
bodies.Add(cbs);
}
}
else
{
bodies.Add(null);
}
}
else
{
bodies.Add(null);
}
VarHint = locals[i].Name;
VarHint2 = vars[i];
NameHint = SymbolTable.StringToId(n + "::" + Builtins.UnGenSymInternal(vars[i]));
Expression e = GetAst(defs[i], cb);
VarHint = VarHint2 = SymbolId.Empty;
if (e is UnaryExpression && e.NodeType == AstNodeType.Convert && e.Type != typeof(object))
{
locals[i].Type = e.Type;
}
else if (e.Type.IsValueType)
{
e = Ast.ConvertHelper(e, typeof(object));
}
assignments.Add(e);
if (e is MethodCallExpression)
{
MethodCallExpression mce = e as MethodCallExpression;
if (mce.Method == Closure_Make)
{
var cbe = mce.Arguments[0] as CodeBlockExpression;
cbe.Block.Source = sources[i];
libraryglobals.Add(locals[i].Name, cbe);
libraryglobals.Add(vars[i], cbe);
}
else if (mce.Method == Closure_MakeVarArgsX)
{
libraryglobalsX.Add(locals[i].Name, mce.Arguments[0] as CodeBlockExpression);
libraryglobalsX.Add(vars[i], mce.Arguments[0] as CodeBlockExpression);
}
else if (mce.Method == Closure_MakeCase)
{
NewArrayExpression tcs = mce.Arguments[0] as NewArrayExpression;
List <CodeBlockDescriptor> cdbs = new List <CodeBlockDescriptor>();
foreach (CodeBlockExpression tc in tcs.Expressions)
{
//where do we clean this up??
cdbs.Add(descriptorshack[tc]);
}
libraryglobalsN.Add(locals[i].Name, cdbs.ToArray());
libraryglobalsN.Add(vars[i], cdbs.ToArray());
}
else if (mce.Method == Closure_MakeTypedCase)
{
NewArrayExpression tcs = mce.Arguments[0] as NewArrayExpression;
List <CodeBlockDescriptor> cdbs = new List <CodeBlockDescriptor>();
foreach (Expression tc in tcs.Expressions)
{
//where do we clean this up??
cdbs.Add(descriptorshack2[tc]);
}
libraryglobalsN.Add(locals[i].Name, cdbs.ToArray());
libraryglobalsN.Add(vars[i], cdbs.ToArray());
}
}
else if (e is NewExpression)
{
NewExpression ne = e as NewExpression;
if (typeof(ITypedCallable).IsAssignableFrom(e.Type))
{
libraryglobals.Add(locals[i].Name, ne.Arguments[0] as CodeBlockExpression);
libraryglobals.Add(vars[i], ne.Arguments[0] as CodeBlockExpression);
}
}
}
// pass 2, expand lambda bodies
for (int i = 0; i < vars.Count; i++)
{
Expression e = assignments[i];
NameHint = SymbolTable.StringToId(n + "::" + Builtins.UnGenSymInternal(vars[i]));
if (bodies[i] != null)
{
CodeBlockDescriptor[] cbds;
CodeBlockExpression cbe;
if (libraryglobals.TryGetValue(locals[i].Name, out cbe))
{
Cons b = bodies[i] as Cons;
CodeBlock cbody = cbe.Block;
cbody.Body = null;
FillBody(cbody, new List <Statement>(), b, true);
}
else if (libraryglobalsX.TryGetValue(locals[i].Name, out cbe))
{
Cons b = bodies[i] as Cons;
CodeBlock cbody = cbe.Block;
cbody.Body = null;
FillBody(cbody, new List <Statement>(), b, true);
}
else if (libraryglobalsN.TryGetValue(locals[i].Name, out cbds))
{
List <Cons> b = bodies[i] as List <Cons>;
for (int j = 0; j < b.Count; j++)
{
CodeBlock cbody = cbds[j].codeblock.Block;
cbody.Body = null;
FillBody(cbody, new List <Statement>(), b[j], true);
}
}
}
stmts.Add(Ast.Write(locals[i], e));
// needed indeed
if (!isprogram)
{
stmts.Add(Ast.Statement(Ast.SimpleCallHelper(SetSymbolValue, Ast.Constant(vars[i]), Ast.Read(locals[i]))));
}
}
Cons body = Builtins.Cdr(args) as Cons;
FillBody(cb, stmts, body, true);
cb.ExplicitCodeContextExpression = Ast.CodeContext();
#if OPTIMIZATIONS
Expression ex = InlineCall(c, Ast.CodeBlockExpression(cb, false));
#else
Expression ex = Ast.SimpleCallHelper(MakeClosure(cb, false), GetCallable(0));
#endif
NameHint = SymbolId.Invalid;
ClrGenerator.ResetReferences(ns);
return(ex);
}
public override Expression Generate(object args, CodeBlock c)
{
Cons lambdas = args as Cons;
int arlen = lambdas == null ? 0 : lambdas.Length;
if (arlen == 1)
{
if (lambdagen == null)
{
lambdagen = Context.Scope.LookupName(SymbolTable.StringToId("lambda")) as LambdaGenerator;
}
return(lambdagen.Generate(lambdas.car, c));
}
else
{
List <CodeBlockDescriptor> cbs = new List <CodeBlockDescriptor>();
Cons annotations = this.annotations;
this.annotations = null;
string lambdaname = GetLambdaName(c);
NameHint = SymbolId.Empty;
var sh = SpanHint;
var lh = LocationHint;
Annotation ann = null;
while (lambdas != null)
{
object actual = lambdas.car;
if (annotations != null)
{
ann = annotations.car as Annotation;
if (ann != null)
{
var h = (Cons)ann.source;
if (h.cdr is string)
{
sh = ExtractLocation(((Cons)ann.source).cdr as string);
}
else if (h.cdr is SourceSpan)
{
sh = (SourceSpan)h.cdr;
}
}
}
var refs = ClrGenerator.SaveReferences();
CodeBlock cb = Ast.CodeBlock(sh, lambdaname);
cb.Filename = lh;
cb.Parent = c;
object arg = Builtins.First(actual);
Cons body = Builtins.Cdr(actual) as Cons;
bool isrest = AssignParameters(cb, arg);
cb.IsRest = isrest;
List <Statement> stmts = new List <Statement>();
FillBody(cb, stmts, body, true);
CodeBlockDescriptor cbd = new CodeBlockDescriptor();
cbd.arity = isrest ? -cb.ParameterCount : cb.ParameterCount;
cbd.codeblock = Ast.CodeBlockExpression(cb, false);
cbd.varargs = isrest;
descriptorshack.Add(cbd.codeblock, cbd);
cbs.Add(cbd);
if (annotations != null)
{
annotations = annotations.cdr as Cons;
}
lambdas = lambdas.cdr as Cons;
ClrGenerator.ResetReferences(refs);
}
return(MakeCaseClosure(lambdaname, cbs));
}
}
public override Expression Generate(object args, CodeBlock c)
{
var refs = ClrGenerator.SaveReferences();
NameHint = SymbolTable.StringToId("");
CodeBlock cb = Ast.CodeBlock(SpanHint, GetLambdaName(c));
cb.Parent = c;
List <Variable> vars = new List <Variable>();
List <Variable> temps = new List <Variable>();
List <object> defs = new List <object>();
Cons a = (args as Cons).car as Cons;
while (a != null)
{
Cons d = a.car as Cons;
Variable t = cb.CreateVariable((SymbolId)Builtins.GenSym(d.car), Variable.VariableKind.Temporary, typeof(object));
temps.Add(t);
Variable r = Create((SymbolId)d.car, cb, typeof(object));
r.SetUnInitialized();
vars.Add(r);
defs.Add(((Cons)d.cdr).car);
a = a.cdr as Cons;
}
List <Statement> stmts = new List <Statement>();
var notstrict = !ScriptDomainManager.Options.StrictMode;
for (int i = 0; i < vars.Count; i++)
{
NameHint = Builtins.UnGenSymInternal(vars[i].Name);
//VarHint = vars[i].Name;
Expression e = GetAst(defs[i], cb);
if (e is MethodCallExpression)
{
MethodCallExpression mce = (MethodCallExpression)e;
if (mce.Method == Closure_Make || mce.Method == Closure_MakeCase || mce.Method == Closure_MakeVarArgsX)
{
if (notstrict)
{
vars[i].SetInitialized();
temps[i].Type = vars[i].Type = typeof(Callable);
}
}
}
else if (e is NewExpression)
{
var ne = (NewExpression)e;
if (typeof(ITypedCallable).IsAssignableFrom(ne.Type))
{
if (notstrict)
{
vars[i].SetInitialized();
temps[i].Type = vars[i].Type = ne.Type;
}
}
}
if (e is UnaryExpression && e.NodeType == AstNodeType.Convert && e.Type != typeof(object))
{
if (notstrict)
{
temps[i].Type = vars[i].Type = e.Type;
}
}
else if (e.Type.IsValueType)
{
e = Ast.ConvertHelper(e, typeof(object));
}
stmts.Add(Ast.Write(temps[i], e));
}
for (int i = 0; i < vars.Count; i++)
{
stmts.Add(Ast.Write(vars[i], temps[i]));
}
NameHint = SymbolId.Invalid;
Cons body = Builtins.Cdr(args) as Cons;
FillBody(cb, stmts, body, true);
#if OPTIMIZATIONS
Expression ex = InlineCall(c, Ast.CodeBlockExpression(cb, false));
#else
Expression ex = Ast.SimpleCallHelper(MakeClosure(cb, false), GetCallable(0));
#endif
ClrGenerator.ResetReferences(refs);
return(ex);
}
public override Expression Generate(object args, CodeBlock c)
{
Cons lambdas = args as Cons;
int arlen = lambdas == null ? 0 : lambdas.Length;
if (arlen == 1)
{
if (lambdagen == null)
{
lambdagen = Context.Scope.LookupName(SymbolTable.StringToId("typed-lambda")) as TypedLambdaGenerator;
}
return(lambdagen.Generate(lambdas.car, c));
}
else
{
List <CodeBlockDescriptor> cbs = new List <CodeBlockDescriptor>();
string lambdaname = GetLambdaName(c);
NameHint = SymbolId.Empty;
var sh = SpanHint;
var lh = LocationHint;
while (lambdas != null)
{
var refs = ClrGenerator.SaveReferences();
object actual = lambdas.car;
object arg = Builtins.First(actual);
object typespec = (Builtins.Second(actual));
Cons body = Builtins.Cdr(Builtins.Cdr(actual)) as Cons;
var returntype = ClrGenerator.ExtractTypeInfo(Builtins.List(quote, Builtins.Second(typespec)));
CodeBlock cb = Ast.CodeBlock(SpanHint, lambdaname, returntype);
NameHint = SymbolId.Empty;
cb.Filename = lh;
cb.Parent = c;
bool isrest = AssignParameters(cb, arg, Builtins.Car(typespec));
List <Statement> stmts = new List <Statement>();
FillBody(cb, stmts, body, true);
Type dt = GetDelegateType(cb);
Type ct = GetClosureType(cb);
var cbe = Ast.CodeBlockExpression(cb, true, dt);
Expression ex = Ast.New(ct.GetConstructor(new Type[] { dt }), cbe);
CodeBlockDescriptor cbd = new CodeBlockDescriptor();
cbd.arity = isrest ? -cb.ParameterCount : cb.ParameterCount;
cbd.callable = ex;
cbd.codeblock = cbe;
cbd.varargs = isrest;
descriptorshack2.Add(cbd.callable, cbd);
cbs.Add(cbd);
lambdas = lambdas.cdr as Cons;
ClrGenerator.ResetReferences(refs);
}
return(MakeTypedCaseClosure(lambdaname, cbs));
}
}
