p6.p6

class Rule {
    has $.prefix  is rw = '';
    has $.subject is rw = '';
    has $.op is rw;

    method gist { "<Rule: {$!op//''} $!prefix ($!subject)>" }
}

class RuleGroup {
    has $.parent;
    has $.level;
    has $.op;
    has $.rule-count is rw = 1;
    has $.rules = [Rule.new, ];

    method gist { "<RuleGroup: {self.perl}>" }
}

constant &T_SKIP = {;}
constant &T_NEW_GROUP = {
    .group-current-level += 1;
    .current-group = RuleGroup.new:
        :parent(.current-group), :level(.group-current-level)
}
constant &T_APPEND_CHAR_PRE = {
    .current-group.rules[
        .current-group.rule-count - 1
    ].prefix ~= .current-char
}
constant &T_ADD_OP = &T_APPEND_CHAR_PRE;

constant &T_ADD_OP_NEW_RULE = {
    .current-group.rules.append: Rule.new;
    .current-group.rules[.current-group.rule-count++].op = .current-char;
}
constant &T_END_GROUP = {
    .current-group = RuleGroup.new: :parent(.current-group),
        :level(.group-current-level += 1)
}
constant &T_END_RULE = {;}
constant &T_APPEND_CHAR_SUBJ = {
    .current-group.rules[
        .current-group.rule-count - 1
    ].subject ~= .current-char
}
constant &T_ADD_GROUP_OP = {
    .current-group.op = .current-char
}

constant S_NEW_GROUP = "STATE: NEW_GROUP";
constant S_END_GROUP = "STATE: END_GROUP";
constant S_PRE = "STATE: PREFIX";
constant S_OP = "STATE: OPERATOR";
constant S_END_RULE = "STATE: END_RULE";
constant S_SUBJ = "STATE: SUBJECT";

my @FSM-MAP :=
    {
        :src(S_NEW_GROUP | S_PRE),
        :dst(S_PRE),
        :condition(/<[A..Za..z\d+-]>/),
        :callback(&T_APPEND_CHAR_PRE),
    },
    {
        :src(S_PRE),
        :dst(S_SUBJ),
        :condition(* eq '('),
        :callback(&T_SKIP),
    },# 3
    {
        :src(S_SUBJ),
        :dst(S_SUBJ),
        :condition(* ne ')'),
        :callback(&T_APPEND_CHAR_SUBJ),
    },  # 4
    {
        :src(S_SUBJ),
        :dst(S_END_RULE),
        :condition(* eq ')'),
        :callback(&T_END_RULE),
    },  # 5
    {
        :src(S_END_RULE),
        :dst(S_END_GROUP),
        :condition(* eq ')'),
        :callback(&T_END_GROUP),
    },  # 6
    {
        :src(S_END_RULE),
        :dst(S_OP),
        :condition(/<[&|]>/),
        :callback(&T_ADD_OP_NEW_RULE),
    },  # 7
    {
        :src(S_END_GROUP),
        :dst(S_OP),
        :condition(/<[&|]>/),
        :callback(&T_ADD_GROUP_OP),
    },  # 8
    {
        :src(S_OP),
        :dst(S_NEW_GROUP),
        :condition(* eq '('),
        :callback(&T_NEW_GROUP),
    },  # 9
    {
        :src(S_OP),
        :dst(S_PRE),
        :condition(/<[A..Za..z\d+-]>/),
        :callback(&T_APPEND_CHAR_PRE),
    },  # 10
    {
        :src(S_SUBJ),
        :dst(S_END_RULE),
        :condition(* eq ')'),
        :callback(&T_END_RULE),
    }; # 11


class RuleParseFSM {
    has $.input-str;
    has $.current-state = S_NEW_GROUP;
    has $.group-current-level is rw = 0;
    has $.current-group is rw = RuleGroup.new: :level($!group-current-level);
    has $.current-char = '';

    method run {
        self.process-next: $_  or say "skip '$_' in $!current-state"
            for $!input-str.comb
    }

    method process-next($!current-char) {
        defined @FSM-MAP.first: {
            .<src> eq $!current-state
            and self.iter-re-evals: $!current-char, $_
        }
    }

    method iter-re-evals (\achar, $_) {
        return False unless .<condition>.ACCEPTS: achar;
        self.update-state: .<dst>, .<callback>;
        True
    }

    method update-state ($new-state, &callback) {
        say "$!current-char -> $!current-state : $new-state";
        $!current-state = $new-state;
        callback self
    }
}

with RuleParseFSM.new: :input-str('AN(hello) & AN(world)') {
    .run;
    say .current-group;
}