public CCCompiler(CCVM v)
{
fn_symbols = new CCCons(null, null);
mc_symbols = new CCCons(null, null);
root_env = new CCCons(fn_symbols, new CCCons(mc_symbols, null));
vm = v;
}
public void LoadSymbol(string filename)
{
IFormatter formatter = new BinaryFormatter();
Stream stream = new FileStream(filename + ".s", FileMode.Open, FileAccess.Read, FileShare.Read);
root_env = (CCCons)formatter.Deserialize(stream);
fn_symbols = root_env.car as CCCons;
mc_symbols = root_env.cadr as CCCons;
stream.Close();
}
private CCObject ParseList(IEnumerator<CCObject> ts)
{
if (!ts.MoveNext()) // to car
{
// no car exists
throw new CCParserException();
}
if (ts.Current == ParenR) // end of list
{
return null;
}
var list = new CCCons(null, null);
list.car = ParseBasicForm(ts);
list.cdr = ParseList(ts);
return list;
}
public void Push(CCObject val)
{
Stack = new CCCons(val, Stack);
}
private void SetEnvIndex2(int y, CCCons env, CCObject v)
{
if (y > 1)
{
var cdr = env.cdr as CCCons;
if (cdr == null)
{
cdr = new CCCons(null, null);
env.cdr = cdr;
}
SetEnvIndex2(y - 1, cdr, v);
}
else
{
env.car = v;
}
}
private void SetEnvIndex1(int x, int y, CCCons env, CCObject v)
{
if (x > 1)
{
var cdr = env.cdr as CCCons;
SetEnvIndex1(x - 1, y, cdr, v);
}
else
{
var car = env.car as CCCons;
SetEnvIndex2(y, car, v);
}
}
private CCObject Compile1(CCObject exp, CCCons env, CCObject cont)
{
if (exp == null) // nil
{
return new CCCons(null, cont);
}
else if (exp.GetType() != typeof(CCCons)) // number, string or identifier
{
if (exp.GetType() == typeof(CCInt) || exp.GetType() == typeof(CCString))
{
return new CCCons(new CCIS("LDC"), new CCCons(exp, cont));
}
else // identifier
{
var ij = Index(exp as CCIdentifier, env);
if (ij == null)
{
throw new CCCompileIdentifierNotFoundException(exp.ToString());
}
else
{
if (ij.cdr.GetType() == typeof(CCCons)) // parameter with additional information
{
if (ij.caddr.ToString() == "&rest") // rest parameter
{
ij.cdr = ij.cadr; // variable position
return new CCCons(new CCIS("LDR"), new CCCons(ij, cont));
}
else
{
throw new CCCompileInvalidFormalParameterException(ij.caddr.ToString());
}
}
else
{
return new CCCons(new CCIS("LD"), new CCCons(ij, cont));
}
}
}
}
else // apply
{
var expc = exp as CCCons;
var fcn = expc.car;
var args = expc.cdr;
if (fcn.GetType() != typeof(CCCons)) // apply function is a builtin, lambda or special form
{
var fn = fcn as CCIdentifier;
var name = from x in CCVM.Builtin where x == fn.Name select x;
if (name.Count() == 1) // builtin
{
if (name.First() == "list")
{
return new CCCons(null, CompileList(args, env, cont));
}
else
{
return CompileBuiltin(args, env, new CCCons(fcn, cont));
}
}
else if (fn.Name == "fn") // lambda special form
{
var argsc = args as CCCons;
return CompileLambda(argsc.cadr, new CCCons(argsc.car, env), cont);
}
else if (fn.Name == "if") // if special form
{
var argsc = args as CCCons;
return CompileIf(argsc.car, argsc.cadr, argsc.caddr, env, cont);
}
else if (fn.Name == "let" || fn.Name == "letrec") // let or letrec
{
var argsc = args as CCCons;
var newn = new CCCons(argsc.car, env);
var values = argsc.cadr;
var body = argsc.caddr;
if (fn.Name == "let") // let
{
return new CCCons(null, CompileApp(values as CCCons, env, CompileLambda(body, newn, new CCCons(new CCIS("AP"), cont))));
}
else // letrec
{
return new CCCons(new CCIS("DUM"), new CCCons(null, CompileApp(values as CCCons, newn, CompileLambda(body, newn, new CCCons(new CCIS("RAP"), cont)))));
}
}
else if (fn.Name == "quote") // quote
{
return new CCCons(new CCIS("LDC"), new CCCons((args as CCCons).car, cont));
}
else if(fn.Name == "set") // setf
{
var argsc = args as CCCons;
var symbol = argsc.car as CCIdentifier;
var value = argsc.cadr;
var pos = Index(symbol, env);
if (pos == null)
{
// create new symbol(root environment)
CCCons i = fn_symbols;
while (i.cdr != null)
i = i.cdr as CCCons;
if (i.car == null)
{
i.car = symbol;
}
else
{
var cons = new CCCons(symbol, null);
i.cdr = cons;
}
// re-find index
pos = Index(symbol, env);
}
return Compile1(value, env, new CCCons(new CCIS("ST"), new CCCons(pos, cont)));
}
else if(fn.Name == "defm") // defmacro
{
var argsc = args as CCCons;
var symbol = argsc.car as CCIdentifier;
var margs = argsc.cadr;
var mbody = argsc.caddr;
var pos = Index(symbol, env);
if (pos == null)
{
// create new symbol(root environment)
CCCons i = mc_symbols;
while (i.cdr != null)
i = i.cdr as CCCons;
if (i.car == null)
{
i.car = symbol;
}
else
{
var cons = new CCCons(symbol, null);
i.cdr = cons;
}
// re-find index
pos = Index(symbol, env);
}
return CompileLambda(mbody, new CCCons(margs, env), new CCCons(new CCIS("ST"), new CCCons(pos, cont)));
}
else if(fn.Name == "macroexpand-1")
{
var form = (args as CCCons).car as CCCons;
var macfn = form.car;
var macarg = form.cdr;
if (Index2(macfn as CCIdentifier, mc_symbols, 1) != null)
{ // macro expansion compile
var expand_code = new CCCons(new CCIS("LDC"), new CCCons(macarg, new CCCons(new CCIS("LD"), new CCCons(Index(macfn as CCIdentifier, env), new CCCons(new CCIS("AP"), new CCCons(new CCIS("HALT"), null))))));
vm.Eval(expand_code);
return new CCCons(new CCIS("LDC"), new CCCons(vm.GetResult(), cont));
}
else
{
return null;
}
}
else // application or macro
{
// check if it is macro or not
if (Index2(fcn as CCIdentifier, mc_symbols, 1) != null)
{ // macro expansion compile
var expand_code = new CCCons(new CCIS("LDC"), new CCCons(args, new CCCons(new CCIS("LD"), new CCCons(Index(fcn as CCIdentifier, env), new CCCons(new CCIS("AP"), new CCCons(new CCIS("HALT"), null))))));
vm.Eval(expand_code);
var r = vm.GetResult();
return Compile1(r, env, cont);
}
else // normal application
{
var func = Index(fcn as CCIdentifier, env);
if(func == null)
{
throw new CCCompileIdentifierNotFoundException(fcn.ToString());
}
else
{
return new CCCons(null, CompileApp(args as CCCons, env, new CCCons(new CCIS("LD"), new CCCons(func, new CCCons(new CCIS("AP"), cont)))));
}
}
}
}
else // application with nested function
{
return new CCCons(null, CompileApp(args as CCCons, env, Compile1(fcn, env, new CCCons(new CCIS("AP"), cont))));
}
}
}
public CCObject Compile(CCObject obj)
{
var cont = new CCCons(new CCIS("HALT"), null);
return Compile1(obj, root_env, cont);
}
private CCObject Index2(CCIdentifier exp, CCCons env, int j)
{
if (env == null || env.car == null)
{
return null;
}
else
{
if(env.car.GetType() == typeof(CCCons)) // function or macro
{
if (env.caar.ToString() == exp.ToString())
{
return new CCCons(new CCInt() { value = j }, env.cdar);
}
else
{
return Index2(exp, env.cdr as CCCons, j + 1);
}
}
else // atom
{
if (env.car.ToString() == exp.ToString())
{
return new CCInt() { value = j };
}
else
{
return Index2(exp, env.cdr as CCCons, j + 1);
}
}
}
}
private CCCons Index(CCIdentifier exp, CCCons env, int i)
{
if (env == null)
{
return null;
}
else
{
var j = Index2(exp, env.car as CCCons, 1);
if (j == null)
{
return Index(exp, env.cdr as CCCons, i + 1);
}
else
{
return new CCCons(new CCInt() { value = i }, j);
}
}
}
private CCCons Index(CCIdentifier exp, CCCons env)
{
return Index(exp, env, 1);
}
private CCObject CompileList(CCObject args, CCCons env, CCObject cont)
{
if (args == null)
{
return cont;
}
else
{
return CompileList((args as CCCons).cdr, env, Compile1((args as CCCons).car, env, new CCCons(new CCIS("CONS"), cont)));
}
}
private CCObject CompileLambda(CCObject body, CCCons env, CCObject cont)
{
return new CCCons(
new CCIS("LDF"), new CCCons(
Compile1(body, env, new CCCons(new CCIS("RTN"), null)),
cont));
}
private CCObject CompileIf(CCObject test, CCObject t, CCObject f, CCCons env, CCObject cont)
{
return Compile1(test, env, new CCCons(
new CCIS("SEL"), new CCCons(
Compile1(t, env, new CCCons(new CCIS("JOIN"), null)), new CCCons(
Compile1(f, env, new CCCons(new CCIS("JOIN"), null)), cont))));
}
private CCObject CompileBuiltin(CCObject args, CCCons env, CCObject cont)
{
if (args == null)
{
return cont;
}
else
{
return CompileBuiltin((args as CCCons).cdr, env, Compile1((args as CCCons).car, env, cont));
}
}
