Compare commits
2 Commits
4f4adaa284
...
e180dc955d
| Author | SHA1 | Date | |
|---|---|---|---|
 Peter Harpending
|
e180dc955d | ||
|
Peter Harpending
|
4e54bebeba |
@@ -0,0 +1,67 @@
|
||||
-spec mktree(Signal) -> Tree when
|
||||
Signal :: gsc:signal(),
|
||||
Tree :: gsc_ntree:ntree().
|
||||
|
||||
% @doc make into a tree
|
||||
mktree(Sig) ->
|
||||
Tree0 = gsc_ntree:nstem(vtokens, Sig),
|
||||
Tree1 = rerootl_tkstr("=>", Tree0),
|
||||
Tree2 = rerootl_tkstr("*", Tree1),
|
||||
Tree2.
|
||||
|
||||
|
||||
rerootl_tkstr(S, Tree0 = #ns{val = Root0}) ->
|
||||
Kids0 = gsc_ntree:deleaf0(Tree0),
|
||||
IsntS = fun(Tk) -> isnt_str(S, Tk) end,
|
||||
case lists:splitwith(IsntS, Kids0) of
|
||||
% found
|
||||
% input:
|
||||
% *s Root0
|
||||
% |
|
||||
% +-- .l Foo
|
||||
% +-- .l "=>"
|
||||
% +-- .l Bar
|
||||
% output:
|
||||
% *s "=>"
|
||||
% |
|
||||
% +-- *s Root0 -- .l Foo
|
||||
% +-- *s Root0 -- .l Bar
|
||||
{LHS1, [Tk0 | RHS1]} ->
|
||||
Root1 = Root0,
|
||||
LTree1 = gsc_ntree:releaf0(Root1, LHS1),
|
||||
RTree1 = rerootl_tkstr(S, gsc_ntree:releaf0(Root1, RHS1)),
|
||||
NewRoot0 = {op, Tk0},
|
||||
NewKids0 = [LTree1, RTree1],
|
||||
NewTree = gsc_ntree:releaf0(NewRoot0, NewKids0),
|
||||
NewTree;
|
||||
% not found, nothing to do
|
||||
{Kids0, []} ->
|
||||
Tree0
|
||||
end.
|
||||
|
||||
|
||||
%reroot_mapsto(Tree0 = #ns{val = Root0}) ->
|
||||
% Kids0 = gsc_ntree:deleaf0(Tree0),
|
||||
% IsntMapsto = fun(DL) -> isnt_str("=>", Tk) end,
|
||||
% case lists:splitwith(IsntMapsto, Kids0) of
|
||||
% % found
|
||||
% {LHS1, [Tk0 | RHS1]} ->
|
||||
% Root1 = Root0,
|
||||
% LTree1 = gsc_ntree:releaf0(Root1, LHS1),
|
||||
% RTree1 = reroot_mapsto(gsc_ntree:releaf0(Root1, RHS1)),
|
||||
% NewRoot0 = {op, Tk0},
|
||||
% NewKids0 = [LTree1, RTree1],
|
||||
% NewTree = gsc_ntree:releaf0(NewRoot0, NewKids0),
|
||||
% NewTree;
|
||||
% % nothing to do
|
||||
% {Kids0, []} ->
|
||||
% Tree0
|
||||
% end.
|
||||
|
||||
|
||||
|
||||
isnt_str(X, Y) ->
|
||||
not is_str(X, Y).
|
||||
|
||||
is_str(S, #tk{str = S}) -> true;
|
||||
is_str(_, _) -> false.
|
||||
+123
-77
@@ -6,6 +6,32 @@
|
||||
|
||||
-include("$gsc_include/gsc.hrl").
|
||||
|
||||
% records copypasta for now
|
||||
-record(ns, {meta :: any(), kids :: list(any())}).
|
||||
|
||||
-type ntree(X, Y) :: gsc_ntree:ntree(X, Y).
|
||||
-type nforest(X, Y) :: gsc_nforest:nforest(X, Y).
|
||||
|
||||
-type nt(X, Y) :: gsc_ntree:ntree(X, Y).
|
||||
-type nf(X, Y) :: gsc_nforest:nforest(X, Y).
|
||||
|
||||
|
||||
% just parsing type expressions right now, so only need
|
||||
% to worry about round parens
|
||||
%
|
||||
% none is to indicate general-purpose grouping, for
|
||||
% e.g. LHS/RHS of an op
|
||||
-type syntax_meta()
|
||||
:: none
|
||||
| {op, tk()}
|
||||
| {parens, Open :: tk(), Close :: tk()}
|
||||
.
|
||||
|
||||
-type ast() :: ntree(StemMeta :: syntax_meta(),
|
||||
LeafType :: tk()).
|
||||
-type asf() :: nforest(syntax_meta(), tk()).
|
||||
-type asts() :: asf().
|
||||
|
||||
|
||||
main() ->
|
||||
x00(),
|
||||
@@ -17,93 +43,113 @@ x00() ->
|
||||
io:format(" SrcStr = ~p~n", [x00_src()]),
|
||||
io:format(" Tokens = ~p~n", [x00_tks()]),
|
||||
io:format(" Signal = ~p~n", [x00_sgl()]),
|
||||
io:format(" Tree0 = ~p~n", [x00_tree0()]),
|
||||
io:format(" Forest = ~p~n", [x00_fst()]),
|
||||
ok.
|
||||
|
||||
% sample type expr, tokens, signal
|
||||
x00_src() -> "foo => bar * baz".
|
||||
x00_tks() -> gsc:unsafe_tokens_from_string(x00_src()).
|
||||
x00_sgl() -> gsc:filter_signal(x00_tks()).
|
||||
x00_tree0() -> mktree(x00_sgl()).
|
||||
|
||||
% records copypasta for now
|
||||
-record(ns, {val :: any(), kids :: list(any())}).
|
||||
-record(nl, {val :: any()}).
|
||||
|
||||
-type ntree(X, Y) :: gsc_ntree:ntree(X, Y).
|
||||
-type ntree() :: gsc_ntree:ntree().
|
||||
|
||||
-type ast_stem_t() :: vtokens
|
||||
| {op, tk()}
|
||||
.
|
||||
|
||||
-type ast() :: ntree(ast_stem_t(), tk()).
|
||||
x00_src() -> "(foo => (bar) * baz)".
|
||||
x00_tks() -> gsc:unsafe_tokens_from_string(x00_src()).
|
||||
x00_sgl() -> gsc:filter_signal(x00_tks()).
|
||||
x00_fst() -> parse(x00_sgl()).
|
||||
|
||||
|
||||
-spec mktree(Signal) -> Tree when
|
||||
Signal :: gsc:signal(),
|
||||
Tree :: gsc_ntree:ntree().
|
||||
-spec parse(Signal) -> ASF when
|
||||
Signal :: [tk()],
|
||||
ASF :: asf().
|
||||
|
||||
% @doc make into a tree
|
||||
mktree(Sig) ->
|
||||
Tree0 = gsc_ntree:nstem(vtokens, Sig),
|
||||
Tree1 = rerootl_tkstr("=>", Tree0),
|
||||
Tree2 = rerootl_tkstr("*", Tree1),
|
||||
Tree2.
|
||||
parse(Signal) ->
|
||||
% key insight here is our signal is already a
|
||||
% forest, assuming the leaf type is `tk()`.
|
||||
%
|
||||
% our parser is a sequence of forest-to-forest
|
||||
% transformers.
|
||||
%
|
||||
% at the end we should end up with just one tree (i
|
||||
% think)?
|
||||
F0 = Signal,
|
||||
F1 = f2f_parens(F0),
|
||||
F2 = f2f_op("=>", F1),
|
||||
F3 = f2f_op("*", F2),
|
||||
Result = F2,
|
||||
Result.
|
||||
|
||||
|
||||
rerootl_tkstr(S, Tree0 = #ns{val = Root0}) ->
|
||||
Kids0 = gsc_ntree:deleaf0(Tree0),
|
||||
IsntS = fun(Tk) -> isnt_str(S, Tk) end,
|
||||
case lists:splitwith(IsntS, Kids0) of
|
||||
% found
|
||||
% input:
|
||||
% *s Root0
|
||||
% |
|
||||
% +-- .l Foo
|
||||
% +-- .l "=>"
|
||||
% +-- .l Bar
|
||||
% output:
|
||||
% *s "=>"
|
||||
% |
|
||||
% +-- *s Root0 -- .l Foo
|
||||
% +-- *s Root0 -- .l Bar
|
||||
{LHS1, [Tk0 | RHS1]} ->
|
||||
Root1 = Root0,
|
||||
LTree1 = gsc_ntree:releaf0(Root1, LHS1),
|
||||
RTree1 = rerootl_tkstr(S, gsc_ntree:releaf0(Root1, RHS1)),
|
||||
NewRoot0 = {op, Tk0},
|
||||
NewKids0 = [LTree1, RTree1],
|
||||
NewTree = gsc_ntree:releaf0(NewRoot0, NewKids0),
|
||||
NewTree;
|
||||
% not found, nothing to do
|
||||
{Kids0, []} ->
|
||||
Tree0
|
||||
end.
|
||||
f2f_op(OpStr, Fst) ->
|
||||
f2f_op(OpStr, [], Fst).
|
||||
|
||||
|
||||
%reroot_mapsto(Tree0 = #ns{val = Root0}) ->
|
||||
% Kids0 = gsc_ntree:deleaf0(Tree0),
|
||||
% IsntMapsto = fun(DL) -> isnt_str("=>", Tk) end,
|
||||
% case lists:splitwith(IsntMapsto, Kids0) of
|
||||
% % found
|
||||
% {LHS1, [Tk0 | RHS1]} ->
|
||||
% Root1 = Root0,
|
||||
% LTree1 = gsc_ntree:releaf0(Root1, LHS1),
|
||||
% RTree1 = reroot_mapsto(gsc_ntree:releaf0(Root1, RHS1)),
|
||||
% NewRoot0 = {op, Tk0},
|
||||
% NewKids0 = [LTree1, RTree1],
|
||||
% NewTree = gsc_ntree:releaf0(NewRoot0, NewKids0),
|
||||
% NewTree;
|
||||
% % nothing to do
|
||||
% {Kids0, []} ->
|
||||
% Tree0
|
||||
% end.
|
||||
% never saw the op
|
||||
f2f_op(_opstr, Stk, []) ->
|
||||
lists:reverse(Stk);
|
||||
% see op
|
||||
f2f_op(OpStr, LhsStk, [#tk{str = OpStr} = OpTk | Rest]) ->
|
||||
Lhf = lists:reverse(LhsStk),
|
||||
Rhf = f2f_op(OpStr, Rest),
|
||||
Lht = #ns{meta = none, kids = Lhf},
|
||||
Rht = #ns{meta = none, kids = Rhf},
|
||||
ResultT = #ns{meta = {op, OpTk},
|
||||
kids = [Lht, Rht]},
|
||||
ResultF = [ResultT],
|
||||
ResultF;
|
||||
% see stem, descend
|
||||
f2f_op(OpStr, LhsStk, [Ns = #ns{kids = NsKids} | Rest]) ->
|
||||
NewNsKids = f2f_op(OpStr, NsKids),
|
||||
NewNs = Ns#ns{kids = NewNsKids},
|
||||
NewStk = [NewNs | LhsStk],
|
||||
f2f_op(OpStr, NewStk, Rest);
|
||||
% see leaf, just add
|
||||
f2f_op(OpStr, Stk, [L | Rest]) ->
|
||||
f2f_op(OpStr, [L | Stk], Rest).
|
||||
|
||||
|
||||
-spec f2f_parens(Forest) -> NewForest when
|
||||
Forest :: asts(),
|
||||
NewForest :: Forest.
|
||||
% @doc
|
||||
% recursive parens decomposition
|
||||
%
|
||||
% the input here is the flat list of tokens. here we
|
||||
% basically replace the string of tokens between `(`
|
||||
% and `)` with a single tree
|
||||
%
|
||||
% interesting quirk is that this doesn't error on too
|
||||
% many close parens, only too many open parens
|
||||
|
||||
f2f_parens(Fst) ->
|
||||
f2f_parens([], Fst).
|
||||
|
||||
% done
|
||||
f2f_parens(Stk, []) ->
|
||||
lists:reverse(Stk);
|
||||
% crawl down the forest and scan for open parens
|
||||
% open paren, we descend
|
||||
f2f_parens(Stk, [#tk{str = "("} = TkOpen | Rest0]) ->
|
||||
InitMeta = {parens, TkOpen, none},
|
||||
{slurp, PStem, Rest1} = slurp_pstem(InitMeta, [], Rest0),
|
||||
NewStk = [PStem | Stk],
|
||||
f2f_parens(NewStk, Rest1);
|
||||
% something else, we continue
|
||||
f2f_parens(Stk, [Tree | Rest]) ->
|
||||
f2f_parens([Tree | Stk], Rest).
|
||||
|
||||
|
||||
|
||||
isnt_str(X, Y) ->
|
||||
not is_str(X, Y).
|
||||
|
||||
is_str(S, #tk{str = S}) -> true;
|
||||
is_str(_, _) -> false.
|
||||
% ran out of tokens before close paren
|
||||
slurp_pstem({parens, TkOpen, none}, Stk, []) ->
|
||||
error({no_close_for, TkOpen, Stk});
|
||||
% hit close paren, we done
|
||||
slurp_pstem({parens, TkOpen, none}, Stk, [TkClose = #tk{str = ")"} | Rest]) ->
|
||||
FinalMeta = {parens, TkOpen, TkClose},
|
||||
Midsection = lists:reverse(Stk),
|
||||
FinalTree = #ns{meta = FinalMeta,
|
||||
kids = Midsection},
|
||||
{slurp, FinalTree, Rest};
|
||||
% hit open paren, we recurse
|
||||
slurp_pstem(AccMeta, Stk, [TkOpen_II = #tk{str = "("} | Rest0]) ->
|
||||
InitMeta_II = {parens, TkOpen_II, none},
|
||||
{slurp, PStem_II, Rest1} = slurp_pstem(InitMeta_II, [], Rest0),
|
||||
NewStk = [PStem_II | Stk],
|
||||
slurp_pstem(AccMeta, NewStk, Rest1);
|
||||
% hit something else, we move along
|
||||
slurp_pstem(AccMeta, Stk, [Tree | Rest]) ->
|
||||
slurp_pstem(AccMeta, [Tree | Stk], Rest).
|
||||
|
||||
+66
-99
@@ -1,15 +1,15 @@
|
||||
-module(gsc_ntree).
|
||||
|
||||
-export_type([
|
||||
ntree/2,
|
||||
ntree/0
|
||||
ntree/2, ntree/0,
|
||||
nforest/2, nforest/0,
|
||||
nt/2, nt/0,
|
||||
nf/2, nf/0
|
||||
]).
|
||||
|
||||
-export([
|
||||
nstem/2,
|
||||
flatten/1,
|
||||
deleaf0/1,
|
||||
releaf0/2
|
||||
nstem/2, meta/1, kids/1,
|
||||
flatten_tree/1, flatten_forest/1
|
||||
]).
|
||||
|
||||
|
||||
@@ -19,109 +19,76 @@
|
||||
%% API: types
|
||||
%%=====================================================
|
||||
|
||||
-record(ns, {val :: any(), kids :: list(any())}).
|
||||
-record(nl, {val :: any()}).
|
||||
% @doc stem record
|
||||
-record(ns, {meta :: any(),
|
||||
kids :: list(any())}).
|
||||
|
||||
%% @doc ntree(S, L) is a "node tree" (meaning stems
|
||||
%% have values and children)
|
||||
-type ntree(S, L)
|
||||
:: #ns{val :: S, kids :: [ntree(S, L)]}
|
||||
| #nl{val :: L}.
|
||||
% @doc `ntree(S, L)' is a "node tree" (meaning stems
|
||||
% have values and children)
|
||||
%
|
||||
% for the purposes of the compiler, the key observation
|
||||
% is that a flat list of tokens is already a forest
|
||||
-type ntree(S, L) :: #ns{meta :: S, kids :: [ntree(S, L)]}
|
||||
| L.
|
||||
|
||||
-type ntree() :: ntree(any(), any()).
|
||||
% @doc forest is just a list of trees
|
||||
-type nforest(S, L) :: [ntree(S, L)].
|
||||
|
||||
|
||||
% aliases
|
||||
|
||||
-type nt(S, L) :: ntree(S, L).
|
||||
-type nf(S, L) :: nforest(S, L).
|
||||
|
||||
-type ntree() :: ntree(any(), any()).
|
||||
-type nforest() :: [ntree()].
|
||||
|
||||
-type nt() :: ntree().
|
||||
-type nf() :: nforest().
|
||||
|
||||
|
||||
%%=====================================================
|
||||
%% API: functions
|
||||
%%=====================================================
|
||||
|
||||
|
||||
-spec nstem(Root, List) -> Tree when
|
||||
Root :: X,
|
||||
List :: list(Y),
|
||||
Tree :: ntree(X, Y),
|
||||
X :: any(),
|
||||
Y :: any().
|
||||
% @doc
|
||||
% You *probably* want `releaf0/2' instead.
|
||||
%
|
||||
% This function naively wraps each element in the list
|
||||
% in a leaf type, even if it's already wrapped.
|
||||
%
|
||||
% nstem(root, [Foo, Bar, Baz]) ~>
|
||||
% *s root
|
||||
% |
|
||||
% +--- .l Foo
|
||||
% |
|
||||
% +--- .l Bar
|
||||
% |
|
||||
% +--- .l Baz
|
||||
%
|
||||
% Much more common use case is to releaf only the input
|
||||
% nodes which are not already wrapped, which is what
|
||||
% `releaf0/2' does.
|
||||
% @end
|
||||
nstem(Root, List) ->
|
||||
{ns, Root, [{nl, Y} || Y <- List]}.
|
||||
|
||||
|
||||
|
||||
-spec flatten(Tree) -> LeafVals when
|
||||
Tree :: ntree(any(), LeafType),
|
||||
LeafVals :: [LeafType],
|
||||
LeafType :: any().
|
||||
|
||||
flatten({nl, X}) ->
|
||||
[X];
|
||||
flatten({ns, _, Keeids}) ->
|
||||
lists:flatten([flatten(Keeid) || Keeid <- Keeids]).
|
||||
|
||||
|
||||
|
||||
-spec deleaf0(Tree) -> Result when
|
||||
Tree :: ntree(S, L),
|
||||
Result :: [L | Tree],
|
||||
S :: any(),
|
||||
L :: any().
|
||||
|
||||
% @doc unwrap the leaf children, and leave the stem
|
||||
% children intact
|
||||
%
|
||||
% ex. 1:
|
||||
% (+ 1 2 (* 3 4) 5)
|
||||
% ~> '(1 2 (* 3 4) 5)
|
||||
%
|
||||
% ex. 2:
|
||||
% {ns, '+', [{nl, 1},
|
||||
% {nl, 2},
|
||||
% {ns, '*', [{nl, 3}, {nl, 4}]},
|
||||
% {nl, 5}]}
|
||||
% ~> [1, 2, {ns, '*', [{nl, 3}, {nl, 4}]}, 5]
|
||||
% @end
|
||||
deleaf0({nl, L}) -> [L];
|
||||
deleaf0({ns, _, Ls}) -> dl0([], Ls).
|
||||
|
||||
dl0(Stk, []) -> lists:reverse(Stk);
|
||||
dl0(Stk, [{nl, X} | Rest]) -> dl0([X | Stk], Rest);
|
||||
dl0(Stk, [X | Rest]) -> dl0([X | Stk], Rest).
|
||||
|
||||
|
||||
|
||||
-spec releaf0(Root, Keeids) -> Rooted when
|
||||
-spec nstem(Root, Forest) -> Tree when
|
||||
Root :: S,
|
||||
Keeids :: [L | ntree(S, L)],
|
||||
Rooted :: ntree(S, L),
|
||||
Forest :: nforest(S, L),
|
||||
Tree :: ntree(S, L),
|
||||
S :: any(),
|
||||
L :: any().
|
||||
|
||||
% @doc notional inverse of `deleaf0/1'
|
||||
%
|
||||
% Note that this does **NOT** double-wrap leafs in the
|
||||
% input
|
||||
releaf0(Root, Ks) ->
|
||||
#ns{val = Root,
|
||||
kids = lists:map(fun rl0/1, Ks)}.
|
||||
nstem(Root, List) ->
|
||||
{ns, Root, List}.
|
||||
|
||||
|
||||
meta(#ns{meta = M}) -> M.
|
||||
kids(#ns{kids = K}) -> K.
|
||||
|
||||
|
||||
|
||||
-spec flatten_tree(Tree) -> Leafs when
|
||||
Tree :: ntree(_, L),
|
||||
Leafs :: [L],
|
||||
L :: any().
|
||||
|
||||
flatten_tree(T) ->
|
||||
lists:flatten(ft(T)).
|
||||
|
||||
|
||||
|
||||
-spec flatten_forest(Forest) -> Leafs when
|
||||
Forest :: nforest(_, L),
|
||||
Leafs :: [L],
|
||||
L :: any().
|
||||
|
||||
flatten_forest(F) ->
|
||||
lists:flatten(ff(F)).
|
||||
|
||||
|
||||
ft(#ns{kids = F}) -> ff(F);
|
||||
ft(Leaf) -> [Leaf].
|
||||
|
||||
ff(F) ->
|
||||
[ft(T) || T <- F].
|
||||
|
||||
rl0(X = #ns{}) -> X;
|
||||
rl0(X = #nl{}) -> X;
|
||||
rl0(X) -> {nl, X}.
|
||||
|
||||
Reference in New Issue
Block a user