diff --git a/cli/scratch/test_ntree.erl b/cli/scratch/test_ntree.erl new file mode 100644 index 0000000..131e1a6 --- /dev/null +++ b/cli/scratch/test_ntree.erl @@ -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. diff --git a/cli/src/gsc_test_ntree.erl b/cli/src/gsc_test_ntree.erl index d7fe151..6183897 100644 --- a/cli/src/gsc_test_ntree.erl +++ b/cli/src/gsc_test_ntree.erl @@ -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,102 @@ 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), + Result = F1, + 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) -> +% case f2f_op(OpStr, [], none, Fst) of +% % never saw it, no change +% ident -> Fst; +% +% +%% never saw the op +%f2f_op(_, _, none, []) -> +% ident; +%% see op +%f2f_op(OpStr, LhsStk, none, [OpTk = #tk{str = OpStr} | Rest]) -> +% Lhf = lists:reverse(LhsStk), +% Rhf = f2f_op(OpStr, Rest), +% Lht = #ns{meta = none, kids = Lhf}, +% Rht = #ns{meta = none, kids = Rhf}, +% Result = -%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. +-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). diff --git a/src/gsc_ntree.erl b/src/gsc_ntree.erl index 264f941..49328ad 100644 --- a/src/gsc_ntree.erl +++ b/src/gsc_ntree.erl @@ -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,16 +19,32 @@ %% 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(). %%===================================================== @@ -36,92 +52,40 @@ %%===================================================== --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}. -rl0(X = #ns{}) -> X; -rl0(X = #nl{}) -> X; -rl0(X) -> {nl, X}. + +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].