Permalink
Browse files

support $module-name $line-number and $function-name calls

Signed-off-by: Jordan Wilberding <diginux@gmail.com>
  • Loading branch information...
1 parent d12174a commit 1d05858e60c925b937286b5d746467ada20b3fbf @ericbmerritt ericbmerritt committed with jwilberding Apr 12, 2012
Showing with 102 additions and 1 deletion.
  1. +2 −1 Makefile
  2. +12 −0 features/jxat_module_fun_line_support.feature
  3. +31 −0 src/joxa/compiler.jxa
  4. +57 −0 test/jxat_module_fun_line_support.erl
View
@@ -67,7 +67,8 @@ TESTBEAMS = $(BEAMDIR)/jxat_anon_fun.beam \
$(BEAMDIR)/jxat_receive.beam \
$(BEAMDIR)/jxat_do_test.beam \
$(BEAMDIR)/jxat_macros.beam \
- $(BEAMDIR)/jxat_records.beam
+ $(BEAMDIR)/jxat_records.beam \
+ $(BEAMDIR)/jxat_module_fun_line_support.beam
.SUFFIXES:
.SUFFIXES:.jxa
@@ -0,0 +1,12 @@
+Feature: Compile Time Information
+ In order to allow a developer to have access to context
+ information at compile time
+ As a Joxa Developer
+ I want to be able to call the functions (module) (function) (line) and have
+ them evaluate to the correct result
+
+ Scenario: Write a function that evaluates to the module name
+ Given a module that has a function that calls module
+ When joxa is called on this module
+ Then a beam binary is produced
+ And the described function returns the name of the module
View
@@ -142,6 +142,7 @@
(:errors (erlang/element 22 raw-ctx))
(:result (erlang/element 23 raw-ctx))
(:filename (erlang/element 24 raw-ctx))
+ (:function-name (erlang/element 25 raw-ctx))
(_ (erlang/throw {:invalid-field, :context field}))))
(defn+ set-context (field value raw-ctx)
@@ -169,6 +170,7 @@
(:errors (erlang/setelement 22 raw-ctx value))
(:result (erlang/setelement 23 raw-ctx value))
(:filename (erlang/setelement 24 raw-ctx value))
+ (:function-name (erlang/setelement 25 raw-ctx value))
(_ (erlang/throw {:invalid-field, :context field}))))
(defn+ internal-new-context (key-values)
@@ -200,6 +202,7 @@
[] ; Errors
:undefined ; binary
"" ; Filename
+ :undefined ; function name
} key-values))
(defn internal-add-warning (warning raw-ctx)
@@ -454,6 +457,8 @@
{raw-ctx (get-context :annots raw-ctx)})
(:filename
{raw-ctx (get-context :filename raw-ctx)})
+ (:function-name
+ {raw-ctx (get-context :function-name raw-ctx)})
(:anon-fun-index
{raw-ctx (get-context :anon-fun-index raw-ctx)})
(:options
@@ -536,6 +541,8 @@
{:noreply (set-context :exports new-exports raw-ctx)})
({:filename filename}
{:noreply (set-context :filename filename raw-ctx)})
+ ({:function-name name}
+ {:noreply (set-context :function-name name raw-ctx)})
({:module-name new-module-name}
{:noreply (set-context :module-name new-module-name raw-ctx)})
({:line line-annots}
@@ -745,6 +752,12 @@
(defn result-ctx (ctx result)
(gen_server/cast ctx {:result result}))
+(defn function-name-ctx (ctx)
+ (gen_server/call ctx :function-name))
+
+(defn function-name-ctx (ctx name)
+ (gen_server/cast ctx {:function-name name}))
+
(defn filename-ctx (ctx)
(gen_server/call ctx :filename))
@@ -2852,6 +2865,14 @@
([:quote args]
(let (literal (make-literal (traverse-incr-path path0) ctx args))
{guards0 literal}))
+ ([:$module-name]
+ (cerl/ann_c_atom annots (module-name-ctx ctx)))
+ ([:$line-number]
+ (case (get-line-annots (path? path0) (annots-ctx ctx))
+ ([line-number _]
+ (cerl/ann_c_int annots line-number))))
+ ([:$function-name]
+ (cerl/ann_c_atom annots (function-name-ctx ctx)))
([:string str0]
(let (literal (make-literal-string (traverse-incr-path path0) annots ctx str0))
{guards0 literal}))
@@ -3119,6 +3140,14 @@
(make-seq (incr-path path0) ctx args))
((:binary . _)
(make-binary path0 ctx form))
+ ([:$module-name]
+ (cerl/ann_c_atom annots (module-name-ctx ctx)))
+ ([:$line-number]
+ (case (get-line-annots (path? path0) (annots-ctx ctx))
+ ([line-number _]
+ (cerl/ann_c_int annots line-number))))
+ ([:$function-name]
+ (cerl/ann_c_atom annots (function-name-ctx ctx)))
([arg1 :. arg2]
(make-cons annots (traverse-path path0) (traverse-incr-path 2 path0)
ctx arg1 arg2))
@@ -3382,8 +3411,10 @@
(_
(default-type)))) args))
(make-implicit-spec path0 ctx name spec-args return-type)
+ (function-name-ctx ctx name)
(case (do-function-body (incr-path path0) ctx :false name args expressions)
({arg-list body}
+ (function-name-ctx ctx :undefined)
{name arg-list body}))))
(defn make-function (path0 ctx form)
@@ -0,0 +1,57 @@
+-module(jxat_module_fun_line_support).
+
+-export([given/3, 'when'/3, then/3]).
+-include_lib("eunit/include/eunit.hrl").
+
+given([a,module,that,has,a,function,that,calls,
+ module], _State, _) ->
+ Source = <<"
+(module jxat-module-fun)
+
+ (defn+ get-module ()
+ ($module-name))
+
+ (defn+ get-fun()
+ ($function-name))
+
+ (defn+ get-line()
+ ($line-number))
+
+ (defn+ test-case ()
+ (case (get-module)
+ (:jxat-module-fun
+ :ok))
+ (case (get-fun)
+ (:get-fun
+ :ok))
+ (case (get-line)
+ (11
+ :ok)))
+">>,
+ {ok, Source}.
+
+
+'when'([joxa,is,called,on,this,module], Source, _) ->
+ {ok, joxa.compiler:forms(Source, [])}.
+
+then([a,beam,binary,is,produced], Ctx, _) ->
+ ?assertMatch(false, 'joxa.compiler':'has-errors?'(Ctx)),
+ ?assertMatch(true, is_binary(joxa.compiler:'get-context'(result, Ctx))),
+ ?assertMatch([{'--joxa-info',1},
+ {'--joxa-info',2},
+ {'get-fun',0},
+ {'get-line',0},
+ {'get-module',0},
+ {module_info,0},
+ {module_info,1},
+ {'test-case',0}],
+ lists:sort('jxat-module-fun':module_info(exports))),
+ {ok, Ctx};
+then([the,described,function,returns,the,name,'of',the,module],
+ State, _) ->
+ ?assertMatch('jxat-module-fun', 'jxat-module-fun':'get-module'()),
+ ?assertMatch('get-fun', 'jxat-module-fun':'get-fun'()),
+ ?assertMatch(11, 'jxat-module-fun':'get-line'()),
+ 'jxat-module-fun':'test-case'(),
+ {ok, State}.
+

0 comments on commit 1d05858

Please sign in to comment.