Permalink
Browse files

Complex module support, module_info compilation

  • Loading branch information...
1 parent ebe57b2 commit 1a2debd3f52b4afbaa8f2fc8e1ad2796a3a73431 @ericbmerritt ericbmerritt committed Dec 10, 2011
View
13 examples/complex_module.jxa
@@ -0,0 +1,13 @@
+(module jxat-featureful
+ (use string code)
+ (attr spec 123)
+ (use [lists :only [member/2 append/2]
+ :rename [[member/2 mbr]]])
+ (use [file :as f
+ :exclude [delete/1]
+ :rename [[change_group/2 chgrp] [change_mode/2 chmod]]])
+ (attr super_duper "Hello World")
+ (require [proplists :as props])
+ (require erlang code)
+ (use [filename
+ :exclude [flatten/1 append/2 join/2 absname/1 absname_join/2]]))
View
6 examples/helloworld.jxa
@@ -2,11 +2,11 @@
(require io)
(require [io :as print])
(attr hello world)
- (use [string :only split]))
+ (use [string :only split :rename [split/2 str-split]]))
(defn+ hello-world []
(io:format "~s" '("Hello World")))
(defn+ hello-world
- ([:bar] (print:format "atom bar" '[bar]))
- ([foo] (print:format "~s" '[foo])))
+ ([:bar] (print:format "atom bar" '(bar)))
+ ([foo] (print:format "~s" '(foo))))
View
10 features/jxat_bare_module.feature
@@ -0,0 +1,10 @@
+Feature: Joxa should be able to compile a module
+ In order to allow a developer to compile a minimal module
+ As an Joxa Developer
+ I want to Joxa to be able to compile a form consisting of a single module
+
+ Scenario: Allow a bare module
+ Given a bare module
+ When joxa is called on this module
+ Then a beam binary is produced
+ And the joxa context for a bare module is correctly formed
View
11 features/jxat_featureful_module.feature
@@ -0,0 +1,11 @@
+Feature: Joxa should be able to compile a module with use,require and attr clauses
+ In order to allow a developer to compile a featureful module
+ As an Joxa Developer
+ I want to Joxa to be able to compile a form consisting of a single
+ module with various clauses
+
+ Scenario: Allow a bare module
+ Given a featureful module
+ When joxa is called on this module
+ Then a beam binary is produced
+ And the joxa context for a featureful module is correctly formed
View
2 include/joxa.hrl
@@ -0,0 +1,2 @@
+-define(JXA_THROW(Detail),
+ erlang:throw({?MODULE, Detail})).
View
2 src/joxa.app.src
@@ -6,6 +6,6 @@
{modules, [joxa_app,
joxa_sup]},
{registered,[joxa_sup]},
- {applications, [kernel, stdlib, neotoma]},
+ {applications, [kernel, stdlib, compiler, erlware_commons]},
{mod, {joxa_app,[]}},
{start_phases, []}]}.
View
109 src/joxa.erl
@@ -0,0 +1,109 @@
+%% -*- mode: Erlang; fill-column: 76; comment-column: 76; -*-
+-module(joxa).
+
+-export([comp/1, comp/2, format_exception/1]).
+
+-include_lib("joxa/include/joxa.hrl").
+%%=============================================================================
+%% Types
+%%=============================================================================
+
+%%=============================================================================
+%% Public API
+%%=============================================================================
+-spec comp(string() | binary()) -> {jxa_ctx:ctx(), binary()}.
+comp(FileName) ->
+ case file:read_file(FileName) of
+ {ok, Binary} ->
+ ModuleName = extract_module_name(FileName),
+ Result = {_, Binary} = comp(ModuleName, Binary),
+ {module, ModuleName} =
+ code:load_binary(ModuleName, FileName, Binary),
+ Result;
+ {error, Reason} ->
+ ?JXA_THROW({file_access, Reason, FileName})
+ end.
+
+-spec comp(ModuleName::atom(), Body::binary()) ->
+ {jxa_ctx:context(), binary()}.
+comp(ModuleName, BinaryData) when is_binary(BinaryData) ->
+ {Annots, Ast} = jxa_parser:parse(BinaryData),
+ Ctx = jxa_ctx:new(Annots, ModuleName, -1),
+ Result = {_, Binary} = comp_forms(jxa_annot:new_path(), Ctx, Ast),
+ {module, ModuleName} = code:load_binary(ModuleName, "", Binary),
+ Result.
+
+-spec format_exception(ExceptionBody::term()) -> IoList::[term()].
+format_exception({file_access, enoent, FileName}) ->
+ io_lib:format("File does not exist ~s", [FileName]);
+format_exception({file_access, eacces, FileName}) ->
+ io_lib:format("Missing permission for reading the file: ~s",
+ [FileName]);
+format_exception({file_access, eisdir, FileName}) ->
+ io_lib:format("The named file is a directory: ~s",
+ [FileName]);
+format_exception({file_access, enomem, FileName}) ->
+ io_lib:format("There is not enough memory for the contents of the file: ~s",
+ [FileName]);
+format_exception({file_access, Reason, FileName}) ->
+ io_lib:format("Unexpected error (~p) attempting to read file: ~s",
+ [Reason, FileName]).
+
+%%=============================================================================
+%% Internal Functions
+%%=============================================================================
+%% Extract a module name from a file name
+-spec extract_module_name(string()) -> ModuleName::atom().
+extract_module_name(FileName) ->
+ erlang:list_to_atom(filename:rootname(
+ filename:basename(FileName))).
+
+-spec comp_forms(jxa_annot:path(),
+ jxa_ctx:context(),
+ [term()]) ->
+ jxa_ctx:context().
+comp_forms(Path0, Ctx0, Module = [module | _]) ->
+ Ctx1 = jxa_module:comp(Path0, Ctx0, Module),
+ compile_context(Ctx1);
+comp_forms(Path0, Ctx0, _) ->
+ {_, Idx} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ ?JXA_THROW({invalid_form, Idx}).
+
+-spec compile_context(jxa_ctx:context()) -> jxa_ctx:context().
+compile_context(Ctx0) ->
+ Ctx1 = compile_module_info(Ctx0),
+ Line = jxa_ctx:line(Ctx1),
+ ModuleName = cerl:ann_c_atom([Line],
+ jxa_ctx:module_name(Ctx1)),
+ Exports = [cerl:ann_c_fname([ELine], Fun, Arity) ||
+ {Fun, Arity, ELine} <- jxa_ctx:exports(Ctx1)],
+ Attrs = jxa_ctx:attrs(Ctx1),
+ Defs = jxa_ctx:definitions(Ctx1),
+ {Ctx1, erl_comp(cerl:ann_c_module([Line], ModuleName,
+ Exports, Attrs, Defs))}.
+
+-spec compile_module_info(jxa_ctx:context()) -> jxa_ctx:context().
+compile_module_info(Ctx0) ->
+ ModuleName = cerl:c_atom(jxa_ctx:module_name(Ctx0)),
+ ArglessBody = cerl:c_call(cerl:c_atom(erlang),
+ cerl:c_atom(get_module_info), [ModuleName]),
+ Ctx1 = jxa_ctx:add_exported_definition(0, module_info, [],
+ ArglessBody, Ctx0),
+ VarName = cerl:c_var(mdetail),
+ ArgBody = cerl:c_call(cerl:c_atom(erlang),
+ cerl:c_atom(get_module_info),
+ [ModuleName, VarName]),
+ jxa_ctx:add_exported_definition(0, module_info, [VarName],
+ ArgBody, Ctx1).
+
+
+-spec erl_comp(cerl:cerl()) -> binary().
+erl_comp(CerlAST) ->
+ case compile:forms(CerlAST, [from_core,binary,no_bopt]) of
+ {ok, _, Result} ->
+ Result;
+ Error = {error, _Errors, _Warnings} ->
+ ?JXA_THROW(Error);
+ InternalError ->
+ ?JXA_THROW(InternalError)
+ end.
View
120 src/jxa_annot.erl
@@ -0,0 +1,120 @@
+%% Path Hashing for Line and Type Information
+%% ==========================================
+
+%% We have the problem that for macros and for ease of parsing we want
+%% to keep the AST as clean as possible. That is, we want it to be as
+%% close to a normal list as we can get away with. However, we want to
+%% be able to hang information on the graph that the AST
+%% represents. Things like line numbers, additional type information
+%% etc. However, in erlang we cant do that without polluting the graph
+%% itself and making it harder for user written macros to be
+%% implemented. So we need some way to identify specific points in the
+%% graph that is the AST that we can then use as a key on this
+%% additional information that we would like to show.
+%%
+%% In an AST nodes are identified by their location in the graph. That
+%% is, every node in the graph is identified by the path leading to
+%% that node. Lets look at an example.
+%%
+%% (hello world (I rock))
+%%
+%% In this case the 'I' node could be identified by the path [hello,
+%% world, <start of children>, I]. This should be a unique identifier
+%% for any point in the graph assuming that there is a single root
+%% term being parsed.
+%%
+%% If that is true we can replace the actual elements with their
+%% positions in the list. So the example above would become. [1, 3,
+%% 1]. Where the outer list is 1 (everything starts at one) the 3rd
+%% position is the list and the first element in that third
+%% position. Lets look at something a bit more something more realistic.
+%%
+%% (defn+ hello-world [foo bar] (baz bang bong))
+%%
+%% In this example the bang node could be identified by everything
+%% leading up to it. So the path would be [defn+, hello-world,
+%% <children>, <start-of_children>, bang]. Lets translate this to our
+%% simple numerical paths. [1, 4, 2]. This should work to any level in
+%% the graph.
+%%
+%% We can make it even easier to manipulate buy having the firstest
+%% point in the graph be the closest point in the list so that we can
+%% push onto the list as we go forward. The actual path in the example
+%% above would be [2, 4, 1] and built up each time we see a list.
+-module(jxa_annot).
+
+-export([new/0,
+ new_path/0,
+ new_base_position/2,
+ add_base_position/2,
+ add/2,
+ add_annot/3,
+ get_annot/2]).
+
+-define(START_CHILDREN_MARKER, -100).
+
+
+-define(PATH_ROOT, -1).
+
+
+%%=============================================================================
+%% Types
+%%=============================================================================
+-type annotations() ::
+ ec_dictionary:dictionary(path(), Annotation::term()).
+
+-type path() :: integer().
+
+%%=============================================================================
+%% Internal Functions
+%%=============================================================================
+
+%% #### new_store
+%%
+%% We store the annotations in an ec_dictionary structure. This
+%% initial dictionary is backed by ec_dict, however, this may change
+%% in the future.
+-spec new() -> annotations().
+new() ->
+ ec_dictionary:new(ec_dict).
+
+%% #### new_path An empty path is simply a list. This function exists
+%% more for documentation then anything else.
+-spec new_path() -> path().
+new_path() ->
+ {0, []}.
+
+-spec new_base_position(non_neg_integer(), path()) -> path().
+new_base_position(Pos, {_, Path}) ->
+ {Pos, Path}.
+
+-spec add_base_position(non_neg_integer(), path()) -> path().
+add_base_position(Pos, {OldPos, Path}) ->
+ {Pos + OldPos, Path}.
+
+%% #### add
+%%
+%% Add a new position to the path.
+-spec add(non_neg_integer(), path()) -> path().
+add(Position, {OldPosition, Path}) ->
+ {OldPosition, [Position + OldPosition | Path]}.
+
+%% #### add
+%%
+%% Given a pre created path, an annotation and the annotations object
+%% we add the annotation at that path.
+-spec add_annot(path(), term(), annotations()) -> annotations().
+add_annot({_, Path}, Annots, Annotations) ->
+ ec_dictionary:add(Path, Annots, Annotations).
+
+%% #### get
+%%
+%% Given a precreated path and an annotations object we get the
+%% annotation at that location.
+-spec get_annot(path(), annotations()) -> term().
+get_annot({_, Path}, Annotations) ->
+ ec_dictionary:get(Path, Annotations).
+
+%%=============================================================================
+%% Internal Functions
+%%=============================================================================
View
228 src/jxa_ctx.erl
@@ -0,0 +1,228 @@
+%% -*- mode: Erlang; fill-column: 80; comment-column: 76; -*-
+-module(jxa_ctx).
+
+-export([new/1,
+ new/3,
+ new/4,
+ annots/1,
+ module_name/1,
+ module_name/2,
+ exports/1,
+ add_export/4,
+ attrs/1,
+ attrs/2,
+ add_attr/2,
+ alias/1,
+ alias/2,
+ add_alias/3,
+ require/1,
+ require/2,
+ add_require/2,
+ use/1,
+ use/2,
+ add_use/5,
+ line/1,
+ line/2,
+ definitions/1,
+ add_exported_definition/5,
+ add_definition/5]).
+
+-export_type([context/0,
+ attr/0,
+ export/0,
+ alias/0,
+ require/0,
+ use/0,
+ definition/0]).
+
+-record(context, {module_name :: atom(),
+ annots :: jxa_annot:annotations(),
+ exports :: [export()],
+ attrs :: [attr()],
+ alias :: alias(),
+ require :: require(),
+ use :: use(),
+ definitions :: definition(),
+ line :: non_neg_integer()}).
+
+%%=============================================================================
+%% Types
+%%=============================================================================
+-type context() :: record(context).
+-type attr() :: {Key::cerl:cerl(), Value::cerl:cerl()}.
+-type alias() :: ec_dictionary:dictionary(module(), module()).
+-type require() :: set().
+-type use_key() :: {FunctionName::atom(), arity()}.
+-type use_value() :: {FunctionName::atom(), ModuleName::module()}.
+-type use() :: ec_dictionary:dictionary(use_key(), use_value()).
+-type definition() :: {cerl:c_fname(), cerl:c_fun()}.
+-type export() :: {Fun::atom(), Arity::non_neg_integer(),
+ Line::non_neg_integer()}.
+%%=============================================================================
+%% Public API
+%%=============================================================================
+
+%% create a new context to use for compilation of the system to use during
+%% compilation.
+-spec new(jxa_annot:annotations()) -> context().
+new(Annots) ->
+ #context{module_name=undefined,
+ attrs=[],
+ exports=[],
+ definitions=[],
+ annots=Annots,
+ alias=ec_dictionary:new(ec_dict),
+ require=sets:new(),
+ use=ec_dictionary:new(ec_dict)}.
+
+-spec new(jxa_annot:annotations(),
+ module(), non_neg_integer()) -> context().
+new(Annots, ModuleName, Line)
+ when is_atom(ModuleName), is_integer(Line) ->
+ #context{module_name=ModuleName,
+ line=Line,
+ annots=Annots,
+ exports=[],
+ attrs=[],
+ definitions=[],
+ alias=ec_dictionary:new(ec_dict),
+ require=sets:new(),
+ use=ec_dictionary:new(ec_dict)}.
+
+%% create a new context with default values for aliased modules, required
+%% modules use 'used' or imported modules.
+%%
+%% Aliases
+%% -------
+%% This is a key value list where both the key and value are represented by
+%% atoms that represent module names. The key is the alias and the module is
+%% the aliased module.
+%%
+%% Requires
+%% --------
+%%
+%% This is a list of modules that may be used in he module. This is represented
+%% as a list of atoms.
+%%
+%% Uses
+%% ----
+%%
+%% This is a property list of key value pairs. The key is a atom that represents
+%% a function. The value is the module that contains the function.
+-spec new(jxa_annot:annotations(),
+ [{module(), module()}],
+ [module()], [{use_key(), use_value()}]) ->
+ context().
+new(Annots, Aliases, Requires, Uses) ->
+ #context{module_name=undefined,
+ annots=Annots,
+ exports=[],
+ attrs=[],
+ definitions=[],
+ alias=ec_dictionary:from_list(ec_dict, Aliases),
+ require=sets:from_list(Requires),
+ use=ec_dictionary:from_list(ec_dict, Uses)}.
+
+-spec annots(context()) -> jxa_annot:annotations().
+annots(#context{annots=Annots}) ->
+ Annots.
+
+-spec line(context()) -> non_neg_integer().
+line(#context{line=Line}) ->
+ Line.
+
+-spec line(non_neg_integer(), context()) -> context().
+line(Line, Ctx0) ->
+ Ctx0#context{line=Line}.
+
+-spec module_name(context()) -> module().
+module_name(#context{module_name=ModuleName}) ->
+ ModuleName.
+
+-spec module_name(module(), context()) -> context().
+module_name(Module, Ctx0) ->
+ Ctx0#context{module_name=Module}.
+
+exports(#context{exports=Exports}) ->
+ Exports.
+
+-spec add_export(Line::non_neg_integer(),
+ Fun::atom(), Arity::non_neg_integer(),
+ context()) ->
+ context().
+add_export(Line, FunName, Arity, Ctx0=#context{exports=Exports}) ->
+ Ctx0#context{exports=[{FunName, Arity, Line} | Exports]}.
+
+-spec attrs(context()) -> [attr()].
+attrs(#context{attrs=Attrs}) ->
+ Attrs.
+
+-spec attrs([attr()], context()) -> context().
+attrs(Attrs, Ctx0) ->
+ Ctx0#context{attrs=Attrs}.
+
+-spec add_attr(attr(), context()) -> context().
+add_attr({Key, Value}, Ctx0=#context{attrs=Attrs}) ->
+ Ctx0#context{attrs=[{Key, Value} | Attrs]}.
+
+-spec alias(context()) -> alias().
+alias(#context{alias=Alias}) ->
+ Alias.
+
+-spec alias(alias(), context()) -> context().
+alias(NewAlias, Ctx0) ->
+ Ctx0#context{alias=NewAlias}.
+
+add_alias(AliasedName, Module, Ctx0=#context{alias=Alias}) ->
+ Ctx0#context{alias=ec_dictionary:add(AliasedName, Module, Alias)}.
+
+-spec require(context()) -> require().
+require(#context{require=Require}) ->
+ Require.
+
+-spec require(module(), context()) -> context().
+require(Require, Ctx0) ->
+ Ctx0#context{require=Require}.
+
+-spec add_require(module(), context()) -> context().
+add_require(Module, Ctx0=#context{require=Require}) ->
+ Ctx0#context{require=sets:add_element(Module, Require)}.
+
+-spec use(context()) -> use().
+use(#context{use=Use}) ->
+ Use.
+
+-spec use(use(), context()) -> context().
+use(Use, Ctx0) ->
+ Ctx0#context{use=Use}.
+
+-spec add_use(FunctionName::atom(), Arity::non_neg_integer(),
+ TargetFun::atom(), TargetModule::module(), context()) ->
+ context().
+add_use(Alias, Arity, Target, Module, Ctx0=#context{use=Use}) ->
+ Ctx0#context{use=ec_dictionary:add({Alias, Arity}, {Target, Module}, Use)}.
+
+-spec definitions(context()) -> [definition()].
+definitions(#context{definitions=Definitions}) ->
+ Definitions.
+
+-spec add_exported_definition(non_neg_integer(),
+ atom(), [cerl:cerl()], cerl:cerl(),
+ context()) ->
+ context().
+add_exported_definition(Line, Name, Vars, Body, Ctx0) ->
+ Arity = erlang:length(Vars),
+ add_definition(Line, Name, Vars, Body,
+ add_export(Line, Name, Arity, Ctx0)).
+
+-spec add_definition(non_neg_integer(),
+ atom(), [cerl:cerl()], cerl:cerl(),
+ context()) ->
+ context().
+add_definition(Line, Name, Vars, Body, Ctx0=#context{definitions=Defs}) ->
+ Arity = erlang:length(Vars),
+ CerlName = cerl:ann_c_fname([Line],
+ Name, Arity),
+ CerlBody = cerl:ann_c_fun([Line], Vars, Body),
+ Ctx0#context{definitions=[{CerlName, CerlBody} | Defs]}.
+
View
65 src/jxa_literal.erl
@@ -0,0 +1,65 @@
+%% -*- mode: Erlang; fill-column: 80; comment-column: 76; -*-
+-module(jxa_literal).
+
+-export([comp/3]).
+
+%%=============================================================================
+%% Types
+%%=============================================================================
+
+%%=============================================================================
+%% Public API
+%%=============================================================================
+-spec comp(jxa_annot:path(), jxa_ctx:context(), term()) -> cerl:cerl().
+comp(Path0, Ctx0, Symbol) when is_atom(Symbol) ->
+ {_, {Line, _}} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ cerl:ann_c_atom([Line], Symbol);
+comp(Path0, Ctx0, Integer) when is_integer(Integer) ->
+ {Type, {Line, _}} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ case Type of
+ integer ->
+ cerl:ann_c_int([Line], Integer);
+ char ->
+ cerl:ann_c_char([Line], Integer)
+ end;
+comp(Path0, Ctx0, Float) when is_float(Float) ->
+ {float, {Line, _}} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ cerl:ann_c_float([Line], float);
+comp(Path0, Ctx0, Element) when is_list(Element) ->
+ {Type, {Line, _}} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ case Type of
+ list ->
+ comp_list(Path0, Line, Ctx0, Element);
+ vector ->
+ comp_vector(Path0, Line, Ctx0, Element);
+ string ->
+ comp_string(Path0, Line, Ctx0, Element)
+ end.
+
+%%=============================================================================
+%% Internal Functions
+%%=============================================================================
+-spec comp_list(jxa_annot:path(), non_neg_integer(), jxa_ctx:context(), list()) ->
+ cerl:cerl().
+comp_list(_Path0, _Line, _Ctx0, []) ->
+ cerl:c_nil();
+comp_list(Path0, Line, Ctx0, [H | T]) ->
+ Path1 = jxa_annot:add_base_position(1, Path0),
+ cerl:ann_c_cons([Line], comp(Path0, Ctx0, H), comp_list(Path1, Line, Ctx0, T)).
+
+-spec comp_vector(jxa_annot:path(), non_neg_integer(), jxa_ctx:context(), list()) ->
+ cerl:cerl().
+comp_vector(Path0, Line, Ctx0, Elements0) ->
+ {_, Elements1} =
+ lists:foldl(fun(Element, {Count0, Acc0}) ->
+ Count1 = Count0 + 1,
+ Acc1 = [comp(jxa_annot:add(Count1, Path0), Ctx0, Element) | Acc0],
+ {Count1, Acc1}
+ end, {0, []}, Elements0),
+ cerl:ann_c_tuple([Line],
+ Elements1).
+
+-spec comp_string(jxa_annot:path(), non_neg_integer(), jxa_ctx:context(), list()) ->
+ cerl:cerl().
+comp_string(_Path0, Line, _Ctx0, String) ->
+ cerl:ann_c_string([Line], String).
View
341 src/jxa_module.erl
@@ -0,0 +1,341 @@
+%% -*- mode: Erlang; fill-column: 76; comment-column: 76; -*-
+%% Joxa Module Definitions
+%% =======================
+%%
+%% Module declarations in Joxa are more complex then module definitions in
+%% Erlang. They follow the Clojure model much more closely then the Erlang
+%% module. That is that all modules used in the system must be required. You
+%% may provide an alias for a dependent module name in both the require
+%% clause and the use clauses. You may also import functions from modules in
+%% the use clause.
+%%
+%% At the moment paramaratized modules are not supported. There may be
+%% mulitiple
+
+-module(jxa_module).
+
+-include_lib("joxa/include/joxa.hrl").
+-export([comp/3, format_exception/1]).
+
+%%=============================================================================
+%% Public API
+%%=============================================================================
+format_exception({invalid_module_declaration, {Line, _}}) ->
+ io_lib:format("Invalid module declaration at line ~p", [Line]);
+format_exception({invalid_module_declaration, -1}) ->
+ "Invalid module declaration";
+format_exception({invalid_require_clause, {Line, Col}}) ->
+ io_lib:format("Invalid require clause in module declaration ~p:~p",
+ [Line, Col]);
+format_exception({invalid_use, non_existant_fun_name, {Line, Column}}) ->
+ io_lib:format("Function specified that does not exist in use clause "
+ "in module declaration ~p:~p",
+ [Line, Column]);
+format_exception({invalid_use, invalid_fun_spec, {Line, Column}}) ->
+ io_lib:format("Malformed function specification at ~p:~p",
+ {Line, Column});
+format_exception({invalid_module, Module, {Line, Column}}) ->
+ io_lib:format("Invalid module (~p) specified at ~p:~p",
+ [Module, Line, Column]).
+
+
+%% Module Form
+%% -----------
+%% The form of the module is defined as follows.
+%%
+%% (module <module_name>
+%% <require>
+%% <use>
+%% <attributes>)
+%%
+%% The module clause is a special form and its contents are not evaluated.
+%%
+%% comp compiles the provided AST into a Joxa context. Later that context
+%% must be compiled to core erlang.
+-spec comp(jxa_annot:path(), jxa_ctx:context(), jxa_parser:ast()) ->
+ xa_ctx:context().
+comp(Path0, Ctx0, [module, ModuleName | Rest])
+ when is_atom(ModuleName) ->
+ Path1 = jxa_annot:add(2, Path0),
+ case jxa_annot:get_annot(Path1, jxa_ctx:annots(Ctx0)) of
+ {ident, {Line, _}} ->
+ comp_body(jxa_annot:new_base_position(2, Path0),
+ jxa_ctx:line(Line,
+ jxa_ctx:module_name(ModuleName, Ctx0)),
+ Rest);
+ {_, Idx} ->
+ ?JXA_THROW({invalid_module_declaration, Idx});
+ _ ->
+ ?JXA_THROW({invalid_module_declaration, -1})
+ end.
+
+%% Module Body
+%% ----------
+%%
+%% The module body may consist of any number of require, use are attribute
+%% clauses in any order. Each clause starts with a (require ...)
+%% (use ....) or (attr ...)
+%%
+-spec comp_body(jxa_annot:path(), jxa_ctx:context(), term()) ->
+ jxa_ctx:context().
+comp_body(_Path0, Ctx0, []) ->
+ Ctx0;
+comp_body(Path0, Ctx0, [[require | ReqBody] | Rest]) ->
+ Ctx1 = comp_require(jxa_annot:new_base_position(1, jxa_annot:add(1, Path0)), Ctx0, ReqBody),
+ comp_body(jxa_annot:add_base_position(1, Path0), Ctx1, Rest);
+comp_body(Path0, Ctx0, [[attr | AttrBody] | Rest]) ->
+ Ctx1 = comp_attr(jxa_annot:new_base_position(1, jxa_annot:add(1, Path0)), Ctx0, AttrBody),
+ comp_body(jxa_annot:add_base_position(1, Path0), Ctx1, Rest);
+comp_body(Path0, Ctx0, [[use | UseBody] | Rest]) ->
+ {_, Idx} = jxa_annot:get_annot(jxa_annot:add(1, Path0), jxa_ctx:annots(Ctx0)),
+ Ctx1 = comp_use(Idx, Ctx0, UseBody, {undefined, []}),
+ comp_body(jxa_annot:add_base_position(1, Path0), Ctx1, Rest).
+
+%% Require Clause
+%% --------------
+%%
+%% The require clause is a list that starts with the ident 'require' and
+%% then contains a require body. Examples of the require and require bodies
+%% appear below.
+%%
+%% (require (erlang string test))
+%% (require string [test :as test])
+%% (require [string :as str])
+%% (require [string :as str1])
+%% (require string test)
+%%
+%% The body of the require contains a list of require clauses, in the form
+%%
+%% (erlang string test)
+%% (string [test :as test])
+%%
+%% or a simple group of require clauses in the form:
+%%
+%% string test
+%% [string :as str] compiler
+%%
+%% Each clause is a module name or a module alias form in the form:
+%%
+%% [string :as str]
+%%
+-spec comp_require(jxa_annot:path(), jxa_ctx:context(),
+ RequireClause::term()) -> jxa_ctx:context().
+comp_require(_Path0, Ctx0, []) ->
+ Ctx0;
+comp_require(Path0, Ctx0, [Module | Rest]) when is_atom(Module) ->
+ try
+ Module:module_info()
+ catch
+ error:undef ->
+ {_, Idx} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ ?JXA_THROW({invalid_require_clause, {bad_module, Module}, Idx})
+ end,
+ Ctx1 = jxa_ctx:add_require(Module, Ctx0),
+ comp_require(Path0, Ctx1, Rest);
+comp_require(Path0, Ctx0, [[Module, as, ModuleAlias] | Rest])
+ when is_atom(Module), is_atom(ModuleAlias) ->
+ Ctx1 = jxa_ctx:add_alias(ModuleAlias, Module,
+ jxa_ctx:add_require(Module, Ctx0)),
+ comp_require(Path0, Ctx1, Rest);
+comp_require(Path0, Ctx0, _Invalid) ->
+ {_, Idx} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ ?JXA_THROW({invalid_require_clause, Idx}).
+
+%% Attribute Clauses
+%% -----------------
+%%
+%% Attribute clauses are the simplest of the three clauses There are simply
+%% a three element list where the first element is the ident 'attr', the
+%% second element is a Joxa term that provides the key value and the third
+%% is a Joxa term that provides the value.
+%%
+%% Attributes follow the form:
+%%
+%% (attr <key> <value>)
+%%
+-spec comp_attr(jxa_annot:path(), jxa_ctx:context(), term()) ->
+ jxa_ctx:context().
+comp_attr(Path0, Ctx0, [Key, Value]) ->
+ jxa_ctx:add_attr({jxa_literal:comp(jxa_annot:add(1, Path0), Ctx0, Key),
+ jxa_literal:comp(jxa_annot:add(2, Path0), Ctx0, Value)},
+ Ctx0);
+comp_attr(Path0, Ctx0, _) ->
+ {_, Idx} = jxa_annot:get_annot(Path0, jxa_ctx:annots(Ctx0)),
+ ?JXA_THROW({invalid_require_clause, Idx}).
+
+%% Use Clauses
+%% -----------
+%%
+%% At last we get to the use clauses. Use clauses are, by far, the most
+%% complex of the header clauses as the both manipulate and subset the
+%% functions buing used while at the same time aliasing the function if
+%% required.
+%%
+%% (use string)
+%% (use [string :only [tokens/2]])
+%% (use [string :exclude [substr/3 join/2 join/3]])
+%% (use [string :rename ([substr/3 str-substring] [join/2 str-join])])
+%% (use [string :as str :only [join/2 substr/3]])
+%% (use [string :as str :only [tokens/2]])
+%% (use [string :as str :exclude [substr/3 join/2 join/3]])
+%% (use [string :as str :rename ([substr/3 str-substring] [join/2 str-join])])
+%%
+%% As you can see each clause may consist of a module name, or a vector/list
+%% that contains a few some clauses. The subcluase is always headed by a
+%% module name, followed by an action, followed by the subject of that
+%% action. The subclause action/subject may ocurre in any order. Even though
+%% some do not make sense when used together. So, for example you could have
+%% the following
+%%
+%% (use [string :rename ([substr/3 str-substring] [join/2 str-join]
+%% :exclude [substr/4 join/2]
+%% :as str)])
+%%
+%% This would be perfectly valid and could use occur in any order at all.
+-spec comp_use(jxa_annot:index(), jxa_ctx:context(), term(),
+ {ModuleName::atom(),
+ Imports::[{FunName::atom(), Arity::non_neg_integer()}]}) ->
+ jxa_ctx:context().
+
+comp_use(_Idx, Ctx0, [], {ModuleName, Exports}) ->
+ populate_use_context({ModuleName, Exports}, Ctx0);
+comp_use(Idx, Ctx0, [[ModuleName | ClauseBody] | Rest], _Acc)
+ when is_atom(ModuleName) ->
+ Exports = get_exports(ModuleName, Idx),
+ Ctx1 = handle_use_clauses(Idx, Ctx0, ClauseBody, {ModuleName, Exports}),
+ comp_use(Idx, Ctx1, Rest, {undefined, []});
+comp_use(Idx, Ctx0, [ModuleName | Rest], _Acc)
+ when is_atom(ModuleName) ->
+ Exports = get_exports(ModuleName, Idx),
+ comp_use(Idx, populate_use_context({ModuleName, Exports}, Ctx0),
+ Rest, {undefined, []}).
+
+
+-spec handle_use_clauses(jxa_annot:index(), jxa_ctx:content(),
+ [term()], {ModuleName::atom(),
+ Exports::[{AliasFun::atom(),
+ Arity::non_neg_integer(),
+ AliasFun::atom()}]}) ->
+ jxa_ctx:context().
+handle_use_clauses(_Idx, Ctx0, [], Acc) ->
+ populate_use_context(Acc, Ctx0);
+handle_use_clauses(Idx, Ctx0, [as, AliasName | Rest], Acc = {ModuleName, _}) ->
+ Ctx1 = jxa_ctx:add_alias(AliasName, ModuleName, Ctx0),
+ handle_use_clauses(Idx, Ctx1, Rest, Acc);
+handle_use_clauses(Idx, Ctx0, [only, TargetFuns | Rest],
+ {ModuleName, Exports0})
+ when is_atom(ModuleName), is_list(TargetFuns) ->
+ Specs = gather_fun_arity_pairs(Idx, TargetFuns, []),
+ Exports1 = lists:foldl(fun({Fun, Arity}, Acc) ->
+ El = {{Fun, Arity}, Fun},
+ case lists:member(El, Exports0) of
+ true ->
+ [El | Acc];
+ false ->
+ ?JXA_THROW({invalid_use,
+ non_existant_fun_name,
+ Idx})
+ end
+ end, [], Specs),
+ handle_use_clauses(Idx, Ctx0, Rest, {ModuleName, Exports1});
+handle_use_clauses(Idx, Ctx0, [exclude, TargetFuns | Rest],
+ {ModuleName, Exports0})
+ when is_atom(ModuleName), is_list(TargetFuns) ->
+ Specs = gather_fun_arity_pairs(Idx, TargetFuns, []),
+ Exports1 = lists:foldl(fun(El = {{Fun, Arity}, _}, Acc) ->
+ El = {{Fun, Arity}, Fun},
+ case lists:member({Fun, Arity}, Specs) of
+ true ->
+ Acc;
+ false ->
+ [El | Acc]
+ end
+ end, [], Exports0),
+ handle_use_clauses(Idx, Ctx0, Rest, {ModuleName, Exports1});
+handle_use_clauses(Idx, Ctx0, [rename, TargetFuns | Rest],
+ {ModuleName, Exports0})
+ when is_atom(ModuleName), is_list(TargetFuns) ->
+ Specs = gather_fun_alias_pairs(Idx, TargetFuns, []),
+ Exports2 =
+ lists:foldl(fun({{Fun, Arity}, Alias}, Exports1) ->
+ lists:keyreplace({Fun, Arity}, 1, Exports1,
+ {{Fun, Arity}, Alias})
+ end, Exports0, Specs),
+ handle_use_clauses(Idx, Ctx0, Rest, {ModuleName, Exports2});
+handle_use_clauses(Idx, Ctx0, ProbablyMoreSpecs, Acc) ->
+ comp_use(Idx, Ctx0, ProbablyMoreSpecs, Acc).
+
+-spec populate_use_context({ModuleName::atom(),
+ Exports::[{Fun::atom(),
+ Arity::non_neg_integer()}]},
+ jxa_ctx:context()) ->
+ jxa_ctx:context().
+populate_use_context({undefined, []}, Ctx0) ->
+ Ctx0;
+populate_use_context({ModuleName, Imports}, Ctx0) ->
+ lists:foldl(fun({{Name, Arity}, AliasName}, Ctx1) ->
+ jxa_ctx:add_use(AliasName, Arity, Name, ModuleName, Ctx1)
+ end, Ctx0, Imports).
+
+%% A Function ref in the module declaration looks as follows
+%%
+%% fun_name/3
+%%
+%% When this is parsed it is actually parsed into three seperate elements. the
+%% atom 'fun_name' the atom '/' and finially the atom 3, this function takes a
+%% form that looks like this:
+%%
+%% [substr/3 str-substring]
+%%
+%% that is parsed into this [substr, '/', 3, 'sub-string'] into a something more
+%% usable in erlang ie
+%%
+%% [{substr, 3}, str-substring]
+%%
+-spec gather_fun_alias_pairs(jxa_annot:index(),
+ [atom() | non_neg_integer()],
+ [{{FunName::atom(), Arity::non_neg_integer()},
+ Alias::atom()}]) ->
+ [{{FunName::atom(),
+ Arity::non_neg_integer()},
+ Alias::atom()}].
+gather_fun_alias_pairs(Idx, [[Fun, '/', Arity, Alias] | Rest], Acc)
+ when is_atom(Fun), is_integer(Arity), is_atom(Alias) ->
+ gather_fun_alias_pairs(Idx, Rest, [{{Fun, Arity}, Alias} | Acc]);
+gather_fun_alias_pairs(_Idx, [], Acc) ->
+ Acc;
+gather_fun_alias_pairs(Idx, _, _) ->
+ ?JXA_THROW({invalid_use, invalid_fun_spec, Idx}).
+
+%% Similar to gather_fun_alias_pairs gather_fun_arity_pairs parses fun refs
+%% in the form of fun_name/3 that get parsed into ['fun_name', '/', 3] into
+%% nice tuples of the furm {fun_name, 3}.
+-spec gather_fun_arity_pairs(jxa_annot:index(),
+ [atom() | non_neg_integer()],
+ [{FunName::atom(), Arity::non_neg_integer()}]) ->
+ [{FunName::atom(),
+ Arity::non_neg_integer()}].
+gather_fun_arity_pairs(Idx, [Fun, '/', Arity | Rest], Acc) ->
+ gather_fun_arity_pairs(Idx, Rest, [{Fun, Arity} | Acc]);
+gather_fun_arity_pairs(_Idx, [], Acc) ->
+ Acc;
+gather_fun_arity_pairs(Idx, _, _Acc) ->
+ ?JXA_THROW({invalid_use, invalid_fun_spec, Idx}).
+
+-spec get_exports(ModuleName::atom(), jxa_parser:index()) ->
+ [{FunName::atom(), Arity::non_neg_integer()}].
+get_exports(Module, Idx) ->
+ case proplists:get_value(exports, Module:module_info()) of
+ undefined ->
+ ?JXA_THROW({undefined_module, Module, Idx});
+ Exports ->
+ [{{Fun, Arity}, Fun} || {Fun, Arity} <- Exports]
+ end.
+
+%%=============================================================================
+%% Unit tests
+%%=============================================================================
+-ifndef(NOTEST).
+-include_lib("eunit/include/eunit.hrl").
+
+-endif.
View
621 src/jxa_parser.erl
@@ -32,162 +32,157 @@
-export([file/1, parse/1]).
--export([p_eof/0,
- p_optional/1,
- p_not/1,
- p_assert/1,
- p_seq/1,
- p_and/1,
- p_choose/1,
- p_zero_or_more/1,
- p_one_or_more/1,
- p_label/2,
- p_string/1,
- p_anything/0,
- p_charclass/1,
- line/1,
- column/1]).
-
--export_type([ast/0]).
+%% for testing purposes
+-export([intermediate_parse/1]).
+
+-export_type([ast/0, type_desc/0, annotation/0]).
%%=============================================================================
%% Types
%%=============================================================================
--type ast() :: {char, char(), non_neg_integer()} |
- {string, string(), non_neg_integer()} |
- {list, [ast()], non_neg_integer()} |
- {vector, [ast()], non_neg_integer()} |
- {float, float(), non_neg_integer()} |
- {integer, integer(), non_neg_integer()} |
- {quote, ast(), non_neg_integer()} |
- {syntax_quote, ast(), non_neg_integer()} |
- {unquote, ast(), non_neg_integer()} |
- {unquote_splicing,
- {list, [ast()], non_neg_integer()} |
- {vector, [ast()], non_neg_integer()}}.
-
--type index() :: {{line, non_neg_integer()}, {column, non_neg_integer()}}.
+-type type_desc() :: char |
+ string |
+ list |
+ vector |
+ float |
+ integer.
+
+-type raw_type() :: char() | string() | list() |
+ float() | integer().
+
+-type intermediate_ast() :: {char, char(), non_neg_integer()} |
+ {string, string(), non_neg_integer()} |
+ {list, [intermediate_ast()], non_neg_integer()} |
+ {vector, [intermediate_ast()], non_neg_integer()} |
+ {float, float(), non_neg_integer()} |
+ {integer, integer(), non_neg_integer()}.
+
+-type ast() :: [ast()] |
+ tuple(ast()) |
+ integer() |
+ float() |
+ atom().
+
+-type annotation() :: {type_desc(), index()}.
+-type index() :: {non_neg_integer(), non_neg_integer()}.
%%=============================================================================
-%% Internal Functions
+%% API
%%=============================================================================
--spec file(string()) -> ast().
+-spec file(string()) -> intermediate_ast().
file(Filename) ->
{ok, Bin} = file:read_file(Filename),
parse(Bin).
--spec parse(string()) -> ast() | fail.
-parse(Input) when is_binary(Input) ->
- parse(Input, new_index()).
+-spec intermediate_parse(binary()) -> intermediate_ast() | fail.
+intermediate_parse(Input) when is_binary(Input) ->
+ intermediate_parse(Input, new_index()).
--spec parse(string(), index()) -> ast() | fail.
-parse(Input, Index) when is_binary(Input) ->
- setup_memo(),
- Result = case value(Input, Index) of
- {AST, [], _Index} -> AST;
- Any -> Any
- end,
- release_memo(),
- Result.
+-spec parse(binary()) -> ast().
+parse(Input) ->
+ {IntermediateAst, _, _} = intermediate_parse(Input),
+ transform_ast(jxa_annot:new_path(), jxa_annot:new(), IntermediateAst).
%%=============================================================================
%% Internal Functions
%%=============================================================================
+-spec transform_ast(jxa_annot:path(), jxa_annot:annotations(), fail | intermediate_ast()) ->
+ {jxa_annot:annotations(), raw_type()}.
+transform_ast(_, _, fail) ->
+ erlang:throw(fail);
+transform_ast(Path0, Annotations, {Type, Ident, Idx})
+ when Type == symbol; Type == ident ->
+ AIdent = list_to_atom(Ident),
+ {jxa_annot:add_annot(Path0, {Type, Idx}, Annotations),
+ AIdent};
+transform_ast(Path0, Annotations, {char, Char, Idx}) ->
+ {jxa_annot:add_annot(Path0, {char, Idx}, Annotations), Char};
+transform_ast(Path0, Annotations, {string, List, Idx}) ->
+ {jxa_annot:add_annot(Path0, {string, Idx}, Annotations), List};
+transform_ast(Path0, Annotations, {float, Float, Idx}) ->
+ {jxa_annot:add_annot(Path0, {float, Idx}, Annotations), Float};
+transform_ast(Path0, Annotations, {integer, Integer, Idx}) ->
+ {jxa_annot:add_annot(Path0, {integer, Idx}, Annotations), Integer};
+transform_ast(Path0, Annotations0, {Type, List, Idx})
+ when Type == vector; Type == list ->
+ {_, Annotations3, TransformList} =
+ lists:foldl(fun(El, {Count0, Annotations1, Elements}) ->
+ Count1 = Count0 + 1,
+ {Annotations2, Transformed} =
+ transform_ast(jxa_annot:add(Count1, Path0), Annotations1, El),
+ {Count1, Annotations2, [Transformed | Elements]}
+ end, {0, Annotations0, []}, List),
+ {jxa_annot:add_annot(Path0, {Type, Idx}, Annotations3),
+ lists:reverse(TransformList)}.
+
+-spec intermediate_parse(string(), index()) -> intermediate_ast() | fail.
+intermediate_parse(Input, Index) when is_binary(Input) ->
+ setup_memo(),
+ Result = case value(Input, Index) of
+ {AST, [], _Index} -> AST;
+ Any -> Any
+ end,
+ release_memo(),
+ Result.
+
-spec index() -> index().
new_index() ->
- {{line,1}, {column,1}}.
-
--spec syntax_quote(binary(), index()) -> ast().
-syntax_quote(Input, Index) ->
- p(Input, Index, syntax_quote,
- p_seq([p_string("`"),
- fun value/2]),
- fun([_, Ast], Idx) ->
- {syntax_quote, Ast, line(Idx)}
- end).
+ {1, 1}.
-
--spec unquote_splicing(binary(), index()) -> ast().
-unquote_splicing(Input, Index) ->
- p(Input, Index, unquote_splicing,
- p_seq([p_string("~@"),
- fun list/2]),
- fun([_, AST], Idx) ->
- {unquote_splicing, AST, line(Idx)}
- end).
-
--spec unquote(binary(), index()) -> ast().
-unquote(Input, Index) ->
- p(Input, Index, unquote,
- p_seq([p_string("~"),
- fun value/2]),
- fun([_, AST], Idx) ->
- {unquote, AST, line(Idx)}
- end).
-
--spec quote(binary(), index()) -> ast().
-quote(Input, Index) ->
- p(Input, Index, quote,
- p_seq([p_string("'"),
- fun value/2]),
- fun([_, AST], Idx) ->
- {quote, AST, line(Idx)}
- end).
-
--spec integer(binary(), index()) -> ast().
+-spec integer(binary(), index()) -> intermediate_ast().
integer(Input, Index) ->
p(Input, Index, integer,
fun int_part/2,
fun(Node, Idx) ->
Result =
list_to_integer(binary_to_list(iolist_to_binary(Node))),
- {integer, Result, line(Idx)}
+ {integer, Result, Idx}
end).
--spec float(binary(), index()) -> ast().
+-spec float(binary(), index()) -> intermediate_ast().
float(Input, Index) ->
p(Input, Index, float,
p_seq([fun int_part/2,
fun frac_part/2,
p_optional(fun exp_part/2)]),
- fun(Node, Idx) ->
- Result =
- list_to_float(binary_to_list(iolist_to_binary(Node))),
- {float, Result, line(Idx)}
- end).
+ fun(Node, Idx) ->
+ Result =
+ list_to_float(binary_to_list(iolist_to_binary(Node))),
+ {float, Result, Idx}
+ end).
--spec char(binary(), index()) -> ast().
+-spec char(binary(), index()) -> intermediate_ast().
char(Input, Index) ->
p(Input, Index, char,
- p_seq([p_string(<<"\\">>),
- p_anything()]),
+ p_seq([p_string(<<"\\">>),
+ p_anything()]),
fun([_, Char], Idx) ->
- {char, Char, line(Idx)}
+ {char, Char, Idx}
end).
--spec int_part(binary(), index()) -> ast().
+-spec int_part(binary(), index()) -> intermediate_ast().
int_part(Input, Index) ->
p(Input, Index, int_part,
p_seq([p_optional(p_string(<<"-">>)),
p_one_or_more(fun digit/2)])).
--spec frac_part(binary(), index()) -> ast().
+-spec frac_part(binary(), index()) -> intermediate_ast().
frac_part(Input, Index) ->
p(Input, Index, frac_part,
fun(I,D) ->
- (p_seq([p_string(<<".">>), p_one_or_more(fun 'digit'/2)]))(I,D)
+ (p_seq([p_string(<<".">>), p_one_or_more(fun digit/2)]))(I,D)
end).
--spec exp_part(binary(), index()) -> ast().
+-spec exp_part(binary(), index()) -> intermediate_ast().
exp_part(Input, Index) ->
p(Input, Index, exp_part,
fun(I,D) ->
(p_seq([fun 'e'/2, p_one_or_more(fun 'digit'/2)]))(I,D)
end).
--spec e(binary(), index()) -> ast().
+-spec e(binary(), index()) -> intermediate_ast().
e(Input, Index) ->
p(Input, Index, e,
fun(I,D) ->
@@ -196,64 +191,55 @@ e(Input, Index) ->
p_string(<<"-">>)]))]))(I,D)
end).
--spec non_zero_digit(binary(), index()) -> ast().
-non_zero_digit(Input, Index) ->
- p(Input, Index, non_zero_digit,
- fun(I,D) ->
- (p_charclass(<<"[1-9]">>))(I,D)
- end).
-
--spec digit(binary(), index()) -> ast().
digit(Input, Index) ->
p(Input, Index, digit,
fun(I,D) ->
(p_charclass(<<"[0-9]">>))(I,D)
end).
--spec vector(binary(), index()) -> ast().
+-spec vector(binary(), index()) -> intermediate_ast().
vector(Input, Index) ->
p(Input, Index, vector,
- fun(I,D) ->
- (p_choose([p_seq([p_string(<<"[">>),
- p_optional(fun 'space'/2),
- fun value/2,
- p_zero_or_more(p_seq([fun space/2,
- fun value/2])),
- p_optional(fun space/2),
- p_string(<<"]">>)]),
- p_seq([p_string(<<"[">>),
- p_optional(fun 'space'/2),
- p_string(<<"]">>)])]))(I,D)
- end,
+ fun(I,D) ->
+ (p_choose([p_seq([p_string(<<"[">>),
+ p_optional(fun 'space'/2),
+ fun value/2,
+ p_zero_or_more(p_seq([fun space/2,
+ fun value/2])),
+ p_optional(fun space/2),
+ p_string(<<"]">>)]),
+ p_seq([p_string(<<"[">>),
+ p_optional(fun 'space'/2),
+ p_string(<<"]">>)])]))(I,D)
+ end,
fun([_, _, H, T, _, _], Idx) ->
- {vector, lists:flatten([H, T]), line(Idx)};
+ {vector, lists:flatten([H, T]), Idx};
([_, _, _], Idx) ->
- {vector, [], line(Idx)}
+ {vector, [], Idx}
end).
-
--spec list(binary(), index()) -> ast().
+-spec list(binary(), index()) -> intermediate_ast().
list(Input, Index) ->
p(Input, Index, list,
- fun(I,D) ->
- (p_choose([p_seq([p_string(<<"(">>),
- p_optional(fun 'space'/2),
- fun value/2,
- p_zero_or_more(p_seq([fun space/2,
- fun value/2])),
- p_optional(fun space/2),
- p_string(<<")">>)]),
- p_seq([p_string(<<"(">>),
- p_optional(fun 'space'/2),
- p_string(<<")">>)])]))(I,D)
- end,
+ fun(I,D) ->
+ (p_choose([p_seq([p_string(<<"(">>),
+ p_optional(fun 'space'/2),
+ fun value/2,
+ p_zero_or_more(p_seq([fun space/2,
+ fun value/2])),
+ p_optional(fun space/2),
+ p_string(<<")">>)]),
+ p_seq([p_string(<<"(">>),
+ p_optional(fun 'space'/2),
+ p_string(<<")">>)])]))(I,D)
+ end,
fun([_, _, H, T, _, _], Idx) ->
- {list, lists:flatten([H, T]), line(Idx)};
+ {list, lists:flatten([H, T]), Idx};
([_, _, _], Idx) ->
- {list, [], line(Idx)}
+ {list, [], Idx}
end).
--spec string(binary(), index()) -> ast().
+-spec string(binary(), index()) -> intermediate_ast().
string(Input, Index) ->
p(Input, Index, string,
p_seq([p_string(<<"\"">>),
@@ -287,29 +273,39 @@ string(Input, Index) ->
El
end,
Node))),
- {string, Result, line(Idx)}
+ {string, Result, Idx}
end).
--spec space(binary(), index()) -> ast().
+-spec space(binary(), index()) -> intermediate_ast().
space(Input, Index) ->
p(Input, Index, space,
- fun(I,D) ->
- (p_zero_or_more(p_charclass(<<"[ \t\n\s\r]">>)))(I,D)
+ p_zero_or_more(p_charclass(<<"[ \t\n\s\r]">>))).
+
+-spec symbol(binary(), index()) -> intermediate_ast().
+symbol(Input, Index) ->
+ p(Input, Index, symbol,
+ p_seq([p_string(":"),
+ fun ident/2]),
+ fun([_, {ident, Symbol, _}], Idx) ->
+ Result =
+ binary_to_list(iolist_to_binary(Symbol)),
+ {symbol, Result, Idx}
end).
--spec ident(binary(), index()) -> ast().
+-spec ident(binary(), index()) -> intermediate_ast().
ident(Input, Index) ->
p(Input, Index, ident,
- p_one_or_more(p_and([p_not(p_charclass(<<"[ \t\n\s\r\\(\\)\\[\\]\"]">>)),
- p_anything()])),
+ p_choose([p_string("/"),
+ p_one_or_more(p_and([p_not(p_charclass(<<"[ /\t\n\s\r\\(\\)\\[\\]\"]">>)),
+ p_anything()]))]),
fun(Node, Idx) ->
Result =
binary_to_list(iolist_to_binary(Node)),
- {ident, Result, line(Idx)}
+ {ident, Result, Idx}
end).
--spec value(binary(), index()) -> ast().
+-spec value(binary(), index()) -> intermediate_ast().
value(Input, Index) ->
p(Input, Index, value,
fun(I,D) ->
@@ -319,175 +315,157 @@ value(Input, Index) ->
fun float/2,
fun integer/2,
fun char/2,
- fun syntax_quote/2,
- fun unquote_splicing/2,
- fun unquote/2,
- fun quote/2,
fun string/2,
+ fun symbol/2,
fun ident/2]),
p_optional(fun space/2)]))(I,D) end,
fun(Node, _Idx) ->
lists:nth(2, Node)
end).
p(Inp, Index, Name, ParseFun) ->
- p(Inp, Index, Name, ParseFun, fun(N, _Idx) -> N end).
+ p(Inp, Index, Name, ParseFun, fun(N, _Idx) -> N end).
p(Inp, StartIndex, Name, ParseFun, TransformFun) ->
- case get_memo(StartIndex, Name) of % See if the current reduction is memoized
- {ok, Memo} -> %Memo; % If it is, return the stored result
- Memo;
- _ -> % If not, attempt to parse
- Result = case ParseFun(Inp, StartIndex) of
- {fail,_} = Failure -> % If it fails, memoize the failure
- Failure;
- {Match, InpRem, NewIndex} -> % If it passes, transform and memoize the result.
- Transformed = TransformFun(Match, StartIndex),
- {Transformed, InpRem, NewIndex}
- end,
- memoize(StartIndex, Name, Result),
- Result
- end.
-
+ %% See if the current reduction is memoized
+ case get_memo(StartIndex, Name) of
+ %% If it is, return the stored result
+ {ok, Memo} ->
+ Memo;
+ _ ->
+ %% If not, attempt to parse
+ Result =
+ case ParseFun(Inp, StartIndex) of
+ %% If it fails, memoize the failure
+ {fail,_} = Failure ->
+ Failure;
+ %% If it passes, transform and memoize the result.
+ {Match, InpRem, NewIndex} ->
+ Transformed = TransformFun(Match, StartIndex),
+ {Transformed, InpRem, NewIndex}
+ end,
+ memoize(StartIndex, Name, Result),
+ Result
+ end.
setup_memo() ->
- put(parse_memo_table, ets:new(?MODULE, [set])).
+ put(parse_memo_table, ets:new(?MODULE, [set])).
release_memo() ->
- ets:delete(memo_table()).
+ ets:delete(memo_table()).
memoize(Index, Name, Result) ->
- Memo = case ets:lookup(memo_table(), Index) of
- [] -> [];
- [{Index, Plist}] -> Plist
- end,
- ets:insert(memo_table(), {Index, [{Name, Result}|Memo]}).
+ Memo = case ets:lookup(memo_table(), Index) of
+ [] -> [];
+ [{Index, Plist}] -> Plist
+ end,
+ ets:insert(memo_table(), {Index, [{Name, Result}|Memo]}).
get_memo(Index, Name) ->
- case ets:lookup(memo_table(), Index) of
- [] -> {error, not_found};
- [{Index, Plist}] ->
- case proplists:lookup(Name, Plist) of
- {Name, Result} -> {ok, Result};
- _ -> {error, not_found}
- end
+ case ets:lookup(memo_table(), Index) of
+ [] -> {error, not_found};
+ [{Index, Plist}] ->
+ case proplists:lookup(Name, Plist) of
+ {Name, Result} -> {ok, Result};
+ _ -> {error, not_found}
+ end
end.
memo_table() ->
get(parse_memo_table).
-p_eof() ->
- fun(<<>>, Index) -> {eof, [], Index};
- (_, Index) -> {fail, {expected, eof, Index}} end.
-
p_optional(P) ->
- fun(Input, Index) ->
- case P(Input, Index) of
- {fail,_} -> {[], Input, Index};
- {_, _, _} = Success -> Success
- end
- end.
+ fun(Input, Index) ->
+ case P(Input, Index) of
+ {fail,_} -> {[], Input, Index};
+ {_, _, _} = Success -> Success
+ end
+ end.
p_not(P) ->
- fun(Input, Index)->
- case P(Input,Index) of
- {fail,_} ->
- {[], Input, Index};
- {Result, _, _} -> {fail, {expected, {no_match, Result},Index}}
- end
- end.
-
-p_assert(P) ->
- fun(Input,Index) ->
- case P(Input,Index) of
- {fail,_} = Failure-> Failure;
- _ -> {[], Input, Index}
- end
- end.
+ fun(Input, Index)->
+ case P(Input,Index) of
+ {fail,_} ->
+ {[], Input, Index};
+ {Result, _, _} -> {fail, {expected, {no_match, Result},Index}}
+ end
+ end.
p_and(P) ->
- p_seq(P).
+ p_seq(P).
p_seq(P) ->
- fun(Input, Index) ->
- p_all(P, Input, Index, [])
- end.
+ fun(Input, Index) ->
+ p_all(P, Input, Index, [])
+ end.
p_all([], Inp, Index, Accum ) -> {lists:reverse( Accum ), Inp, Index};
p_all([P|Parsers], Inp, Index, Accum) ->
- case P(Inp, Index) of
- {fail, _} = Failure -> Failure;
- {Result, InpRem, NewIndex} -> p_all(Parsers, InpRem, NewIndex, [Result|Accum])
- end.
+ case P(Inp, Index) of
+ {fail, _} = Failure -> Failure;
+ {Result, InpRem, NewIndex} ->
+ p_all(Parsers, InpRem, NewIndex, [Result|Accum])
+ end.
p_choose(Parsers) ->
- fun(Input, Index) ->
- p_attempt(Parsers, Input, Index, none)
- end.
+ fun(Input, Index) ->
+ p_attempt(Parsers, Input, Index, none)
+ end.
p_attempt([], _Input, _Index, Failure) -> Failure;
p_attempt([P|Parsers], Input, Index, FirstFailure)->
- case P(Input, Index) of
- {fail, _} = Failure ->
- case FirstFailure of
- none -> p_attempt(Parsers, Input, Index, Failure);
- _ -> p_attempt(Parsers, Input, Index, FirstFailure)
- end;
- Result -> Result
- end.
+ case P(Input, Index) of
+ {fail, _} = Failure ->
+ case FirstFailure of
+ none -> p_attempt(Parsers, Input, Index, Failure);
+ _ -> p_attempt(Parsers, Input, Index, FirstFailure)
+ end;
+ Result -> Result
+ end.
p_zero_or_more(P) ->
- fun(Input, Index) ->
- p_scan(P, Input, Index, [])
- end.
+ fun(Input, Index) ->
+ p_scan(P, Input, Index, [])
+ end.
p_one_or_more(P) ->
- fun(Input, Index)->
- Result = p_scan(P, Input, Index, []),
- case Result of
- {[_|_], _, _} ->
- Result;
- _ ->
- {fail, {expected, Failure, _}} = P(Input,Index),
- {fail, {expected, {at_least_one, Failure}, Index}}
- end
- end.
-
-p_label(Tag, P) ->
- fun(Input, Index) ->
- case P(Input, Index) of
- {fail,_} = Failure ->
- Failure;
- {Result, InpRem, NewIndex} ->
- {{Tag, Result}, InpRem, NewIndex}
- end
- end.
+ fun(Input, Index)->
+ Result = p_scan(P, Input, Index, []),
+ case Result of
+ {[_|_], _, _} ->
+ Result;
+ _ ->
+ {fail, {expected, Failure, _}} = P(Input,Index),
+ {fail, {expected, {at_least_one, Failure}, Index}}
+ end
+ end.
p_scan(_, [], Index, Accum) -> {lists:reverse( Accum ), [], Index};
p_scan(P, Inp, Index, Accum) ->
- case P(Inp, Index) of
- {fail,_} -> {lists:reverse(Accum), Inp, Index};
- {Result, InpRem, NewIndex} -> p_scan(P, InpRem, NewIndex, [Result | Accum])
- end.
+ case P(Inp, Index) of
+ {fail,_} -> {lists:reverse(Accum), Inp, Index};
+ {Result, InpRem, NewIndex} ->
+ p_scan(P, InpRem, NewIndex, [Result | Accum])
+ end.
p_string(S) when is_list(S) -> p_string(list_to_binary(S));
p_string(S) ->
Length = erlang:byte_size(S),
fun(Input, Index) ->
- try
- <<S:Length/binary, Rest/binary>> = Input,
- {S, Rest, p_advance_index(S, Index)}
- catch
- error:{badmatch,_} -> {fail, {expected, {string, S}, Index}}
- end
+ try
+ <<S:Length/binary, Rest/binary>> = Input,
+ {S, Rest, p_advance_index(S, Index)}
+ catch
+ error:{badmatch,_} -> {fail, {expected, {string, S}, Index}}
+ end
end.
p_anything() ->
- fun(<<>>, Index) -> {fail, {expected, any_character, Index}};
- (Input, Index) when is_binary(Input) ->
- <<C/utf8, Rest/binary>> = Input,
- {<<C/utf8>>, Rest, p_advance_index(<<C/utf8>>, Index)}
- end.
+ fun(<<>>, Index) -> {fail, {expected, any_character, Index}};
+ (Input, Index) when is_binary(Input) ->
+ <<C/utf8, Rest/binary>> = Input,
+ {<<C/utf8>>, Rest, p_advance_index(<<C/utf8>>, Index)}
+ end.
p_charclass(Class) ->
{ok, RE} = re:compile(Class, [unicode, dotall]),
@@ -496,24 +474,24 @@ p_charclass(Class) ->
{match, [{0, Length}|_]} ->
{Head, Tail} = erlang:split_binary(Inp, Length),
{Head, Tail, p_advance_index(Head, Index)};
- _ -> {fail, {expected, {character_class, binary_to_list(Class)}, Index}}
+ _ ->
+ {fail, {expected, {character_class,
+ binary_to_list(Class)}, Index}}
end
end.
-line({{line,L},_}) -> L;
-line(_) -> undefined.
-
-column({_,{column,C}}) -> C;
-column(_) -> undefined.
-
-p_advance_index(MatchedInput, Index) when is_list(MatchedInput) orelse is_binary(MatchedInput)-> % strings
- lists:foldl(fun p_advance_index/2, Index, unicode:characters_to_list(MatchedInput));
-p_advance_index(MatchedInput, Index) when is_integer(MatchedInput) -> % single characters
- {{line, Line}, {column, Col}} = Index,
- case MatchedInput of
- $\n -> {{line, Line+1}, {column, 1}};
- _ -> {{line, Line}, {column, Col+1}}
- end.
+p_advance_index(MatchedInput, Index)
+ when is_list(MatchedInput) orelse is_binary(MatchedInput)->
+ lists:foldl(fun p_advance_index/2,
+ Index,
+ unicode:characters_to_list(MatchedInput));
+p_advance_index(MatchedInput, Index)
+ when is_integer(MatchedInput) ->
+ {Line, Col} = Index,
+ case MatchedInput of
+ $\n -> {Line+1, 1};
+ _ -> {Line, Col+1}
+ end.
%%=============================================================================
%% Unit tests
@@ -522,60 +500,75 @@ p_advance_index(MatchedInput, Index) when is_integer(MatchedInput) -> % single c
-include_lib("eunit/include/eunit.hrl").
index() ->
- {{line,1}, {column,1}}.
+ {1, 1}.
-define(memo(X), setup_memo(), X, release_memo()).
number_test() ->
- ?memo(?assertMatch({{integer, 44, 1}, <<>>, _}, value(<<"44">>, index()))),
- ?memo(?assertMatch({{integer, -44, 1}, <<>>, _}, value(<<"-44">>, index()))),
- ?memo(?assertMatch({{float, 44.00, 1}, <<>>, _}, value(<<"44.00">>, index()))),
- ?memo(?assertMatch({{float, -44.01, 1}, <<>>, _}, value(<<"-44.01">>, index()))),
- ?memo(?assertMatch({{float, 44.00e+33, 1}, <<>>, _},
+ ?memo(?assertMatch({{integer, 44, {1, _}}, <<>>, _}, value(<<"44">>, index()))),
+ ?memo(?assertMatch({{integer, -44, {1, _}}, <<>>, _}, value(<<"-44">>, index()))),
+ ?memo(?assertMatch({{float, 44.00, {1, _}}, <<>>, _}, value(<<"44.00">>, index()))),
+ ?memo(?assertMatch({{float, -44.01, {1, _}}, <<>>, _}, value(<<"-44.01">>, index()))),
+ ?memo(?assertMatch({{float, 44.00e+33, {1, _}}, <<>>, _},
value(<<"44.00e+33">>, index()))),
- ?memo(?assertMatch({{float, 44.00e33, 1}, <<>>, _}, value(<<"44.00e33">>, index()))),
- ?memo(?assertMatch({{float, 44.00e-10, 1}, <<>>, _},
+ ?memo(?assertMatch({{float, 44.00e33, {1, _}}, <<>>, _}, value(<<"44.00e33">>, index()))),
+ ?memo(?assertMatch({{float, 44.00e-10, {1, _}}, <<>>, _},
value(<<"44.00e-10">>, index()))),
- ?memo(?assertMatch({{float, 42.44, 1}, <<>>, _}, value(<<"42.44">>, index()))),
- ?memo(?assertMatch({{float, 41.33, 1}, <<>>, _}, value(<<"41.33">>, index()))),
- ?memo(?assertMatch({{integer, 0, 1}, <<>>, _}, value(<<"0">>, index()))),
- ?memo(?assertMatch({{float, -0.1, 1}, <<>>, _}, value(<<"-0.1">>, index()))).
+ ?memo(?assertMatch({{float, 42.44, {1, _}}, <<>>, _}, value(<<"42.44">>, index()))),
+ ?memo(?assertMatch({{float, 41.33, {1, _}}, <<>>, _}, value(<<"41.33">>, index()))),
+ ?memo(?assertMatch({{integer, 0, {1, _}}, <<>>, _}, value(<<"0">>, index()))),
+ ?memo(?assertMatch({{float, -0.1, {1, _}}, <<>>, _}, value(<<"-0.1">>, index()))).
string_test() ->
- ?memo(?assertMatch({{string, "Hello World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello World", {1, _}}, <<>>, _},
value(<<"\"Hello World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\n World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\n World", {1, _}}, <<>>, _},
value(<<"\"Hello\n World\"">>, index()))),
- ?memo(?assertMatch({{string,"Hello \\\" World",1}, <<>>, _},
+ ?memo(?assertMatch({{string,"Hello \\\" World", {1, _}}, <<>>, _},
value(<<"\"Hello \\\\\\\" World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\\ World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\\ World", {1, _}}, <<>>, _},
value(<<"\"Hello\\ World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\/ World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\/ World", {1, _}}, <<>>, _},
value(<<"\"Hello\/ World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\b World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\b World", {1, _}}, <<>>, _},
value(<<"\"Hello\b World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\f World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\f World", {1, _}}, <<>>, _},
value(<<"\"Hello\f World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\n World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\n World", {1, _}}, <<>>, _},
value(<<"\"Hello\n World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\r World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\r World", {1, _}}, <<>>, _},
value(<<"\"Hello\r World\"">>, index()))),
- ?memo(?assertMatch({{string, "Hello\t World", 1}, <<>>, _},
+ ?memo(?assertMatch({{string, "Hello\t World", {1, _}}, <<>>, _},
value(<<"\"Hello\t World\"">>, index()))).
ident_test() ->
- ?memo(?assertMatch({{ident, "true", 1}, <<>>, _}, value(<<"true">>, index()))),
- ?memo(?assertMatch({{ident, "false", 1}, <<>>, _},value(<<"false">>, index()))),
- ?memo(?assertMatch({{ident, ":keyword", 1}, <<>>, _},
+ ?memo(?assertMatch({{ident, "true", {1, _}}, <<>>, _}, value(<<"true">>, index()))),
+ ?memo(?assertMatch({{ident, "false", {1, _}}, <<>>, _},value(<<"false">>, index()))),
+ ?memo(?assertMatch({{symbol, "keyword", {1, _}}, <<>>, _},
value(<<":keyword">>, index()))),
- ?memo(?assertMatch({{ident, "*foo*", 1}, <<>>, _}, value(<<"*foo*">>, index()))),
- ?memo(?assertMatch({{ident, "foo-bar", 1}, <<>>, _}, value(<<"foo-bar">>, index()))),
- ?memo(?assertMatch({{ident, "null", 1}, <<>>, _}, value(<<"null">>, index()))),
- ?memo(?assertMatch({{ident, "Hello?", 1}, <<>>, _}, value(<<"Hello?">>, index()))),
- ?memo(?assertMatch({{ident, "boo88", 1}, <<>>, _}, value(<<"boo88">>, index()))),
- ?memo(?assertMatch({{ident, "bock:", 1}, <<>>, _}, value(<<"bock:">>, index()))),
- ?memo(?assertMatch({{ident, "bock{", 1}, <<>>, _}, value(<<"bock{">>, index()))),
- ?memo(?assertMatch({{ident, "bock", 1}, <<"[">>, _}, value(<<"bock[">>, index()))),
- ?memo(?assertMatch({{ident, "bock", 1}, <<"(ee">>, _}, value(<<"bock(ee">>, index()))).
+ ?memo(?assertMatch({{ident, "*foo*", {1, _}}, <<>>, _}, value(<<"*foo*">>, index()))),
+ ?memo(?assertMatch({{ident, "foo-bar", {1, _}}, <<>>, _}, value(<<"foo-bar">>, index()))),
+ ?memo(?assertMatch({{ident, "null", {1, _}}, <<>>, _}, value(<<"null">>, index()))),
+ ?memo(?assertMatch({{ident, "Hello?", {1, _}}, <<>>, _}, value(<<"Hello?">>, index()))),
+ ?memo(?assertMatch({{ident, "boo88", {1, _}}, <<>>, _}, value(<<"boo88">>, index()))),
+ ?memo(?assertMatch({{ident, "bock:", {1, _}}, <<>>, _}, value(<<"bock:">>, index()))),
+ ?memo(?assertMatch({{ident, "bock{", {1, _}}, <<>>, _}, value(<<"bock{">>, index()))),
+ ?memo(?assertMatch({{ident, "bock", {1, _}}, <<"[">>, _}, value(<<"bock[">>, index()))),
+ ?memo(?assertMatch({{ident, "bock", {1, _}}, <<"(ee">>, _}, value(<<"bock(ee">>, index()))).
+
+parse_test() ->
+ Value = list_to_binary("(io:format \n \"~p\" \n '(\n(foo \n bar \n baz 33)))"),
+ {Annots, Result} = parse(Value),
+ ?assertMatch(['io:format', "~p", '\'',
+ [[foo, bar, baz, 33]]], Result),
+
+ ?assertMatch({ident, {1, 2}},
+ jxa_annot:get_annot({0, [1]}, Annots)),
+ ?assertMatch({string, {2, 2}},
+ jxa_annot:get_annot({0, [2]}, Annots)),
+ ?assertMatch({ident, {3, 2}},
+ jxa_annot:get_annot({0, [3]}, Annots)),
+ ?assertMatch({ident, {4, 2}},
+ jxa_annot:get_annot({0, [1, 1, 4]}, Annots)).
-endif.
View
26 test/jxat_bare_module.erl
@@ -0,0 +1,26 @@
+-module(jxat_bare_module).
+
+-export([given/3, 'when'/3, then/3]).
+
+-include_lib("eunit/include/eunit.hrl").
+
+given([a,bare,module], _State, _) ->
+ Module = <<"(module my-module)">>,
+ {ok, Module}.
+
+'when'([joxa,is,called,on,this,module], State, _) ->
+ Result = joxa:comp('my-module', State),
+ {ok, Result}.
+
+then([a,beam,binary,is,produced], State={_Ctx, Binary}, _) ->
+ ?assertMatch(true, is_binary(Binary)),
+ ?assertMatch([{module_info,0},{module_info,1}],
+ 'my-module':module_info(exports)),
+ ?assertMatch([],
+ 'my-module':module_info(imports)),
+
+ {ok, State};
+then([the,joxa,context,for,a,bare,module,is,correctly,formed], State={Ctx, _}, _) ->
+ ?assertMatch('my-module', jxa_ctx:module_name(Ctx)),
+ {ok, State}.
+
View
126 test/jxat_featureful_module.erl
@@ -0,0 +1,126 @@
+-module(jxat_featureful_module).
+
+-export([given/3, 'when'/3, then/3]).
+
+-include_lib("eunit/include/eunit.hrl").
+given([a,featureful,module], _State, _) ->
+ Source = <<"(module jxat-featureful
+ (use string code)
+ (attr sfoo 123)
+ (use [lists :only [member/2 append/2]
+ :rename [[member/2 mbr]]])
+ (use [file :as f
+ :exclude [delete/1]
+ :rename [[change_group/2 chgrp] [change_mode/2 chmod]]])
+ (attr super_duper \"Hello World\")
+ (require [proplists :as props])
+ (require erlang code)
+ (use [filename :exclude [flatten/1 append/2 join/2 absname/1 absname_join/2]]))">>,
+ {ok, Source}.
+
+'when'([joxa,is,called,on,this,module], State, _) ->
+ Result = joxa:comp('jxat-featureful', State),
+ {ok, Result}.
+
+then([a,beam,binary,is,produced], State={_, Binary}, _) ->
+ ?assertMatch(true, is_binary(Binary)),
+ {ok, State};
+then([the,joxa,context,for,a,featureful,module,is,correctly,formed], State={Ctx0, _}, _) ->
+ validate_module(string, Ctx0),
+ validate_module(code, Ctx0),
+ validate_lists(Ctx0),
+ validate_file(Ctx0),
+ validate_filename(Ctx0),
+ Required = jxa_ctx:require(Ctx0),
+ Alias = jxa_ctx:alias(Ctx0),
+ _Attrs = jxa_ctx:attrs(Ctx0),
+ ?assertMatch(true, sets:is_element(proplists, Required)),
+ ?assertMatch(true, sets:is_element(erlang, Required)),
+ ?assertMatch(true, sets:is_element(code, Required)),
+ ?assertMatch(proplists, ec_dictionary:get(props, Alias)),
+ ?assertMatch(file, ec_dictionary:get(f, Alias)),
+ ?assertMatch("Hello World",
+ proplists:get_value(super_duper,
+ 'jxat-featureful':module_info(attributes))),
+
+ ?assertMatch(123,
+ proplists:get_value(sfoo,
+ 'jxat-featureful':module_info(attributes))),
+ {ok, State}.
+
+validate_module(Module, Ctx0) ->
+ %% module_info causes problems and is mostly ignored
+ Exports = [El || El={Fun, _}
+ <- proplists:get_value(exports, Module:module_info()),
+ Fun =/= module_info],
+ Used = jxa_ctx:use(Ctx0),
+ lists:foreach(fun(Export={Fun, _}) ->
+ ?assertMatch({Fun, Module},
+ ec_dictionary:get(Export, Used))
+ end, Exports).
+
+validate_lists(Ctx0) ->
+ Required = [{append, 2}],
+ Exports = [El || El={Fun, _}
+ <- proplists:get_value(exports, lists:module_info()),
+ Fun =/= module_info],
+ FilteredExports = [FunArity || FunArity <- Exports,
+ not lists:member(FunArity, Required)],
+ Used = jxa_ctx:use(Ctx0),
+ lists:foreach(fun(Export={Fun, _}) ->
+ ?assertMatch({Fun, lists},
+ ec_dictionary:get(Export, Used))
+ end, Required),
+
+ ?assertMatch({member, lists},
+ ec_dictionary:get({mbr, 2}, Used)),
+
+ lists:foreach(fun(Export) ->
+ ?assertThrow(not_found,
+ ec_dictionary:get(Export, Used))
+ end, FilteredExports).
+
+validate_file(Ctx0) ->
+ DescUsed = [{{chgrp, 2}, change_group},
+ {{chmod, 2}, change_mode}],
+ Exports = [El || El={Fun, _}
+ <- proplists:get_value(exports, file:module_info()),
+ Fun =/= module_info],
+ FilteredExports = [FunArity || FunArity <- Exports,
+ not lists:member(FunArity,
+ [{delete, 1},
+ {change_group, 2},
+ {change_mode, 2}])],
+ Used = jxa_ctx:use(Ctx0),
+ lists:foreach(fun({Export, Target}) ->
+ ?assertMatch({Target, file},
+ ec_dictionary:get(Export, Used))
+ end, DescUsed),
+ lists:foreach(fun(Export={Fun, _}) ->
+ ?assertMatch({Fun, file},
+ ec_dictionary:get(Export, Used))
+ end, FilteredExports).
+
+validate_filename(Ctx0) ->
+ Exports = [El || El={Fun, _}
+ <- proplists:get_value(exports, filename:module_info()),
+ Fun =/= module_info],
+ DescExclude = [{absname, 1},
+ {join, 2},
+ {append, 2},
+ {flatten, 1},
+ {absname_join, 2}],
+ FilteredExports = [FunArity || FunArity <- Exports,
+ not lists:member(FunArity,
+ DescExclude)],
+ Used = jxa_ctx:use(Ctx0),
+ lists:foreach(fun(Export={Target, _}) ->
+ ?assertMatch({Target, filename},
+ ec_dictionary:get(Export, Used))
+ end, FilteredExports),
+
+ lists:foreach(fun(Export) ->
+ ?assertThrow(not_found,
+ ec_dictionary:get(Export, Used))
+ end, [{absname, 1}, {absname_join, 2}]).
+
View
78 test/jxat_parser_proper.erl
@@ -6,16 +6,17 @@
to_string({ident, Ident, _}) ->
Ident;
+to_string({symbol, Ident, _}) ->
+ ":" ++ Ident;
+to_string({fun_ref, {Module, Fun, Arity}, _}) ->
+ Module ++ ":" ++
+ Fun ++ "/" ++
+ integer_to_list(Arity);
+to_string({fun_ref, {Fun, Arity}, _}) ->
+ Fun ++ "/" ++
+ integer_to_list(Arity);
to_string({char, Char, _}) ->
[$\\, Char];
-to_string({syntax_quote, Ast, _}) ->
- "`" ++ to_string(Ast);
-to_string({unquote_splicing, Ast, _}) ->
- "~@" ++ to_string(Ast);
-to_string({unquote, Ast, _}) ->
- "~" ++ to_string(Ast);
-to_string({quote, Ast, _}) ->
- "'" ++ to_string(Ast);
to_string({integer, I, _}) ->
erlang:integer_to_list(I);
to_string({float, F, _}) ->
@@ -36,16 +37,12 @@ to_binary(AST) ->
compare({ident, Ident, _}, {ident, Ident, _}) ->
true;
+compare({symbol, Ident, _}, {symbol, Ident, _}) ->
+ true;
compare({char, Char, _}, {char, Char, _}) ->
true;
-compare({syntax_quote, A1, _}, {syntax_quote, A2, _}) ->
- compare(A1, A2);
-compare({unquote_splicing, A1, _}, {unquote_splicing, A2, _}) ->
- compare(A1, A2);
-compare({unquote, A1, _}, {unquote, A2, _}) ->
- compare(A1, A2);
-compare({quote, A1, _}, {quote, A2, _}) ->
- compare(A1, A2);
+compare({fun_ref, Spec, _}, {fun_ref, Spec, _}) ->
+ true;
compare({integer, I, _}, {integer, I, _}) ->
true;
compare({float, F, _}, {float, F, _}) ->
@@ -69,7 +66,7 @@ prop_parser() ->
?FORALL({Expr}, {expression()},
begin
BinExpr = to_binary(Expr),
- {ParsedExpr, _, _} = jxa_parser:parse(BinExpr),
+ {ParsedExpr, _, _} = jxa_parser:intermediate_parse(BinExpr),
compare(Expr, ParsedExpr)
end).
@@ -88,16 +85,16 @@ internal_string() ->
ident_initial() ->
union([33,
integer(35, 38),
- integer(42, 47),
- integer(58, 90),
+ integer(42, 46),
+ integer(59, 90),
integer(94, 95),
integer(97, 125)]).
ident_character() ->
union([33,
integer(35, 38),
- integer(42, 47),
- integer(58, 90),
+ integer(42, 46),
+ integer(59, 90),
integer(94, 125)]).
ident_string() ->
@@ -106,10 +103,6 @@ ident_string() ->
list([ident_character()])},
[S1 | erlang:binary_to_list(unicode:characters_to_binary(S2))]).
-keyword_style_ident() ->
- ?LET(S, ident_string(),
- ":" ++ S).
-
defvar_style_ident() ->
?LET(S, ident_string(),
"*" ++ S ++ "*").
@@ -120,36 +113,19 @@ split_ident() ->
normal_ident() ->
ident_string().
+symbol() ->
+ ?LET(I, normal_ident(),
+ {symbol, I, 0}).
+
ident() ->
{ident, union([normal_ident(),
split_ident(),
- defvar_style_ident(),
- keyword_style_ident()]), 0}.
+ defvar_style_ident()]), 0}.
character() ->
?LET(Char, string_character(),
{char, list_to_binary([Char]), 0}).
-syntax_quote(0) ->
- {syntax_quote, {list, [], 0}, 0};
-syntax_quote(Size) ->
- {syntax_quote, value(Size div 4), 0}.
-
-unquote_splicing(0) ->
- {unquote_splicing, {list, [], 0}, 0};
-unquote_splicing(Size) ->
- {unquote_splicing, jxa_list(Size div 4), 0}.
-
-unquote(0) ->
- {unquote, {list, [], 0}, 0};
-unquote(Size) ->
- {unquote, value(Size div 4), 0}.
-
-quote(0) ->
- {quote, {list, [], 0}, 0};
-quote(Size) ->
- {quote, value(Size div 4), 0}.
-
jxa_int() ->
{integer, integer(), 0}.
@@ -175,13 +151,9 @@ value(Size) ->
jxa_float(),
jxa_int(),
jxa_string(),
- quote(Size),
- unquote(Size),
- unquote_splicing(Size),
- syntax_quote(Size),
character(),
+ symbol(),
ident()]).
expression() ->
- %%?SIZED(N, value(N)).
- value(10).
+ ?SIZED(N, value(N)).

0 comments on commit 1a2debd

Please sign in to comment.