public static Cons GetLast(int num, Cons list)
{
int len = GetLength(list);
if (num > len)
return null;
return GetNthTail(len - num, list);
}
public static int GetLength(Cons list)
{
int len = 0;
while (list != null) {
len++;
list = list.Rest;
}
return len;
}
//.........................................................................
public Closure(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerInterpreter = interpreter;
InnerLocation = loc;
ArgSpecs specs = AnalyzeArgSpec((Cons)args.First, env, loc);
//create an env expanded by params in which to analyze body
IEnvironment env2 = new Environment(specs.Parameters, null, env);
InnerArgsSpecs = specs;
InnerBody = interpreter.Analyze(new Cons(interpreter.BLOCK, args.Rest), env2, loc);
InnerEnvironment = env;
}
//.........................................................................
public ApplyExpression(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerLocation = loc;
InnerInterpreter = interpreter;
InnerFExpression = interpreter.Analyze(args.First, env, loc);
if (InnerFExpression is IVariable) {
InnerFSymbol = ((IVariable)InnerFExpression).Symbol;
}
Int32 len = Cons.GetLength(args.Rest);
InnerArgsExpressions = new IExpression[len];
args = args.Rest;
for (Int32 i = 0; i < InnerArgsExpressions.Length; i++, args = args.Rest) {
InnerArgsExpressions[i] = interpreter.Analyze(args.First, env, loc);
}
}
public static Object GetFourth(Cons list)
{
return GetThird(list.Rest);
}
public static Cons Append(Cons x, Cons y)
{
return (x != null) ? new Cons(x.First, Append(x.Rest, y)) : y;
}
public static Object GetFirst(Cons list)
{
return list.First;
}
//returns an array of evaluated args corresponding to params of argspec,
//including substitution of default values where none provided, construction of
//rest list etc
//suitable for extending the environment prior to evaluating body of closure
protected virtual object[] BuildParamArray(object[] code, int offset, IEnvironment env)
{
//do nothing if fixed params and matching number
if (InnerArgsSpecs.GetParamCount() == InnerArgsSpecs.NumReq && InnerArgsSpecs.NumReq == code.Length)
return code;
Object[] argArray = new Object[GetParamCount()];
int nargs = code.Length - offset;
if (nargs < InnerArgsSpecs.NumReq)
throw new LispException("Too few arguments to procedure, expected at least " + InnerArgsSpecs.NumReq
+ ", but found " + nargs + " arguments");
int i;
// Fill in the required parameters
for (i = 0; i < InnerArgsSpecs.NumReq; i++) {
argArray[i] = //evalArgs?Interpreter.execute(code[i+offset], env):
code[i + offset];
}
//now grab args to satisfy optionals
if (InnerArgsSpecs.NumOpt > 0) {
for (i = InnerArgsSpecs.NumReq; i < InnerArgsSpecs.NumReq + InnerArgsSpecs.NumOpt; i++) {
if (i < nargs) {
argArray[i] = //evalArgs?Interpreter.execute(code[i+offset], env):
code[i + offset];
//if missing passed to optional, get default
if (argArray[i] == Missing.Value) {
argArray[i] = GetDefaultParamValue(InnerArgsSpecs.Parameters[i]);
}
} else //ran out of args, default the rest
{
argArray[i] = GetDefaultParamValue(InnerArgsSpecs.Parameters[i]);
}
}
}
//build a rest list
Cons rest = null;
for (int x = code.Length - 1; x - offset >= i; --x) {
Object val = //evalArgs?Interpreter.execute(code[x], env):
code[x];
rest = new Cons(val, rest);
}
//search for key args in rest
if (InnerArgsSpecs.NumKey > 0) {
for (i = InnerArgsSpecs.NumReq + InnerArgsSpecs.NumOpt;
i < InnerArgsSpecs.NumReq + InnerArgsSpecs.NumOpt + InnerArgsSpecs.NumKey; i++) {
argArray[i] = FindKeyParamValue(InnerArgsSpecs.Parameters[i], rest);
}
}
// Add the rest parameter (if there is one)
if (InnerArgsSpecs.NumRest == 1) {
argArray[i] = rest;
}
return argArray;
}
public void Reset()
{
this.current = null;
this.next = start;
}
public static Object GetSecond(Cons list)
{
return list.Rest.First;
}
//.........................................................................
public Macro(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
: base(args, env, interpreter, loc)
{
}
public static Object GetNth(int n, Cons list)
{
return GetNthTail(n, list).First;
}
public static Object GetRest(Cons list)
{
return list.Rest;
}
public static Object[] ToVector(Cons list)
{
int len = GetLength(list);
if (len == 0)
return Util.EMPTY_VECTOR;
else {
Object[] result = new Object[len];
for (int i = 0; list != null; i++, list = list.Rest) {
result[i] = list.First;
}
return result;
}
}
public static object ToVectorOf(Type t, Cons list)
{
int len = GetLength(list);
Array result = Array.CreateInstance(t, len);
for (int i = 0; list != null; i++, list = list.Rest)
result.SetValue(list.First, i);
return result;
}
public static Cons Reverse(Cons list)
{
Cons result = null;
while (list != null) {
result = new Cons(list.First, result);
list = list.Rest;
}
return result;
}
public static Object MakeList(params Object[] args)
{
Cons ret = null;
for (int i = args.Length - 1; i >= 0; --i) {
ret = new Cons(args[i], ret);
}
return ret;
}
public static Object GetThird(Cons list)
{
return GetSecond(list.Rest);
}
protected object FindKeyParamValue(Parameter p, Cons args)
{
for (; args != null; args = args.Rest) {
Symbol first = args.First as Symbol;
if (args.First == p.Key) {
if (args.Rest != null) {
Object ret = Cons.GetSecond(args);
if (ret == Missing.Value) {
ret = GetDefaultParamValue(p);
}
return ret;
} else
throw new LispException("Key args must be provided in pairs of [:key value]");
}
}
return GetDefaultParamValue(p);
}
protected Cons ReadDelimitedList(LocTextReader t, Int32 delim)
{
Cons ret = null;
Cons tail = null;
Int32 ch = t.Peek();
while (Char.IsWhiteSpace((Char)ch)) {
t.Read();
ch = t.Peek();
}
while (ch != delim) {
Object o = DoRead(t, delim == ')' && ret == null);
if (Eof(o)) {
throw new LispException("Read error - eof found before matching: "
+ (Char)delim + "\n File: " + t.File + ", line: " + t.Line);
}
EndDelimiter ed = o as EndDelimiter;
if (ed != null) {
if (ed.Delim == delim) {
return ret;
} else
throw new LispException("Read error - read unmatched: " + ed.Delim
+ "\n File: " + t.File + ", line: " + t.Line);
}
Cons link = new Cons(o, null);
if (delim == ')' && ret == null && o is CompositeSymbol) {
ret = ((CompositeSymbol)o).SymbolAsList;
tail = ret.Rest;
} else if (ret == null) {
ret = tail = link;
} else {
tail.Rest = link;
tail = link;
}
ch = t.Peek();
while (Char.IsWhiteSpace((Char)ch)) {
t.Read();
ch = t.Peek();
}
}
//eat delim
t.Read();
return ret;
}
//.........................................................................
protected bool EqualsFirst(Cons that)
{
return (First == null) ? that.First == null :
First.Equals(that.First);
}
//parse out params from spec (which may contain &optional, &key, &rest, initforms etc
protected ArgSpecs AnalyzeArgSpec(Cons arglist, IEnvironment env, Location loc)
{
//count the params
int nParams = 0;
Cons a = arglist;
while (a != null) {
Object p = a.First;
if (p != InnerInterpreter.AMPOPT && p != InnerInterpreter.AMPKEY && p != InnerInterpreter.AMPREST)
++nParams;
a = a.Rest;
}
ArgSpecs ret = new ArgSpecs(env);
ret.Parameters = new Parameter[nParams];
Parameter.Specification state = Parameter.Specification.REQ;
int param = 0;
a = arglist;
while (a != null) {
Object p = a.First;
switch (state) {
case Parameter.Specification.REQ:
if (p == InnerInterpreter.AMPOPT)
state = Parameter.Specification.OPT;
else if (p == InnerInterpreter.AMPKEY)
state = Parameter.Specification.KEY;
else if (p == InnerInterpreter.AMPREST)
state = Parameter.Specification.REST;
else {
if (p is Symbol) {
ret.Parameters[param++] =
new Parameter((Symbol)p, Parameter.Specification.REQ, null);
++ret.NumReq;
} else if (p is Cons) {
ret.Parameters[param] =
new Parameter((Symbol)((Cons)p).First, Parameter.Specification.REQ, null);
ret.Parameters[param].TypeSpec = InnerInterpreter.Eval(Cons.GetSecond((Cons)p), env);
++param;
++ret.NumReq;
}
}
break;
case Parameter.Specification.OPT:
if (p == InnerInterpreter.AMPOPT)
throw new LispException("&optional can appear only once in arg list");
else if (p == InnerInterpreter.AMPKEY)
state = Parameter.Specification.KEY;
else if (p == InnerInterpreter.AMPREST)
state = Parameter.Specification.REST;
else {
if (p is Symbol) {
ret.Parameters[param++] =
new Parameter((Symbol)p, Parameter.Specification.OPT, null);
++ret.NumOpt;
} else if (p is Cons) {
ret.Parameters[param++] =
new Parameter((Symbol)((Cons)p).First, Parameter.Specification.OPT,
InnerInterpreter.Analyze(Cons.GetSecond((Cons)p), env, loc));
++ret.NumOpt;
} else
throw new LispException("&optional parameters must be symbols or (symbol init-form)");
}
break;
case Parameter.Specification.KEY:
if (p == InnerInterpreter.AMPOPT)
throw new LispException("&optional must appear before &key in arg list");
else if (p == InnerInterpreter.AMPKEY)
throw new LispException("&key can appear only once in arg list");
else if (p == InnerInterpreter.AMPREST)
state = Parameter.Specification.REST;
else {
if (p is Symbol) {
ret.Parameters[param] =
new Parameter((Symbol)p, Parameter.Specification.KEY, null);
ret.Parameters[param].Key = InnerInterpreter.Intern(":" + ((Symbol)p).Name);
++param;
++ret.NumKey;
} else if (p is Cons) {
ret.Parameters[param] =
new Parameter((Symbol)((Cons)p).First, Parameter.Specification.KEY,
InnerInterpreter.Analyze(Cons.GetSecond((Cons)p), env, loc));
ret.Parameters[param].Key =
InnerInterpreter.Intern(":" + ((Symbol)((Cons)p).First).Name);
++param;
++ret.NumKey;
} else
throw new LispException("&key parameters must be symbols or (symbol init-form)");
}
break;
case Parameter.Specification.REST:
if (p == InnerInterpreter.AMPOPT)
throw new LispException("&optional must appear before &rest in arg list");
else if (p == InnerInterpreter.AMPKEY)
throw new LispException("&key must appear before &rest in arg list");
else if (p == InnerInterpreter.AMPREST)
throw new LispException("&rest can appear only once in arg list");
else {
if (!(p is Symbol))
throw new LispException("&rest parameter must be a symbol");
else {
if (ret.NumRest > 0) //already got a rest param
throw new LispException("Only one &rest arg can be specified");
ret.Parameters[param++] =
new Parameter((Symbol)p, Parameter.Specification.REST, null);
++ret.NumRest;
}
}
break;
}
a = a.Rest;
}
return ret;
}
public static Cons GetNthTail(int n, Cons list)
{
while (n > 0) {
n--;
list = list.Rest;
}
return list;
}
protected bool EqualsRest(Cons that)
{
return (Rest == null) ? that.Rest == null :
Rest.Equals(that.Rest);
}
//.........................................................................
public CompositeSymbol(Cons symAsList)
{
InnerSymbolAsList = symAsList;
}
public ConsEnumerator(Cons start)
{
this.start = start;
this.current = null;
this.next = start;
}
protected Object ReadVector(params Object[] args)
{
LocTextReader t = (LocTextReader)args[0];
Int32 line = t.Line;
Cons largs = ReadDelimitedList(t, ']');
Object ret = new Cons(Interpreter.VECTOR, largs);
//record the location
LocationTable[ret] = new Location(t.File, line);
return ret;
}
public Cons(object first, Cons rest)
{
InnerFirst = first;
InnerRest = rest;
}
protected Object MapToList(params Object[] args)
{
Object f = Primitives.Arg(0, args);
IEnumerator[] enums = new IEnumerator[args.Length - 1];
for (int i = 0; i < enums.Length; i++) {
enums[i] = (IEnumerator)InnerGetEnumGF.Invoke(Primitives.Arg(i + 1, args));
}
//n.b. setting up arg array which will be reused
//mean functions cannot assume ownership of args w/o copying them
Object[] fargs = new Object[enums.Length];
Cons ret = null;
Cons tail = null;
while (true) {
for (int i = 0; i < enums.Length; i++) {
if (enums[i].MoveNext())
fargs[i] = enums[i].Current;
else //bail on shortest
return ret;
}
Object x = Util.InvokeObject(f, fargs);
Cons node = new Cons(x, null);
if (ret == null)
ret = tail = node;
else
tail = tail.Rest = node;
}
}
public Boolean MoveNext()
{
current = next;
if (current != null)
next = current.Rest;
return current != null;
}