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);
}
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);
}
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));
}
}
// (clr-new type arg1 ... )
public override Expression Generate(object args, CodeBlock cb)
{
Type t;
string type;
bool inferred;
object rtype = Builtins.First(args);
ExtractTypeInfo(rtype, out t, out type, out inferred);
if (t == null)
{
ClrSyntaxError("clr-new", "type not found", type);
}
Expression[] arguments = GetAstListNoCast(Builtins.Cdr(args) as Cons, cb);
List <MethodBase> candidates = new List <MethodBase>();
foreach (ConstructorInfo c in t.GetConstructors())
{
bool add = true;
foreach (var pi in c.GetParameters())
{
if (pi.ParameterType.IsPointer)
{
add = false;
break;
}
}
if (add)
{
candidates.Add(c);
}
}
if (t.IsValueType && arguments.Length == 0)
{
// create default valuetype here
return(Ast.DefaultValueType(t));
}
Type[] types = new Type[arguments.Length];
for (int i = 0; i < types.Length; i++)
{
types[i] = arguments[i].Type;
}
CallType ct = CallType.None;
MethodBinder mb = MethodBinder.MakeBinder(Binder, "ctr", candidates, BinderType.Normal);
MethodCandidate mc = mb.MakeBindingTarget(ct, types);
if (mc == null)
{
types = new Type[arguments.Length];
for (int i = 0; i < types.Length; i++)
{
types[i] = typeof(object);
}
if (ct == CallType.ImplicitInstance)
{
types = ArrayUtils.Insert(t, types);
}
mc = mb.MakeBindingTarget(ct, types);
}
ConstructorInfo ci = null;
if (mc == null && candidates.Count > 0)
{
foreach (ConstructorInfo c in candidates)
{
if (c.GetParameters().Length == arguments.Length)
{
ci = c;
break; // tough luck for now
}
}
}
else
{
ci = mc.Target.Method as ConstructorInfo;
}
if (ci != null)
{
ParameterInfo[] pars = ci.GetParameters();
for (int i = 0; i < arguments.Length; i++)
{
Type tt = pars[i].ParameterType;
arguments[i] = ConvertToHelper(tt, arguments[i]);
}
Expression r = Ast.New(ci, arguments);
return(r);
}
ClrSyntaxError("clr-new", "constructor could not be resolved on type: " + type, args);
return(null);
}
static object Cdddr(object lst)
{
return(Builtins.Cdr(Builtins.Cdr(Builtins.Cdr(lst))));
}
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));
}
}