/// <summary>
/// Build argument pair from identifier and initializer only (lambda (:optional (x 1) (y 2) (z 3)) ...)
/// </summary>
private static void ParseArg(string name, Syntax stx, LinkedList <Value> list, Environment env, out Syntax id, out AST ast)
{
Debug.Assert(stx != null);
Debug.Assert(list != null);
Debug.Assert(env != null);
var argc = list.Count;
if (argc != 2)
{
throw SchemeError.ArityError("let", "lambda: bad &key or &optional argument", 2, argc, list, stx);
}
var a = list[0].AsSyntax();
var b = list[1].AsSyntax();
if (!a.IsIdentifier)
{
SchemeError.ArgumentError(name, "symbol?", a);
}
// compile initializer in the parent scope
var exast = AstBuilder.ExpandInternal(b, env.Parent);
id = a; ast = exast;
}
/// <summary>
/// Get identifier (exception if syntax is not identifier)
/// </summary>
/// <returns></returns>
public Symbol AsIdentifier()
{
if (expression.IsSymbol)
{
return(expression.AsSymbol());
}
throw SchemeError.ArgumentError("get-identifier", "identifier?", this);
}
/// <summary>
/// Method safely cast the syntax's expression to the Datum
/// </summary>
/// <param name="expression"></param>
/// <returns></returns>
private static Value GetDatum(Value expression)
{
if (expression.IsSyntax)
{
expression = (expression.AsSyntax()).expression;
}
if (expression.IsLinkedList <Value>())
{
var result = new LinkedList <Value>();
foreach (var val in expression.AsLinkedList <Value>())
{
result.AddLast(GetDatum(val));
}
return(new Value(result));
}
if (expression.IsLinkedList <Syntax>())
{
var src = expression.AsLinkedList <Syntax>();
var dst = new LinkedList <Value>();
foreach (var v in src)
{
dst.AddLast(GetDatum(v.ToValue()));
}
return(new Value(dst));
}
if (expression.IsList <Value>())
{
var src = expression.AsList <Value>();
var dst = new List <Value>(src.Count);
foreach (var v in src)
{
if (v.IsSyntax)
{
dst.Add(GetDatum(v.AsSyntax().ToValue()));
}
else
{
throw SchemeError.ArgumentError("syntax->datum", "identifier?", v);
}
}
return(new Value(dst));
}
if (expression.IsValuePair)
{
var pair = expression.AsValuePair();
return(new Value(new ValuePair(GetDatum(pair.Item1), GetDatum(pair.Item2))));
}
return(expression);
}
/// <summary>
/// Build argument pair from identifier only (lambda (:optional x y z) ...)
/// </summary>
private static void ParseArg(string name, Syntax stx, Syntax identifier, Environment env, out Syntax var)
{
Debug.Assert(stx != null);
Debug.Assert(identifier != null);
Debug.Assert(env != null);
if (!identifier.IsIdentifier)
{
SchemeError.ArgumentError(name, "symbol?", identifier);
}
var = identifier;
}
private static AstBinding ParseOptional(string name, Syntax stx, Syntax definition, Environment env, ArgumentBinding.Type type)
{
Syntax var = null;
AST val = null;
if (definition.IsIdentifier)
{
ParseArg(name, stx, definition, env, out var);
}
else if (definition.IsExpression)
{
ParseArg(name, stx, definition.AsLinkedList <Value>(), env, out var, out val);
}
else
{
throw SchemeError.ArgumentError("lambda", "list?", definition);
}
var binding = new ArgumentBinding(var, type, val);
env.Define(binding);
return(binding);
}
public static Environment ParseLet(Syntax expression, LinkedList <Value> arguments, Environment environment)
{
var newenv = new Environment(environment, Symbol.NULL);
if (arguments == null)
{
return(newenv);
}
foreach (var arg in arguments)
{
var argstx = arg.AsSyntax();
if (argstx.IsExpression)
{
ParseOptional("let", argstx, argstx, newenv, ArgumentBinding.Type.Required);
}
else
{
throw SchemeError.ArgumentError("let", "list?", argstx);
}
}
return(newenv);
}
// (define x ...)
// (define (x) ...)
public static AST Expand(Syntax stx, Environment env)
{
var list = stx.AsLinkedList <Value>();
var argc = GetArgsCount(list);
AssertArgsMinimum("define", "arity mismatch", 2, argc, list, stx);
var def_stx = list[0].AsSyntax(); // define
var var_stx = list[1].AsSyntax(); // ()
if (var_stx.IsIdentifier)
{
AssertArgsMaximum("define", "arity mismatch", 2, argc, list, stx);
var val_stx = list[2].AsSyntax();
// ----------------------------------------------------------------
// identifier aka: (define x ...)
// ----------------------------------------------------------------
var value = AstBuilder.ExpandInternal(val_stx, env);
var var_id = var_stx.AsIdentifier();
var binding = env.LookupAst(var_id);
if (binding == null)
{
// Global variable
return(new AstSet(stx, var_stx, value, -1, -1, -1));
}
else if (binding is UpBinding)
{
// Up-value variable
var ubind = binding as UpBinding;
return(new AstSet(stx, var_stx, value, binding.VarIdx, ubind.UpEnvIdx, ubind.UpVarIdx));
}
else
{
// Local variable
return(new AstSet(stx, var_stx, value, binding.VarIdx, 0, 0));
}
}
else if (var_stx.IsExpression)
{
// ----------------------------------------------------------------
// identifier aka: (define (x ...) ...) as result lambda expression
// ----------------------------------------------------------------
var args_list = var_stx.AsLinkedList <Value>();
var newenv = ArgumentsParser.ParseLambda(stx, args_list, env);
var lambda_body = AstBuilder.ExpandListElements(list, 2, newenv);
var lambda = new AstLambda(stx, def_stx, newenv, lambda_body);
var identifier_stx = args_list[0].AsSyntax();
var identifier = identifier_stx.AsIdentifier();
var binding = env.LookupAst(identifier);
if (binding == null)
{
/// Global variable
return(new AstSet(stx, var_stx, lambda, -1, -1, -1));
}
else if (binding is UpBinding)
{
/// Up-value variable
var ubind = binding as UpBinding;
return(new AstSet(stx, var_stx, lambda, binding.VarIdx, ubind.UpEnvIdx, ubind.UpVarIdx));
}
else
{
/// Local variable
return(new AstSet(stx, var_stx, lambda, binding.VarIdx, 0, 0));
}
}
else
{
throw SchemeError.ArgumentError("define", "symbol? or list?", var_stx);
}
}
/// <summary>
/// The result structure has lists of arguments where
/// the variable names as syntaxes, but initializers as AST
/// </summary>
/// <param name="expression">expression where this aregumens located</param>
/// <param name="arguments">the arguments list (syntax syntax syntax ...)</param>
/// <param name="env">environment</param>
/// <param name="args">destination arguments structure</param>
public static Environment ParseLambda(Syntax expression, LinkedList <Value> arguments, Environment environment)
{
var newenv = new Environment(environment, Symbol.NULL);
if (arguments == null)
{
return(newenv);
}
var arg_type = ArgumentBinding.Type.Required;
/// ----------------------------------------------------------------------
/// Waiting for the DSSSL keywords, when found change mode and return true
/// ----------------------------------------------------------------------
Func <Syntax, bool> SymbolToArgumentType = (Syntax stx) =>
{
if (!stx.IsSymbol)
{
return(false);
}
var symbol = stx.GetDatum().AsSymbol();
if (symbol == Symbol.OPTIONAL)
{
arg_type = ArgumentBinding.Type.Optionals;
}
else if (symbol == Symbol.KEY)
{
arg_type = ArgumentBinding.Type.Key;
}
else if (symbol == Symbol.REST)
{
arg_type = ArgumentBinding.Type.Rest;
}
else if (symbol == Symbol.BODY)
{
arg_type = ArgumentBinding.Type.Body;
}
else
{
return(false);
}
return(true);
};
foreach (var arg in arguments)
{
var argstx = arg.AsSyntax();
if (!SymbolToArgumentType(argstx))
{
switch (arg_type)
{
case ArgumentBinding.Type.Required:
if (argstx.IsIdentifier)
{
ParseRequired("lambda", argstx, argstx, newenv, ArgumentBinding.Type.Required);
}
else
{
throw SchemeError.ArgumentError("lambda", "symbol?", argstx);
}
break;
case ArgumentBinding.Type.Optionals:
ParseOptional("lambda", argstx, argstx, newenv, ArgumentBinding.Type.Optionals);
break;
case ArgumentBinding.Type.Key:
ParseOptional("lambda", argstx, argstx, newenv, ArgumentBinding.Type.Key);
break;
case ArgumentBinding.Type.Rest:
ParseRequired("lambda", argstx, argstx, newenv, ArgumentBinding.Type.Rest);
arg_type = ArgumentBinding.Type.End;
break;
case ArgumentBinding.Type.Body:
ParseBody("lambda", argstx, argstx, newenv);
arg_type = ArgumentBinding.Type.End;
break;
case ArgumentBinding.Type.End:
throw SchemeError.SyntaxError("lambda", "unexpected extra argument", argstx);
}
}
}
return(newenv);
}