Skip to content

Commit

Permalink
support implicit do in case/let/defn body's
Browse files Browse the repository at this point in the history
  • Loading branch information
@ericbmerritt
ericbmerritt committed Jan 21, 2012
1 parent 2edd6a7 commit 2787f37
Show file tree
Hide file tree
Showing 3 changed files with 68 additions and 24 deletions.
10 changes: 10 additions & 0 deletions features/jxat_implicit_do.feature
View file
@@ -0,0 +1,10 @@
Feature: Joxa should support mulitple expressions in the body of let, defn and case
In order to allow a developer to do side effect code easily
As an Joxa Developer
I want to Joxa to be able have mulitple expressions in bodies without having a do

Scenario: Support implicit do
Given a module that has an anonymous function
When joxa is called on this module
Then a beam binary is produced
And the described function can be called and works correctly
45 changes: 21 additions & 24 deletions src/joxa/compiler.jxa
View file
Expand Up @@ -1943,7 +1943,7 @@
([[var expr]]
(make-let-binding body-path0 binding-path0 ctx0 var expr
(fn (body-path1 binding-path1 ctx1)
(comp-expr (traverse-path body-path1) ctx1 body))))
(make-do body-path1 ctx1 body))))
(([var expr] . rest)
(make-let-binding body-path0 binding-path0 ctx0 var expr
(fn (body-path1 binding-path1 ctx1)
Expand All @@ -1958,7 +1958,7 @@
(defn make-let (path0 ctx0 form)
(let ((path1 (traverse-incr-path path0)))
(case form
([:let bindings body]
((:let . (bindings . body))
(make-let-bindings (incr-path 2 path0) path1 ctx0 bindings body))
(_
(erlang/throw {:invalid-form (idx-from-context [] path0 ctx0)})))))
Expand Down Expand Up @@ -2229,15 +2229,15 @@
(let ((ctx1 (push-scope-ctx ctx0))
(annots (annots-from-context [] path0 ctx0)))
(case form
([pattern [:when guards] body]
((pattern . ([:when guards] . body))
(case (make-pattern-element (traverse-path path0) ctx1 [] pattern)
({ctx2 pattern-guards cerl-pattern}
(let ((guard-annots (annots-from-context []
(traverse-incr-path path0) ctx2))
(guard-idx (idx-from-context [] (traverse-incr-path path0) ctx2)))
(case (comp-expr (traverse-incr-path (traverse-incr-path path0)) ctx2 guards)
({ctx3 cerl-guard}
(case (comp-expr (traverse-incr-path 2 path0) ctx3 body)
(case (make-do (incr-path 2 path0) ctx3 body)
({ctx4 cerl-body}
{(pop-scope-ctx ctx4)
(cerl/ann_c_clause annots
Expand All @@ -2246,10 +2246,10 @@
(make-guards guard-annots
(cerl-guard . pattern-guards)))
cerl-body)}))))))))
([pattern body]
((pattern . body)
(case (make-pattern-element (traverse-path path0) ctx1 [] pattern)
({ctx2 pattern-guards cerl-pattern}
(case (comp-expr (traverse-incr-path path0) ctx2 body)
(case (make-do (incr-path path0) ctx2 body)
({ctx3 cerl-body}
{(pop-scope-ctx ctx3)
(cerl/ann_c_clause annots
Expand Down Expand Up @@ -2303,7 +2303,7 @@
({_ ctx2 args1}
{ctx2 (lists/reverse args1)})))

(defn do-function-body (path0 ctx0 args0 expression)
(defn do-function-body (path0 ctx0 args0 expressions)
(case (lists/foldl (fn (el, acc0)
(let ((arg (case el
([_ arg]
Expand All @@ -2318,9 +2318,9 @@
({ctx2 args1}
(case (gen-args (traverse-path path0) ctx2 (lists/reverse args1))
({ctx3 arg-list}
(case (comp-expr (traverse-incr-path path0) ctx3 expression)
({ctx4 body}
{(pop-scope-ctx ctx4) arg-list body})))))))
(case (make-do (incr-path path0) ctx3 expressions)
({ctx4 body}
{(pop-scope-ctx ctx4) arg-list body})))))))

(defn comp-expr (path0 ctx0 form)
(let ((annots (annots-from-context [] path0 ctx0)))
Expand Down Expand Up @@ -2374,7 +2374,7 @@
(make-try path0 ctx0 form))
((:fn . fn-body)
(case fn-body
([args expression]
((args . expression)
(case (do-function-body (incr-path path0) ctx0 args expression)
({ctx1 arg-list body}
{ctx1 (cerl/ann_c_fun annots arg-list body)})
Expand Down Expand Up @@ -2618,30 +2618,28 @@
(let ((idx (idx-from-context [] path0 ctx0)))
(erlang/throw {:invalid-type-definition idx})))))

(defn comp-function1 (path0 ctx0 form)
(case form
([return-type name args expression]
(defn comp-function1 (path0 ctx0 return-type name args expressions)
(let ((spec-args (lists/map (fn (arg)
(case arg
([spec-arg _]
spec-arg)
(_
(default-type)))) args))
(ctx1 (comp-implicit-spec path0 ctx0 name spec-args return-type)))
(case (do-function-body (incr-path path0) ctx1 args expression)
(case (do-function-body (incr-path path0) ctx1 args expressions)
({ctx2 arg-list body}
{ctx2 name arg-list body}))))))
{ctx2 name arg-list body}))))

(defn comp-function (path0 ctx0 form)
(case form
((= body [name args _])
(when (and (erlang/is_list args)
(erlang/is_atom name)))
(comp-function1 path0 ctx0 ((default-type) . body)))
((= body [_ name args _])
((return-type . (name . (args . expressions)))
(when (erlang/and (erlang/is_atom name)
(erlang/is_list args)))
(comp-function1 (incr-path path0) ctx0 return-type name args expressions))
((name . (args . expressions))
(when (and (erlang/is_list args)
(erlang/is_atom name)))
(comp-function1 (incr-path path0) ctx0 body))
(comp-function1 path0 ctx0 (default-type) name args expressions))
(_
(erlang/throw {:invalid-definition (idx-from-context [] path0 ctx0)}))))

Expand Down Expand Up @@ -2920,8 +2918,7 @@
(let ((module-name (get-context :module-name ctx))
(path (re/split (erlang/atom_to_list module-name) "\\."))
(out-path (filename/join (out-dir . path)))
(out-file (lists/flatten ((erlang/binary_to_list out-path) . (get-extension options))))
(_ (io/format "writing ~p~n" [out-file])))
(out-file (lists/flatten ((erlang/binary_to_list out-path) . (get-extension options)))))
(do
(filelib/ensure_dir out-path)
(file/write_file out-file binary)))))))
Expand Down
37 changes: 37 additions & 0 deletions test/jxat_implicit_do.erl
View file
@@ -0,0 +1,37 @@
-module(jxat_implicit_do).

-export([given/3, 'when'/3, then/3]).
-include_lib("eunit/include/eunit.hrl").

given([a,module,that,has,an,anonymous,function], _State, _) ->
Source = <<"(module jxat-implicit-do-test
(require io))
(defn t1 ()
(let ((a 1))
(io/format \"~p\" [a])
:booha))
(defn+ do-test ()
(case (t1)
(:booha
(io/format \"did it\")
:return-it)))
(defn+ do-test2 ()
(t1)
(do-test))">>,
{ok, Source}.


'when'([joxa,is,called,on,this,module], Source, _) ->
Result = joxa.compiler:forms("", Source, []),
{ok, Result}.

then([a,beam,binary,is,produced], State = {_, Binary}, _) ->
?assertMatch(true, is_binary(Binary)),
{ok, State};
then([the,described,function,can,be,called,'and',works,correctly], State, _) ->
?assertMatch([{'do-test',0},{'do-test2',0},{module_info,0},{module_info,1}],
lists:sort('jxat-implicit-do-test':module_info(exports))),
{ok, State}.

0 comments on commit 2787f37

Please sign in to comment.