Merge pull request #9 from aeternity/interface-to-sophia

PT-163063316 Interface to sophia

.gitignore

@@ -16,3 +16,5 @@ _build
 .idea
 *.iml
 rebar3.crashdump
+*.erl~
+*.aes~

README.md

@@ -8,3 +8,88 @@ It is an OTP application written in Erlang and is by default included in
 [the æternity node](https://github.com/aeternity/epoch). However, it can
 also be included in other system to compile contracts coded in sophia which
 can then be loaded into the æternity system.
+
+## Modules
+
+### aeso_compiler
+
+The Sophia compiler
+
+### Description
+
+This module provides the interface to the standard Sophia compiler. It
+returns the compiled module in a map which can then be loaded.
+
+### Types
+```erlang
+contract_string() = string() | binary()
+contract_map() = #{bytecode => binary(),
+                   compiler_version => string(),
+                   contract_souce => string(),
+                   type_info => type_info()}
+type_info()
+errorstring() = binary()
+```
+### Exports
+
+#### file(File)
+#### file(File, Options) -> CompRet
+#### from_string(ContractString, Options) -> CompRet
+
+Types
+
+``` erlang
+ContractString = contract_string()
+Options = [Option]
+CompRet = {ok,ContractMap} | {error,ErrorString}
+ContractMap = contract_map()
+ErrorString = errorstring()
+```
+
+Compile a contract defined in a file or in a string.
+
+The **pp_** options all print to standard output the following:
+
+`pp_sophia_code` - print the input Sophia code.
+
+`pp_ast` - print the AST of the code
+
+`pp_types` - print information about the types
+
+`pp_typed_ast` - print the AST with type information at each node
+
+`pp_icode` - print the internal code structure
+
+`pp_assembler` - print the generated assembler code
+
+`pp_bytecode` - print the bytecode instructions
+
+#### check_call(ContractString, Options) -> CheckRet
+
+Types
+```
+ContractString = string() | binary()
+CheckRet = {ok,string(),{Types,Type | any()},Terms} | {error,Term}
+Types = [Type]
+Type = term()
+```
+Check a call in contract through the `__call` function.
+
+#### sophia_type_to_typerep(String) -> TypeRep
+
+Types
+``` erlang
+ {ok,TypeRep} | {error, badtype}
+```
+
+Get the type representation of a type declaration.
+
+#### version() -> Version
+
+Types
+
+``` erlang
+Version = integer()
+```
+
+Get the current version of the Sophia compiler.

src/aeso_ast.erl

@@ -17,11 +17,12 @@ line({symbol, Line, _}) -> Line.
 symbol_name({symbol, _, Name}) -> Name.
 
 pp(Ast) ->
-    %% TODO: Actually do *Pretty* printing.
+    %% io:format("Tree:\n~p\n",[Ast]),
-    io:format("~p~n", [Ast]).
+    String = prettypr:format(aeso_pretty:decls(Ast, [])),
+    io:format("Ast:\n~s\n", [String]).
 
 pp_typed(TypedAst) ->
+    %% io:format("Typed tree:\n~p\n",[TypedAst]),
     String = prettypr:format(aeso_pretty:decls(TypedAst, [show_generated])),
-    %%io:format("Typed tree:\n~p\n",[TypedAst]),
+    io:format("Type ast:\n~s\n",[String]).
-    io:format("Type info:\n~s\n",[String]).
 

src/aeso_compiler.erl

@@ -21,8 +21,8 @@
 -include("aeso_icode.hrl").
 
 
--type option() :: pp_sophia_code | pp_ast | pp_icode | pp_assembler |
+-type option() :: pp_sophia_code | pp_ast | pp_types | pp_typed_ast |
-                  pp_bytecode.
+		  pp_icode| pp_assembler | pp_bytecode.
 -type options() :: [option()].
 
 -export_type([ option/0
@@ -43,12 +43,17 @@ file(Filename) ->
     file(Filename, []).
 
 -spec file(string(), options()) -> map().
-file(Filename, Options) ->
+file(File, Options) ->
-    C = read_contract(Filename),
+    case read_contract(File, Options) of
-    from_string(C, Options).
+	{ok,Bin} -> from_string(Bin, Options);
+	{error,Error} -> {error,{File,Error}}
+    end.
 
--spec from_string(string(), options()) -> map().
+-spec from_string(binary() | string(), options()) -> map().
+from_string(ContractBin, Options) when is_binary(ContractBin) ->
+    from_string(binary_to_list(ContractBin), Options);
 from_string(ContractString, Options) ->
+    try
 	Ast = parse(ContractString, Options),
 	ok = pp_sophia_code(Ast, Options),
 	ok = pp_ast(Ast, Options),
@@ -63,9 +68,26 @@ from_string(ContractString, Options) ->
 	ByteCodeList = to_bytecode(Assembler, Options),
 	ByteCode = << << B:8 >> || B <- ByteCodeList >>,
 	ok = pp_bytecode(ByteCode, Options),
-    #{byte_code => ByteCode, type_info => TypeInfo,
+	{ok,#{byte_code => ByteCode,
+	      compiler_version => version(),
 	      contract_source => ContractString,
-      compiler_version => version()}.
+	      type_info => TypeInfo
+	     }}
+    catch
+        %% The compiler errors.
+        error:{parse_errors,Errors} ->
+	    {error,join_errors("Parse errors", Errors, fun(E) -> E end)};
+        error:{type_errors,Errors} ->
+	    {error,join_errors("Type errors", Errors, fun(E) -> E end)};
+        error:{code_errors,Errors} ->
+            {error,join_errors("Code errors", Errors,
+			       fun (E) -> io_lib:format("~p", [E]) end)}
+        %% General programming errors in the compiler just signal error.
+    end.
+
+join_errors(Prefix, Errors, Pfun) ->
+    Ess = [ Pfun(E) || E <- Errors ],
+    list_to_binary(string:join([Prefix|Ess], "\n")).
 
 -define(CALL_NAME, "__call").
 
@@ -76,6 +98,7 @@ from_string(ContractString, Options) ->
 -spec check_call(string(), options()) -> {ok, string(), {[Type], Type | any}, [term()]} | {error, term()}
     when Type :: term().
 check_call(ContractString, Options) ->
+    try
 	Ast = parse(ContractString, Options),
 	ok = pp_sophia_code(Ast, Options),
 	ok = pp_ast(Ast, Options),
@@ -91,11 +114,20 @@ check_call(ContractString, Options) ->
 	ok = pp_icode(Icode, Options),
 	#{ functions := Funs } = Icode,
 	ArgIcode = get_arg_icode(Funs),
-    try [ icode_to_term(T, Arg) || {T, Arg} <- lists:zip(ArgVMTypes, ArgIcode) ] of
+	ArgTerms = [ icode_to_term(T, Arg) ||
-        ArgTerms ->
+		       {T, Arg} <- lists:zip(ArgVMTypes, ArgIcode) ],
 	{ok, FunName, {ArgVMTypes, RetVMType}, ArgTerms}
-    catch throw:Err ->
+    catch
-        {error, Err}
+	error:{parse_errors, Errors} ->
+	    {error,join_errors("Parse errors", Errors, fun (E) -> E end)};
+	error:{type_errors, Errors} ->
+	    {error,join_errors("Type errors", Errors, fun (E) -> E end)};
+	error:{badmatch,{error,missing_call_function}} ->
+	    {error,join_errors("Type errors", ["missing __call function"],
+			       fun (E) -> E end)};
+	throw:Error ->				%Don't ask
+            {error,join_errors("Code errors", [Error],
+			       fun (E) -> io_lib:format("~p", [E]) end)}
     end.
 
 -spec create_calldata(map(), string(), string()) ->
@@ -251,9 +283,13 @@ parse_error({Line,Pos}, ErrorString) ->
     Error = io_lib:format("line ~p, column ~p: ~s", [Line,Pos,ErrorString]),
     error({parse_errors,[Error]}).
 
-read_contract(Name) ->
+read_contract(Name, Opts) ->
-    {ok, Bin} = file:read_file(filename:join(contract_path(), lists:concat([Name, ".aes"]))),
+    FileName = filename(Name, ".aes", Opts),
-    binary_to_list(Bin).
+    file:read_file(FileName).
 
-contract_path() ->
+filename(File, Suffix, _Opts) ->
-    "apps/aesophia/test/contracts".
+    Base = filename:basename(File, Suffix),
+    Sdir = filename:dirname(File),
+    if Sdir == "." -> Base ++ Suffix;
+       true -> filename:join(Sdir, Base ++ Suffix)
+    end.

test/aeso_compiler_tests.erl

@@ -28,13 +28,15 @@ simple_compile_test_() ->
         end} || ContractName <- compilable_contracts() ] ++
      [ {"Testing error messages of " ++ ContractName,
         fun() ->
-            {type_errors, Errors} = compile(ContractName),
+            <<"Type errors\n",ErrorString/binary>> = compile(ContractName),
-            check_errors(lists:sort(ExpectedErrors), lists:sort(Errors))
+            check_errors(lists:sort(ExpectedErrors), ErrorString)
         end} ||
             {ContractName, ExpectedErrors} <- failing_contracts() ]
     }.
 
