From 69a89cf78e3897f60412ed9431403d6e82eaf320 Mon Sep 17 00:00:00 2001 From: Peter Harpending Date: Thu, 2 Oct 2025 08:44:17 -0700 Subject: [PATCH] too fucking tired... going to bed --- src/wfc.erl | 102 ++++++++++++++++++++++++ src/wfc_eval.erl | 84 ++++++++++++++++++++ src/wfc_eval_context.erl | 41 ++++++++++ src/wfc_parse.erl | 4 + src/wfc_pp.erl | 50 ++++++++++++ src/wfc_read.erl | 167 +++++++++++++++++++++++++++++++++++++++ src/wfc_sentence.erl | 68 +++++++++++++++- src/wfc_word.erl | 14 +++- 8 files changed, 527 insertions(+), 3 deletions(-) create mode 100644 src/wfc_eval.erl create mode 100644 src/wfc_eval_context.erl create mode 100644 src/wfc_parse.erl create mode 100644 src/wfc_pp.erl create mode 100644 src/wfc_read.erl diff --git a/src/wfc.erl b/src/wfc.erl index 31bcc00..5fe80ef 100644 --- a/src/wfc.erl +++ b/src/wfc.erl @@ -7,8 +7,110 @@ ]). -export([ + test/0, + to_sentence/1, + rep/1, + reps/1, + reps/2, + add/1, + mul/1 ]). +test() -> + reptest("(*)"), + reptest("(+)"), + reptest("(+ a b)"), + reptest("(+ a b (* a b))"), + ok. + +reptest(S) -> + io:format("input: ~s~n", [S]), + rep(S), + io:format("~n", []). + -type sentence() :: wfc_sentence:sentence(). +-spec to_sentence(term()) -> {ok, sentence()} | {error, string()}. + +to_sentence(Ltr = {c, _}) -> wfc_sentence:from_ltr(Ltr); +to_sentence(Word = {w, _}) -> wfc_sentence:from_word(Word); +to_sentence({s, Words}) -> wfc_sentence:from_list(Words); +to_sentence(Bad) -> {error, wfc_utils:str("wfc:to_sentence: cannot coerce to sentence: ~p", [Bad])}. + + +-spec rep(string()) -> ok. +% @doc read/eval/print + +rep(String) -> + case wfc_read:expr(String) of + {ok, Expr, Rest} -> + case wfc_eval:eval(Expr) of + {ok, Result, NewContext} -> + io:format("result: ~s~n", [wfc_pp:eval_result(Result)]), + %io:format("context: ~tw~n", [NewContext]), + ok; + %{ok, Result, NewContext}; + {error, Msg} -> io:format("~s~n", [Msg]) + end, + io:format("rest: ~p~n", [Rest]); + {error, Message} -> + io:format("~s~n", [Message]) + end. + + +-spec reps(string()) -> ok. +% @doc read/eval/print loop + +reps(String) -> + reps(String, wfc_eval_context:default()). + +reps(String, Ctx) -> + %io:format("reps(~ts, ~tw)~n", [String, Ctx]), + case wfc_read:expr(String) of + {ok, Expr, Rest} -> + %io:format("{ok, ~tw, ~ts}~n", [Expr, Rest]), + case wfc_eval:eval(Expr, Ctx) of + {ok, Result, NewContext} -> + io:format("result: ~s~n", [wfc_pp:eval_result(Result)]), + io:format("context: ~tw~n", [NewContext]), + reps(Rest, NewContext); + {error, Msg} -> io:format("~s~n", [Msg]) + end, + io:format("rest: ~p~n~n", [Rest]); + {error, Message} -> + io:format("~s~n", [Message]) + end. + + + +-spec add([term()]) -> {ok, sentence()} | {error, string()}. + +add([Arg | Rest]) -> + case to_sentence(Arg) of + {ok, S} -> + case add(Rest) of + {ok, S2} -> + io:format("S2 = ~p~n", [S2]), + {ok, wfc_sentence:add(S, S2)}; + Error -> Error + end; + Error -> Error + end; +add([]) -> + {ok, wfc_sentence:zero()}. + + +-spec mul([term()]) -> {ok, sentence()} | {error, string()}. + +mul([Arg | Rest]) -> + case to_sentence(Arg) of + {ok, S} -> + case mul(Rest) of + {ok, S2} -> wfc_sentence:mul(S, S2); + Error -> Error + end; + Error -> Error + end; +mul([]) -> + wfc_sentence:zero(). diff --git a/src/wfc_eval.erl b/src/wfc_eval.erl new file mode 100644 index 0000000..7732dfe --- /dev/null +++ b/src/wfc_eval.erl @@ -0,0 +1,84 @@ +-module(wfc_eval). + +-export_type([ +]). + +-export([ + eval/1, eval/2 +]). + +-type context() :: wfc_eval_context:context(). +-type expr() :: wfc_read:expr(). +-type sentence() :: wfc_sentence:sentence(). +-type eval_result() :: noop | sentence(). + + +%-type op() :: {op, '+' | '*'}. +%-type val() :: {val, 0 | 1}. +%-type ltr() :: wfc_ltr:ltr(). +%-type snowflake() :: {snowflake, binary()}. +%-type pattern() :: {pattern, binary()}. +%-type sexp() :: {sexp, [expr()]}. +%-type expr() :: sexp() | ltr() | op() | snowflake() | pattern() | val(). + +-spec eval(expr()) -> {ok, eval_result(), context()} | {error, string()}. + +eval(Expr) -> + eval(Expr, wfc_eval_context:default()). + + +-spec eval(expr(), context()) -> {ok, eval_result(), context()} | {error, string()}. + +eval({sexp, Args}, Ctx) -> eval_sexp(Args, Ctx); +eval({val, 0}, Ctx) -> {ok, wfc_sentence:zero(), Ctx}; +eval({val, 1}, Ctx) -> {ok, wfc_sentence:one(), Ctx}; +eval({pattern, Pat}, Ctx) -> + case wfc_eval_context:resolve_pattern(Pat, Ctx) of + {ok, Sentence} -> {ok, Sentence, Ctx}; + Error -> Error + end; +eval(Ltr = {c, _}, Ctx) -> + case wfc:to_sentence(Ltr) of + {ok, S} -> {ok, S, Ctx}; + Error -> Error + end; +eval(Expr, _) -> {error, wfc_utils:str("wfc_eval:eval: cannot evaluate expression: ~p", [Expr])}. + + +eval_sexp(Args = [{snowflake, <<"define">>}, {pattern, Pat}, Expr], Ctx0) -> + case eval(Expr, Ctx0) of + {ok, noop, _} -> + {error, wfc_utils:str("wfc_eval:eval_sexp: define X Y: Y evaluated to noop: ~w", [Args])}; + {ok, Sentence, _} -> + case wfc_eval_context:define(Pat, Sentence, Ctx0) of + {ok, NewContext} -> {ok, noop, NewContext}; + Error -> Error + end; + Error -> + Error + end; +eval_sexp([{op, '+'} | Exprs], Ctx) -> + case eval_sexp_args(Exprs, Ctx, []) of + {ok, Sentences, NewCtx} -> {ok, wfc_sentence:add(Sentences), NewCtx}; + Error -> Error + end; +eval_sexp([{op, '*'} | Exprs], Ctx) -> + case eval_sexp_args(Exprs, Ctx, []) of + {ok, Sentences, NewCtx} -> {ok, wfc_sentence:mul(Sentences), NewCtx}; + Error -> Error + end; +eval_sexp(Args, Ctx) -> + {error, wfc_utils:str("wfc_eval:eval_sexp: bad sexp: Args=~tw; Ctx=~tw", [Args, Ctx])}. + + +eval_sexp_args(Exprs, Ctx0, Acc) -> + case Exprs of + [] -> {ok, lists:reverse(Acc), Ctx0}; + [E | Rest] -> + case eval(E, Ctx0) of + {ok, noop, Ctx1} -> eval_sexp_args(Rest, Ctx1, Acc); + {ok, S, Ctx1} -> eval_sexp_args(Rest, Ctx1, [S | Acc]); + Error -> + Error + end + end. diff --git a/src/wfc_eval_context.erl b/src/wfc_eval_context.erl new file mode 100644 index 0000000..6a87ec0 --- /dev/null +++ b/src/wfc_eval_context.erl @@ -0,0 +1,41 @@ +-module(wfc_eval_context). + +-export_type([ + context/0 +]). + +-export([ + new/0, + default/0, + define/3, + resolve_pattern/2 +]). + +-type sentence() :: wfc_sentence:sentence(). + +-record(ctx, + {snowflakes :: #{binary() := fun()}, + patterns :: #{binary() := sentence()}}). + +-opaque context() :: #ctx{}. + + +new() -> + #ctx{snowflakes = #{}, + patterns = #{}}. + + +%% FIXME +default() -> + new(). + + +define(Pat, Sentence, Ctx = #ctx{patterns = OldPatterns}) -> + NewPatterns = maps:put(Pat, Sentence, OldPatterns), + {ok, Ctx#ctx{patterns = NewPatterns}}. + +resolve_pattern(Pat, Ctx = #ctx{patterns = Patterns}) -> + case maps:find(Pat, Patterns) of + error -> {error, wfc_utils:str("wfc_eval_context:resolve_pattern: not found: ~w; context: ~w", [Pat, Ctx])}; + Result -> Result + end. diff --git a/src/wfc_parse.erl b/src/wfc_parse.erl new file mode 100644 index 0000000..5821c26 --- /dev/null +++ b/src/wfc_parse.erl @@ -0,0 +1,4 @@ +-module(wfc_parse). + +-export([ +]). diff --git a/src/wfc_pp.erl b/src/wfc_pp.erl new file mode 100644 index 0000000..dcc6535 --- /dev/null +++ b/src/wfc_pp.erl @@ -0,0 +1,50 @@ +-module(wfc_pp). + +-export([ + eval_result/1, + sentence/1, + word/1, + ltr/1 +]). + + +-spec eval_result(wfc_eval:eval_result()) -> string(). + +eval_result(noop) -> ""; +eval_result(S = {s, _}) -> sentence(S). + +-spec sentence(wfc_sentence:sentence()) -> string(). + +sentence({s, []}) -> + "(+)"; +sentence({s, Words}) -> + wfc_utils:str("(+ ~s)", [words(Words)]). + + +-spec words([wfc_word:word()]) -> iolist(). +% @private + +words([W]) -> word(W); +words([W | More]) -> [word(W), " ", words(More)]; +words([]) -> "". + + +-spec word(wfc_word:word()) -> string(). + +word({w, []}) -> + "(*)"; +word({w, Letters}) -> + wfc_utils:str("(* ~s)", [letters(Letters)]). + + +-spec letters([wfc_ltr:ltr()]) -> iolist(). +% @private + +letters([W]) -> ltr(W); +letters([W | More]) -> [ltr(W), " ", letters(More)]; +letters([]) -> "". + + +-spec ltr(wfc_ltr:ltr()) -> string(). + +ltr({c, Binary}) -> unicode:characters_to_list(Binary). diff --git a/src/wfc_read.erl b/src/wfc_read.erl new file mode 100644 index 0000000..01564f3 --- /dev/null +++ b/src/wfc_read.erl @@ -0,0 +1,167 @@ +-module(wfc_read). + +-export_type([ +]). + +-export([ + expr/1, + sexp/1, + ltr/1, + snowflake/1, + pattern/1, + val/1, + whitespace/1 +]). + +-type op() :: {op, '+' | '*'}. +-type val() :: {val, 0 | 1}. +-type ltr() :: wfc_ltr:ltr(). +-type snowflake() :: {snowflake, binary()}. +-type pattern() :: {pattern, binary()}. +-type sexp() :: {sexp, [expr()]}. +-type expr() :: sexp() | ltr() | op() | snowflake() | pattern() | val(). + + +-spec expr(string()) -> {ok, expr(), Rest :: string()} | {error, string()}. + +expr(Str0) -> + {ok, skip, Str1} = whitespace(Str0), + attempt([fun sexp/1, fun op/1, fun ltr/1, fun snowflake/1, fun pattern/1, fun val/1], Str1). + + +attempt([Fun | Rest], Str) -> + case Fun(Str) of + {error, _} -> attempt(Rest, Str); + Result -> Result + end; +attempt([], Bad) -> + {error, wfc_utils:str("wfc_read:attempt: invalid expression: ~p", [Bad])}. + + + +-spec sexp(string()) -> {ok, sexp(), Rest :: string()} | {error, string()}. + +sexp(Str0) -> + {ok, skip, Str1} = whitespace(Str0), + case sexp_open(Str1) of + {ok, round, Str2} -> sexp2(round, [], Str2); + Error -> Error + end. + + +sexp_open("[" ++ Rest) -> {ok, square, Rest}; +sexp_open("(" ++ Rest) -> {ok, round, Rest}; +sexp_open(Bad) -> {error, wfc_utils:str("wfc_read:sexp_open: invalid sexp: ~p", [Bad])}. + +sexp2(Shape, AccExprs, Str0) -> + {ok, skip, Str1} = whitespace(Str0), + case {Shape, attempt([fun expr/1, fun(S) -> sexp_close(Shape, S) end], Str1)} of + {round, {ok, round, Rem}} -> + {ok, {sexp, lists:reverse(AccExprs)}, Rem}; + {square, {ok, square, Rem}} -> + {ok, {sexp, lists:reverse(AccExprs)}, Rem}; + {round, {ok, square, Rem}} -> + {error, wfc_utils:str("wfc_read:sexp2: ( terminated by ]; parsed: ~p; rem: ~p", [lists:reverse(AccExprs), Rem])}; + {square, {ok, round, Rem}} -> + {error, wfc_utils:str("wfc_read:sexp2: [ terminated by ); parsed: ~p; rem: ~p", [lists:reverse(AccExprs), Rem])}; + {_, {ok, Expr, Rem}} -> + sexp2(Shape, [Expr | AccExprs], Rem); + {_, Error} -> + Error + end. + + +sexp_close(_, "]" ++ Rem) -> {ok, square, Rem}; +sexp_close(_, ")" ++ Rem) -> {ok, round, Rem}; +sexp_close(_, Bad) -> {error, wfc_utils:str("wfc_read:sexp_close: invalid closing bracket: ~p", [Bad])}. + + +-spec op(string()) -> {ok, op(), Rest :: string()} | {error, string()}. + +op("*" ++ Rest) -> {ok, {op, '*'}, Rest}; +op("+" ++ Rest) -> {ok, {op, '+'}, Rest}; +op(Invalid) -> {error, wfc_utils:str("wfc_read:op: invalid op: ~p", [Invalid])}. + + +-spec ltr(string()) -> {ok, ltr(), Rest :: string()} | {error, string()}. + +%% @doc read a 'letter': a sequence of +ltr(Str) -> + case ltr_init(Str) of + {ok, InitLetter, Rest} -> ltr_guts(<>, Rest); + Error -> Error + end. + +ltr_init([Char | Rest]) when $a =< Char, Char =< $z -> + {ok, Char, Rest}; +ltr_init(Ltr) -> + {error, wfc_utils:str("wfc_read:ltr_init: bad letter: ~p", [Ltr])}. + +ltr_guts(Acc, Rest) -> + case Rest of + %% valid character, consume + [L | Rest2] when ($A =< L andalso L =< $Z) + orelse ($a =< L andalso L =< $z) + orelse ($0 =< L andalso L =< $9) + orelse (L =:= $_) -> + ltr_guts(<>, Rest2); + %% nope, terminate + _ -> + case wfc_ltr:from_binary(Acc) of + {ok, Ltr} -> {ok, Ltr, Rest}; + Error -> Error + end + end. + + +-spec whitespace(string()) -> {ok, skip, string()}. +% @doc consumes space characters + +whitespace(" " ++ Rest) -> whitespace(Rest); +whitespace(Done) -> {ok, skip, Done}. + + +-spec snowflake(string()) -> {ok, snowflake(), string()} | {error, string()}. +% @doc A snowflake expr is ~ltr where ltr is a letter + +snowflake("~" ++ Str1) -> + case ltr(Str1) of + {ok, {c, Binary}, Str2} -> + {ok, {snowflake, Binary}, Str2}; + {error, BadLetter} -> + {error, wfc_utils:str("wfc_read:snowflake: error parsing \~snowflake: ~p", [BadLetter])} + end; +snowflake(S) -> + {error, wfc_utils:str("wfc_read:snowflake: bad snowflake: ~p", [S])}. + + +-spec pattern(string()) -> {ok, pattern(), string()} | {error, string()}. + +pattern([L | Rest]) when $A =< L, L =< $Z -> + pattern(<>, Rest); +pattern(Bad) -> + {error, wfc_utils:str("wfc_read:pattern: bad pattern: ~p", [Bad])}. + +pattern(Acc, [L | Rest]) when ($A =< L andalso L =< $Z) + orelse ($a =< L andalso L =< $z) + orelse ($0 =< L andalso L =< $9) + orelse (L =:= $_) -> + pattern(<>, Rest); +pattern(Acc, Rest) -> + {ok, {pattern, Acc}, Rest}. + + +-spec val(string()) -> {ok, val(), string()} | {error, string()}. + +val("0" ++ Rest) -> {ok, {val, 0}, Rest}; +val("1" ++ Rest) -> {ok, {val, 1}, Rest}; +val(X) -> {error, wfc_utils:str("wfc_read:val: bad val: ~tw", [X])}. + +% +%snowflake(Str0 = "~" ++ Str1) -> +% case ltr(Str1) of +% {ok, Ltr, Str2} -> +% {ok, {snowflake, Ltr}, Str2}; +% {error, BadLetter} -> +% {error, wfc_utils:str("wfc_read:snowflake: error parsing \~snowflake: ~p", [BadLetter])} +% end. diff --git a/src/wfc_sentence.erl b/src/wfc_sentence.erl index 3587edd..6422468 100644 --- a/src/wfc_sentence.erl +++ b/src/wfc_sentence.erl @@ -13,11 +13,14 @@ -export([ %% constructors - zero/0, + zero/0, one/0, validate/1, from_list/1, to_list/1, %% ops - add/2, add/1 + add/2, add/1, + mul/2, mul_wxs/2, mul/1, + %%% from_ + from_ltr/1, from_word/1 ]). -opaque sentence() :: {s, ordsets:ordset(wfc_word:word())}. @@ -27,11 +30,21 @@ %%-------------------------- -spec zero() -> sentence(). +% @doc the 0-sentence is the empty sentence zero() -> {s, []}. + +-spec one() -> sentence(). +% @doc the 1-sentence is the sentence that contains only the 1-word + +one() -> + {s, [wfc_word:one()]}. + + + -spec from_list(Words) -> Result when Words :: [wfc_word:word()], Result :: {ok, sentence()} @@ -91,3 +104,54 @@ symdiff(X, Y) -> add([S | Rest]) -> add(S, add(Rest)); add([]) -> zero(). + + +%%--------------------------- +%% spec ops +%%--------------------------- + +-spec mul(sentence(), sentence()) -> sentence(). + +mul({s, [W | Rest]}, S) -> + %% (W + Rest) * S = W*S + Rest*S + add(mul_wxs(W, S), + mul({s, Rest}, S)); +mul({s, []}, _) -> + %% first arg 0 = result 0 + zero(). + + +-spec mul([sentence()]) -> sentence(). +% @doc +% multiply a list of sentences together; mul([]) = {s, {w, []}} + +mul([S | Rest]) -> mul(S, mul(Rest)); +mul([]) -> one(). + +-spec mul_wxs(wfc_word:word(), sentence()) -> sentence(). + +mul_wxs(W, {s, [X | Rest]}) -> + % W * (X + Rest) = W*X + W*Rest + add({s, [wfc_word:mul(W, X)]}, + mul_wxs(W, {s, Rest})); +mul_wxs(_, {s, []}) -> + zero(). + + +%%--------------------------- +%% from_ +%%--------------------------- + +-spec from_ltr(term()) -> {ok, sentence()} | {error, string()}. + +from_ltr(Ltr) -> + case wfc_word:from_ltr(Ltr) of + {ok, Word} -> from_word(Word); + Error -> Error + end. + + +-spec from_word(term()) -> {ok, sentence()} | {error, string()}. + +from_word(Word) -> + from_list([Word]). diff --git a/src/wfc_word.erl b/src/wfc_word.erl index b7b3e7c..8ffc6e5 100644 --- a/src/wfc_word.erl +++ b/src/wfc_word.erl @@ -24,7 +24,9 @@ validate/1, from_list/1, to_list/1, %% ops - mul/2, mul/1 + mul/2, mul/1, + %% from_ + from_ltr/1 ]). -opaque word() :: {w, ordsets:ordset(wfc_ltr:ltr())}. @@ -108,3 +110,13 @@ mul({w, X}, {w, Y}) -> mul([Word | Rest]) -> mul(Word, mul(Rest)); mul([]) -> one(). + + +%%----------------------------- +%% from_ +%%----------------------------- + +-spec from_ltr(term()) -> {ok, word()} | {error, string()}. + +from_ltr(Ltr) -> + from_list([Ltr]).