public ValueToken BinaryOperator(string op, ValueToken lhs, ValueToken rhs) =>
Convert(rhs)
.Map(rhsconv =>
BinaryOperators.ContainsKey(op)
? BinaryOperators[op](lhs, rhsconv)
: failwith <ValueToken>($"binary operator '{op}' not supported for {Name}"))
.IfNone(() => failwith <ValueToken>($"binary operator '{op}' used with incompatible types {lhs.Type} and {rhs.Type}"));
public ClusterToken SetEnvironment(ValueToken env) =>
new ClusterToken(
Settings.AddOrUpdate("env", env),
NodeName,
Role,
Connection,
Database,
(string)env.Value,
UserEnv
);
Option <ValueToken> MapTokenType <T>(ValueToken token)
{
var type = typeof(T);
if (type.GetTypeInfo().IsAssignableFrom(token.Value.GetType().GetTypeInfo()))
{
return(new ValueToken(token.Type, Convert.ChangeType(token.Value, type)));
}
return(from def in types.TypeMap.Find(type.FullName)
from map in def.Convert(token)
select map);
}
public ProcessToken SetRegisteredName(ValueToken registeredName) =>
new ProcessToken(
ProcessId,
Flags,
MailboxSize,
Strategy,
Settings.AddOrUpdate("register-as", registeredName),
(ProcessName)registeredName.Value,
Dispatch,
Route,
Workers,
WorkerCount,
WorkerName
);
public ProcessSystemConfigParser(string nodeName, Types typeDefs, IEnumerable <FuncSpec> strategyFuncs)
{
strategyFuncs = strategyFuncs ?? new FuncSpec[0];
this.nodeName = nodeName;
this.types = typeDefs;
this.clusterType = types.Register(BuildClusterType());
this.processType = types.Register(BuildProcessType());
this.routerType = types.Register(BuildRouterType());
this.strategyType = types.Register(BuildStrategySpec(types, strategyFuncs));
var opChars = ":!%&*+.<=>\\^|-~";
// Process config definition
Definition = GenLanguageDef.Empty.With(
CommentStart: "/*",
CommentEnd: "*/",
CommentLine: "//",
NestedComments: true,
OpStart: oneOf(opChars),
OpLetter: oneOf(opChars),
IdentStart: letter,
IdentLetter: either(alphaNum, oneOf("-_")),
ReservedNames: List("if", "then", "else").AddRange(types.AllInOrder.Map(t => t.Name)),
ReservedOpNames: List("-", "+", "/", "*", "==", "!=", ">", "<", "<=", ">=", "||", "&&", "|", "&", "%", "!", "~", "^")
);
// Token parser
// This builds the standard token parser from the definition above
TokenParser = makeTokenParser(Definition);
identifier = TokenParser.Identifier;
stringLiteral = TokenParser.StringLiteral;
integer = TokenParser.Integer;
floating = TokenParser.Float;
natural = TokenParser.Natural;
whiteSpace = TokenParser.WhiteSpace;
symbol = TokenParser.Symbol;
reserved = TokenParser.Reserved;
reservedOp = TokenParser.ReservedOp;
// Binary operator parser
Func <string, Assoc, Operator <ValueToken> > binary =
(name, assoc) =>
Operator.Infix(assoc,
from x in reservedOp(name)
select ValueToken.BinaryOp(name));
// Prefix operator parser
Func <string, Operator <ValueToken> > prefix =
(name) =>
Operator.Prefix(
from x in reservedOp(name)
select ValueToken.PrefixOp(name));
// Postfix operator parser
Func <string, Operator <ValueToken> > postfix =
(name) =>
Operator.Postfix(
from x in reservedOp(name)
select ValueToken.PostfixOp(name));
// Operator table
Operator <ValueToken>[][] table =
{
new [] { prefix("-"), prefix("+"), prefix("!") },
new [] { binary("*", Assoc.Left), binary("/", Assoc.Left), binary("%", Assoc.Left)},
new [] { binary("+", Assoc.Left), binary("-", Assoc.Left)},
new [] { binary("<", Assoc.Left), binary(">", Assoc.Left), binary(">=", Assoc.Left), binary("<=", Assoc.Left)},
new [] { binary("==", Assoc.Left), binary("!=", Assoc.Left)},
new [] { binary("&", Assoc.Left) },
new [] { binary("^", Assoc.Left) },
new [] { binary("|", Assoc.Left) },
new [] { binary("&&", Assoc.Left) },
new [] { binary("||", Assoc.Left) },
};
Func <Option <string>, TypeDef, Parser <ValueToken> > valueInst = null;
Parser <TypeDef> typeName = null;
// ProcessId parser
processId =
token(
from xs in many1(choice(lower, digit, oneOf("@/[,-_]{}: ")))
let r = (new string(xs.ToArray())).Trim()
let pid = ProcessId.TryParse(r)
from res in pid.Match(
Right: x => result(x),
Left: ex => failure <ProcessId>($"{ex.Message} '({r})'"))
select res);
// ProcessName parser
processName =
token(
from o in symbol("\"")
from xs in many1(choice(lower, digit, oneOf("@/[,-_]{.}: ")))
from c in symbol("\"")
let r = (new string(xs.ToArray())).Trim()
let n = ProcessName.TryParse(r)
from res in n.Match(
Right: x => result(x),
Left: ex => failure <ProcessName>(ex.Message))
select res);
// Attribute parser
Func <string, Parser <ValueToken>, Parser <NamedValueToken> > attr =
(name, p) =>
from x in reserved(name)
from _ in symbol("=")
from v in p
select new NamedValueToken(name, v, None);
// Type name parser
Parser <Type> type =
from x in letter
from xs in many1(choice(letter, ch('.'), ch('_')))
select Type.GetType(new string(x.Cons(xs).ToArray()));
var directive = types.Directive.ValueParser(this).Map(x => (Directive)x);
var msgDirective = types.MessageDirective.ValueParser(this).Map(x => (MessageDirective)x);
Parser <State <Exception, Option <Directive> > > exceptionDirective =
from b in symbol("|")
from t in token(type)
from a in symbol("->")
from d in directive
select Strategy.With(d, t);
Parser <State <Exception, Option <Directive> > > otherwiseDirective =
from b in symbol("|")
from t in symbol("_")
from a in symbol("->")
from d in directive
select Strategy.Otherwise(d);
Parser <State <Directive, Option <MessageDirective> > > matchMessageDirective =
from b in symbol("|")
from d in token(directive)
from a in symbol("->")
from m in token(msgDirective)
select Strategy.When(m, d);
Parser <State <Directive, Option <MessageDirective> > > otherwiseMsgDirective =
from b in symbol("|")
from t in symbol("_")
from a in symbol("->")
from d in token(msgDirective)
select Strategy.Otherwise(d);
// Strategy exception -> directive parser
match =
from _ in attempt(reserved("match"))
from direx in many(attempt(exceptionDirective))
from other in optional(otherwiseDirective)
let dirs = direx.Append(other.AsEnumerable()).ToArray()
from ok in dirs.Length > 0
? result(dirs)
: failure <State <Exception, Option <Directive> >[]>("'match' must be followed by at least one clause")
select new ValueToken(types.Get("strategy"), Strategy.Match(dirs));
Parser <State <StrategyContext, Unit> > redirectMatch =
from direx in many(attempt(matchMessageDirective))
from other in optional(otherwiseMsgDirective)
let dirs = direx.Append(other.AsEnumerable()).ToArray()
from ok in dirs.Length > 0
? result(dirs)
: failure <State <Directive, Option <MessageDirective> >[]>("'redirect when' must be followed by at least one clause")
select Strategy.Redirect(dirs);
// Strategy directive -> message-directive matching parser
redirect =
from n in attempt(reserved("redirect"))
from t in either(attempt(symbol(":")), reserved("when"))
from r in t == ":"
? from d in token(msgDirective)
select Strategy.Redirect(d)
: redirectMatch
select new ValueToken(types.Get("strategy"), r);
// Type name parser
typeName = choice(types.AllInOrder.Map(t => reserved(t.Name).Map(_ => t)).ToArray());
// cluster.<alias>.<property> parser -- TODO: generalise
Parser <ValueToken> clusterVar =
attempt(
from _ in reserved("cluster")
from tup in either(
attempt(
from d1 in symbol(".")
from alias in identifier
from d2 in symbol(".")
from id in identifier
select Tuple(alias, id)),
attempt(
from d in symbol(".")
from id in identifier
select Tuple("", id)))
from sub in optional(from d2 in symbol(".")
from id2 in identifier
select id2).Map(x => x.IfNone("value"))
from state in getState <ParserState>() // TODO: This can be generalised into an object walking system
from v in state.Clusters.Find(tup.Item1).Match( // where an object (in this case the cluster), is in 'scope'
Some: cluster => // and recursive walking of the dot operator will find the
cluster.Settings.Find(tup.Item2).Match( // value.
Some: local => result(local),
None: () => failure <ValueToken>($"unknown identifier 'cluster.{tup.Item2}'")),
None: () => failure <ValueToken>($"cluster.{tup.Item2} used when a cluster with a node-name attribute set to '{nodeName}' hasn't been defined. Or the cluster called '{nodeName}' exists and is aliased, and you're not providing the variable in the form: cluster.<alias>.<property-name>"))
select v
);
// Variable of unknown type parser
Parser <ValueToken> variable =
either(
clusterVar,
attempt(
from id in identifier
from state in getState <ParserState>()
from v in state.Local(id).Match(
Some: v => result(v),
None: () => failure <ValueToken>($"unknown identifier '{id}' "))
select v
)
);
// Variable of known type parser
Func <TypeDef, Parser <ValueToken> > variableOfType =
expect =>
from v in variable
from r in v.Type == expect
? result(v)
: expect.Convert(v).Match(
Some: x => result(x),
None: () => failure <ValueToken>($"type mismatch {v.Type} found, expected {expect}")
)
select r;
Parser <ValueToken> ternary =
token(
from __ in attempt(reserved("if"))
from eb in exprUnknownType
from ex in eb.Type == types.Bool
? result(eb)
: failure <ValueToken>("ternary expressions must evaluate to a boolean value")
from th in reserved("then")
from te in exprUnknownType
from el in reserved("else")
from ee in exprUnknownType
select((bool)ex.Value) ? te : ee
);
valueUntyped = choice(
variable,
choice(types.AllInOrder.Map(typ => attempt(typ.ValueParser(this).Map(val => new ValueToken(typ, typ.Ctor(None, val))))).ToArray())
);
// Expression term parser
Parser <ValueToken> termUnknownType =
choice(
parens(lazyp(() => exprUnknownType)),
ternary,
valueUntyped);
// Expression parser
exprUnknownType =
buildExpressionParser(table, termUnknownType);
// Variable declaration parser
valueDef =
from typ in either(
attempt(reserved("let")).Map(x => Option <TypeDef> .None),
typeName.Map(Option <TypeDef> .Some)
)
from arr in optional(symbol("[]"))
from _ in arr.IsSome && typ.IsNone
? failure <Unit>("when declaring an array you must specify the type, you can't use 'let'")
: result <Unit>(unit)
from id in identifier.label("identifier")
from alias in optional(
from a_ in reserved("as")
from nm in identifier
select nm)
from __ in symbol(":")
from v in arr.IsSome
? either(
attempt(valueInst(alias, TypeDef.Map(() => typ.IfNone(TypeDef.Unknown)))),
valueInst(alias, TypeDef.Array(() => typ.IfNone(TypeDef.Unknown))))
: typ.Map(t => expr(alias, t))
.IfNone(() => exprUnknownType)
from nv in result(new NamedValueToken(id, v, alias))
from state in getState <ParserState>()
from res in state.LocalExists(id)
? failure <ParserState>($"A value with the name '{id}' already declared")
: result(state.AddLocal(id, v))
from ___ in setState(res)
select nv;
// Value or variable parser
valueInst = (alias, typ) => either(variableOfType(typ), typ.ValueParser(this).Map(value => new ValueToken(typ, typ.Ctor(alias, value))));
// Expression term parser
term =
(alias, expected) =>
choice(
parens(lazyp(() => expr(alias, expected))),
valueInst(alias, expected),
from val in exprUnknownType
from res in val.Type == expected
? result(val)
: failure <ValueToken>($"expression must evaluate to {expected}, it actually evaluates to {val.Type}")
select res
);
// Expression parser
expr =
(alias, expected) =>
buildExpressionParser(table, term(alias, expected));
// Parses a named argument: name = value
namedArgument =
(settingName, spec) =>
attempt(token(attr(spec.Name, expr(None, spec.Type()))));
// Parses a single non-named argument
argument =
(settingName, spec) =>
attempt(token(expr(None, spec.Type()).Map(x => new NamedValueToken(spec.Name, x, None))));
// Parses many arguments, wrapped in ( )
argumentMany =
(settingName, spec) =>
from a in commaSep1(choice(spec.Map(arg => namedArgument(settingName, arg))))
from r in a.Count == spec.Length
? result(a)
: failure <Seq <NamedValueToken> >("Invalid arguments for " + settingName)
select r;
// Parses the arguments for a setting
arguments =
(settingName, spec) =>
spec.Length == 0
? failure <Seq <NamedValueToken> >("Invalid arguments spec, has zero arguments")
: spec.Length == 1
? from a in argument(settingName, spec.Head())
select SeqOne(a)
: argumentMany(settingName, spec);
// Declare the global type
var globalType = new TypeDef("global", (_, x) => x, typeof(Lst <NamedValueToken>), nodeName, 0);
// Global namespace
parser = from ws in whiteSpace
from __ in setState(ParserState.Empty)
from ss in globalType.ValueParser(this)
select(Lst <NamedValueToken>) ss;
}
public ValueToken PostfixOperator(string op, ValueToken lhs) =>
PostfixOperators.ContainsKey(op)
? PostfixOperators[op](lhs)
: failwith <ValueToken>($"postfix operator '{op}' not supported for {Name}");
public Option <ValueToken> Convert(ValueToken token) =>
token.Type == this
? token
: ConversionOperators.ContainsKey(token.Type.Name)
? Some(new ValueToken(this, ConversionOperators[token.Type.Name](token.Value)))
: None;
public NamedValueToken(string name, ValueToken value, Option <string> alias)
{
Name = name;
Value = value;
Alias = alias;
}
public ParserState AddLocal(string name, ValueToken value) => new ParserState(Clusters, Locals.Add(name, value));