-check_errors(Expect, Actual) ->
+check_errors(Expect, ErrorString) ->
+    %% This removes the final single \n as well.
+    Actual = binary:split(<<ErrorString/binary,$\n>>, <<"\n\n">>, [global,trim]),
     case {Expect -- Actual, Actual -- Expect} of
         {[], Extra}   -> ?assertMatch({unexpected, []}, {unexpected, Extra});
         {Missing, []} -> ?assertMatch({missing, []}, {missing, Missing});
@@ -42,10 +44,10 @@ check_errors(Expect, Actual) ->
     end.
 
 compile(Name) ->
-    try
+    String = aeso_test_utils:read_contract(Name),
-        aeso_compiler:from_string(aeso_test_utils:read_contract(Name), [])
+    case aeso_compiler:from_string(String, []) of
-    catch _:{type_errors, _} = E ->
+        {ok,Map} -> Map;
-        E
+        {error,ErrorString} -> ErrorString
     end.
 
 %% compilable_contracts() -> [ContractName].
@@ -75,82 +77,94 @@ compilable_contracts() ->
 
 failing_contracts() ->
     [ {"name_clash",
-        ["Duplicate definitions of abort at\n  - (builtin location)\n  - line 14, column 3\n",
+       [<<"Duplicate definitions of abort at\n"
-         "Duplicate definitions of double_def at\n  - line 10, column 3\n  - line 11, column 3\n",
+          "  - (builtin location)\n"
-         "Duplicate definitions of double_proto at\n  - line 4, column 3\n  - line 5, column 3\n",
+          "  - line 14, column 3">>,
-         "Duplicate definitions of proto_and_def at\n  - line 7, column 3\n  - line 8, column 3\n",
+        <<"Duplicate definitions of double_def at\n"
-         "Duplicate definitions of put at\n  - (builtin location)\n  - line 15, column 3\n",
+          "  - line 10, column 3\n"
-         "Duplicate definitions of state at\n  - (builtin location)\n  - line 16, column 3\n"]}
+          "  - line 11, column 3">>,
+        <<"Duplicate definitions of double_proto at\n"
+          "  - line 4, column 3\n"
+          "  - line 5, column 3">>,
+        <<"Duplicate definitions of proto_and_def at\n"
+          "  - line 7, column 3\n"
+          "  - line 8, column 3">>,
+        <<"Duplicate definitions of put at\n"
+          "  - (builtin location)\n"
+          "  - line 15, column 3">>,
+        <<"Duplicate definitions of state at\n"
+          "  - (builtin location)\n"
+          "  - line 16, column 3">>]}
     , {"type_errors",
-        ["Unbound variable zz at line 17, column 21\n",
+       [<<"Unbound variable zz at line 17, column 21">>,
-         "Cannot unify int\n"
+        <<"Cannot unify int\n"
           "         and list(int)\n"
           "when checking the application at line 26, column 9 of\n"
           "  (::) : (int, list(int)) => list(int)\n"
           "to arguments\n"
           "  x : int\n"
-         "  x : int\n",
+          "  x : int">>,
-         "Cannot unify string\n"
+        <<"Cannot unify string\n"
           "         and int\n"
           "when checking the assignment of the field\n"
           "  x : map(string, string) (at line 9, column 46)\n"
           "to the old value __x and the new value\n"
-         "  __x {[\"foo\"] @ x = x + 1} : map(string, int)\n",
+          "  __x {[\"foo\"] @ x = x + 1} : map(string, int)">>,
-         "Cannot unify int\n"
+        <<"Cannot unify int\n"
           "         and string\n"
           "when checking the type of the expression at line 34, column 45\n"
           "  1 : int\n"
           "against the expected type\n"
-         "  string\n",
+          "  string">>,
-         "Cannot unify string\n"
+        <<"Cannot unify string\n"
           "         and int\n"
           "when checking the type of the expression at line 34, column 50\n"
           "  \"bla\" : string\n"
           "against the expected type\n"
-         "  int\n",
+          "  int">>,
-         "Cannot unify string\n"
+        <<"Cannot unify string\n"
           "         and int\n"
           "when checking the type of the expression at line 32, column 18\n"
           "  \"x\" : string\n"
           "against the expected type\n"
-         "  int\n",
+          "  int">>,
-         "Cannot unify string\n"
+        <<"Cannot unify string\n"
           "         and int\n"
           "when checking the type of the expression at line 11, column 56\n"
           "  \"foo\" : string\n"
           "against the expected type\n"
-         "  int\n",
+          "  int">>,
-         "Cannot unify int\n"
+        <<"Cannot unify int\n"
           "         and string\n"
           "when comparing the types of the if-branches\n"
           "  - w : int (at line 38, column 13)\n"
-         "  - z : string (at line 39, column 10)\n",
+          "  - z : string (at line 39, column 10)">>,
-         "Not a record type: string\n"
+        <<"Not a record type: string\n"
-         "arising from the projection of the field y (at line 22, column 38)\n",
+          "arising from the projection of the field y (at line 22, column 38)">>,
-         "Not a record type: string\n"
+        <<"Not a record type: string\n"
-         "arising from an assignment of the field y (at line 21, column 42)\n",
+          "arising from an assignment of the field y (at line 21, column 42)">>,
-         "Not a record type: string\n"
+        <<"Not a record type: string\n"
-         "arising from an assignment of the field y (at line 20, column 38)\n",
+          "arising from an assignment of the field y (at line 20, column 38)">>,
-         "Not a record type: string\n"
+        <<"Not a record type: string\n"
-         "arising from an assignment of the field y (at line 19, column 35)\n",
+          "arising from an assignment of the field y (at line 19, column 35)">>,
-         "Ambiguous record type with field y (at line 13, column 25) could be one of\n"
+        <<"Ambiguous record type with field y (at line 13, column 25) could be one of\n"
           "  - r (at line 4, column 10)\n"
-         "  - r' (at line 5, column 10)\n",
+          "  - r' (at line 5, column 10)">>,
-         "Record type r2 does not have field y (at line 15, column 22)\n",
+        <<"Record type r2 does not have field y (at line 15, column 22)">>,
-         "The field z is missing when constructing an element of type r2 (at line 15, column 24)\n",
+        <<"The field z is missing when constructing an element of type r2 (at line 15, column 24)">>,
-         "Repeated name x in pattern\n"
+        <<"Repeated name x in pattern\n"
-         "  x :: x (at line 26, column 7)\n",
+          "  x :: x (at line 26, column 7)">>,
-         "No record type with fields y, z (at line 14, column 22)\n"]}
+        <<"No record type with fields y, z (at line 14, column 22)">>]}
     , {"init_type_error",
-        ["Cannot unify string\n"
+       [<<"Cannot unify string\n"
           "         and map(int, int)\n"
-         "when checking that 'init' returns a value of type 'state' at line 7, column 3\n"]}
+          "when checking that 'init' returns a value of type 'state' at line 7, column 3">>]}
     , {"missing_state_type",
-        ["Cannot unify string\n"
+       [<<"Cannot unify string\n"
           "         and ()\n"
-         "when checking that 'init' returns a value of type 'state' at line 5, column 3\n"]}
+          "when checking that 'init' returns a value of type 'state' at line 5, column 3">>]}
     , {"missing_fields_in_record_expression",
-        ["The field x is missing when constructing an element of type r('a) (at line 7, column 40)\n",
+       [<<"The field x is missing when constructing an element of type r('a) (at line 7, column 40)">>,
-         "The field y is missing when constructing an element of type r(int) (at line 8, column 40)\n",
+        <<"The field y is missing when constructing an element of type r(int) (at line 8, column 40)">>,
-         "The fields y, z are missing when constructing an element of type r('1) (at line 6, column 40)\n"]}
+        <<"The fields y, z are missing when constructing an element of type r('1) (at line 6, column 40)">>]}
     ].