Merge pull request #17 from phonohawk/master

Support Erlang/OTP R17B and later

.gitignore

@@ -0,0 +1,3 @@
+.eunit
+.rebar
+ebin

README.md

@@ -195,14 +195,23 @@ you're just defining another list element.
 #### Records
 
     -record(vector, { x, y, z }).
-    
+
     test() ->
         GetZ = _#vector.z,
         7 = GetZ(#vector { z = 7 }),
         SetX = _#vector{x = _},
         V = #vector{ x = 5, y = 4 } = SetX(#vector{ y = 4 }, 5).
 
 
+#### Maps
+
+    test() ->
+        GetZ = maps:get(z, _),
+        7    = GetZ(#{ z => 7 }),
+        SetX = _#{x => _},
+        V    = #{ x := 5, y := 4 } = SetX(#{ y => 4 }, 5).
+
+
 #### Case
 
     F = case _ of

src/cut.erl

@@ -96,6 +96,10 @@ pattern({cons,Line,H0,T0}) ->
 pattern({tuple,Line,Ps0}) ->
     Ps1 = pattern_list(Ps0),
     {tuple,Line,Ps1};
+%% OTP 17.0: EEP 443: Map pattern
+pattern({map, Line, Fields0}) ->
+    Fields1 = map_fields(Fields0),
+    {map, Line, Fields1};
 %%pattern({struct,Line,Tag,Ps0}) ->
 %%    Ps1 = pattern_list(Ps0),
 %%    {struct,Line,Tag,Ps1};
@@ -234,6 +238,27 @@ expr({tuple, Line, Es0}) ->
             {'fun', Line, {clauses, [{clause, Line, Pattern, [],
                                       [{tuple, Line, Es2}]}]}}
     end;
+%% OTP 17.0: EEP 443: Map construction
+expr({map, Line, Fields0}) ->
+    Fields1 = map_fields(Fields0),
+    case find_map_cut_vars(Fields1) of
+        {[],     _Fields2} ->
+            {map, Line, Fields1};
+        {Pattern, Fields2} ->
+            {'fun', Line, {clauses, [{clause, Line, Pattern, [],
+                                      [{map, Line, Fields2}]}]}}
+    end;
+%% OTP 17.0: EEP 443: Map update
+expr({map, Line, Expr0, Fields0}) ->
+    Expr1   = expr(Expr0),
+    Fields1 = map_fields(Fields0),
+    case {find_cut_vars([Expr1]), find_map_cut_vars(Fields1)} of
+        {{[], _Expr2}, {[], _Fields2}} ->
+            {map, Line, Expr1, Fields1};
+        {{Pattern1, [Expr2]}, {Pattern2, Fields2}} ->
+            {'fun', Line, {clauses, [{clause, Line, Pattern1++Pattern2, [],
+                                      [{map, Line, Expr2, Fields2}]}]}}
+    end;
 %%expr({struct,Line,Tag,Es0}) ->
 %%    Es1 = pattern_list(Es0),
 %%    {struct,Line,Tag,Es1};
@@ -328,6 +353,10 @@ expr({'fun', Line, Body}) ->
         {function, M, F, A} -> %% R10B-6: fun M:F/A.
             {'fun', Line, {function, M, F, A}}
     end;
+%% OTP 17.0: EEP 37: Funs with names
+expr({named_fun, Line, Name, Cs0}) ->
+    Cs1 = fun_clauses(Cs0),
+    {named_fun, Line, Name, Cs1};
 expr({call, Line, F0, As0}) ->
     %% N.B. If F an atom then call to local function or BIF, if F a
     %% remote structure (see below) then call to other module,
@@ -404,6 +433,17 @@ expr_list([E0|Es]) ->
     [E1|expr_list(Es)];
 expr_list([]) -> [].
 
+%% -type map_fields([MapField]) -> [MapField].
+map_fields([{map_field_assoc, Line, ExpK0, ExpV0}|Fs]) ->
+    ExpK1 = expr(ExpK0),
+    ExpV1 = expr(ExpV0),
+    [{map_field_assoc, Line, ExpK1, ExpV1}|map_fields(Fs)];
+map_fields([{map_field_exact, Line, ExpK0, ExpV0}|Fs]) ->
+    ExpK1 = expr(ExpK0),
+    ExpV1 = expr(ExpV0),
+    [{map_field_exact, Line, ExpK1, ExpV1}|map_fields(Fs)];
+map_fields([]) -> [].
+
 %% -type record_inits([RecordInit]) -> [RecordInit].
 %%  N.B. Field names are full expressions here but only atoms are allowed
 %%  by the *linter*!.
@@ -478,6 +518,27 @@ find_binary_cut_vars(BinFields) ->
       end,
       BinFields).
 
+find_map_cut_vars(MapFields) ->
+    cut_vars(
+      fun ({map_field_assoc, _Line, {var, _Line1, '_'} = ExpK, {var, _Line2, '_'} = ExpV}) -> [ExpK, ExpV];
+          ({map_field_assoc, _Line, {var, _Line1, '_'} = ExpK,                     _ExpV}) -> [ExpK];
+          ({map_field_assoc, _Line,                     _ExpK, {var, _Line1, '_'} = ExpV}) -> [ExpV];
+          ({map_field_assoc, _Line,                     _ExpK,                     _ExpV}) -> [];
+          ({map_field_exact, _Line, {var, _Line1, '_'} = ExpK, {var, _Line2, '_'} = ExpV}) -> [ExpK, ExpV];
+          ({map_field_exact, _Line, {var, _Line1, '_'} = ExpK,                     _ExpV}) -> [ExpK];
+          ({map_field_exact, _Line,                     _ExpK, {var, _Line1, '_'} = ExpV}) -> [ExpV];
+          ({map_field_exact, _Line,                     _ExpK,                     _ExpV}) -> [];
+          (_)                                                                              -> []
+      end,
+      fun ({map_field_assoc, Line, _ExpK             , _ExpV             }, [ExpK, ExpV]) -> {map_field_assoc, Line, ExpK, ExpV};
+          ({map_field_assoc, Line, {var, _Line1, '_'},  ExpV             }, [ExpK]      ) -> {map_field_assoc, Line, ExpK, ExpV};
+          ({map_field_assoc, Line, ExpK              , {var, _Line2, '_'}}, [ExpV]      ) -> {map_field_assoc, Line, ExpK, ExpV};
+          ({map_field_exact, Line, _ExpK             , _ExpV             }, [ExpK, ExpV]) -> {map_field_assoc, Line, ExpK, ExpV};
+          ({map_field_exact, Line, {var, _Line1, '_'},  ExpV             }, [ExpK]      ) -> {map_field_assoc, Line, ExpK, ExpV};
+          ({map_field_exact, Line, ExpK              , {var, _Line2, '_'}}, [ExpV]      ) -> {map_field_assoc, Line, ExpK, ExpV}
+      end,
+      MapFields).
+
 find_record_cut_vars(RecFields) ->
     cut_vars(
       fun ({record_field, _Line, _FName, {var, _Line1, '_'} = Var}) -> [Var];

src/do.erl

@@ -95,6 +95,10 @@ pattern({cons,Line,H0,T0}) ->
 pattern({tuple,Line,Ps0}) ->
     Ps1 = pattern_list(Ps0),
     {tuple,Line,Ps1};
+%% OTP 17.0: EEP 443: Map pattern
+pattern({map, Line, Fields0}) ->
+    Fields1 = map_fields(Fields0, []),
+    {map, Line, Fields1};
 %%pattern({struct,Line,Tag,Ps0}) ->
 %%    Ps1 = pattern_list(Ps0),
 %%    {struct,Line,Tag,Ps1};
@@ -201,6 +205,15 @@ expr({bc, Line, E0, Qs0}, MonadStack) ->
 expr({tuple, Line, Es0}, MonadStack) ->
     Es1 = expr_list(Es0, MonadStack),
     {tuple, Line, Es1};
+%% OTP 17.0: EEP 443: Map construction
+expr({map, Line, Fields0}, MonadStack) ->
+    Fields1 = map_fields(Fields0, MonadStack),
+    {map, Line, Fields1};
+%% OTP 17.0: EEP 443: Map update
+expr({map, Line, Expr0, Fields0}, MonadStack) ->
+    Expr1 = expr(Expr0, MonadStack),
+    Fields1 = map_fields(Fields0, MonadStack),
+    {map, Line, Expr1, Fields1};
 expr({record_index, Line, Name, Field0}, MonadStack) ->
     Field1 = expr(Field0, MonadStack),
     {record_index, Line, Name, Field1};
@@ -254,6 +267,10 @@ expr({'fun', Line, Body}, MonadStack) ->
         {function, M, F, A} -> %% R10B-6: fun M:F/A.
             {'fun', Line, {function, M, F, A}}
     end;
+%% OTP 17.0: EEP 37: Funs with names
+expr({named_fun, Line, Name, Cs0}, MonadStack) ->
+    Cs1 = fun_clauses(Cs0, MonadStack),
+    {named_fun, Line, Name, Cs1};
 %%  do syntax detection:
 expr({call, Line, {atom, _Line1, do},
       [{lc, _Line2, {AtomOrVar, _Line3, _MonadModule} = Monad, Qs}]},
@@ -320,6 +337,17 @@ expr_list([E0|Es], MonadStack) ->
     [E1|expr_list(Es, MonadStack)];
 expr_list([], _MonadStack) -> [].
 
+%% -type map_fields([MapField]) -> [MapField].
+map_fields([{map_field_assoc, Line, ExpK0, ExpV0}|Fs], MonadStack) ->
+    ExpK1 = expr(ExpK0, MonadStack),
+    ExpV1 = expr(ExpV0, MonadStack),
+    [{map_field_assoc, Line, ExpK1, ExpV1}|map_fields(Fs, MonadStack)];
+map_fields([{map_field_exact, Line, ExpK0, ExpV0}|Fs], MonadStack) ->
+    ExpK1 = expr(ExpK0, MonadStack),
+    ExpV1 = expr(ExpV0, MonadStack),
+    [{map_field_exact, Line, ExpK1, ExpV1}|map_fields(Fs, MonadStack)];
+map_fields([], _MoandStack) -> [].
+
 %% -type record_inits([RecordInit]) -> [RecordInit].
 %%  N.B. Field names are full expressions here but only atoms are allowed
 %%  by the *linter*!.

src/error_m.erl

@@ -16,21 +16,27 @@
 
 -module(error_m).
 
+-export_type([error_m/1]).
+
 -behaviour(monad).
 -export(['>>='/2, return/1, fail/1]).
 
 %% This is really instance (Error e) => Monad (Either e) with 'error'
 %% for Left and 'ok' for Right.
+-type error_m(A) :: ok | {ok, A} | {error, any()}.
 
--ifdef(use_specs).
--type(monad(A) :: 'ok' | {'ok', A} | {'error', any()}).
--include("monad_specs.hrl").
--endif.
 
+-spec '>>='(error_m(A), fun( (A) -> error_m(B) )) -> error_m(B).
 '>>='({error, _Err} = Error, _Fun) -> Error;
 '>>='({ok, Result},           Fun) -> Fun(Result);
 '>>='(ok,                     Fun) -> Fun(ok).
 
+
+-spec return(A) -> error_m(A).
 return(ok) -> ok;
-return(X)  -> {ok,    X}.
-fail(X)    -> {error, X}.
+return(X ) -> {ok, X}.
+
+
+-spec fail(any()) -> error_m(_A).
+fail(X) ->
+    {error, X}.

src/error_t.erl

@@ -14,30 +14,36 @@
 %% Copyright (c) 2011-2013 VMware, Inc.  All rights reserved.
 %%
 
--module(error_t, [InnerMonad]).
+-module(error_t).
 -compile({parse_transform, do}).
 
--behaviour(monad).
--export(['>>='/2, return/1, fail/1, run/1, lift/1]).
+-export_type([error_t/2]).
 
--ifdef(use_specs).
--type(monad(A) :: fun (() -> 'ok' | {'ok', A} | {'error', any()})).
--include("monad_specs.hrl").
--endif.
+-behaviour(monad_trans).
+-export([new/1, '>>='/3, return/2, fail/2, run/2, lift/2]).
 
-'>>='(X, Fun) -> fun () ->
-                         do([InnerMonad ||
-                                R <- X(),
-                                case R of
-                                    {error, _Err} = Error -> return(Error);
-                                    {ok,  Result}         -> (Fun(Result))();
-                                    ok                    -> (Fun(ok))()
-                                end
-                            ])
-                 end.
+-opaque error_t(M, A) :: monad:monadic(M, ok | {ok, A} | {error, any()}).
 
-return(ok) -> fun () -> InnerMonad:return(ok) end;
-return(X)  -> fun () -> InnerMonad:return({ok, X}) end.
+
+-spec new(M) -> TM when TM :: monad:monad(), M :: monad:monad().
+new(M) ->
+    {?MODULE, M}.
+
+
+-spec '>>='(error_t(M, A), fun( (A) -> error_t(M, B) ), M) -> error_t(M, B).
+'>>='(X, Fun, {?MODULE, M}) ->
+    do([M || R <- X,
+             case R of
+                 {error, _Err} = Error -> return(Error);
+                 {ok,  Result}         -> Fun(Result);
+                 ok                    -> Fun(ok)
+             end
+       ]).
+
+
+-spec return(A, M) -> error_t(M, A).
+return(ok, {?MODULE, M}) -> M:return(ok);
+return(X , {?MODULE, M}) -> M:return({ok, X}).
 
 %% This is the equivalent of
 %%     fail msg = ErrorT $ return (Left (strMsg msg))
@@ -48,8 +54,16 @@ return(X)  -> fun () -> InnerMonad:return({ok, X}) end.
 %% I.e. note that calling fail on the outer monad is not a failure of
 %% the inner monad: it is success of the inner monad, but the failure
 %% is encapsulated.
-fail(X)   -> fun () -> InnerMonad:return({error, X}) end.
+-spec fail(any(), M) -> error_t(M, _A).
+fail(E, {?MODULE, M}) ->
+    M:return({error, E}).
+
+
+-spec run(error_t(M, A), M) -> monad:monadic(M, ok | {ok, A} | {error, any()}).
+run(EM, _M) -> EM.
 
-run(Fun) -> Fun().
 
-lift(X) -> fun () -> do([InnerMonad || A <- X, return({ok, A})]) end.
+-spec lift(monad:monadic(M, A), M) -> error_t(M, A).
+lift(X, {?MODULE, M}) ->
+    do([M || A <- X,
+             return({ok, A})]).

src/identity_m.erl

@@ -15,16 +15,24 @@
 %%
 
 -module(identity_m).
-
 -behaviour(monad).
+
+-export_type([identity_m/1]).
+
 -export(['>>='/2, return/1, fail/1]).
 
--ifdef(use_specs).
--type(monad(A) :: A).
--include("monad_specs.hrl").
--endif.
 
+-type identity_m(A) :: A.
+
+
+-spec '>>='(identity_m(A), fun( (A) -> identity_m(B) )) -> identity_m(B).
 '>>='(X, Fun) -> Fun(X).
 
+
+-spec return(A) -> identity_m(A).
 return(X) -> X.
-fail(X)   -> throw({error, X}).
+
+
+-spec fail(any()) -> identity_m(_A).
+fail(E) ->
+    throw({error, E}).

src/list_m.erl

@@ -24,21 +24,27 @@
 -behaviour(monad_plus).
 -export([mzero/0, mplus/2]).
 
--ifdef(use_specs).
--type(monad(A) :: [A]).
--include("monad_specs.hrl").
--include("monad_plus_specs.hrl").
--endif.
 
 %% Note that using a list comprehension is (obviously) cheating, but
 %% it's easier to read. The "real" implementation is also included for
 %% completeness.
-
+-spec '>>='([A], fun( (A) -> [B] )) -> [B].
 '>>='(X, Fun) -> lists:append([Fun(E) || E <- X]).
 %%               lists:foldr(fun (E, Acc) -> Fun(E) ++ Acc end, [], X).
 
+
+-spec return(A) -> [A].
 return(X) -> [X].
-fail(_X)  -> [].
 
+
+-spec fail(any()) -> [_A].
+fail(_E) -> [].
+
+
+-spec mzero() -> [_A].
 mzero() -> [].
-mplus(X, Y) -> lists:append(X, Y).
+
+
+-spec mplus([A], [A]) -> [A].
+mplus(X, Y) ->
+    lists:append(X, Y).