private void Load()
{
Lisp source = Pop(ref C);
if (source is Cons)
{
Cons c = source as Cons;
Cons l = E as Cons;
for (int i = (c.Car as Integer).ivalue; i > 0; i--)
{
l = l.Cdr as Cons;
}
l = l.Car as Cons;
for (int i = (c.Cdr as Integer).ivalue; i > 0; i--)
{
l = l.Cdr as Cons;
}
Push(l.Car, ref S);
}
else if (source is Symbol)
{
Push((source as Symbol).GlobalValue, ref S);
}
else
{
throw new ApplicationException("Illegal load source");
}
}
// cdr to string
private string CdrToString(Lisp l)
{
if (l == null)
{
return(")");
}
if (l is ConsC) // Don't chase circular references
{
return("@)");
}
if (l is Cons)
{
Cons lc = l as Cons;
if (lc.Car == null)
{
return(" nil" + CdrToString(lc.cdr));
}
else
{
return(" " + lc.car.ToString() + CdrToString(lc.cdr));
}
}
// atomic cdr
return(" . " + l.ToString() + ")");
}
private void Store()
{
Lisp target = Pop(ref C);
Lisp val = Pop(ref S);
// Push(null, ref S); // is this needed?
if (target is Cons)
{
Cons c = target as Cons;
Cons l = E as Cons;
for (int i = (c.Car as Integer).ivalue; i > 0; i--)
{
l = l.Cdr as Cons;
}
l = l.Car as Cons;
for (int i = (c.Cdr as Integer).ivalue; i > 0; i--)
{
l = l.Cdr as Cons;
}
l.Car = val;
}
else if (target is Symbol)
{
(target as Symbol).GlobalValue = val;
}
else
{
throw new ApplicationException("Illegal store target");
}
}
private Lisp ReadList()
{
Lisp t;
char c = eatwhite();
if (c == ')')
{
ptr++;
return(null);
}
if (c == '.')
{
ptr++;
t = Read();
if (eatwhite() != ')')
{
throw new ApplicationException("Illegal dotted pair");
}
ptr++;
return(t);
}
Lisp h = Read();
t = ReadList();
return(new Cons(h, t));
}
public static string ToEscapedString(Lisp l)
{
escaped = true;
string s = l.ToString();
escaped = false;
return(s);
}
public static void SaveFile(Lisp data, string path)
{
FileStream fs = new FileStream(path, FileMode.Create, FileAccess.Write, FileShare.None);
StreamWriter sw = new StreamWriter(fs, Encoding.ASCII, 20000);
sw.Write(Lisp.ToEscapedString(data));
sw.Close();
fs.Close();
}
protected override Lisp Eql(Lisp l)
{
if (l is Opcode)
{
return(Bool((l as Opcode).op == op));
}
else
{
return(NIL);
}
}
protected override Lisp Eql(Lisp l)
{
if (l is Primitive)
{
return(Bool((l as Primitive).id == id));
}
else
{
return(NIL);
}
}
protected override Lisp Eql(Lisp l)
{
if (l is Str)
{
return(Bool((l as Str).svalue == svalue));
}
else
{
return(NIL);
}
}
protected override Lisp Eql(Lisp l)
{
if (l is Symbol)
{
return(Bool((l as Symbol).name == name));
}
else
{
return(NIL);
}
}
public Form1()
{
InitializeComponent();
string secdComp = File.ReadAllText("../../../Compilers/compiler7.secd");
// Read the compiler object
Sexp sx = new Sexp(secdComp);
compiler = sx.Read();
vm = new VM();
}
protected override Lisp Eql(Lisp l)
{
if (l is Integer)
{
return(Bool((l as Integer).ivalue == ivalue));
}
else
{
return(NIL);
}
}
private void Compile(object sender, EventArgs e)
{
vm.Clear();
vm.SetProgram(compiler);
Sexp src = new Sexp(txtSource.Text);
Lisp ssrc = src.Read();
vm.SetInput(new Cons(ssrc, null));
Run();
txtObject.Text = vm.Printed() + vm.STop;
}
public static Lisp Eql(Lisp a, Lisp b)
{
if (ReferenceEquals(a, b))
{
return(Lisp.T);
}
if ((a == null) || (b == null))
{
return(Lisp.NIL);
}
return(a.Eql(b));
}
public void SetAll(string s, string e, string c, string d)
{
Sexp xp;
xp = new Sexp(s);
S = xp.Read();
xp = new Sexp(e);
E = xp.Read();
xp = new Sexp(c);
C = xp.Read();
xp = new Sexp(d);
D = xp.Read();
}
public Lisp Top(Lisp stack)
{
Cons c = stack as Cons;
if (c != null)
{
return(c.Car);
}
else
{
throw new ApplicationException("Can't pop an atom");
}
}
public Lisp Pop(ref Lisp stack)
{
Cons c = stack as Cons;
if (c != null)
{
Lisp t = c.Car;
stack = c.Cdr;
return(t);
}
else
{
throw new ApplicationException("Can't pop an atom");
}
}
private void RunLisp(object sender, EventArgs e)
{
vm.Clear();
Sexp sx = new Sexp(txtObject.Text);
Lisp prog = sx.Read();
vm.SetProgram(prog);
string argstr = txtArgs.Text.Trim();
if (argstr != "")
{
Sexp args = new Sexp(argstr);
vm.SetInput(args.Read());
}
else
{
vm.SetInput(null);
}
Run();
txtResult.Text = vm.Printed() + vm.STop;
}
public static Lisp Eq(Lisp a, Lisp b)
{
return(Bool(ReferenceEquals(a, b)));
}
public Cons(Lisp a, Lisp d)
{
car = a;
cdr = d;
}
public Op Step()
{
Lisp instr = Pop(ref C);
Lisp l, t, f, a1, a2;
int i1, i2;
Cons c;
op = (instr as Opcode).op;
has_arg = false;
if (stop)
{
return(op);
}
switch (op)
{
case Op.NIL:
Push(Lisp.NIL, ref S);
break;
case Op.LD:
arg = Top(C);
has_arg = true;
Load();
break;
case Op.LDC:
arg = Top(C);
has_arg = true;
Push(Pop(ref C), ref S);
break;
case Op.ST:
arg = Top(C);
has_arg = true;
Store();
break;
case Op.LDF:
arg = Top(C);
has_arg = true;
Push(new Cons(Pop(ref C), E), ref S);
break;
case Op.AP:
Push(C, ref D);
Push(E, ref D);
E = Pop(ref S);
C = Pop(ref E);
Push(Pop(ref S), ref E);
Push(S, ref D);
S = Lisp.NIL;
break;
case Op.RTN:
S = new Cons(Top(S), Pop(ref D));
E = Pop(ref D);
C = Pop(ref D);
break;
case Op.DUM:
E = new ConsC(null, E);
break;
case Op.RAP:
Push(C, ref D);
Push(Top(E), ref D);
E = Pop(ref S);
C = Pop(ref E);
(E as Cons).Car = Pop(ref S);
Push(S, ref D);
S = null;
break;
case Op.SEL:
l = Pop(ref S);
t = Pop(ref C);
f = Pop(ref C);
Push(C, ref D);
C = l == Lisp.NIL ? f : t;
break;
case Op.JOIN:
C = Pop(ref D);
break;
case Op.CAR:
c = Pop(ref S) as Cons;
Push(c.Car, ref S);
break;
case Op.CDR:
c = Pop(ref S) as Cons;
Push(c.Cdr, ref S);
break;
case Op.ATOM:
l = Pop(ref S);
Push(Lisp.Bool(!(l is Cons)), ref S);
break;
case Op.INT:
l = Pop(ref S);
Push(Lisp.Bool(l is Integer), ref S);
break;
case Op.SYM:
l = Pop(ref S);
Push(Lisp.Bool(l is Symbol), ref S);
break;
case Op.STR:
l = Pop(ref S);
Push(Lisp.Bool(l is Str), ref S);
break;
case Op.CONS:
a1 = Pop(ref S);
a2 = Pop(ref S);
Push(new Cons(a1, a2), ref S);
break;
case Op.EQ:
a2 = Pop(ref S);
a1 = Pop(ref S);
Push(Lisp.Eq(a1, a2), ref S);
break;
case Op.EQL:
a2 = Pop(ref S);
a1 = Pop(ref S);
Push(Lisp.Eql(a1, a2), ref S);
break;
case Op.ADD:
i2 = (Pop(ref S) as Integer).ivalue;
i1 = (Pop(ref S) as Integer).ivalue;
Push(new Integer(i1 + i2), ref S);
break;
case Op.SUB:
i2 = (Pop(ref S) as Integer).ivalue;
i1 = (Pop(ref S) as Integer).ivalue;
Push(new Integer(i1 - i2), ref S);
break;
case Op.MUL:
i2 = (Pop(ref S) as Integer).ivalue;
i1 = (Pop(ref S) as Integer).ivalue;
Push(new Integer(i1 * i2), ref S);
break;
case Op.DIV:
i2 = (Pop(ref S) as Integer).ivalue;
i1 = (Pop(ref S) as Integer).ivalue;
Push(new Integer(i1 / i2), ref S);
break;
case Op.REM:
i2 = (Pop(ref S) as Integer).ivalue;
i1 = (Pop(ref S) as Integer).ivalue;
Push(new Integer(i1 % i2), ref S);
break;
case Op.LEQ:
i2 = (Pop(ref S) as Integer).ivalue;
i1 = (Pop(ref S) as Integer).ivalue;
Push(Lisp.Bool(i1 <= i2), ref S);
break;
case Op.AND:
a2 = (Pop(ref S));
a1 = (Pop(ref S));
Push(Lisp.Bool((a1 != Lisp.NIL) && (a2 != Lisp.NIL)), ref S);
break;
case Op.OR:
a2 = (Pop(ref S));
a1 = (Pop(ref S));
Push(Lisp.Bool((a1 != Lisp.NIL) || (a2 != Lisp.NIL)), ref S);
break;
case Op.NOT:
Push(Lisp.Bool(Pop(ref S) == Lisp.NIL), ref S);
break;
case Op.TRY:
a1 = Pop(ref C); // First try
a2 = Pop(ref C); // Second try
Push(C, ref D); // Push continuation for JOIN
C = a1;
Push(D, ref R); // Build Resumption
Push(a2, ref R);
Push(E, ref R);
Push(S, ref R);
break;
case Op.FAIL:
if (R == null) // Complete failure
{
S = new Cons(FAIL, Lisp.NIL);
E = D = Lisp.NIL;
C = new Cons(new Integer((int)Op.STOP), Lisp.NIL);
}
else // Try resuming
{
S = Pop(ref R);
E = Pop(ref R);
C = Pop(ref R);
D = Pop(ref R);
}
break;
case Op.STOP:
stop = true;
break;
case Op.PRINT:
l = Pop(ref S);
c = l as Cons;
if (c == null)
{
prtout.AppendLine(l.ToString());
//Console.WriteLine(l);
}
else
{
while (c != null)
{
prtout.Append($"{c.Car} ");
//Console.Write(c.Car);
//Console.Write(" ");
c = c.Cdr as Cons;
}
prtout.AppendLine();
Console.WriteLine();
}
break;
case Op.ERR:
Console.WriteLine("******ERROR******");
l = Pop(ref S);
c = l as Cons;
if (c == null)
{
prtout.AppendLine(l.ToString());
//Console.WriteLine(l);
}
else
{
while (c != null)
{
prtout.Append($"{c.Car} ");
Console.Write(c.Car);
Console.Write(" ");
c = c.Cdr as Cons;
}
prtout.AppendLine();
Console.WriteLine();
}
stop = true;
error = true;
break;
case Op.PRIM:
l = Pop(ref S);
a1 = null;
if (l is Symbol)
{
l = (l as Symbol).GlobalValue;
if (l is Primitive)
{
a1 = new Integer((l as Primitive).id);
}
}
Push(a1, ref S); // return nil or primitive id
break;
/*
* case Op.PCALL:
* l = Pop(ref S);
* arg = Top(C);
* Push(Primitives.Call(arg, l), S);
* break;
*/
default:
throw new ApplicationException("Unknown Opcode");
}
return(op);
}
public void Push(Lisp x, ref Lisp stack)
{
Cons c = new Cons(x, stack);
stack = c;
}
public void SetInput(Lisp val)
{
// Push item onto stack
S = new Cons(val, null);
}
public void SetProgram(Lisp prog)
{
C = prog;
stop = false;
error = false;
}
public ConsC(Lisp a, Lisp d)
: base(a, d)
{
}
public void Clear()
{
S = E = C = D = R = null;
prtout = new StringBuilder();
}
// Arguments
// Bootstrap C S [B]
// Load program compilerC.secd
// Load source compilerS.lsp
// Compile to compilerS.secd
// If B present:
// Load program compilerS.secd
// Compile to compilerS.secd
static void Main(string[] args)
{
VM vm;
string c, s;
bool b = args.Length == 3;
if (args.Length < 2)
{
Console.WriteLine("Invalid Args");
return;
}
c = args[0];
s = args[1];
if (s == c)
{
Console.WriteLine("File idents must be different");
return;
}
// Load compiled compiler
Lisp compiler = LoadFile("compiler" + c + ".secd");
// Load compiler source
Lisp source = LoadFile("compiler" + s + ".lsp");
// Convert to argument list
source = new Cons(source, Lisp.NIL);
vm = new VM();
vm.SetProgram(compiler);
vm.SetInput(source);
Op op;
do
{
op = vm.Step();
}while (vm.Running());
if (vm.Errored())
{
return;
}
Console.WriteLine("Compilation complete");
if (b)
{
Console.WriteLine("Bootstrapping");
compiler = vm.Result();
vm.Clear();
vm.SetProgram(compiler);
vm.SetInput(source);
do
{
op = vm.Step();
}while (vm.Running());
if (vm.Errored())
{
return;
}
Console.WriteLine("Bootstrap Compilation complete");
}
Console.WriteLine("Writing compiler object to compiler" + s + ".secd");
if (vm.Result() == null)
{
Console.WriteLine("Not writing null output");
}
else
{
SaveFile(vm.Result(), "compiler" + s + ".secd");
}
}
protected override Lisp Eql(Lisp l)
{
return(Eq(this, l));
}
protected abstract Lisp Eql(Lisp l);
private Symbol(string name)
{
this.name = name;
symbols.Add(name, this);
globalValue = UNDEFINED;
}
