caching works correctly

src/fd_cache.erl

@@ -0,0 +1,120 @@
+% @doc storing map #{cookie := Context}
+-module(fd_cache).
+
+-behavior(gen_server).
+
+-export([
+    start_link/0,
+    query/1, set/2, unset/1,
+    %%---
+    %% everything below here runs in process context
+    %%--
+    %% gen_server callbacks
+    init/1, handle_call/3, handle_cast/2, handle_info/2,
+    code_change/3, terminate/2
+]).
+
+-include("$zx_include/zx_logger.hrl").
+
+-type context() :: wfc_eval_context:context().
+
+-record(s,
+        {cookies = #{} :: #{Cookie :: binary() := context()}}).
+% -type state() :: #s{}.
+
+
+%%--------------------------------
+%% api (runs in context of caller)
+%%--------------------------------
+
+-spec start_link() -> {ok, pid()} | {error, term()}.
+start_link() ->
+    gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
+
+
+
+-spec query(Cookie) -> {ok, Context} | error
+    when Cookie  :: binary(),
+         Context :: context().
+
+query(Cookie) ->
+    gen_server:call(?MODULE, {query, Cookie}).
+
+
+
+-spec set(Cookie, Context) -> ok
+    when Cookie  :: binary(),
+         Context :: context().
+
+set(Cookie, Context) ->
+    gen_server:cast(?MODULE, {set, Cookie, Context}).
+
+
+-spec unset(Cookie) -> ok
+    when Cookie  :: binary().
+
+unset(Cookie) ->
+    gen_server:cast(?MODULE, {unset, Cookie}).
+
+
+%%----------------------
+%% gen-server bs
+%%----------------------
+
+
+
+init(none) ->
+    log(info, "starting fd_cache"),
+    InitState = #s{},
+    {ok, InitState}.
+
+
+handle_call({query, Cookie}, _, State) ->
+    Result = do_query(Cookie, State),
+    {reply, Result, State};
+handle_call(Unexpected, From, State) ->
+    tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
+    {noreply, State}.
+
+
+handle_cast({set, Cookie, Context}, State) ->
+    NewState = do_set(Cookie, Context, State),
+    {noreply, NewState};
+handle_cast({unset, Cookie}, State) ->
+    NewState = do_unset(Cookie, State),
+    {noreply, NewState};
+handle_cast(Unexpected, State) ->
+    tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
+    {noreply, State}.
+
+
+handle_info(Unexpected, State) ->
+    tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
+    {noreply, State}.
+
+
+code_change(_, State, _) ->
+    {ok, State}.
+
+terminate(_, _) ->
+    ok.
+
+
+%%---------------------
+%% doers
+%%---------------------
+
+do_set(Cookie, Context, State = #s{cookies = Cookies}) ->
+    NewCookies = maps:put(Cookie, Context, Cookies),
+    NewState   = State#s{cookies = NewCookies},
+    NewState.
+
+
+do_unset(Cookie, State = #s{cookies = Cookies}) ->
+    NewCookies = maps:remove(Cookie, Cookies),
+    NewState   = State#s{cookies = NewCookies},
+    NewState.
+
+
+do_query(Cookie, _State = #s{cookies = Cookies}) ->
+    maps:find(Cookie, Cookies).

src/fd_client.erl

@@ -263,34 +263,52 @@ default_css(Sock) ->
             http_err(Sock, 500)
     end.
 
-wfcin(Sock, #request{enctype = json, body = #{"wfcin" := Input}}) ->
+wfcin(Sock, #request{enctype = json,
+                     cookies = Cookies,
+                     body = #{"wfcin" := Input}}) ->
     tell("wfcin good request: ~tp", [Input]),
-    RespObj =
+    {Cookie, Ctx0} = ctx(Cookies),
+    {RespObj, NewCtx} =
+        %% FIXME: this should really be a new process
         try
             case wfc_read:expr(Input) of
-                %% FIXME support multiple expressions
                 {ok, Expr, _Rest} ->
-                    case wfc_eval:eval(Expr, wfc_eval_context:default()) of
-                        {ok, noop, _NewContext}     -> jsgud("<noop>");
-                        {ok, Sentence, _NewContext} -> jsgud(wfc_pp:sentence(Sentence));
-                        {error, Message}            -> jsbad(Message)
+                    case wfc_eval:eval(Expr, Ctx0) of
+                        {ok, noop, Ctx1}     -> {jsgud("<noop>"), Ctx1};
+                        {ok, Sentence, Ctx1} -> {jsgud(wfc_pp:sentence(Sentence)), Ctx1};
+                        {error, Message}     -> {jsbad(Message), Ctx0}
                     end;
                 {error, Message} ->
-                    jsbad(Message)
+                    {jsbad(Message), Ctx0}
             end
         catch
             error:E:S ->
                 ErrorMessage = unicode:characters_to_list(io_lib:format("parser crashed: ~p:~p", [E, S])),
-                jsbad(ErrorMessage)
+                {jsbad(ErrorMessage), Ctx0}
         end,
+    % update cache with new context
+    ok = fd_cache:set(Cookie, NewCtx),
     Body    = zj:encode(RespObj),
-    Response = #response{headers = [{"content-type", "application/json"}],
+    Response = #response{headers = [{"content-type", "application/json"},
+                                    {"set-cookie",   ["wfc=", Cookie]}],
                          body    = Body},
     respond(Sock, Response);
 wfcin(Sock, Request) ->
     tell("wfcin: bad request: ~tp", [Request]),
     http_err(Sock, 400).
 
+
+ctx(#{<<"wfc">> := Cookie}) ->
+    case fd_cache:query(Cookie) of
+        {ok, Context} -> {Cookie, Context};
+        error         -> {Cookie, wfc_eval_context:default()}
+    end;
+ctx(_) ->
+    {new_cookie(), wfc_eval_context:default()}.
+
+new_cookie() ->
+    binary:encode_hex(crypto:strong_rand_bytes(8)).
+
 jsgud(X) ->
     #{"ok"     => true,
       "result" => X}.

src/fd_sup.erl

@@ -42,5 +42,11 @@ init([]) ->
                  5000,
                  supervisor,
                  [fd_clients]},
-    Children  = [Clients],
+    Cache     = {fd_cache,
+                 {fd_cache, start_link, []},
+                 permanent,
+                 5000,
+                 worker,
+                 [fd_cache]},
+    Children  = [Clients, Cache],
     {ok, {RestartStrategy, Children}}.

src/wfc.erl

@@ -13,7 +13,8 @@
     reps/1,
     reps/2,
     add/1,
-    mul/1
+    mul/1,
+    zero/0, one/0
 ]).
 
 
@@ -114,3 +115,7 @@ mul([Arg | Rest]) ->
     end;
 mul([]) ->
     {ok, wfc_sentence:one()}.
+
+
+zero() -> wfc_sentence:zero().
+one() -> wfc_sentence:one().

src/wfc_bm.erl

@@ -27,6 +27,7 @@
     blocks/1,
     %% fancier constructors
     from_list/1, bmt/1,
+    row/1, col/1,
     %% useful operations
     transpose/1, from_bitfun/2,
     to_list/1
@@ -117,7 +118,7 @@ rth(RowIdx1, {bm, _Shape = {rc, NR, NC}, Bits})
     RowIdx0        = RowIdx1 - 1,
     RowLength      = NC,
     SkipToGetToRow = RowIdx0 * RowLength,
-    <<_:SkipToGetToRow, RowBits:RowLength, _/bits>> = Bits,
+    <<_:SkipToGetToRow, RowBits:RowLength/bits, _/bits>> = Bits,
     {bm, NewShape, RowBits}.
 
 
@@ -213,11 +214,12 @@ mulfold({rc, R, C}, Shape, AccBits, M1, M2) ->
 dot({bm, {rc, 1, Same}, Bits1}, {bm, {rc, Same, 1}, Bits2}) ->
     <<Int1:Same>> = Bits1,
     <<Int2:Same>> = Bits2,
-    SummandBits   = Int1 band Int2,
+    SummandInt    = Int1 band Int2,
+    SummandBits   = <<SummandInt:Same>>,
     parity(SummandBits).
 
 
--spec mand(bitstring(), bitstring()) -> bitstring().
+-spec mand(bm(), bm()) -> bm().
 % @doc bitwise-and two matrices of the same shape
 
 mand({bm, Shape, Bits1}, {bm, Shape, Bits2}) ->
@@ -322,6 +324,18 @@ bitsy([Bit | Rest], Acc)    -> bitsy(Rest, <<Acc/bits, Bit:1>>);
 bitsy([],           Result) -> Result.
 
 
+-spec row([bit()]) -> bm().
+
+row(Row) ->
+    from_list([Row]).
+
+
+-spec col([bit()]) -> bm().
+
+col(Col) ->
+    transpose(row(Col)).
+
+
 -spec bmt(Arity :: pos_integer()) -> bm().
 % @doc Boole-Mobius transform
 %
@@ -329,8 +343,8 @@ bitsy([],           Result) -> Result.
 
 bmt(N) when N > 0 ->
     %% this might be backwards...
-    blocks([[bmt(N-1), bmt(N-1)],
-            [ztn(N-1), bmt(N-1)]]);
+    blocks([[bmt(N-1), ztn(N-1)],
+            [bmt(N-1), bmt(N-1)]]);
 bmt(0) ->
     from_list([[1]]).
 

src/wfc_eval.erl

@@ -59,6 +59,11 @@ eval_sexp(Args = [{snowflake, <<"define">>}, {pattern, Pat}, Expr], Ctx0) ->
         Error ->
             Error
     end;
+eval_sexp(_Args = [{snowflake, <<"undefine">>}, {pattern, Pat}], Ctx0) ->
+    case wfc_eval_context:undefine(Pat, Ctx0) of
+        {ok, NewContext} -> {ok, noop, NewContext};
+        Error            -> Error
+    end;
 eval_sexp([{snowflake, SF} | Args], Ctx0) ->
     % first evaluate the arguments individually
     case eval_sexp_args(Args, Ctx0, []) of

src/wfc_eval_context.erl

@@ -9,6 +9,7 @@
     default/0,
     default_snowflakes/0,
     define/3,
+    undefine/2,
     resolve_pattern/2,
     resolve_snowflake/2
 ]).
