private static Syntax ParseVector(Token thisToken, Tokenizer moreTokens)
{
var listContents = new List <object>();
Token dotToken = null;
var nextToken = moreTokens.ReadToken();
while (nextToken != null && nextToken.Type != TokenType.CloseBracket)
{
// Parse this token
listContents.Add(ParseToken(nextToken, moreTokens));
// Fetch the next token
nextToken = moreTokens.ReadToken();
if (nextToken == null)
{
throw SchemeError.SyntaxError("parser", "Improperly formed list.", dotToken);
}
//if (!improper && nextToken.Type == TokenType.Symbol && dotSymbol.Equals(nextToken.Value) && thisToken.Type == TokenType.OpenBracket)
if (nextToken.Type == TokenType.Dot)
{
throw SchemeError.SyntaxError("parser", "Improperly formed dotted list", nextToken);
}
}
if (nextToken == null) // Missing ')'
{
throw SchemeError.SyntaxError("parser", "Missing close parenthesis", thisToken);
}
return(new Syntax(ValueList.FromList(listContents), thisToken));
}
/// <summary>
/// Make instruction of format A,B,C
/// </summary>
/// <param name="code"></param>
/// <param name="a"></param>
public static Instruction MakeABC(OpCode code, int a, int b, int c)
{
if (IsNotValueInRange(a, 0, AMask))
{
throw SchemeError.RangeError("Opcode.A.B.C", "Opcode", "A", a, code, 0, AMask);
}
if (IsNotValueInRange(b, 0, BMask))
{
throw SchemeError.RangeError("Opcode.A.B.C", "Opcode", "B", b, code, 0, BMask);
}
if (IsNotValueInRange(c, 0, CMask))
{
throw SchemeError.RangeError("Opcode.A.B.C", "Opcode", "C", c, code, 0, CMask);
}
var inst = new Instruction();
inst.OpCode = code;
inst.A = a;
inst.B = b;
inst.C = c;
return(inst);
}
protected static void AssertArgsEqual(string name, string message, int expected, int given, LinkedList <Value> argv, Syntax expression)
{
if (given != expected)
{
throw SchemeError.ArityError(name, message, expected, given, argv, expression);
}
}
// retrieve a quoted sugar token (' ` , ,@) and advance our position
private Token QuoteSugar()
{
TokenType type;
builder.Clear();
switch (Character)
{
case '\'':
type = TokenType.Quote;
break;
case '`':
type = TokenType.QuasiQuote;
break;
case ',':
type = TokenType.Unquote;
break;
default:
throw SchemeError.SyntaxError("tokenizer", "unexpected character", lastToken);
}
builder.Append((char)Character);
NextChar();
if (Character == '@')
{
type = TokenType.UnquoteSplicing;
NextChar();
builder.Append((char)Character);
}
return(DefineToken(type, builder.ToString()));
}
/// <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;
}
// (let () ...)
public static AST Expand(Syntax stx, Environment env)
{
var list = stx.AsLinkedList <Value>();
var argc = GetArgsCount(list);
AssertArgsMinimum("let", "arity mismatch", 2, argc, list, stx);
var keyword = list[0].AsSyntax(); // let arguments
var arguments = list[1].AsSyntax(); // let arguments
if (!arguments.IsExpression)
{
throw SchemeError.SyntaxError("let", "bad syntax (missing name or binding pairs)", stx);
}
var localEnv = ArgumentsParser.ParseLet(stx, arguments.AsLinkedList <Value>(), env);
AST lambda = new AstLambda(stx, keyword, localEnv, AstBuilder.ExpandListElements(list, 2, localEnv));
var result = new LinkedList <Value>();
result.AddLast(lambda.ToValue());
foreach (var v in localEnv)
{
if (v is ArgumentBinding)
{
var arg = v as ArgumentBinding;
if (arg.ArgType == ArgumentBinding.Type.Required)
{
result.AddLast(new Value(arg.Initializer));
}
}
}
return(new AstApplication(stx, result));
}
/// <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);
}
public static string ToString(ValueType value)
{
Debug.Assert(value != null);
if (value is NumericalType)
{
throw SchemeError.ErrorWithName("to-string", "can't inspect number-class", value);
}
return(value.ToString());
}
/// <summary>
/// Set value from the C# value type as the argument
/// is object reference then value is in the box.
/// </summary>
/// <param name="value"></param>
private void SetFromValueType(object value)
{
// the quick check
if (value is Value)
{
this = (Value)value;
}
// core types first
else if (value is bool)
{
Set((bool)value);
}
else if (value is int)
{
Set((int)value);
}
else if (value is double)
{
Set((double)value);
}
//and now all the odd cases (note the leading else!)
else if (value is uint)
{
Set((double)(uint)value);
}
else if (value is float)
{
Set((double)(float)value);
}
else if (value is sbyte)
{
Set((double)(sbyte)value);
}
else if (value is byte)
{
Set((double)(byte)value);
}
else if (value is short)
{
Set((double)(short)value);
}
else if (value is ushort)
{
Set((double)(ushort)value);
}
else
{
throw SchemeError.ErrorWithName("value-set", "can't assign the C# value-type", value);
}
}
/// <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;
}
/// <summary>
/// Make instruction of format A
/// </summary>
/// <param name="code"></param>
/// <param name="a"></param>
public static Instruction MakeA(OpCode code, int a)
{
if (IsNotValueInRange(a, 0, AMask))
{
throw SchemeError.RangeError("Opcode.A", "Opcode", "A", a, code, 0, AMask);
}
var inst = new Instruction();
inst.OpCode = code;
inst.A = a;
return(inst);
}
/// <summary>
/// Turns thisToken into an object, using moreTokens to get further tokens if required
/// </summary>
/// <returns></returns>
protected static Syntax ParseToken(Token thisToken, Tokenizer moreTokens)
{
if (thisToken == null)
{
throw SchemeError.SyntaxError("parser", "unexpectedly reached the end of the input", moreTokens.LastToken);
}
switch (thisToken.Type)
{
//case TokenType.Dot:
// return thisToken; //TODO maybe exception or symbol .
case TokenType.Character:
return(new Syntax(new Value(thisToken.GetCharacter()), thisToken));
case TokenType.Boolean:
return(new Syntax(new Value(thisToken.GetBool()), thisToken));
case TokenType.String:
return(new Syntax(new Value(thisToken.GetString()), thisToken));
case TokenType.Symbol:
return(new Syntax(thisToken.GetSymbol(), thisToken));
case TokenType.Heximal:
case TokenType.Integer:
return(new Syntax(new Value(thisToken.GetInteger()), thisToken));
case TokenType.Floating:
return(new Syntax(new Value(thisToken.GetFloat()), thisToken));
case TokenType.OpenBracket:
return(ParseList(thisToken, moreTokens));
case TokenType.OpenVector:
return(ParseVector(thisToken, moreTokens));
case TokenType.Quote:
case TokenType.Unquote:
case TokenType.UnquoteSplicing:
case TokenType.QuasiQuote:
return(ParseQuoted(thisToken, moreTokens));
case TokenType.BadNumber:
throw SchemeError.SyntaxError("parser", "looks like it should be a number, but it contains a syntax error", thisToken);
default:
// Unknown token type
throw SchemeError.SyntaxError("parser", "the element is being used in a context where it is not understood", thisToken);
}
}
/// <summary>
/// Parses a scheme expression in the default manner
/// </summary>
/// <returns>A scheme object</returns>
/// <remarks>It is an error to pass scheme to this method with 'extraneous' tokens, such as trailing closing brackets</remarks>
public static Syntax Parse(string scheme, string filepath)
{
var reader = new Tokenizer(new System.IO.StringReader(scheme), filepath);
var res = Parse(reader);
var token = reader.ReadToken();
if (token != null)
{
throw SchemeError.SyntaxError("parser", "found extra tokens after the end of a scheme expression", token);
}
return(res);
}
/// <summary>
/// Define new definition.
/// </summary>
/// <param name="name">identifier</param>
/// <param name="binding">binding</param>
public int Define(Symbol name, AstBinding binding)
{
var variable = LookupLocal(name);
if (variable != null)
{
throw SchemeError.SyntaxError("define", "environment already have key", binding.Id);
}
binding.environment = this;
binding.VarIdx = Bindings.Count;
Bindings[name] = binding;
return(binding.VarIdx);
}
/// <summary>
///
/// </summary>
/// <param name="ast"></param>
/// <param name="template"></param>
/// <returns>return dummy value</returns>
private int Generate(AST ast)
{
if (ast is AstLiteral)
{
return(GenerateLiteral(ast as AstLiteral));
}
if (ast is AstReference)
{
return(GenerateReference(ast as AstReference));
}
if (ast is AstSet)
{
return(GenerateSet(ast as AstSet));
}
if (ast is AstLambda)
{
return(GenerateLambda(ast as AstLambda));
}
if (ast is AstConditionIf)
{
return(GenerateConditionIf(ast as AstConditionIf));
}
if (ast is AstCondition)
{
return(GenerateCondition(ast as AstCondition));
}
if (ast is AstPrimitive)
{
return(GeneratePrimitive(ast as AstPrimitive));
}
if (ast is AstApplication)
{
return(GenerateApplication(ast as AstApplication));
}
if (ast is AstSequence)
{
return(GenerateSequence(ast as AstSequence));
}
throw SchemeError.ErrorWithName("codegen-generate", "unexpected ast", ast);
}
public char GetCharacter()
{
Debug.Assert(Type == TokenType.Character);
if (Value.Length == 3)
{
return(System.Convert.ToChar(Value[2]));
}
else
{
var c = (char)0;
if (CharType.NameToCharacter(Value, out c))
{
return(c);
}
throw SchemeError.SyntaxError("get-character", "improperly formed char value", this);
}
}
public bool GetBool()
{
Debug.Assert(Type == TokenType.Boolean);
if (Value == "#t")
{
return(true);
}
else if (Value == "#f")
{
return(false);
}
else
{
throw SchemeError.SyntaxError("get-bool", "improperly formed bool value", this);
}
}
public int GetInteger()
{
try
{
switch (Type)
{
case TokenType.Integer:
return(StringLibs.GetInteger(Value));
case TokenType.Heximal:
return(StringLibs.GetHexadecimal(Value));
default:
throw SchemeError.SyntaxError("get-integer", "wrong token type", this);
}
}
catch (System.Exception ex)
{
throw SchemeError.SyntaxError("get-integer", "improperly formed int value", this);
}
}
// retrieve a string literal token and advance our position
private Token StringLiteral()
{
builder.Clear();
NextChar();
var type = TokenType.String;
var matchingQuotes = false;
while (Character >= 0)
{
// if we get an escape, increment the position some more and map the escaped character to what it should be
if (Character == '\\')
{
NextChar();
builder.Append(MapEscaped(Character));
NextChar();
continue;
}
// unescaped quote? We're done with this string.
if (Character == '"')
{
NextChar();
matchingQuotes = true;
break;
}
builder.Append((char)Character);
NextChar();
}
// we didn't get opening and closing quotes :(
if (!matchingQuotes)
{
throw SchemeError.SyntaxError("tokenizer", "unmatched quotes in string literal", lastToken);
}
return(DefineToken(type, builder.ToString()));
}
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);
}
// Expand string @syntax to abstract syntax tree, in given @env environment
public static Ast ExpandInternal(Syntax syntax, Environment env)
{
if (syntax == null)
{
return(null);
}
else if (syntax.IsLiteral)
{
return(ExpandLiteral(syntax, env));
}
else if (syntax.IsIdentifier)
{
return(ExpandIdentifier(syntax, env));
}
else if (syntax.IsExpression)
{
return(ExpandExpression(syntax, env));
}
else
{
throw SchemeError.SyntaxError("ast-builder-expand", "expected literal, identifier or list expression", syntax);
}
}
