module Main where import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as Text import Codec.Beam.Instructions import qualified Codec.Beam as Beam import qualified Eunit main :: IO () main = Eunit.run [ Eunit.test "loads_empty" [ Beam.insertModuleInfo ] [ "?assertMatch({module, loads_empty}, code:load_file(loads_empty))" , "?assertEqual(erlang:get_module_info(loads_empty), loads_empty:module_info())" , "?assertEqual(erlang:get_module_info(loads_empty, attributes), loads_empty:module_info(attributes))" ] [] -- From beam_asm: https://git.io/vHTBY , withConstant "number_five" id (5 :: Int) , withConstant "number_one_thousand" id (5 :: Int) , withConstant "number_two_thousand_forty_seven" id (2047 :: Int) , withConstant "number_two_thousand_forty_eight" id (2048 :: Int) , withConstant "number_negative_one" id (-1 :: Int) , withConstant "number_large_negative" id (-4294967295 :: Int) , withConstant "number_large_positive" id (4294967295 :: Int) , withConstant "number_very_large_positive" id (429496729501 :: Int) -- Atom table encodings , withConstant "arbitrary_atom" id ("hello" :: Text) , withConstant "module_name_atom" id ("module_name_atom" :: Text) , withConstant_ "constant_nil" Beam.Nil "[]" -- Comparisons , Eunit.test "is_equal" [ Beam.export "test" 2 ] [ "?assertNot(is_equal:test(2, 3))" , "?assertNot(is_equal:test(2.0, 3))" , "?assert(is_equal:test(2.0, 2))" , "?assert(is_equal:test(2.0, 2.0))" ] $ withCmp is_eq , Eunit.test "is_not_equal" [ Beam.export "test" 2 ] [ "?assert(is_not_equal:test(2, 3))" , "?assert(is_not_equal:test(2.0, 3))" , "?assertNot(is_not_equal:test(2.0, 2))" , "?assertNot(is_not_equal:test(2.0, 2.0))" ] $ withCmp is_ne , Eunit.test "is_exactly_equal" [ Beam.export "test" 2 ] [ "?assertNot(is_exactly_equal:test(2, 3))" , "?assertNot(is_exactly_equal:test(2.0, 3))" , "?assertNot(is_exactly_equal:test(2.0, 2))" , "?assert(is_exactly_equal:test(2.0, 2.0))" ] $ withCmp is_eq_exact , Eunit.test "is_not_exactly_equal" [ Beam.export "test" 2 ] [ "?assert(is_not_exactly_equal:test(2, 3))" , "?assert(is_not_exactly_equal:test(2.0, 3))" , "?assert(is_not_exactly_equal:test(2.0, 2))" , "?assertNot(is_not_exactly_equal:test(2.0, 2.0))" ] $ withCmp is_ne_exact , Eunit.test "is_less_than" [ Beam.export "test" 2 ] [ "?assert(is_less_than:test(5, 6))" , "?assertNot(is_less_than:test(6, 5))" , "?assertNot(is_less_than:test(5.0, 5))" , "?assertNot(is_less_than:test(6.0, 5.0))" ] $ withCmp is_lt , Eunit.test "is_greater_than_or_equal" [ Beam.export "test" 2 ] [ "?assertNot(is_greater_than_or_equal:test(5, 6))" , "?assert(is_greater_than_or_equal:test(6, 5))" , "?assert(is_greater_than_or_equal:test(5.0, 5))" , "?assert(is_greater_than_or_equal:test(6.0, 5.0))" ] $ withCmp is_ge -- Literal table encodings , withConstant_ "atom" (Beam.Atom "hiya") "hiya" , withConstant_ "float" (Beam.Float 3.1415) "3.1415" , withConstant_ "bitstring" (Beam.Binary "teapot") "<<\"teapot\">>" , withConstant_ "empty_tuple" (Beam.Tuple []) "{}" , withConstant_ "small_tuple" (Beam.Tuple [Beam.Integer 1]) "{1}" , withConstant_ "empty_list" (Beam.List []) "[]" , withConstant_ "small_list" (Beam.List [Beam.Integer 4, Beam.Integer 5]) "[4, 5]" , withConstant_ "empty_map" (Beam.Map []) "#{}" , withConstant_ "small_map" (Beam.Map [(Beam.Atom "a", Beam.Integer 1), (Beam.Atom "b", Beam.Integer 2)]) "#{a=>1,b=>2}" , Eunit.test "large_tuple" [ Beam.export "test" 0 ] [ "?assertEqual(300, tuple_size(large_tuple:test()))" , "?assertEqual(300, element(300, large_tuple:test()))" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , move (Beam.Tuple (map Beam.Integer [1..300])) (Beam.X 0) , return' ] , Eunit.test "multiple_literals" [ Beam.export "test" 0 ] [ "?assert(multiple_literals:test())" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , move (Beam.Atom "dummy") (Beam.X 0) , move (Beam.Atom "true") (Beam.X 0) , return' ] , Eunit.test "call_into_identity" [ Beam.export "test" 0 ] [ "?assertEqual(1023, call_into_identity:test())" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , move (Beam.Integer 1023) (Beam.X 0) , call_only 1 (Beam.Label 4) , return' , label (Beam.Label 3) , func_info "identity" 1 , label (Beam.Label 4) , return' ] -- Type checks , Eunit.test "is_nil" [ Beam.export "test" 1 ] [ "?assert(is_nil:test([]))" , "?assertNot(is_nil:test(23))" , "?assertNot(is_nil:test([23]))" ] $ withType is_nil , Eunit.test "is_list" [ Beam.export "test" 1 ] [ "?assert(is_list:test([]))" , "?assertNot(is_list:test(23))" , "?assert(is_list:test([23]))" ] $ withType is_list , Eunit.test "is_nonempty_list" [ Beam.export "test" 1 ] [ "?assertNot(is_nonempty_list:test([]))" , "?assertNot(is_nonempty_list:test(23))" , "?assert(is_nonempty_list:test([23]))" ] $ withType is_nonempty_list , Eunit.test "is_map" [ Beam.export "test" 1 ] [ "?assert(is_map:test(#{}))" , "?assertNot(is_map:test(23))" , "?assert(is_map:test(#{a=>23}))" ] $ withType is_map -- Based on https://happi.github.io/theBeamBook/#x_and_y_regs_in_memory , Eunit.test "allocate_for_call_fun" [ Beam.export "apply2" 3 ] [ "_add = fun 'erlang':'+'/2" , "?assertEqual(4, allocate_for_call_fun:apply2(2, 2, _add))" ] [ label (Beam.Label 1) , func_info "apply2" 3 , label (Beam.Label 2) , allocate 2 3 , move (Beam.X 2) (Beam.Y 1) , move (Beam.X 1) (Beam.Y 0) , call 1 (Beam.Label 4) , move (Beam.X 0) (Beam.X 1) , move (Beam.Y 0) (Beam.X 0) , move (Beam.X 1) (Beam.Y 0) , call 1 (Beam.Label 4) , move (Beam.Y 1) (Beam.X 2) , move (Beam.X 0) (Beam.X 1) , move (Beam.Y 0) (Beam.X 0) , call_fun 2 , deallocate 2 , return' , label (Beam.Label 3) , func_info "identity" 1 , label (Beam.Label 4) , return' ] , Eunit.test "external_fun" [ Beam.export "test" 0 ] [ "?assertEqual(3, (external_fun:test())(1, 2))" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , move (Beam.ExternalFun (Beam.Import "erlang" "+" 2)) (Beam.X 0) , return' ] , Eunit.test "get_tuple_element" [ Beam.export "first" 1 , Beam.export "second" 1 ] [ "?assertEqual(2, get_tuple_element:first({2}))" , "?assertEqual(hi, get_tuple_element:second({oh, hi, there}))" ] [ label (Beam.Label 1) , func_info "first" 1 , label (Beam.Label 2) , get_tuple_element (Beam.X 0) 0 (Beam.X 0) , return' , label (Beam.Label 3) , func_info "second" 1 , label (Beam.Label 4) , get_tuple_element (Beam.X 0) 1 (Beam.X 0) , return' ] , Eunit.test "set_tuple_element" [ Beam.export "make" 1 ] [ "?assertEqual({dream, work}, set_tuple_element:make({team, work}))" ] [ label (Beam.Label 1) , func_info "make" 1 , label (Beam.Label 2) , set_tuple_element ("dream" :: Text) (Beam.X 0) 0 , return' ] , Eunit.test "put_list" [ Beam.export "test" 0 ] [ "?assertEqual([one, 2], put_list:test())" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , put_list (Beam.Integer 2) Beam.Nil (Beam.X 0) , put_list ("one" :: Text) (Beam.X 0) (Beam.X 0) , return' ] , Eunit.test "make_a_tuple" [ Beam.export "test" 0 ] [ "?assertEqual({one, 2}, make_a_tuple:test())" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , put_tuple (2 :: Int) (Beam.X 0) , put ("one" :: Text) , put (2 :: Int) , return' ] , Eunit.test "make_a_map" [ Beam.export "test" 0 ] [ "?assertEqual(#{a=>1, 2=>b}, make_a_map:test())" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , put_map_assoc (Beam.Label 0) (Beam.Map []) (Beam.X 0) [ (Beam.toSource (Beam.Atom "a"), Beam.toSource (1 :: Int)) , (Beam.toSource (2 :: Int), Beam.toSource (Beam.Atom "b")) ] , return' ] , Eunit.test "get_from_map" [ Beam.export "test" 2 ] [ "?assertEqual(5, get_from_map:test(#{a=>5}, a))" , "?assertEqual(error, get_from_map:test(#{}, a))" ] [ label (Beam.Label 1) , func_info "test" 2 , label (Beam.Label 2) , get_map_elements (Beam.Label 3) (Beam.X 0) [ (Beam.toSource (Beam.X 1), Beam.toRegister (Beam.X 0)) ] , return' , label (Beam.Label 3) , move ("error" :: Text) (Beam.X 0) , return' ] , Eunit.test "get_da_list" [ Beam.export "second" 1 ] [ "?assertEqual(2, get_da_list:second([1,2,3]))" ] [ label (Beam.Label 1) , func_info "second" 1 , label (Beam.Label 2) , get_list (Beam.X 0) (Beam.X 1) (Beam.X 0) , get_list (Beam.X 0) (Beam.X 0) (Beam.X 1) , return' ] , Eunit.test "jumping_around" [ Beam.export "test" 0 ] [ "?assertEqual(yay, jumping_around:test())" ] [ label (Beam.Label 1) , func_info "test" 0 , label (Beam.Label 2) , jump (Beam.Label 4) , label (Beam.Label 3) , move ("yay" :: Text) (Beam.X 0) , return' , label (Beam.Label 4) , jump (Beam.Label 3) ] , Eunit.test "simple_lambda" [ Beam.export "test" 1 ] [ "?assertEqual(to_capture, (simple_lambda:test(to_capture))())" ] [ label (Beam.Label 1) , func_info "test" 1 , label (Beam.Label 2) , make_fun2 (Beam.Lambda "lambda_function" 0 (Beam.Label 4) 1) , return' , label (Beam.Label 3) , func_info "backing_function" 1 , label (Beam.Label 4) , return' ] , Eunit.test "external_call" [ Beam.export "test" 2 ] [ "?assertEqual(3, external_call:test(1, 2))" ] [ label (Beam.Label 1) , func_info "test" 2 , label (Beam.Label 2) , call_ext_only (Beam.Import "erlang" "+" 2) , return' ] , Eunit.test "float_math" [ Beam.export "sum" 2 ] [ "?assertEqual(5.0, float_math:sum(2, 3.0))" ] [ label (Beam.Label 1) , func_info "sum" 2 , label (Beam.Label 2) , fconv (Beam.X 0) (Beam.F 0) , fmove (Beam.X 1) (Beam.F 1) , fclearerror , fadd (Beam.F 0) (Beam.F 1) (Beam.F 0) , fmove (Beam.F 0) (Beam.X 0) , return' ] , Eunit.test "destinations" [ Beam.export "test" 1 ] [ "?assertEqual(four, destinations:test(4))" , "?assertEqual(five, destinations:test(5))" , "?assertEqual(neither, destinations:test(6))" ] [ label (Beam.Label 1) , func_info "test" 1 , label (Beam.Label 2) , select_val (Beam.X 0) (Beam.Label 3) [ (Beam.Label 4, Beam.toSource (4 :: Int)) , (Beam.Label 5, Beam.toSource (5 :: Int)) ] , label (Beam.Label 3) , move ("neither" :: Text) (Beam.X 0) , return' , label (Beam.Label 4) , move ("four" :: Text) (Beam.X 0) , return' , label (Beam.Label 5) , move ("five" :: Text) (Beam.X 0) , return' ] ] -- HELPERS -- Having these in one spot makes it easier to see the pain-points in the API. -- I imagine that some of these will eventually live in a utility module within src/. withConstant_ :: Beam.IsSource s => String -> s -> String -> Eunit.Test withConstant_ name term = withConstant name (const term) withConstant :: (Erlang a, Beam.IsSource s) => String -> (a -> s) -> a -> Eunit.Test withConstant name toSource value = Eunit.test name [ Beam.export "check" 0 ] [ "?assertEqual(" <> erlang value <> ", " <> name <> ":check())" ] [ label (Beam.Label 1) , func_info "check" 0 , label (Beam.Label 2) , move (toSource value) (Beam.X 0) , return' ] withCmp :: (Beam.Label -> Beam.X -> Beam.X -> Beam.Op) -> [Beam.Op] withCmp toOp = jumpFunction 2 $ \i -> toOp i (Beam.X 0) (Beam.X 1) withType :: (Beam.Label -> Beam.X -> Beam.Op) -> [Beam.Op] withType toOp = jumpFunction 1 $ \i -> toOp i (Beam.X 0) jumpFunction :: Int -> (Beam.Label -> Beam.Op) -> [Beam.Op] jumpFunction args decision = [ label (Beam.Label 1) , func_info "test" args , label (Beam.Label 2) , decision (Beam.Label 3) , move ("true" :: Text) (Beam.X 0) , return' , label (Beam.Label 3) , move ("false" :: Text) (Beam.X 0) , return' ] -- PRINT ERLANG LITERALS class Erlang a where erlang :: a -> String instance Erlang a => Erlang [a] where erlang = mconcat . map erlang instance Erlang Text where erlang = Text.unpack instance Erlang Int where erlang = erlang . show instance Erlang Char where erlang x = [x]