@@ -32,20 +33,80 @@ default() ->
 
 default_snowflakes() ->
     #{<<"and">>     => fun wfc:mul/1,
-      <<"xor">>     => fun wfc:add/1}.
+      <<"xor">>     => fun wfc:add/1,
+      <<"implies">> => fun snf_implies/1,
+      <<"ior">> =>
+            fun IOR([S1 | Rest]) ->
+                    case IOR(Rest) of
+                        {ok, S2} -> {ok, sf_ior(S1, S2)};
+                        Error    -> Error
+                    end;
+                IOR([]) ->
+                    {ok, wfc:one()}
+            end,
+      <<"not">> =>
+            fun ([S]) -> {ok, sf_not(S)};
+                (Bad) -> {error, wfc_utils:str("not/1: wrong number of arguments: ~p", [Bad])}
+            end,
+      <<"impliedby">> =>
+            fun ([A, B]) -> {ok, sf_impliedby(A, B)};
+                (Bad)    -> {error, wfc_utils:str("impliedby/2: wrong number of arguments: ~p", [Bad])}
+            end,
+      <<"iff">> =>
+            fun ([A, B]) -> {ok, sf_iff(A, B)};
+                (Bad)    -> {error, wfc_utils:str("iff/2: wrong number of arguments: ~p", [Bad])}
+            end
+     }.
+
+snf_implies([A, B]) -> {ok, sf_implies(A, B)};
+snf_implies(Bad)    -> {error, wfc_utils:str("implies/2: wrong number of arguments: ~p", [Bad])}.
+
+
+sf_ior(A, B) ->
+    wfc_sftt:appl_ttf(fun ttf_ior/2, [A, B]).
+
+sf_not(A) ->
+    {ok, Result} = wfc:add([wfc_sentence:one(), A]),
+    Result.
+
+sf_implies(A, B) ->
+    wfc_sftt:appl_ttf(fun ttf_implies/2, [A, B]).
+
+sf_impliedby(A, B) ->
+    sf_implies(B, A).
+
+sf_iff(A, B) ->
+    {ok, Result} = wfc:mul([sf_implies(A, B), sf_impliedby(A, B)]),
+    Result.
+
+ttf_ior(0, 0) -> 0;
+ttf_ior(1, 0) -> 1;
+ttf_ior(0, 1) -> 1;
+ttf_ior(1, 1) -> 1.
+
+ttf_implies(0, 0) -> 1;
+ttf_implies(1, 0) -> 0;
+ttf_implies(0, 1) -> 1;
+ttf_implies(1, 1) -> 1.
+
+
 
 define(Pat, Sentence, Ctx = #ctx{patterns = OldPatterns}) ->
     NewPatterns = maps:put(Pat, Sentence, OldPatterns),
     {ok, Ctx#ctx{patterns = NewPatterns}}.
 
+undefine(Pat, Ctx = #ctx{patterns = OldPatterns}) ->
+    NewPatterns = maps:remove(Pat, 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])};
+        error -> {error, wfc_utils:str("wfc_eval_context:resolve_pattern: not found: ~s; context: ~w", [Pat, Ctx])};
         Result -> Result
     end.
 
 resolve_snowflake(SF, Ctx = #ctx{snowflakes = Snowflakes}) ->
     case maps:find(SF, Snowflakes) of
-        error -> {error, wfc_utils:str("wfc_eval_context:resolve_snowflake: not found: ~w; context: ~w", [SF, Ctx])};
+        error -> {error, wfc_utils:str("wfc_eval_context:resolve_snowflake: not found: ~s; context: ~w", [SF, Ctx])};
         Result -> Result
     end.

src/wfc_sftt.erl

@@ -0,0 +1,173 @@
+% @doc
+% sentence-fun <-> truth table logic
+-module(wfc_sftt).
+
+-export_type([
+    sf/0, tt/0
+]).
+
+-export([
+    ttfun_to_tt/1,
+    ttfun_to_sf/1,
+    arity/1,
+    tt/1, sf/1,
+    sf_to_tt/1, tt_to_sf/1,
+    appl_ttf/2, appl/2,
+    bfls/1,
+    bfl/2
+]).
+
+-type bit() :: 0 | 1.
+-opaque sf() :: {sf, wfc_bm:bm()}.
+-opaque tt() :: {tt, wfc_bm:bm()}.
+
+-spec ttfun_to_tt(fun()) -> tt().
+
+ttfun_to_tt(Fun) ->
+    {arity, Arity} = erlang:fun_info(Fun, arity),
+    Argses = bfls(Arity),
+    OutputCol = [erlang:apply(Fun, Args) || Args <- Argses],
+    {tt, wfc_bm:col(OutputCol)}.
+
+
+-spec ttfun_to_sf(fun()) -> sf().
+
+ttfun_to_sf(Fun) ->
+    tt_to_sf(ttfun_to_tt(Fun)).
+
+
+-spec arity(sf() | tt()) -> pos_integer().
+
+arity({sf, BM}) -> matrix_arity(BM);
+arity({tt, BM}) -> matrix_arity(BM).
+
+matrix_arity(Matrix) ->
+    {rc, Height, _} = wfc_bm:shape(Matrix),
+    log2(Height).
+
+log2(N) when N > 1 ->
+    1 + log2(N div 2);
+log2(1) ->
+    0.
+
+
+-spec sf_to_tt(sf()) -> tt().
+sf_to_tt({sf, SFBM}) ->
+    {tt, apply_bmt(SFBM)}.
+
+
+-spec tt_to_sf(tt()) -> sf().
+tt_to_sf({tt, SFBM}) ->
+    {sf, apply_bmt(SFBM)}.
+
+
+apply_bmt(Matrix) ->
+    BMT = wfc_bm:bmt(matrix_arity(Matrix)),
+    wfc_bm:mul(BMT, Matrix).
+
+
+tt(List) ->
+    {tt, wfc_bm:col(List)}.
+
+sf(List) ->
+    {sf, wfc_bm:col(List)}.
+
+
+-spec appl_ttf(fun(), [wfc:sentence()]) -> wfc:sentence().
+
+appl_ttf(Fun, Sentences) ->
+    SF = ttfun_to_sf(Fun),
+    appl(SF, Sentences).
+
+
+-spec appl(sf() | tt(), [wfc:sentence()]) -> wfc:sentence().
+
+appl(TT = {tt, _}, Sentences) ->
+    appl(tt_to_sf(TT), Sentences);
+appl(SF = {sf, SFBM}, Sentences) ->
+    Arity = arity(SF),
+    Arity = length(Sentences),
+    % [0, 0, 0], [1, 0, 0], ...
+    BitFlagLists = bfls(Arity),
+    io:format("bfls: ~p~n", [BitFlagLists]),
+    % an SFBM is a Nx1 matrix where N = two_to_the(Arity)
+    % hacky but works
+    [Row] = wfc_bm:to_list(wfc_bm:transpose(SFBM)),
+    io:format("row: ~p~n", [Row]),
+    % filter by whether or not we're including
+    Included = filter_included(BitFlagLists, Row),
+    io:format("included: ~p~n", [Included]),
+    AlmostSummands = inseminate(Included, Sentences),
+    io:format("Almost: ~p~n", [AlmostSummands]),
+    collapse(AlmostSummands).
+
+
+filter_included([_ | Rest], [0 | Rest2]) ->
+    filter_included(Rest, Rest2);
+filter_included([Item | Rest], [1 | Rest2]) ->
+    [Item | filter_included(Rest, Rest2)];
+filter_included([], []) ->
+    [].
+
+
+-spec collapse([[wfc:sentence()]]) -> wfc:sentence().
+
+collapse(AlmostSummands) ->
+    Summands = lists:map(fun(Args) -> {ok,X} = wfc:mul(Args), X end, AlmostSummands),
+    {ok, Y} = wfc:add(Summands),
+    Y.
+
+
+-spec inseminate(BFLs :: [[bit()]], Sentences :: [wfc:sentence()]) -> [[wfc:sentence()]].
+
+inseminate(BFLs, Sentences) ->
+    lists:map(fun(BFL) -> inseminate2(BFL, Sentences) end, BFLs).
+
+
+-spec inseminate2(BFL :: [bit()], Sentences :: [wfc:sentence()]) -> [wfc:sentence()].
+inseminate2(BFL, Sentences) ->
+    lists:zipwith(fun pair/2, BFL, Sentences).
+
+pair(0, _) -> wfc_sentence:one();
+pair(1, S) -> S.
+
+
+-spec bfls(Arity :: non_neg_integer()) -> [[bit()]].
+% @doc get all bit-flag lists for 0..(2^Arity - 1)
+
+bfls(Arity) when Arity >= 0 ->
+    [bfl(Arity, N) || N <- lists:seq(0, two_to_the(Arity) - 1)].
+
+two_to_the(N) ->
+    1 bsl N.
+
+
+-spec bfl(Length :: pos_integer(), N :: non_neg_integer()) -> [bit()].
+% @doc
+% get the little-endian representation of N as binary, as a
+% list of bits.
+
+bfl(Length, N) when Length > 0, N >= 0 ->
+    %% hacky but logically straightforward
+    bfl2(Length, lists:reverse(integer_to_list(N, 2))).
+
+%% we're chopping digits off the end here
+bfl2(Length, Bits_Str) when Length =< length(Bits_Str) ->
+    bfl3(take(Length, Bits_Str));
+bfl2(Length, Bits_Str) when Length > length(Bits_Str) ->
+    % make more zeros than needed because about to circumcise
+    % them.
+    Zeros = [$0 || _ <- lists:seq(1, Length)],
+    bfl2(Length, Bits_Str ++ Zeros).
+
+
+take(0, _) ->
+    [];
+take(N, [Item | Rest]) when N >= 1 ->
+    [Item | take(N-1, Rest)].
+
+bfl3(BitsText) ->
+   lists:map(fun unfuck_char/1, BitsText).
+
+unfuck_char($0) -> 0;
+unfuck_char($1) -> 1.

src/wfc_ttfuns.erl

@@ -1,6 +1,6 @@
 % @doc
 % library of truth tables
--module(wfc_tts).
+-module(wfc_ttfuns).
 
 -export_type([
     bit/0,
@@ -24,8 +24,8 @@
 ]).
 
 -type bit() :: 0 | 1.
--type tt1() :: fun(( bit() ) -> bit() ).
--type tt2() :: fun(( bit() ) -> bit)( ).
+-type tt1() :: fun( (bit())        -> bit() ).
+-type tt2() :: fun( (bit(), bit()) -> bit() ).
 
 %% convert truth tables to fixed-arity sentence-functions
 %% easiest approach is to use boole-mobius transform