private static SyntaxRuleItem BuildSynataxRule(Cons macro)
{
var name = macro.Car().Car() as Symbol;
var args = ReadArguments(macro.Car().Cdr());
var body = macro.Cdr() as Cons;
var prepared = PrepareBody(args, body);
return(new SyntaxRuleItem()
{
Body = prepared, Name = name, Args = macro.Car().Cdr() as Cons
});
}
public Lambda(Cons arguments, EnviromentFrame clojure, Cons body)
{
Argument = arguments;
Closure = clojure;
Arity = arguments.Car() == null ? Arity = 0 : arguments.Count();
Body = body.GetIterator().Select(subExp => (Cons)subExp).ToArray();
}
private void DefineMacro(Cons cons)
{
var macroName = cons.Car() as Symbol;
var macro = cons.Cdr().Car() as Cons;
if ((macro.Car() as Symbol)?.Name == "syntax-rules")
{
var syntaxRules = BuildSynataxRules(macro.Cdr() as Cons);
Macro.Define(macroName, syntaxRules);
}
else
{
// unsuported
}
}
private static SyntaxRules BuildSynataxRules(Cons macro)
{
var literals = macro.Car() as Cons;
var clause = macro.Cdr() as Cons;
var ruleItems = new List <SyntaxRuleItem>();
foreach (Cons rule in clause.GetIterator())
{
ruleItems.Add(BuildSynataxRule(rule.Car() as Cons));
}
return(new SyntaxRules()
{
Rules = ruleItems.ToArray()
});
}
static Cons Expand(Dictionary <string, object> binds, Cons body) // TODO bind val && arg
{
var newBody = new Cons();
while (body != null)
{
var syntax = body.Car() as SyntaxArgument;
if (syntax != null)
{
var nextSym = body.Cdr().Car() as Symbol;
if (nextSym != null && nextSym.Name == "...")
{
if (binds.TryGetValue(syntax.Original.Name, out var val))
{
if (newBody.Car() == null && newBody.Cdr() == null && val is Cons)
{
newBody = binds[syntax.Original.Name] as Cons; // TODO not good
}
else
{
newBody.Add(binds[syntax.Original.Name], true);
}
}
body = body.Cdr() as Cons; // skip ellipse
}
else
{
newBody.Add(binds[syntax.Original.Name]);
}
}
else
{
var form = body.Car() as Cons;
if (form != null)
{
newBody.Add(Expand(binds, form));
}
else
{
newBody.Add(body.Car());
}
}
var next = body.Cdr();
if (next is Cons)
{
body = body.Cdr() as Cons;
}
else if (next is SyntaxArgument) // rest
{
syntax = next as SyntaxArgument;
newBody.Add(binds[syntax.Original.Name], true);
body = null;
}
else
{
body = null;
}
}
return(newBody);
}
static Dictionary <string, object> Bind(Cons args, Cons values)
{
var bind = new Dictionary <string, object>();
object a;
object b;
var isEllipseMode = false;
void SetBind(string key, object value)
{
if (bind.TryGetValue(key, out var oo))
{
if (oo is Cons)
{
var seq = oo as Cons;
seq.Add(value);
bind[key] = seq;
}
else
{
throw new Exception("error");
}
}
else
{
if (isEllipseMode)
{
bind[key] = new Cons(value);
}
else
{
bind[key] = value;
}
}
}
while (true)
{
a = args?.Car();
b = values?.Car();
isEllipseMode = (args?.Cdr().Car() as Symbol)?.Name == "...";
if ((a == null && b == null) || (isEllipseMode && b == null))
{
return(bind);
}
if (a is Symbol && b != null)
{
var sym = a as Symbol;
SetBind(sym.Name, b);
}
else if (a is Cons && b is Cons)
{
var bnd = Bind(a as Cons, b as Cons);
foreach (var pair in bnd)
{
SetBind(pair.Key, pair.Value);
}
}
else
{
return(null);
}
var nexA = args.Cdr();
if (nexA is Symbol) // rest
{
var lst = new Cons();
values = values.Cdr() as Cons;
while (values != null)
{
b = values?.Car();
lst.Add(b);
values = values.Cdr() as Cons;
}
SetBind(((Symbol)nexA).Name, lst);
}
values = values?.Cdr() as Cons;
var nextCons = nexA as Cons;
var nextSym = nextCons?.Car() as Symbol;
if (nextSym?.Name == "...") // repeat for ...
{
if (values == null) // complete
{
return(bind);
}
}
else
{
args = nextCons;
}
}
}