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]