Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

base infrastructure for the joxa-reimplementation

  • Loading branch information...
commit 45b9a5599c2ce722e48a13e3c34d63b5349e4bbe 1 parent 9470f37
@ericbmerritt authored
View
95 build-support/joxa1-build.mkf
@@ -0,0 +1,95 @@
+## -*- mode: Makefile; fill-column: 75; comment-column: 50; -*-
+TEST_EBIN=$(APPDIR)/.eunit
+TEST_FLAGS=--pa $(TEST_EBIN)
+
+DEPS_DIR=$(CURDIR)/deps
+
+EBIN_DIRS=$(wildcard $(DEPS_DIR)/*/ebin)
+BASE_ERLCFLAGS=$(EBIN_DIRS:%= --pa %)
+ERLCFLAGS=$(BASE_ERLCFLAGS) --pa $(BEAMDIR)
+ERLFLAGS=$(ERLCFLAGS)
+ASTDIR=$(SRCDIR)/ast
+
+BOOTSTRAP_ERLFLAGS=-noshell -pa $(BEAMDIR) $(BASE_ERLCFLAGS)
+
+COMP= joxa $(ERLFLAGS) $(TEST_FLAGS)
+
+SRCBEAMS = $(BEAMDIR)/joxa-cc-peg.beam \
+ $(BEAMDIR)/joxa-cc-util.beam \
+ $(BEAMDIR)/joxa-cc-lexer.beam \
+ $(BEAMDIR)/joxa-cc-error.beam \
+ $(BEAMDIR)/joxa-cc-path.beam \
+ $(BEAMDIR)/joxa-cc-ns.beam \
+ $(BEAMDIR)/joxa-cc-ctx.beam \
+ $(BEAMDIR)/joxa-cc-parser.beam \
+ $(BEAMDIR)/joxa-cc-parser.beam \
+ $(BEAMDIR)/joxa-lib.beam \
+ $(BEAMDIR)/joxa-assert.beam \
+ $(BEAMDIR)/joxa-test.beam
+
+TESTBEAMS=$(TEST_EBIN)/joxa-cc-ctx_tests.beam \
+ $(TEST_EBIN)/joxa-cc-error_tests.beam \
+ $(TEST_EBIN)/joxa-cc-path_tests.beam \
+ $(TEST_EBIN)/joxa-cc-peg_tests.beam \
+ $(TEST_EBIN)/joxa-cc-lexer_tests.beam \
+ $(TEST_EBIN)/joxa-assert_tests.beam \
+ $(TEST_EBIN)/joxa-test_tests.beam
+
+.PHONY: all bootstrap clean update-versions \
+ jxa test build get-deps proper eunit \
+ cucumber shell bare-escript
+
+.PRECIOUS: %/.d
+
+all: build test
+
+## Build all the directories as task dependencies
+%/.d:
+ @mkdir -p $(@D)
+ @touch $@
+
+$(BEAMDIR)/%.beam: $(SRCDIR)/joxa-cc-%.jxa $(BEAMDIR)/.d
+ $(COMP) --bootstrap -o $(BEAMDIR) -c $<
+
+$(BEAMDIR)/%.beam: $(SRCDIR)/%.jxa $(BEAMDIR)/.d
+ $(COMP) -o $(BEAMDIR) -c $<
+
+$(TEST_EBIN)/%.beam: $(TESTDIR)/%.jxa $(TEST_EBIN)/.d
+ $(COMP) -o $(TEST_EBIN) -c $<
+
+jxa: $(SRCBEAMS)
+
+update-versions:
+ $(CURDIR)/build-support/update-versions.sh
+
+build: update-versions
+ $(REBAR) compile
+
+get-deps:
+ $(REBAR) get-deps
+
+shell: build $(TESTBEAMS)
+ $(ERL) $(ERLFLAGS) -s joxa main -s init stop
+
+jxa-clean:
+ $(REBAR) skip_deps=true clean
+ rm -rf $(APPDIR)/joxa
+ rm -rf $(APPDIR)/.bootstrap
+ rm -rf $(APPDIR)/_build
+ rm -rf $(APPDIR)/erl_crash.dump
+
+jxa-distclean: jxa-clean
+ rm -rf $(APPDIR)/deps
+
+test: build $(TESTBEAMS) proper eunit
+
+eunit: build
+ $(REBAR) skip_deps=true eunit
+
+bare-escript:
+ $(REBAR) skip_deps=true escriptize
+
+escript: build bare-escript
+
+bootstrap:
+ make -f $(CURDIR)/build-support/bootstrap.mkf
View
8 rebar.config
@@ -16,4 +16,12 @@
{escript_emu_args, "%%!\n"}.
+%%% -*- mode: erlang -*-
+{erl_opts, [warnings_as_errors, debug_info]}.
+
+{cover_enabled, true}.
+{cover_print_enabled, true}.
+{eunit_opts, [{report, {eunit_surefire, [{dir, "."}]}}]}.
+
+
{post_hooks, [{compile, "make jxa"}]}.
View
161 src/joxa-assert.jxa
@@ -0,0 +1,161 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+;; Assertions for Joxa
+;; ===================
+;;
+;; Assertions form part of the design process, and in others they are
+;; used only to check assumptions at runtime. In both cases, they can
+;; be checked for validity at runtime
+;;
+;; These assertions are based directly on the assertions provided by
+;; Eunit with just a bit of Joxification
+(ns joxa-assert
+ (require erlang
+ joxa-core))
+
+;; This macro yields 'true' if the value of E matches the guarded
+;; pattern G, otherwise 'false'.
+(defmacro+ matches? (g e)
+ `(case ~e
+ (~g :true)
+ (_ :false)))
+
+;; The is macro is written the way it is so as not to cause warnings
+;; for clauses that cannot match, even if the expression is a constant.
+(defmacro+ is (bool-expr)
+ (let* (__v (joxa-core/gensym))
+ `(case ~bool-expr
+ (:true
+ :ok)
+ (~__v
+ (erlang/error {:assertion_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~bool-expr)}
+ {:expected (quote :true)}
+ {:value (case ~__v
+ (:false ~__v)
+ (_ {:not_a_boolean ~__v}))}]})))))
+
+(defmacro+ is (guard expr)
+ (let* (__v (joxa-core/gensym))
+ `(case ~expr
+ (~guard :ok)
+ (~__v (erlang/error {:assertMatch_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~expr)}
+ {:pattern (quote ~guard)}
+ {:value ~__v}]})))))
+
+(defmacro+ is-not (guard expr)
+ (let* (__v (joxa-core/gensym))
+ `(let* (~__v ~expr)
+ (case ~__v
+ (~guard
+ (erlang/error {:assertNotMatch_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~expr)}
+ {:pattern (quote ~guard)}
+ {:value ~__v}]}))
+ (_ :ok)))))
+
+;; This is a convenience macro which gives more detailed reports when
+;; the expected LHS value is not a pattern, but a computed value
+(defmacro+ is-equal (expect expr)
+ (let* (__x (joxa-core/gensym)
+ __v (joxa-core/gensym))
+ `(let* (~__x ~expect)
+ (case ~expr
+ (~__x :ok)
+ (~__v
+ (erlang/error {:assertEqual_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~expr)}
+ {:expected ~__x}
+ {:value ~__v}]}))))))
+
+;; This is the inverse case of assertEqual, for convenience.
+(defmacro+ is-not-equal (unexpect expr)
+ (let* (__x (joxa-core/gensym))
+ `(let* (~__x ~unexpect)
+ (case ~expr
+ (~__x
+ (erlang/error {:assertNotEqual_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~expr)}
+ {:value ~__x}]}))
+ (_ :ok)))))
+
+
+;; Note: Class and Term are patterns, and can not be used for value.
+;; Term can be a guarded pattern, but Class cannot.
+(defmacro+ throws-exception (class term expr)
+ (let* (__v (joxa-core/gensym)
+ __c (joxa-core/gensym)
+ __t (joxa-core/gensym))
+ `(joxa-core/try
+ (let* (~__v ~expr)
+ (erlang/error
+ {:assertException_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~expr)}
+ {:pattern
+ {(quote ~class) (quote ~term)}}
+ {:unexpected_success ~__v}]}))
+ (catch
+ ({~class ~term} :ok)
+ ({~__c ~__t}
+ (erlang/error
+ {:assertException_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~expr)}
+ {:pattern {(quote ~class) (quote ~term)}}
+ {:unexpected_exception
+ {~__c ~__t
+ (erlang/get_stacktrace)}}]}))))))
+
+(defmacro+ throws-error (term expr)
+ `(joxa-assert/throws-exception :error ~term ~expr))
+
+(defmacro+ throws-exit (term expr)
+ `(joxa-assert/throws-exception :exit ~term ~expr))
+
+(defmacro+ throws-throw (term expr)
+ `(joxa-assert/throws-exception :throw ~term ~expr))
+
+;; This is the inverse case of assertException, for convenience.
+;; Note: Class and Term are patterns, and can not be used for value.
+;; Both Class and Term can be guarded patterns. Because they can be
+;; guarded expressions both class and term must be enclosed in
+;; parens. That is it shoud be (:exit) not :exit etc
+(defmacro+ does-not-throw-exception (class term expr)
+ (let* (__c (joxa-core/gensym)
+ __t (joxa-core/gensym))
+ `(joxa-core/try
+ ~expr
+ (catch
+ ({~__c ~__t}
+ (case ~__c
+ (~class
+ (case ~__t
+ (~term
+ (erlang/error {:assertNotException_failed
+ [{:namespace ($namespace)}
+ {:line ($line-number)}
+ {:expression (quote ~expr)}
+ {:pattern
+ {(quote ~class) (quote ~term)}}
+ {:unexpected_exception,
+ {~__c ~__t,
+ (erlang/get_stacktrace)}}]}))
+ (_ :ok)))
+ (_ :ok)))))))
View
30 src/joxa-build-support.jxa → src/joxa-build-utils.jxa
@@ -1,3 +1,8 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
;; Test Support
;; ============
;;
@@ -5,7 +10,7 @@
;; tests from a makefile. Given a path to an OTP application it will
;; extract all of the module names from the app and attempt to run the
;; proper and eunit tests on said modules.
-(ns joxa-build-support
+(ns joxa-build-utils
(require joxa-eunit
joxa-assert
joxa-lists
@@ -20,9 +25,7 @@
file
io_lib
code
- filename
- cucumberl
- joxa-assert)
+ filename)
(use (joxa-core :only (try/1 if/3 +/1 when/2 unless/2 !=/2))
(erlang :only (==/2))))
@@ -79,17 +82,6 @@
(name . names))
[])))
-(defn+ cucumberl-test-app (path)
- (joxa-lists/dolist (feature (gather-features-from-app path))
- (io/format "Running feature ~s~n" [feature])
- (try
- (case (cucumberl/run feature)
- ({:ok, _} :ok)
- (_
- (init/stop 1)))
- (catch ({_ _}
- (init/stop 1))))))
-
(defn+ main (args)
;; Path comes in as an atom from the command line
(case args
@@ -97,8 +89,6 @@
(eunit-test-app (erlang/atom_to_list path)))
([:proper path]
(proper-test-app (erlang/atom_to_list path)))
- ([:cucumberl path]
- (cucumberl-test-app (erlang/atom_to_list path)))
([:print path]
(io/format "~p~n"
[(gather-modules-from-app
@@ -112,7 +102,7 @@
(case (file/consult input-path)
({:ok [{:application name mod-info}]}
(io/format "writing ~s~n" [app-file-path])
- (joxa-assert/assert-equal
+ (joxa-assert/is-equal
:ok
(file/write_file
app-file-path
@@ -140,9 +130,9 @@
(let* (ebin-path "/foo/bar/baz"
uber-path "/foo/bar/baz/namespace/module-name.beam"
uber-path2 "/foo/bar/baz/module-name.beam")
- (joxa-assert/assert-equal :namespace.module-name
+ (joxa-assert/is-equal :namespace.module-name
(file-name-to-module-name ebin-path uber-path))
- (joxa-assert/assert-equal :module-name
+ (joxa-assert/is-equal :module-name
(file-name-to-module-name ebin-path uber-path2))))
(joxa-eunit/testable)
View
130 src/joxa-cc-ctx.jxa
@@ -0,0 +1,130 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-cc-ctx
+ (require (dict :joxify)
+ (erlang :joxify)
+ (lists :joxify)
+ (joxa-cc-ns :as ns)
+ (joxa-cc-error :as error)
+ (joxa-cc-path :as path)))
+
+(defn+ empty ()
+ {:context
+ [] ; The list of compilable namespaces for the system
+ :undefined ; current namespace
+ (dict/new) ; decorations
+ (error/empty-error-list) ; Parse time errors and warnings
+ :undefined ; filename
+ })
+
+(defn set! (name value ctx)
+ (case name
+ (:namespaces (erlang/setelement 2 ctx value))
+ (:current-namespace (erlang/setelement 3 ctx value))
+ (:decorations (erlang/setelement 4 ctx value))
+ (:errors (erlang/setelement 5 ctx value))
+ (:filename (erlang/setelement 6 ctx value))))
+
+(defn get (name ctx)
+ (case name
+ (:namespaces (erlang/element 2 ctx))
+ (:current-namespace (erlang/element 3 ctx))
+ (:decorations (erlang/element 4 ctx))
+ (:errors (erlang/element 5 ctx))
+ (:filename (erlang/element 6 ctx))))
+
+(defn+ namespaces (ctx)
+ (get :namespaces ctx))
+
+(defn+ namespaces! (nses ctx)
+ (set! :namespaces nses ctx))
+
+(defn+ add-namespace (namespace ctx)
+ (let* (nses (namespaces ctx))
+ (namespaces! (namespace . nses) ctx)))
+
+(defn+ current-namespace (ctx)
+ (get :current-namespace ctx))
+
+(defn+ current-namespace! (ns ctx)
+ (set! :current-namespace ns ctx))
+
+(defn+ filename (ctx)
+ (get :filename ctx))
+
+(defn+ filename! (filename ctx)
+ (set! :filename filename ctx))
+
+;; ### Decorations storage and retrieval
+;;
+;; This provides a way to handle decorations for the parse
+;; tree. Decoration can be any value but tends to be line numbers.
+(defn+ decorate! (path0 decoration ctx)
+ (let* (decorations (get :decorations ctx))
+ (set! :decorations
+ (dict/append (path/resolve path0) decoration decorations) ctx)))
+
+(defn+ decorate-line! (path0 line ctx)
+ (decorate! path0 {:line line} ctx))
+
+;; sometimes an invalid path are passed in. This is unfortunate but
+;; things like macros mangle the path in unknown
+;; ways. With this in mind we keep backing up the path until such time
+;; that we get a valid decoration.
+(defn get-nearest-decoration (path0 ctx)
+ (let* (decorations (get :decorations ctx))
+ (case path0
+ ([]
+ :not-found)
+ ((_ . rest)
+ (try*
+ (dict/fetch path0 decorations)
+ (catch (type body)
+ (case {type body}
+ ({:error :badarg}
+ (get-nearest-decoration rest ctx)))))))))
+
+(defn+ get-line-decoration (path0 ctx)
+ (case (get-nearest-decoration (path/resolve path0) ctx)
+ (:not-found 0)
+ (decorations
+ (lists/foldl (fn (el acc)
+ (case el
+ ({:line line} line)
+ (_ acc))) 0 decorations))))
+
+(defn error-namespace-name (ctx)
+ (case (current-namespace ctx)
+ (:undefined :undefined)
+ (ns0 (ns/name ns0))))
+
+(defn error-function-name (ctx)
+ (case (current-namespace ctx)
+ (:undefined :undefined)
+ (ns0 (ns/current-function ns0))) )
+
+(defn+ add-error (path line error ctx)
+ (let* (errors (get :errors ctx)
+ ns-name (error-namespace-name ctx)
+ fun (error-function-name ctx))
+ (set! :errors (error/add-error ns-name fun line error errors) ctx)))
+
+(defn+ add-error (path error ctx)
+ (let* (line (get-line-decoration path ctx))
+ (add-error path line error ctx)))
+
+(defn+ add-warning (path line warning ctx)
+ (let* (errors (get :errors ctx)
+ ns-name (error-namespace-name ctx)
+ fun (error-function-name ctx))
+ (set! :errors (error/add-warning ns-name fun line warning errors) ctx)))
+
+(defn+ add-warning (path warning ctx)
+ (let* (line (get-line-decoration path ctx))
+ (add-warning path line warning ctx)))
+
+(defn+ errors (ctx)
+ (error/error-list->list (get :errors ctx)))
View
30 src/joxa-cc-error.jxa
@@ -0,0 +1,30 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-cc-error
+ (require (sets :joxify)))
+
+(defn+ empty-error-list ()
+ "create a new empty error list"
+ (sets/new))
+
+(defn+ new-error (ns function line error)
+ "Create a new error detail record"
+ {:error :error line ns function error})
+
+(defn+ new-warning (ns function line warning)
+ "Create a new error detail record"
+ {:error :warning line ns function warning})
+
+(defn+ add-error (ns function line error errors)
+ "Add an error detail to the error list"
+ (sets/add-element (new-error ns function line error) errors))
+
+(defn+ add-warning (ns function line warning errors)
+ "Add an error detail to the error list"
+ (sets/add-element (new-warning ns function line warning) errors))
+
+(defn+ error-list->list (error-list)
+ (sets/to-list error-list))
View
375 src/joxa-cc-lexer.jxa
@@ -0,0 +1,375 @@
+;;; The Joxa Compiler
+;;; =================
+;;; * author: Eric Merritt
+;;; * copyright: Erlware, LLC 2011 - 2012
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;; The Lexer and Parser
+;; --------------------
+;;
+;; The functions in this namespace represent the Joxa grammer
+;; itself. These are public because it is expected that they will be
+;; used for reader macros.
+(ns joxa-cc-lexer
+ (require (erlang :joxify)
+ (lists :joxify))
+ (use joxa-cc-peg))
+
+(defspec value ((binary) (index)) {:fail (erlang/any)})
+
+(defn+ space (input index)
+ (p input index :space
+ (p-charclass <<"[ \t\n\s\r]">>)))
+
+(defn+ comment (input index)
+ (p input index :comment
+ (p-seq [(p-string <<";">>)
+ (p-zero-or-more (p-charclass <<"[^\n\r]">>))
+ (p-choose [(p-eol)
+ (p-eof)])])))
+
+(defn+ ignorable (input index)
+ (p input index :ignorable
+ (p-optional (p-zero-or-more (p-choose [space/2
+ (p-string <<",">>)
+ comment/2])))
+ (fn (node idx)
+ [])))
+
+(defn+ digit (input index)
+ (p input index :digit
+ (p-charclass <<"[0-9]">>)))
+
+(defn+ int-part (input index)
+ (p input index :int-part
+ (p-seq [(p-optional (p-string <<"-">>)),
+ (p-one-or-more digit/2)])))
+
+(defn+ frac-part (input index)
+ (p input index :frac-part
+ (p-seq [(p-string <<".">>)
+ (p-one-or-more digit/2)])))
+
+(defn+ integer (input index)
+ (p input index :integer
+ int-part/2
+ (fn (node idx)
+ (let* (result
+ (erlang/list_to_integer
+ (erlang/binary_to_list
+ (erlang/iolist_to_binary node))))
+ {:integer result idx}))))
+
+(defn+ e (input index)
+ (p input index :e
+ (p-seq [(p-charclass <<"[eE]">>)
+ (p-optional (p-choose [(p-string <<"+">>)
+ (p-string <<"-">>)]))])))
+
+(defn+ exp-part (input index)
+ (p input index :exp-part
+ (p-seq [e/2
+ (p-one-or-more digit/2)])))
+
+(defn+ float (input index)
+ (p input index :float
+ (p-seq [int-part/2
+ frac-part/2
+ (p-optional exp-part/2)])
+ (fn (node idx)
+ (let* (result (erlang/list_to_float
+ (erlang/binary_to_list
+ (erlang/iolist_to_binary node))))
+ {:float result idx}))))
+
+(defn+ char (input index)
+ (p input index :char
+ (p-seq [(p-string <<"\\">>)
+ (p-choose [(p-string "\\\"")
+ (p-string "\\\\")
+ (p-string "\\b")
+ (p-string "\\f")
+ (p-string "\\n")
+ (p-string "\\r")
+ (p-string "\\t")
+ (p-anything)])])
+ (fn (node idx)
+ (case node
+ ([_ <<"\\\"">>]
+ {:char \" idx})
+ ([_ <<"\\\\">>]
+ {:char \\ idx})
+ ([_ <<"\\b">>]
+ {:char \\b idx})
+ ([_ <<"\\f">>]
+ {:char \\f idx})
+ ([_ <<"\\n">>]
+ {:char \\n idx})
+ ([_ <<"\\r">>]
+ {:char \\r idx})
+ ([_ <<"\\t">>]
+ {:char \\t idx})
+ ([_ char]
+ {:char char idx})))))
+
+(defn+ ident (input index)
+ (p input index :ident
+ (p-one-or-more
+ (p-and [(p-not
+ (p-choose [(p-string <<"<<">>)
+ (p-string <<">>">>)
+ (p-string <<"~@">>)
+ (p-charclass <<"[,`~'\\\\{}/\t\n\s\r\\(\\)\\[\\]\"]">>)]))
+ (p-anything)]))
+ (fn (node idx)
+ (let* (result
+ (erlang/list_to_atom
+ (erlang/binary_to_list
+ (erlang/iolist_to_binary node))))
+ {:ident result idx}))))
+(definline convert-stringlike-thing (node)
+ (case node
+ ([_ string _]
+ (let* (convert (lists/map (fn (el)
+ (case el
+ ([_ <<"\\'">>]
+ <<"'">>)
+ ([_ <<"\\\"">>]
+ <<"\"">>)
+ ([_ <<"\\\\">>]
+ <<"\\">>)
+ ([_ <<"\\b">>]
+ <<"\b">>)
+ ([_ <<"\\f">>]
+ <<"\f">>)
+ ([_ <<"\\n">>]
+ <<"\n">>)
+ ([_ <<"\\r">>]
+ <<"\r">>)
+ ([_ <<"\\t">>]
+ <<"\t">>)
+ (_
+ el)))
+ string))
+ (erlang/binary_to_list (erlang/iolist_to_binary convert))))))
+
+(defn+ quoted-ident (input index)
+ (p input index :quoted-ident
+ (p-seq [(p-string ":'")
+ (p-zero-or-more (p-seq [(p-not (p-string "'"))
+ (p-choose [(p-string "\\'")
+ (p-string "\\\"")
+ (p-string "\\\\")
+ (p-string "\\b")
+ (p-string "\\f")
+ (p-string "\\n")
+ (p-string "\\r")
+ (p-string "\\t")
+ (p-anything)])]))
+ (p-string "'")])
+ (fn (node idx)
+ {:ident (erlang/list_to_atom
+ (convert-stringlike-thing node)) idx})))
+
+
+(defn inclusive-ident (input index)
+ (p input index :ident-types
+ (p-choose [quoted-ident/2
+ ident/2])))
+
+(defn+ fun-reference (input index)
+ (p input index :fun-reference
+ (p-choose [(p-seq [inclusive-ident/2
+ (p-string "/")
+ inclusive-ident/2
+ (p-string "/")
+ integer/2])
+ (p-seq [inclusive-ident/2
+ (p-string "/")
+ integer/2])
+ (p-seq [inclusive-ident/2
+ (p-string "/")
+ inclusive-ident/2])])
+ (fn (node idx)
+ (case node
+ ([{:ident namespace _} _
+ {:ident function _} _
+ {:integer arity _}]
+ {:call {:--fun namespace function arity} idx})
+ ([{:ident function _} _
+ {:integer arity _}]
+ {:call {:--fun function arity} idx})
+ ([{:ident namespace _} _
+ {:ident function _}]
+ {:call {:--fun namespace function} idx})))))
+
+(defn+ string (input index)
+ (p input index :string
+ (p-seq [(p-string "\"")
+ (p-zero-or-more (p-seq [(p-not (p-string "\""))
+ (p-choose [(p-string "\\\"")
+ (p-string "\\\\")
+ (p-string "\\b")
+ (p-string "\\f")
+ (p-string "\\n")
+ (p-string "\\r")
+ (p-string "\\t")
+ (p-anything)])]))
+ (p-string "\"")])
+ (fn (node idx)
+ {:string (convert-stringlike-thing node) idx})))
+
+(defn+ quote (input index)
+ (p input index :quote
+ (p-seq [(p-choose [ (p-string "'")
+ (p-string ":")])
+ value/2])
+ (fn (node idx)
+ (case node
+ ([_ item]
+ {:quote item idx})))))
+
+(defn+ quasiquote (input index)
+ (p input index :quasiquote
+ (p-seq [(p-string "`")
+ value/2])
+ (fn (node idx)
+ (case node
+ ([_ item]
+ {:quasiquote item idx})))))
+
+(defn+ unquote (input index)
+ (p input index :unquote
+ (p-seq [(p-string "~")
+ value/2])
+ (fn (node idx)
+ (case node
+ ([_ item]
+ {:unquote item idx})))))
+
+(defn+ unquote-splicing (input index)
+ (p input index :unquote-splicing
+ (p-seq [(p-string "~@")
+ value/2])
+ (fn (node idx)
+ (case node
+ ([_ item]
+ {:unquote-splicing item idx})))))
+
+(defn+ list (input index)
+ (p input index :list
+ (p-choose [(p-seq [(p-string "(")
+ ignorable/2
+ value/2
+ (p-zero-or-more (p-seq [ignorable/2
+ value/2]))
+ ignorable/2
+ (p-string ")")])
+ (p-seq [(p-string "(")
+ ignorable/2
+ (p-string ")")])
+ (p-seq [(p-string "[")
+ ignorable/2
+ value/2
+ (p-zero-or-more (p-seq [ignorable/2
+ value/2]))
+ ignorable/2
+ (p-string "]")])
+ (p-seq [(p-string "[")
+ ignorable/2
+ (p-string "]")])])
+ (fn (node idx)
+ (case node
+ ([<<"(">> _ h t _ _]
+ {:list (lists/flatten [h t]) idx})
+ ([<<"[">> _ h t _ _]
+ {:literal-list (lists/flatten [h t]) idx})
+ ([<<"[">> _ _]
+ {:literal-list [] idx})
+ ([_ _ _]
+ {:list [] idx})))))
+
+(defn+ tuple (input index)
+ (p input index :tuple
+ (p-choose [(p-seq [(p-string "{")
+ ignorable/2
+ value/2
+ (p-zero-or-more (p-seq [ignorable/2
+ value/2]))
+ ignorable/2
+ (p-string "}")])
+ (p-seq [(p-string "{")
+ ignorable/2
+ (p-string "}")])])
+ (fn (node idx)
+ (case node
+ ([_ _ h t _ _]
+ {:tuple (lists/flatten [h t]) idx})
+ ([_ _ _]
+ {:tuple [] idx})))))
+
+(defn+ binary (input index)
+ (let* (binary-contents (p-choose [integer/2
+ char/2
+ ident/2
+ list/2]))
+ (p input index :binary
+ (p-choose [(p-seq [(p-string "<<")
+ ignorable/2
+ binary-contents
+ (p-zero-or-more (p-seq [ignorable/2
+ binary-contents]))
+ ignorable/2
+ (p-string ">>")])
+ (p-seq [(p-string "<<")
+ ignorable/2
+ string/2
+ ignorable/2
+ (p-string ">>")])
+ (p-seq [(p-string "<<")
+ ignorable/2
+ (p-string ">>")])])
+ (fn (node idx)
+ (case node
+ ([_ _ h t _ _]
+ {:binary (lists/flatten [h t]) idx})
+ ([_ _ string _ _]
+ {:binary string idx})
+ ([_ _ _]
+ {:binary [] idx}))))))
+
+(defn+ value (input index)
+ (p input index :value
+ (p-seq [ignorable/2
+ (p-choose [float/2
+ integer/2
+ binary/2
+ fun-reference/2
+ quoted-ident/2
+ quote/2
+ ident/2
+ list/2
+ tuple/2
+ string/2
+ quasiquote/2
+ unquote-splicing/2
+ unquote/2
+ char/2])
+ ignorable/2])
+ (fn (node idx)
+ (lists/nth 2 node))))
+
+(defn+ new-index ()
+ {1,1})
+
+(defn+ parse (input idx)
+ (setup-memo)
+ (let* (result (value input idx))
+ (release-memo)
+ result))
+
+(defn+ parse (input)
+ (parse input (new-index)))
View
29 src/joxa-cc-ns.jxa
@@ -0,0 +1,29 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-cc-ns
+ (require (erlang :joxify)))
+
+(defn empty ()
+ {:ns
+ :undefined ; name
+ :undefined ; current-function
+ })
+
+(defn+ set (name value ns)
+ (case ns
+ (:name (erlang/setelement 2 value ns))
+ (:current-function (erlang/setelement 3 value ns))))
+
+(defn+ get (name ns)
+ (case ns
+ (:name (erlang/element 2 ns))
+ (:current-function (erlang/element 2 ns))))
+
+(defn+ name (ns)
+ (get :name ns))
+
+(defn+ current-function (ns)
+ (get :current-function ns))
View
136 src/joxa-cc-parser.jxa
@@ -0,0 +1,136 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-cc-parser
+ (require (erlang :joxify)
+ (lists :joxify)
+ (file :joxify)
+ (joxa-cc-peg :as peg)
+ (joxa-cc-path :as path)
+ (joxa-cc-ctx :as ctx)
+ (joxa-cc-lexer :as lexer)))
+
+
+(defspec transform-ast ((erlang/any) (erlang/any) (erlang/any))
+ {(erlang/any) (erlang/list)})
+
+;; ### The First Ast Transformation
+;;
+;; Most of the AST transformations in Joxa happen via macros. however,
+;; this very first initial transformation happens here. Turning the
+;; marked up AST into an annotated lisp AST where the annotations are
+;; hidden unless requested.
+
+(definline convert-list-ast (path0 ctx0 elements line)
+ (let* (transformed
+ (lists/foldl
+ (fn (el acc)
+ (case acc
+ ({path1 ctx1 elements-acc}
+ (let* (result
+ (transform-ast (path/step! path1) ctx1 el))
+ (case result
+ ({ctx2 transformed}
+ {(path/incr! path1) ctx2
+ (transformed . elements-acc)}))))))
+ {path0 ctx0 []}
+ elements))
+ transformed))
+
+(definline convert-list-call-ast (path0 ctx0 elements line type)
+ (let* (transformed
+ (convert-list-ast (path/incr! path0) ctx0 elements line))
+ (case transformed
+ ({_ ctx1 transform-list}
+ (let* (ctx2 (ctx/decorate-line! (path/step! path0) line ctx1))
+ {ctx2
+ (type . (lists/reverse transform-list))})))))
+
+(definline convert-binary-string (path0 ctx0 elements line)
+ (let* (transformed
+ (lists/foldl
+ (fn (el, acc)
+ (case acc
+ ({path1 ctx1 elements-acc}
+ {(path/incr! path1)
+ (ctx/decorate-line! (path/step! path1) line ctx1)
+ (el . elements-acc)})))
+ {path0 ctx0 []} elements))
+ (case transformed
+ ({_ ctx2 transform-list}
+ {(ctx/decorate-line! path0 line ctx2)
+ (:binary . (lists/reverse transform-list))}))))
+
+(defn+ transform-ast (path0 ctx0 node)
+ (case node
+ ({:call mfa {line _}}
+ {(ctx/decorate-line! path0 line ctx0) mfa})
+ ({:literal-list list {line _}}
+ (convert-list-call-ast path0 ctx0 list line :list))
+ ({:binary {:string string _} {line _}}
+ (convert-binary-string path0 ctx0 string line))
+ ({:binary list {line _}}
+ (convert-list-call-ast path0 ctx0 list line :binary))
+ ({:tuple list {line _}}
+ (let* (transformed (convert-list-ast path0 ctx0 list line))
+ (case transformed
+ ({_ ctx1 transform-list}
+ {(ctx/decorate-line! path0 line ctx1)
+ (erlang/list_to_tuple (lists/reverse transform-list))}))))
+ ({:list list {line _}}
+ (let* (transformed (convert-list-ast path0 ctx0 list line))
+ (case transformed
+ ({_ ctx1 transform-list}
+ {(ctx/decorate-line! path0 line ctx1)
+ (lists/reverse transform-list)}))))
+ ({:string result {line _}}
+ {(ctx/decorate-line! path0 line ctx0)
+ [:string, result]})
+ ({type (= val {_ _ _}) {line _}}
+ (let* (result (transform-ast (path/step-incr! path0) ctx0 val))
+ (case result
+ ({ctx1 p-val}
+ {(ctx/decorate-line! path0 line ctx1)
+ [type, p-val]}))))
+ ({type val {line _}}
+ {(ctx/decorate-line! path0 line ctx0) val})))
+
+
+(defn+ has-more-data-to-parse (input)
+ (case input
+ (<<>>
+ :false)
+ ({:parse-output <<>> _ _}
+ :false)
+ (_
+ :true)))
+
+(defn do-parse (ctx0 path input idx0)
+ (case input
+ (<<>>
+ {<<>> path idx0})
+ (_
+ (case (lexer/parse input idx0)
+ ({:fail {:expected expected {line _}}}
+ (let* (ctx1 (ctx/add-error path line {:parse-fail expected} ctx0))
+ {ctx1 {:error input}}))
+ ({intermediate-ast rest _}
+ (transform-ast (path/step! path) ctx0 intermediate-ast))))))
+
+(defn+ parse (ctx0 input)
+ (case input
+ (input (when (erlang/is-binary input))
+ (do-parse ctx0
+ (path/empty)
+ input
+ (lexer/new-index)))
+ ({:parse-output new-input path index}
+ (do-parse ctx0 (path/incr! path) new-input index))))
+
+(defn+ parse-file (ctx0 filename)
+ (ctx/filename! filename ctx0)
+ (case (file/read_file filename)
+ ({:ok bin}
+ (parse ctx0 bin))))
View
101 src/joxa-cc-path.jxa
@@ -0,0 +1,101 @@
+;;; The Joxa Compiler
+;;; =================
+;;; * author: Eric Merritt
+;;; * copyright: Erlware, LLC 2011 - 2012
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; ### 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.
+(ns joxa-cc-path
+ (require (ec_dictionary :joxify))
+ (use (erlang :only (+/2))))
+
+(defn+ empty ()
+ {1, []})
+
+(defn+ incr! (pos path)
+ (case path
+ ({:suspended _}
+ path)
+ ({oldpos oldpath}
+ {(+ pos oldpos) oldpath})))
+
+(defn+ incr! (path)
+ (incr! 1 path))
+
+(defn+ step! (path)
+ (case path
+ ({:suspended _}
+ path)
+ ({old-position old-path}
+ {1, (old-position . old-path)})))
+
+(defn+ resolve (path)
+ (case path
+ ({:suspended {_ old-path}} old-path)
+ ({_ old-path}
+ old-path)))
+
+(defn+ step-and-resolve! (path)
+ (resolve (step! path)))
+
+(defn+ step-incr! (path)
+ (step! (incr! path)))
+
+(defn+ step-incr! (amount path)
+ (step! (incr! amount path)))
+
+(defn+ suspend! (path)
+ "Suspends all pathing additions. This is mostly useful for
+macros. After a macro call is made paths no longer sensical. This
+suspends all pathing at a specific point so all later path
+manipulation calls have no effect. This means that the line number of
+errors in a generated function will always be the line number of the macro."
+ (case path
+ ({:suspended _}
+ path)
+ (_
+ {:suspended path})))
View
241 src/joxa-cc-peg.jxa
@@ -0,0 +1,241 @@
+;;; The Joxa Compiler
+;;; =================
+;;; * author: Eric Merritt
+;;; * copyright: Erlware, LLC 2011 - 2012
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;; The Parser
+;; --------------------
+;;
+;; The parser for Joxa is a [Parsing Expression
+;; Grammer](http://en.wikipedia.org/wiki/Parsing_expression_grammar)3
+;; based heavily on the [Neotoma](emacs joxa-cmp-lexer.jxa
+;; joxa-cc-lexer.jxa) project. This namespace provides generic parsing
+;; functions that are not prefixed with a 'p-' and represent parts of
+;; the Joxa grammer it self. These are public because it is expected
+;; that they will be used for reader macros.
+(ns joxa-cc-peg
+ (require (lists :joxify)
+ (erlang :joxify)
+ (unicode :joxify)
+ (ets :joxify)
+ (proplists :joxify)
+ (re :joxify))
+ (use (erlang :only (or/2 +/2))))
+
+(defn+ line (index)
+ (case index
+ ({l _}
+ l)))
+
+(defn+ column (index)
+ (case index
+ ({_ c}
+ c)))
+
+(defn+ p-advance-index (matched-input index)
+ (case index
+ ({ln col}
+ (case matched-input
+ (mi
+ (when (or (erlang/is-list mi)
+ (erlang/is-binary mi)))
+ (lists/foldl p-advance-index/2 index
+ (unicode/characters-to-list mi)))
+ (\\n
+ {(+ ln 1) 1})
+ (_
+ {ln (+ col 1)})))))
+
+(defn+ p-charclass (class)
+ (case class
+ (class (when (erlang/is-list class))
+ (p-charclass (erlang/list-to-binary class)))
+ (class
+ (when (erlang/is-binary class))
+ (case (re/compile class [:unicode :dotall])
+ ({:ok re}
+ (fn (inp index)
+ (case (re/run inp re [:anchored])
+ ({:match ({0 length} . _)}
+ (case (erlang/split-binary inp length)
+ ({head tail}
+ {head tail (p-advance-index head index)})))
+ (_
+ {:fail {:expected {:character-class
+ (erlang/binary-to-list class)} index}}))))))))
+
+(defn+ p-anything ()
+ (fn (input index)
+ (case input
+ (<<>>
+ {:fail {:expected :any-character index}})
+ (<<(c :utf8) (rest :binary)>>
+ {c rest (p-advance-index c index)}))))
+
+
+(defn+ p-string (s)
+ (case s
+ (s (when (erlang/is-list s))
+ (p-string (erlang/list-to-binary s)))
+ (s (when (erlang/is-binary s))
+ (let* (length (erlang/byte-size s))
+ (fn (input index)
+ (case input
+ (<<(s :size length :binary) (rest :binary)>>
+ {s rest (p-advance-index s index)})
+ (_
+ {:fail {:expected {:string s} index}})))))))
+
+(defn+ p-scan (p inp index acc)
+ (case inp
+ ([]
+ {(lists/reverse acc) [] index})
+ (_
+ (case (p inp index)
+ ({:fail _}
+ {(lists/reverse acc) inp index})
+ ({result inprem new-index}
+ (p-scan p inprem new-index (result . acc)))))))
+
+(defn+ p-one-or-more (p)
+ (fn (input index)
+ (let* (result (p-scan p input index []))
+ (case result
+ ({(_ . _) _ _}
+ result)
+ (_
+ (case (p input index)
+ ({:fail {:expected failure e}}
+ {:fail {:expected {:at-least-one failure} index}})))))))
+
+(defn+ p-zero-or-more (p)
+ (fn (input index)
+ (p-scan p input index [])))
+
+(defn+ p-attempt (in-p input index first-failure)
+ (case in-p
+ ([]
+ first-failure)
+ ((p . parsers)
+ (case (p input index)
+ ((= {:fail _} failure)
+ (case first-failure
+ (:none
+ (p-attempt parsers input index failure))
+ (_
+ (p-attempt parsers input index first-failure))))
+ (result
+ result)))))
+
+(defn+ p-choose (parsers)
+ (fn (input index)
+ (p-attempt parsers input index :none)))
+
+(defn+ p-all (in-p input index acc)
+ (case in-p
+ ([]
+ {(lists/reverse acc) input index})
+ ((p . parsers)
+ (case (p input index)
+ ((= {:fail _} failure)
+ failure)
+ ({result input-rem new-index}
+ (p-all parsers input-rem new-index (result . acc)))))))
+
+(defn+ p-seq (p)
+ (fn (input index)
+ (p-all p input index [])))
+
+(defn+ p-and (p)
+ (fn (input index)
+ (p-all p input index [])))
+
+(defn+ p-assert (p)
+ (fn (input index)
+ (case (p input index)
+ ((= {:fail _} failure)
+ failure)
+ (_
+ {[] input index}))))
+
+(defn+ p-not (p)
+ (fn (input index)
+ (case (p input index)
+ ({:fail _}
+ {[] input index})
+ ({result _ _}
+ {:fail {:expected {:no-match result} index}}))))
+
+(defn+ p-optional (p)
+ (fn (input index)
+ (case (p input index)
+ ({:fail _}
+ {[] input index})
+ ((= {_ _ _} success)
+ success))))
+
+(defn+ p-eol ()
+ (fn (input index)
+ ((p-charclass <<"[\n\r]">>) input index)))
+
+(defn+ p-eof ()
+ (fn (input index)
+ (case input
+ (<<>>
+ {:eof <<>> index})
+ (_
+ {:fail {:expected :eof index}}))))
+
+;; ### Memoization Support Functions
+;;
+;; The following functions support memoization of for the parser. This
+;; is critically important to getting any kind of reasonable speed at
+;; all out of the parser.
+(definline memo-table-name ()
+ (erlang/get :parse-memo-table))
+
+(definline get-memo (index name)
+ (case (ets/lookup (memo-table-name) index)
+ ([]
+ {:error :not-found})
+ ([{index plist}]
+ (case (proplists/lookup name plist)
+ ({name result}
+ {:ok result})
+ (_
+ {:error :not-found})))))
+
+(definline memoize (index name result)
+ (let* (memo (case (ets/lookup (memo-table-name) index)
+ ([]
+ [])
+ ([{index plist}]
+ plist)))
+ (ets/insert (memo-table-name) {index ({name result} . memo)})))
+
+(defn+ release-memo ()
+ (ets/delete (memo-table-name)))
+
+(defn+ setup-memo ()
+ (erlang/put :parse-memo-table (ets/new :joxa-compiler [:set])))
+
+(defn+ p (inp start-index name parse-fun transform-fun)
+ (case (get-memo start-index name)
+ ({:ok memo}
+ memo)
+ (_
+ (let* (result (case (parse-fun inp start-index)
+ ((= {:fail _} failure)
+ failure)
+ ({match inp-rem new-index}
+ {(transform-fun match start-index)
+ inp-rem new-index})))
+ (memoize start-index name result)
+ result))))
+
+(defn+ p (inp start-index name parse-fun)
+ (p inp start-index name parse-fun (fn (n idx) n)))
View
57 src/joxa-cc-util.jxa
@@ -0,0 +1,57 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-cc-util
+ (require (erlang :joxify)
+ (re :joxify)
+ (crypto :joxify)
+ (io_lib :joxify)
+ (lists :joxify)
+ (binary :joxify)
+ (cerl :joxify)))
+
+;; Utilities Used by the Compiler
+;; -----------------------------
+(defn+ joxify-name (name)
+ (let* (str-name (erlang/atom-to-list name))
+ (erlang/list-to-atom (re/replace str-name "_" "-"
+ [:global,{:return, :list}]))))
+
+(defn+ get-joxa-info (type namespace fun-name)
+ (try*
+ (let* (info-fun (erlang/make-fun namespace :--joxa-info 2))
+ (info-fun type fun-name))
+ (catch (type body)
+ (case {type body}
+ ({:error :undef}
+ :false)
+ (_
+ (erlang/raise type body (erlang/get-stacktrace)))))))
+
+(defn+ get-joxa-info (type namespace)
+ (try*
+ (let* (info-fun (erlang/make-fun namespace :--joxa-info 1))
+ (info-fun type))
+ (catch (type body)
+ (case {type body}
+ ({:error :undef}
+ :false)
+ (_
+ (erlang/raise type body (erlang/get-stacktrace)))))))
+
+(defn gensym-body ()
+ (let* (x (erlang/phash2 {(erlang/node) (erlang/now) (crypto/rand_bytes 16)}))
+ (lists/map (fn (el)
+ (io-lib/format "~.16B" [el]))
+ (erlang/binary_to_list
+ (binary/encode_unsigned x)))))
+
+(defn+ gensym ()
+ (erlang/list_to_atom
+ (lists/flatten (io-lib/format "#:G~s" [(gensym-body)]))))
+
+(defn+ gensym (prefix)
+ (erlang/list_to_atom
+ (lists/flatten (io-lib/format "#:|~s~s|" [prefix (gensym-body)]))))
View
347 src/joxa-compiler.jxa
@@ -0,0 +1,347 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-compiler
+ (require (erlang :joxify)
+ (lists :joxify)
+ (cerl :joxify)
+ (io_lib :joxify)
+ (io :joxify)
+ (file :joxify)
+ (code :joxify)
+ (ec_dictionary :joxify)
+ (init :joxify)
+ (getopt :joxify)
+ (re :joxify)
+ (filename :joxify)
+ (filelib :joxify)
+ (compile :joxify)
+ (sets :joxify)
+ (core_pp :joxify)
+ (proplists :joxify)
+ joxa-cmp-ctx
+ joxa-cmp-path
+ joxa-cmp-util
+ joxa-cmp-error-format
+ joxa-cmp-joxa-info
+ joxa-cmp-checks
+ joxa-cmp-parser
+ joxa-cmp-defs
+ joxa-cmp-ns))
+
+(defn internal-forms (ctx input)
+ (case (joxa-cmp-parser/has-more-data-to-parse input)
+ (:false
+ :ok)
+ (:true
+ (case (joxa-cmp-parser/parse ctx input)
+ ({:error _}
+ :error)
+ ({ast0 (= rest {:parse-output _ path _})}
+ (joxa-cmp-defs/make-forms (joxa-cmp-path/traverse-path path) ctx ast0)
+ (case (compile-context ctx :intermediate)
+ (:uncompilable
+ (internal-forms ctx rest))
+ (:ok
+ (post-compile-process ctx)
+ (internal-forms ctx rest))))))))
+
+(defn forms (ctx binary options)
+ (joxa-cmp-ctx/set-context-all-ctx ctx [{:options options}])
+ (internal-forms ctx binary))
+
+(defn+ forms (binary options)
+ (case (joxa-cmp-ctx/start-context)
+ ({:ok ctx}
+ (forms ctx binary options)
+ (do-final-comp ctx)
+ (report-errors-warnings ctx)
+ (let* (result (joxa-cmp-ctx/get-raw-context ctx))
+ (joxa-cmp-ctx/stop-context ctx)
+ result))))
+
+;; Namespace Info
+;; -----------
+;;
+;; This does not compile a file. It simply evaluates a namespace enough
+;; to get a complete context. there by providing information about the
+;; namespace.
+
+(defn get-require (form acc)
+ (case form
+ ([]
+ acc)
+ (((namespace-name . clause-body) . rest)
+ (when (erlang/is_atom namespace-name))
+ (get-require rest (namespace-name . acc)))
+ ((namespace-name . rest)
+ (when (erlang/is_atom namespace-name))
+ (get-require rest (namespace-name . acc)))
+ (_
+ acc)))
+
+(defn get-use (ctx form acc)
+ (case form
+ ([]
+ acc)
+ (((use-namespace-name . clause-body) . rest)
+ (when (erlang/is_atom use-namespace-name))
+ (get-use ctx rest (use-namespace-name . acc)))
+ ((use-namespace-name . rest)
+ (when (erlang/is_atom use-namespace-name))
+ (get-use ctx rest (use-namespace-name . acc)))
+ (_
+ (joxa-cmp-ctx/add-error-ctx ctx (joxa-cmp-path/new-path) {:invalid-use :invalid-form form})
+ acc)))
+
+(defn internal-info (ctx input acc)
+ (case (joxa-cmp-parser/has-more-data-to-parse input)
+ (:false
+ acc)
+ (:true
+ (case (joxa-cmp-parser/parse ctx input)
+ ({:error _}
+ [])
+ ({(:ns . (namespace-name . rest)) rest-input}
+ (internal-info ctx rest-input
+ ({namespace-name
+ (lists/flatten (lists/foldl
+ (fn (form iacc)
+ (case form
+ ((:require . req-rest)
+ ((get-require req-rest []) . iacc))
+ ((:use . use-rest)
+ ((get-use ctx use-rest []) . iacc))
+ (_
+ iacc))) [] rest))
+ } . acc)))
+ ({_ rest-input}
+ (internal-info ctx rest-input acc))))))
+
+(defn info (ctx binary options)
+ (joxa-cmp-ctx/set-context-all-ctx ctx [{:options options}])
+ (internal-info ctx binary []))
+
+(defn+ info (input options)
+ (case input
+ (_ (when (erlang/is-binary input))
+ (case (joxa-cmp-ctx/start-context)
+ ({:ok ctx}
+ (let* (result (info ctx input options))
+ (joxa-cmp-ctx/stop-context ctx)
+ result))))
+ (_ (when (erlang/is-list input))
+ (case (file/read_file input)
+ ({:ok binary}
+ (info binary options))
+ ({:error reason}
+ {:error {:file-access reason input}})))))
+
+(defn+ info (file)
+ (info file []))
+
+;; Interactive Compilation
+;; -----------------------
+;;
+;; This section describes interactive compilation. That is the
+;; compilation as it is designed be used in something like joxa-shell
+;; or the eventual swank implementation for joxa. It is probably not
+;; of interest to your average coder.
+;;
+;; Interactive basically takes the iterative approach and splits it up
+;; into an API that can be called externally by tha user.
+
+(defn+ clear-errors (ctx)
+ (joxa-cmp-ctx/errors-ctx ctx [])
+ (joxa-cmp-ctx/warnings-ctx ctx []))
+
+(defn+ start-interactive ()
+ (case (joxa-cmp-ctx/start-context)
+ ({:ok ctx}
+ ctx)))
+
+(defn make-interactive-fun (ctx name ast)
+ (case (joxa-cmp-defs/make-function (joxa-cmp-path/new-path) ctx ast)
+ ({_ arg-list body}
+ (joxa-cmp-ctx/add-exported-def-ctx (joxa-cmp-path/new-path) ctx [] name arg-list body :replace))))
+
+(defn make-dispatch (ctx interactive-name ast)
+ (let* (dispatchables
+ '(
+ defn+
+ defn
+ definline
+ deftype
+ deftype+
+ defspec
+ ns
+ defmacro
+ do
+ ))
+ (case ast
+ ((:ns . _)
+ (joxa-cmp-ns/make-namespace (joxa-cmp-path/new-path) ctx ast)
+ :defn)
+ ((element . rest)
+ (case (lists/member element dispatchables)
+ (:true
+ (joxa-cmp-defs/make-definition (joxa-cmp-path/new-path) ctx ast))
+ (:false
+ (case element
+ (:require
+ (joxa-cmp-ns/make-require (joxa-cmp-path/new-path) ctx rest)
+ :defn)
+ (:use
+ (joxa-cmp-ns/make-use {0 0} ctx rest :undefined [])
+ :defn)
+ (_
+ (make-interactive-fun ctx interactive-name [interactive-name [] ast])
+ :expr)))))
+ (_
+ (make-interactive-fun ctx interactive-name [:interactive-name [] ast])
+ :expr))))
+
+(defn internal-comp-interactive (ctx interactive-name input result0)
+ (case (joxa-cmp-parser/has-more-data-to-parse input)
+ (:false
+ (do-final-comp ctx)
+ (report-errors-warnings ctx)
+ result0)
+ (:true
+ (case (joxa-cmp-parser/parse ctx input)
+ ({:error rest}
+ {:error rest})
+ ({ast0 (= rest {:parse-output _ path _})}
+ (let* (result1 (case (make-dispatch ctx interactive-name ast0)
+ (:expr
+ :expr)
+ (_
+ result0)))
+ (case (compile-context ctx :intermediate)
+ (:uncompilable
+ (internal-comp-interactive ctx interactive-name rest result1))
+ (:ok
+ (post-compile-process ctx)
+ (internal-comp-interactive ctx interactive-name rest result1)))))))))
+
+(defn+ comp-interactive (ctx interactive-name input options)
+ (joxa-cmp-ctx/set-context-all-ctx ctx [{:options options}])
+ (internal-comp-interactive ctx interactive-name input :defn))
+
+(defn+ stop-interactive (ctx)
+ (let* (raw-ctx (joxa-cmp-ctx/get-raw-context ctx))
+ (joxa-cmp-ctx/stop-context ctx)
+ raw-ctx))
+
+
+
+
+;; Compilation Dispatch Framework
+;; ------------------------------
+;;
+;; This provides a means by which the correct compilation namespace and
+;; result 'saving' namespace might be found.
+(defn get-extension (options)
+ (case (lists/member :to_ast options)
+ (:false
+ (case (lists/member :to_core options)
+ (:false
+ ".beam")
+ (:true
+ ".core")))
+ (:true
+ ".ast")))
+
+(defn save-output (options binary ctx)
+ (let* (out-dir (proplists/get_value :outdir options :undefined))
+ (case out-dir
+ (:undefined
+ :ok)
+ (out-dir
+ (let* (namespace-name (joxa-cmp-ctx/get-context :namespace-name ctx)
+ path (re/split (erlang/atom_to_list namespace-name) "\\.")
+ out-path (filename/join (out-dir . path))
+ out-file (lists/flatten ((erlang/binary_to_list out-path)
+ . (get-extension options))))
+ (filelib/ensure_dir out-path)
+ (file/write_file out-file binary))))))
+
+(defn+ has-errors? (ctx)
+ (case ctx
+ (_ (when (erlang/is_tuple ctx))
+ (let* (errors (joxa-cmp-ctx/get-context :errors ctx)
+ warnings (joxa-cmp-ctx/get-context :warnings ctx))
+ (erlang/or
+ (erlang/> (erlang/length errors) 0)
+ (erlang/> (erlang/length warnings) 0))))
+ (_
+ :true)))
+
+(defn do-file-transition (_trans-state path ctx)
+ (do-final-comp ctx)
+ (let* (result (joxa-cmp-ctx/get-raw-context ctx))
+ (case result
+ (val (when (erlang/== (erlang/element 1 val) :context))
+ (case (has-errors? val)
+ (:false
+ (save-output (joxa-cmp-ctx/get-context :options result)
+ (joxa-cmp-ctx/get-context :result result) result))
+ (:true
+ :ok))
+ val)
+ (_
+ :ok)))
+ {:undefined do-file-transition/3})
+
+(defn+ do-compile (filename options)
+ (case (joxa-cmp-ctx/start-context)
+ ({:ok ctx}
+ (joxa-cmp-ctx/namespace-transition-ctx ctx {:undefined do-file-transition/3})
+ (joxa-cmp-ctx/filename-ctx ctx filename)
+ (case (file/read_file filename)
+ ({:ok binary}
+ (forms ctx binary options)
+ (report-errors-warnings ctx)
+ (do-file-transition :undefined (joxa-cmp-path/new-path) ctx)
+ (let* (result (joxa-cmp-ctx/get-raw-context ctx))
+ (joxa-cmp-ctx/stop-context ctx)
+ result))
+ ({:error reason}
+ {:error {:file-access reason filename}})))))
+
+
+
+;; Command Line Interface
+;; ----------------------
+;;
+;; This set of functions represents the command line interface and its
+;; description to Joxa.
+;;
+(defn usage (os-list)
+ (getopt/usage os-list "" "[option1 option2 ...] <joxa-file>"
+ '()))
+
+(defn+ option-spec-list ()
+ [{:to_ast \a "to_ast" :undefined "compile to core ast"}
+ {:to_core \c "to_core" :undefined "compile to core erlang"}
+ {:outdir \o "outdir" {:string "./"} "the directory to output beam files"}
+ {:bootstrap \b "bootstrap" :undefined
+ "Use the special limited bootstrap compiler"}])
+
+(defn+ main (args)
+ (case (getopt/parse (option-spec-list) args)
+ ({:ok {options [target]}}
+ (let* (raw-ctx (do-compile target options))
+ (case (has-errors? raw-ctx)
+ (:true
+ (init/stop 127))
+ (:false
+ (init/stop 0)))))
+ (_
+ (usage (option-spec-list))
+ (init/stop 127))))
+
+(defn+ main ()
+ (main (init/get_plain_arguments)))
View
27 src/joxa-lib.jxa
@@ -0,0 +1,27 @@
+;;; The Joxa Core Library
+;;; =====================
+;;; * author: Eric Merritt
+;;; * copyright: Erlware, LLC 2011 - 2012
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;;
+;;; This module provides a core set of functions to joxa users.
+(ns joxa-lib
+ (require erlang
+ lists
+ joxa-cc-util
+ io))
+
+;; This is really just a convienience so users don't have to require
+;; both joxa-compiler and core.
+(defn+ gensym ()
+ (joxa-cc-util/gensym))
+
+(defn+ gensym (prefix)
+ (joxa-cc-util/gensym prefix))
+
+(defmacro+ define (name value)
+ `(defmacro ~name () ~value))
View
2  src/joxa-shell.jxa
@@ -79,6 +79,6 @@
(defn+ start ()
(let* (ctx (joxa-compiler/start-interactive))
(joxa-cmp-ctx/namespace-name-ctx ctx :joxa-is)
- (io/format "Joxa Version 0.1.2+build.7.1ba2502~n~n")
+ (io/format "Joxa Version 0.1.2+build.8.9470f37~n~n")
(loop ctx <<>>)
(joxa-compiler/stop-interactive ctx)))
View
93 src/joxa-test.jxa
@@ -0,0 +1,93 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-test
+ (require erlang
+ joxa-lib
+ joxa-assert
+ (eunit :joxify)
+ (eunit_lib :joxify)
+ (io :joxify)
+ (io_lib :joxify)))
+
+
+;; This macro can be used at any time to check whether or not the code
+;; is currently running directly under eunit. Note that it does not work
+;; in secondary processes if they have been assigned a new group leader.
+(defmacro+ under-eunit ()
+ `(joxa-assert/is {:current_function,{:eunit_proc,_,_}}
+ (erlang/process_info (erlang/group_leader)
+ :current_function)))
+
+(defmacro+ -test (expr)
+ ` {($line-number) (fn () ~expr)})
+
+(defmacro+ -is (bool-expr)
+ `(joxa-test/-test (joxa-assert/assert ~bool-expr)))
+
+(defmacro+ -is-not (bool-expr)
+ `(joxa-test/-test (joxa-assert/assert (erlang/not ~bool-expr))))
+
+(defmacro+ -is-match (guard expr)
+ `(joxa-test/-test (joxa-assert/assert-match ~guard ~expr)))
+
+(defmacro+ -is-not-match (guard expr)
+ `(joxa-test/-test (joxa-assert/assert-not-match ~guard ~expr)))
+
+(defmacro+ -is-equal (expect expr)
+ `(joxa-test/-test (joxa-assert/assert-equal ~expect ~expr)))
+
+(defmacro+ -is-not-equal (unexpected expr)
+ `(joxa-test/-test (joxa-assert/assert-not-equal ~unexpected ~expr)))
+
+(defmacro+ -throws-exception- (class term expr)
+ `(joxa-test/-test (joxa-assert/assert-exception ~class ~term ~expr)))
+
+(defmacro+ -throws-error? (term expr)
+ `(joxa-test/-test (joxa-assert/assert-error ~term ~expr)))
+
+(defmacro+ -throws-exit? (term expr)
+ `(joxa-test/-test (joxa-assert/assert-exit ~term ~expr)))
+
+(defmacro+ -throws-throw? (term expr)
+ `(joxa-test/-test (joxa-assert/assert-throw ~term ~expr)))
+
+;; Macros to simplify debugging. (n particular, they work even when the
+;; standard output is being redirected by EUnit while running tests)
+(defmacro+ debug-msg (s)
+ `(io/fwrite :user <<"~s:~w:~w: ~s\n">>
+ [($file-name) ($line-number) (erlang/self) ~s]))
+
+(defmacro+ debug-here ()
+ `(joxa-test/debug-msg "<-"))
+
+(defmacro+ debug-fmt (s as)
+ `(joxa-test/debug-msg (io_lib/format ~s ~as)))
+
+(defmacro+ debug-val (e)
+ `(do
+ (joxa-test/debug-fmt <<"~s = ~P">> [(quote ~e) ~e 15])
+ ~e))
+(defmacro+ debug-time (s e)
+ (let* (--t0 (joxa-lib/gensym)
+ --t1 (joxa-lib/gensym)
+ --v (joxa-lib/gensym))
+ `(let* (~--v ~e)
+ (case (erlang/statistics :wall_clock)
+ ({~--t0 _}
+ (case (erlang/statistics :wall_clock)
+ ({~--t1 _}
+ (joxa-test/debug-fmt <<"~s: ~.3f s">>, [~s, (erlang/:'/'
+ (erlang/- ~--t1 ~--t0)
+ 1000)])))))
+ ~--v)))
+
+;; Macros to support the creation and testability of namespaces
+(defmacro+ testable ()
+ `(defn+ test ()
+ (eunit/test ($namespace))))
+
+(defn+ test (namespace-name)
+ (eunit/test namespace-name))
View
2  src/joxa.app.src
@@ -2,7 +2,7 @@
{application, joxa,
[{description, "The Joxa Language Implementation"},
- {vsn, "0.1.2+build.7.1ba2502"},
+ {vsn, "0.1.2+build.8.9470f37"},
{modules, []},
{registered, []},
{applications, [kernel, stdlib, compiler, erlware_commons,
View
15 src/jxa_utils.erl
@@ -1,4 +1,19 @@
%% -*- mode: Erlang; fill-column: 80; comment-column: 76; -*-
+%%% Copyright Erlware, LLC.
+%%%
+%%% Licensed under the Apache License,
+%%%
+%%% Version 2.0 (the "License"); you may not use this file except in compliance
+%%% with the License. You may obtain a copy of the License at
+%%%
+%%% http://www.apache.org/licenses/LICENSE-2.0
+%%%
+%%% Unless required by applicable law or agreed to in writing, software
+%%% distributed under the License is distributed on an "AS IS" BASIS,
+%%%
+%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%%% See the License for the specific language governing permissions and
+%%% limitations under the License.
-module(jxa_utils).
-export([to_core/1, to_ast/1, to_asm/1,
View
108 test/joxa-assert_tests.jxa
@@ -0,0 +1,108 @@
+(ns joxa-assert_tests
+ (require io)
+ (use joxa-assert))
+
+(defn+ matches_test ()
+ (is :true (matches? :foo :foo))
+ (is :false (matches? :foo :baz)))
+
+(defn+ is_test ()
+ (is :ok (is :true))
+ (throws-error {:assertion_failed [{:namespace joxa-assert_tests}
+ {:line _}
+ {:expression ':false}
+ {:expected ':true}
+ {:value :false}]}
+ (is :false)))
+
+(defn+ is2_test ()
+ (is :ok (is :true ((fn () :true))))
+ (throws-error {:assertMatch_failed [{:namespace joxa-assert_tests}
+ {line _}
+ {expression '((fn () :true))}
+ {pattern ':false}
+ {value :true}]}
+ (is :false ((fn () :true)))))
+
+(defn+ is-not_test ()
+ (is :ok (is-not :false ((fn () :true))))
+ (throws-error {:assertNotMatch_failed [{:namespace :joxa-assert_tests}
+ {:line _}
+ {:expression '((fn () :true))}
+ {:pattern ':true}
+ {:value :true}]}
+ (is-not :true ((fn () :true)))))
+
+(defn+ is-equal_test ()
+ (is :ok (is-equal :true ((fn () :true))))
+ (throws-error {:assertEqual_failed [{:namespace :joxa-assert_tests}
+ {:line _}
+ {:expression '((fn () :true))}
+ {:expected :false}
+ {:value :true}]}
+ (is-equal :false ((fn () :true)))))
+
+(defn is-not-equal_test ()
+ (is :ok (is-not-equal :false ((fn () :true))))
+ (throws-error {:assertNotEqual_failed [{:namespace :jxat-assert-not-equal-test}
+ {:line _}
+ {:expression [[:fn [] [:quote :true]]]}
+ {:value :true}]}
+ (is-not-equal :true ((fn () :true)))))
+
+(defn+ throws-exception_test ()
+ (is :ok (throws-exception :throw :foo-bar (erlang/throw :foo-bar)))
+ (throws-error {:assertException_failed
+ [{:namespace :joxa-assert_tests}
+ {:line _}
+ {:expression '(erlang/throw :not-foo-bar)}
+ {:pattern '{:error :foo-bar}}
+ {:unexpected_exception
+ {:throw :not-foo-bar _}}]}
+ (throws-exception :error :foo-bar (erlang/throw :not-foo-bar))))
+
+(defn+ throws-error_test ()
+ (is :ok (throws-error :foo-bar (erlang/error :foo-bar)))
+ (throws-error {:assertException_failed
+ [{:namespace :joxa-assert_tests}
+ {:line _}
+ {:expression '(erlang/throw :foo-bar)}
+ {:pattern '{:error :foo-bar}}
+ {:unexpected_exception
+ {:throw :foo-bar _}}]}
+ (throws-error :foo-bar
+ (erlang/throw :foo-bar))))
+
+(defn+ throws-exit_test ()
+ (is :ok (throws-exit :foo-bar (erlang/exit :foo-bar)))
+ (throws-error {:assertException_failed
+ [{:namespace :joxa-assert_tests}
+ {:line _}
+ {:expression '(erlang/throw :foo-bar)}
+ {:pattern '{:exit :foo-bar}}
+ {:unexpected_exception
+ {:throw :foo-bar _}}]}
+ (throws-exit :foo-bar (erlang/throw :foo-bar))))
+
+(defn+ throws-thow_test ()
+ (is :ok (throws-throw :foo-bar (erlang/throw :foo-bar)))
+ (throws-error {:assertException_failed
+ [{:namespace :joxa-assert_tests}
+ {:line _}
+ {:expression '(erlang/exit :foo-bar)}
+ {pattern '{:throw :foo-bar}}
+ {:unexpected_exception
+ {:exit :foo-bar _}}]}
+ (throws-throw :foo-bar (erlang/exit :foo-bar))))
+
+(defn+ does-not-throw-exception_test ()
+ (is :ok (does-not-throw-exception :throw :foo-bar (erlang/throw :foody-bar)))
+ (throws-error {:assertNotException_failed
+ [{:namespace :joxa-assert_tests}
+ {:line _}
+ {:expression '(erlang/throw :foo-bar)}
+ {:pattern '{:throw :foo-bar}}
+ {:unexpected_exception
+ {:throw :foo-bar _}}]}
+ (does-not-throw-exception :throw :foo-bar
+ (erlang/throw :foo-bar))))
View
47 test/joxa-cc-ctx_tests.jxa
@@ -0,0 +1,47 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-cc-ctx_tests
+ (require joxa-test
+ (joxa-cc-ctx :as ctx)
+ (joxa-cc-path :as path))
+ (use joxa-test
+ joxa-assert))
+
+
+(defn+ empty_test ()
+ (let* (ctx0 (ctx/empty))
+ (is [] (ctx/namespaces ctx0))
+ (is :undefined (ctx/current-namespace ctx0))
+ (is 6 (erlang/size ctx0))
+ (is :context (erlang/element 1 ctx0))))
+
+(defn+ namespaces_test ()
+ (let* (ctx0 (ctx/namespaces! [:namespace-test] (ctx/empty)))
+ (is [:new-namespace :namespace-test] (ctx/namespaces
+ (ctx/add-namespace :new-namespace ctx0)))))
+
+(defn+ current-namespace_test ()
+ (let* (ctx0 (ctx/current-namespace! :namespace-test (ctx/empty)))
+ (is :namespace-test (ctx/current-namespace ctx0))))
+
+(defn+ filename-namespace_test ()
+ (let* (ctx0 (ctx/filename! "filename" (ctx/empty)))
+ (is "filename" (ctx/filename ctx0))))
+
+(defn+ decorate-error_test ()
+ (let* (path0 (path/step! (path/incr! 5 (path/empty)))
+ ctx0 (ctx/add-error path0 :error
+ (ctx/add-warning path0 :warning
+ (ctx/decorate-line! path0 10
+ (ctx/empty)))))
+ (is [{:error :warning 10 :undefined :undefined :warning}
+ {:error :error 10 :undefined :undefined :error}] (ctx/errors ctx0))))
+
+(defn+ decorate-nearest_test ()
+ (let* (path0 (path/step! (path/incr! 5 (path/empty)))
+ ctx0 (ctx/decorate-line! path0 100 (ctx/empty))
+ path1 (path/step! (path/incr! 4 path0)))
+ (is 100 (ctx/get-line-decoration path1 ctx0))))
View
23 test/joxa-cc-error_tests.jxa
@@ -0,0 +1,23 @@
+;;; @Copyright: Erlware, LLC
+;;;
+;;; Licensed under the Apache License, Version 2.0 you may not use
+;;; this file except in compliance with the License. You may obtain a
+;;; copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+(ns joxa-cc-error_test
+ (require (joxa-cc-error :as error))
+ (use joxa-test
+ joxa-assert))
+
+(defn+ new-error_test ()
+ (is {:error :error 10 :no-ns :cur-fun {:foo :bar}}
+ (error/new-error :no-ns :cur-fun 10 {:foo :bar})))
+
+(defn+ new-warning_test ()
+ (is {:error :warning 10 :no-ns :cur-fun {:foo :bar}}
+ (error/new-warning :no-ns :cur-fun 10 {:foo :bar})))
+
+
+(defn+ add-error_test ()
+ (let* (error-list (joxa-cc-error/empty-error-list))
+ (is [{:error :error 10 :no-ns :cur-fun {:foo :bar}}]
+ (error/error-list->list (error/add-error :no-ns :cur-fun 10 {:foo :bar} error-list)))))
View
592 test/joxa-cc-lexer_tests.jxa
@@ -0,0 +1,592 @@
+(ns joxa-cc-lexer_tests
+ (require (joxa-cc-lexer :as lexer)
+ (joxa-cc-peg :as peg))
+ (use joxa-assert
+ (erlang :only (+/2))))
+
+(defmacro with-memo (&rest body)
+ `(do
+ (peg/setup-memo)
+ ~@body
+ (peg/release-memo)))
+
+(defmacro memo-is (expect real)
+ `(with-memo
+ (is ~expect ~real)))
+
+(defn index ()
+ {1 1})
+
+(defn index (n)
+ {(+ 1 n) (+ 1 n)})
+
+(defn+ digit_test ()
+ (memo-is {:fail {:expected {:character-class "[0-9]"} {1 1}}}
+ (lexer/digit << "ab" >> (index)))
+ (memo-is {<< "2" >> << >> {2 3}}
+ (lexer/digit << "2" >> (index 1)))
+ (memo-is {<< "2" >> << "33" >> {3 4}}
+ (lexer/digit << "233" >> (index 2))))
+
+
+(defn+ int-part_test ()
+ (memo-is {[[] [<< "2" >>]] << >> {1 2}}
+ (lexer/int-part << "2" >> (index)))
+ (memo-is {[<< "-" >> [<< "2" >>]] << >> {1 3}}
+ (lexer/int-part << "-2" >> (index))))
+
+(defn+ frac-part_test ()
+ (memo-is {[<< "." >>,[<< "2" >>]],<< >> {1 3}}
+ (lexer/frac-part << ".2" >> (index)))
+ (memo-is {[<< "." >> [<< "2" >> << "3" >> << "3" >> << "3" >>]]
+ << >>,
+ {2,7}}
+ (lexer/frac-part << ".2333" >> (index 1)))
+ (memo-is {:fail {:expected {:string << "." >>} {3 3}}}
+ (lexer/frac-part << "ee.2" >> (index 2)))
+ (memo-is {:fail {:expected {:string << "." >>} {4 4}}}
+ (lexer/frac-part << "eeff" >> (index 3))))
+
+(defn+ integer_test ()
+ (memo-is {{:integer 123456 {1 1}} << >> {1 7}}
+ (lexer/integer << "123456" >> (index)))
+ (memo-is {{:integer 1234 {1 1}} << ".56" >> {1 5}}
+ (lexer/integer << "1234.56" >> (index)))
+ (memo-is {:fail {:expected {:at-least-one{:character-class "[0-9]"}} {1 1}}}
+ (lexer/integer << "abc123" >> (index)))
+ (memo-is {{:integer 123456 {1 1}} << "abc" >> {1 7}}
+ (lexer/integer << "123456abc" >> (index))))
+
+(defn+ float_test ()
+ (memo-is {{float 123456.22 {1 1}} << >> {1 10}}
+ (lexer/float << "123456.22" >> (index)))
+ (memo-is {{:float 1234.56 {1 1}} << >> {1 8}}
+ (lexer/float << "1234.56" >> (index)))
+ (memo-is {:fail {:expected {:at-least-one {:character-class "[0-9]"}} {1 1}}}
+ (lexer/float << "abc123" >> (index)))
+ (memo-is {:fail {:expected {:string << "." >>} {1 7}}}
+ (lexer/float << "123456abc" >> (index))))
+
+(defn+ char_test ()
+ (memo-is {{:char 97 {1 1}} << >> {1 3}}
+ (lexer/char << "\\a" >> (index)))
+ (memo-is {{:char 123 {1 1}} << >> {1 3}}
+ (lexer/char << "\\{" >> (index)))
+ (memo-is {:fail {:expected {:string << "\\" >>} {1 1}}}
+ (lexer/char << "ab" >> (index)))
+ (memo-is {:fail {:expected {:string << "\\" >>} {1 1}}}
+ (lexer/char << "ab" >> (index)))
+ (memo-is {{:char \" {1 1}} << >> {1 4}}
+ (lexer/char << "\\\\\"" >> (index)))
+ (memo-is {{:char \\b {1 1}} << >> {1 4}}
+ (lexer/char << "\\\\b" >> (index)))
+ (memo-is {{:char \\f {1 1}} << >> {1 4}}
+ (lexer/char << "\\\\f" >> (index)))
+ (memo-is {{:char \\n {1 1}} << >> {1 4}}
+ (lexer/char << "\\\\n" >> (index)))
+ (memo-is {{:char \\r {1 1}} << >> {1 4}}
+ (lexer/char << "\\\\r" >> (index)))
+ (memo-is {{:char \\t {1 1}} << >> {1 4}}
+ (lexer/char << "\\\\t" >> (index))))
+
+(defn+ space_test ()
+ (memo-is {<< " " >> << " " >> {1 2}}
+ (lexer/space << " " >> (index)))
+ (memo-is {<< "\t" >> << " \n" >> {1 2}}
+ (lexer/space << "\t \n" >> (index)))
+ (memo-is {<< "\r" >> << >> {1 2}}
+ (lexer/space << "\r" >> (index)))
+ (memo-is {:fail {:expected
+ {:character-class "[ \t\n\\s\r]"}
+ {1 1}}}
+ (lexer/space << "abc" >> (index))))
+
+(defn+ comment_test ()
+ (memo-is {[<< ";" >>
+ [<< ";" >> << ";" >> << " " >> << "h" >> << "a" >> << "h" >> << "a" >>]
+ :eof]
+ << >>
+ {1 9}}
+ (lexer/comment << ";;; haha" >> (index)))
+ (memo-is {[<< ";" >>
+ [<< ";" >> << ";" >> << " " >> << "h" >> << "a" >> << "h" >> << "a" >>]
+ << "\n" >>]
+ << >>
+ {2 1}}
+ (lexer/comment << ";;; haha\n" >> (index)))
+ (memo-is {[<< ";" >>,
+ [<< ";" >> << ";" >> << " " >> << "h" >> << "a" >> << "h" >> << "a" >>]
+ << "\n" >>]
+ << "one" >>
+ {2 1}}
+ (lexer/comment << ";;; haha\none" >> (index)))
+ (memo-is {[<< ";" >> [] :eof] << >> {1 2}}
+ (lexer/comment << ";" >> (index)))
+ (memo-is {:fail {:expected {:string << ";" >>} {1 1}}},
+ (lexer/comment << "onetwothree" >> (index))))
+(defn+ ignorable_test ()
+ (memo-is {[] << >> {1 4}}
+ (lexer/ignorable << " " >> (index)))
+ (memo-is {[] << >> {2 1}}
+ (lexer/ignorable << "\t \n" >> (index)))
+ (memo-is {[] << >> {1 2}}
+ (lexer/ignorable << "\r" >> (index)))
+ (memo-is {[] << "abc" >> {1 1}}
+ (lexer/ignorable << "abc" >> (index)))
+ (memo-is {[] << >> {1 9}}
+ (lexer/ignorable << ";;; haha" >> (index)))
+ (memo-is {[] << >> {2 1}}
+ (lexer/ignorable << ";;; haha\n" >> (index)))
+ (memo-is {[] << "one" >> {2 1}}
+ (lexer/ignorable << ";;; haha\none" >> (index)))
+ (memo-is {[] << >> {1 2}}
+ (lexer/ignorable << ";" >> (index)))
+ (memo-is {[] << "onetwothree" >> {1 1}}
+ (lexer/ignorable << "onetwothree" >> (index))))
+(defn+ ident_test ()
+ (memo-is {{:ident :true {1 _}} << >> _}
+ (lexer/ident << "true" >> (index)))
+ (memo-is {{:ident :false {1 _}} << >> _}
+ (lexer/ident << "false" >> (index)))
+ (memo-is {{:ident :*foo* {1 _}} << >> _}
+ (lexer/ident << "*foo*" >> (index)))
+ (memo-is {{:ident :foo-bar {1 _}} << >> _}
+ (lexer/ident << "foo-bar" >> (index)))
+ (memo-is {{:ident :null {1 _}} << >> _}
+ (lexer/ident << "null" >> (index)))
+ (memo-is {{:ident :Hello? {1 _}} << >> _}
+ (lexer/ident << "Hello?" >> (index)))
+ (memo-is {{:ident :boo88 {1 _}} << >> _}
+ (lexer/ident << "boo88" >> (index)))
+ (memo-is {{:ident :bock: {1 _}} << >> _}
+ (lexer/ident << "bock:" >> (index)))
+ (memo-is {{:ident :bock {1 _}} << "{" >> _}
+ (lexer/ident << "bock{" >> (index)))
+ (memo-is {{:ident :bock {1 _}} << "[" >> _}
+ (lexer/ident << "bock[" >> (index)))
+ (memo-is {{:ident :bock {1 _}} << "(ee" >> _}
+ (lexer/ident << "bock(ee" >> (index))))
+
+(defn+ fun-reference_test ()
+ (memo-is {{:call {:--fun :fun 3} {1 1}} << >> {1 6}}
+ (lexer/fun-reference << "fun/3" >> (index)))
+ (memo-is {{:call {:--fun :module :fun 3} {1 1}}
+ << >>
+ {1 13}}
+ (lexer/fun-reference << "module/fun/3" >> (index)))
+ (memo-is {{:call {:--fun :module :fun} {1 1}}
+ << >>
+ {1 11}}
+ (lexer/fun-reference << "module/fun" >> (index)))
+ (memo-is {:fail {:expected {:string << "/" >>} {1 7}}}
+ (lexer/fun-reference << "zoo_ma" >> (index)))
+ (memo-is {:fail {:expected {:string << ":'" >>} {1 1}}}
+ (lexer/fun-reference << "/2" >> (index))))
+
+(defn+ string_test ()
+ (memo-is {{:string " \" " {1 1}} << >> {1 7}}
+ (lexer/string << "\" \\\" \"" >> (index)))
+ (memo-is {{:string "\\" {1 1}} << >> {1 5}}
+ (lexer/string << "\"\\\\\"" >> (index)))
+ (memo-is {{:string "\t" {1 1}} << >> {1 5}}
+ (lexer/string << "\"\\t\"" >> (index)))
+ (memo-is {{:string "\n" {1 1}} << >> {1 5}}
+ (lexer/string << "\"\\n\"" >> (index)))
+ (memo-is {{:string "\r" {1 1}} << >> {1 5}}
+ (lexer/string << "\"\\r\"" >> (index))))
+
+(defn+ quoted-ident_test ()
+ (memo-is {{:ident :ok _} << >> _}
+ (lexer/quoted-ident << ":'ok'" >> (index)))
+ (memo-is {{:ident :'()' _} << >> _}
+ (lexer/quoted-ident << ":'()'" >> (index)))
+ (memo-is {{:ident :'[]' _}
+ << >>
+ _}
+ (lexer/quoted-ident << ":'[]'" >> (index)))
+ (memo-is {{:ident :'123' _} << >> _}
+ (lexer/quoted-ident << ":'123'" >> (index)))
+ (memo-is {{:ident :'(1)' _}
+ << >>
+ _}
+ (lexer/quoted-ident << ":'(1)'" >> (index)))
+ (memo-is {{:ident :'{one two}' _}
+ << >>
+ _}
+ (lexer/quoted-ident << ":'{one two}'" >> (index))))
+
+(defn+ quote_test ()
+ (memo-is {{:quote {:ident :ok {1 2}} {1 1}} << >> {1 4}}
+ (lexer/quote << "'ok" >> (index)))
+ (memo-is {{:quote {list [] {1 2}} {1 1}} << >> {1 4}}
+ (lexer/quote << "'()" >> (index)))
+ (memo-is {{:quote {:literal-list [] {1 2}} {1 1}}
+ << >>
+ {1 4}}
+ (lexer/quote << "'[]" >> (index)))
+ (memo-is {{:quote {:integer 123 {1 2}} {1 1}} << >> {1 5}}
+ (lexer/quote << "'123" >> (index)))
+ (memo-is {{:quote {:list [{:integer 1 _}] {1 2}} {1 1}}
+ << >>
+ {1 5}}
+ (lexer/quote << "'(1)" >> (index)))
+ (memo-is {{:quote {:tuple [{:ident :one _} {:ident :two _}]
+ {1 2}} {1 1}}
+ << >>
+ {1 11}}
+ (lexer/quote << "'{one two}" >> (index))))
+
+(defn+ list_test ()
+ (memo-is {{:list [{:quote {:ident :ok _} {1 2}}] {1 1}}
+ << >>
+ {1 6}}
+ (lexer/list << "(:ok)" >> (index)))
+ (memo-is {{:list [{:integer 1 {1 2}}
+ {:integer 2 {1 4}}
+ {:integer 3 _}]
+ {1 1}}
+ << >>
+ {1 8}}
+ (lexer/list << "(1 2 3)" >> (index)))
+ (memo-is {{:literal-list
+ [{:integer 33 {1 2}}
+ {:quote {:ident :forty _} {1 5}}
+ {:list [{:integer 1 _}
+ {:integer 2 _}] _}
+ {:tuple [{:quote {:ident :hello _} _}]
+ _}]
+ {1 1}}
+ << >>
+ {1 27}}
+ (lexer/list << "[33 :forty (1 2) {:hello}]" >> (index)))
+ (memo-is {{:list
+ [{:list
+ [{:list [{:list [{:integer 123 _}] _}
+ {:integer 1 _}] _}
+ {:integer 2 _}] {1 2}}
+ {:integer 3 {1 16}}]
+ {1 1}}
+ << >>
+ {1 18}}
+ (lexer/list << "((((123) 1) 2) 3)" >> (index)))
+ (memo-is {{:list [] {1 1}} << >> {1 3}}
+ (lexer/list << "()" >> (index)))
+ (memo-is {{:list [{:list [{:list [] _}] {1 2}}] {1 1}}
+ << >>
+ {1 7}}
+ (lexer/list << "((()))" >> (index))))
+
+(defn+ tuple_test ()
+ (memo-is {{:tuple [{:quote {:ident :ok _} {1 2}}] {1 1}}
+ << >>
+ {1 6}}
+ (lexer/tuple << "{:ok}" >> (index)))
+ (memo-is {{:tuple [{:integer 1 {1 2}}
+ {:integer 2 {1 4}}
+ {:integer 3 _}]
+ {1 1}}
+ << >>
+ {1 8}}
+ (lexer/tuple << "{1 2 3}" >> (index)))
+ (memo-is {{:tuple [{:integer 33 {1 2}}
+ {:quote {:ident :forty _} {1 5}}
+ {:list [{:integer 1 _}
+ {:integer 2 _}] _}
+ {:tuple [{:quote {:ident :hello _} _}]
+ _}]
+ {1 1}}
+ << >>
+ {1 27}}
+ (lexer/tuple << "{33 :forty (1 2) {:hello}}" >> (index)))
+ (memo-is {{:tuple
+ [{:tuple
+ [{:tuple
+ [{:tuple [{:integer 123 _}] _}
+ {:integer 1 _}] _}
+ {:integer 2 _}] _}
+ {:integer 3 {1 16}}] {1 1}}
+ << >>
+ {1 18}}
+ (lexer/tuple << "{{{{123} 1} 2} 3}" >> (index)))
+ (memo-is {{:tuple [] {1 1}} << >> {1 3}}
+ (lexer/tuple << "{}" >> (index)))
+ (memo-is {{:tuple [{:tuple [{:tuple [] _}] {1 2}}] {1 1}}
+ << >>
+ {1 7}}
+ (lexer/tuple << "{{{}}}" >> (index))))
+
+(defn+ binary_test ()
+ (memo-is {{:binary [{:integer 1 {1 3}}
+ {:integer 2 {1 5}}
+ {:integer 3 _}]
+ {1 1}}
+ << >>
+ {1 10}}
+ (lexer/binary << "<<1 2 3>>" >> (index)))
+ (memo-is {{:binary [{:char 97 {1 3}}
+ {:char 98 {1 6}}
+ {:char 99 _}]
+ {1 1}}
+ << >>
+ {1 13}}
+ (lexer/binary << "<<\\a \\b \\c>>" >> (index)))
+ (memo-is {{:binary [{:ident a {1 3}}
+ {:ident b {1 5}}
+ {list [{:ident c _}
+ {:quote {:ident size _} _}
+ {:integer 16 _}] _}]
+ {1 1}}
+ << >>
+ {1 21}}
+ (lexer/binary << "<<a b (c :size 16)>>" >> (index)))
+ (memo-is {{:binary
+ [{:list [{:ident d _}
+ {:quote {:ident :size _} _}
+ {:integer 16 _}] {1 3}}
+ {:ident e {1 16}}
+ {:list [{:ident f _}
+ {:quote {:ident :binary _} _}]
+ _}]
+ {1 1}}
+ << >>
+ _}
+ (lexer/binary << "<<(d :size 16) e (f :binary)>>" >> (index)))
+ (memo-is {{:binary [] {1 1}} << >> {1 6}}
+ (lexer/binary << "<< >>" >> (index)))
+ (memo-is {{:binary {:string [] {1 3}} {1 1}}
+ << >>
+ {1 8}}
+ (lexer/binary << "<<\"\" >>" >> (index)))
+ (memo-is {{:binary {:string "HelloWorld" {1 4}} {1 1}}
+ << >>
+ {1 19}}
+ (lexer/binary << "<< \"HelloWorld\" >>" >> (index))))
+
+(defn+ value_test ()
+ (memo-is {{:ident :true {1 _}} << >> _}
+ (lexer/value << "true" >> (index)))
+ (memo-is {{:ident :false {1 _}} << >> _}
+ (lexer/value << "false" >> (index)))
+ (memo-is {{:ident :*foo* {1 _}} << >> _}
+ (lexer/value << "*foo*" >> (index)))
+ (memo-is {{:ident :foo-bar {1 _}} << >> _}
+ (lexer/value << "foo-bar" >> (index)))
+ (memo-is {{:ident :null {1 _}} << >> _}
+ (lexer/value << "null" >> (index)))
+ (memo-is {{:ident :Hello? {1 _}} << >> _}
+ (lexer/value << "Hello?" >> (index)))
+ (memo-is {{:ident :boo88 {1 _}} << >> _}
+ (lexer/value << "boo88" >> (index)))
+ (memo-is {{:ident :'bock:' {1 _}} << >> _}
+ (lexer/value << "bock:" >> (index)))
+ (memo-is {{:ident :bock {1 _}} << "{" >> _}
+ (lexer/value << "bock{" >> (index)))
+ (memo-is {{:ident :bock {1 _}} << "[" >> _}
+ (lexer/value << "bock[" >> (index)))
+ (memo-is {{:ident :bock {1 _}} << "(ee" >> _}
+ (lexer/value << "bock(ee" >> (index)))
+ (memo-is {{:quote {:ident :true {1 2}} {1 1}} << >> {1 6}}
+ (lexer/value << ":true" >> (index)))
+ (memo-is {{:quote {:ident :false {1 2}} {1 1}} << >> {1 7}}
+ (lexer/value << ":false" >> (index)))
+ (memo-is {{:quote {:ident :*foo* {1 2}} {1 1}}
+ << >>
+ {1 7}}
+ (lexer/value << ":*foo*" >> (index)))
+ (memo-is {{:ident :foo-bar {1 1}} << >> {1 8}}
+ (lexer/value << "foo-bar" >> (index)))
+ (memo-is {{:quote {:ident :Hello? _} {1 1}}
+ << >>
+ {1 8}}
+ (lexer/value << ":Hello?" >> (index)))
+ (memo-is {{:quote {:ident :boo88 _} {1 1}} << >> {1 7}}
+ (lexer/value << ":boo88" >> (index)))
+ (memo-is {{:ident :bock: {1 1}} << >> {1 6}}
+ (lexer/value << "bock:" >> (index)))
+ (memo-is {{:quote {:ident :bock _} {1 1}}
+ << "(ee" >>
+ {1 6}}
+ (lexer/value << ":bock(ee" >> (index)))
+ (memo-is {{:call {:--fun :fun 3} {1 1}} << >> {1 6}}
+ (lexer/value << "fun/3" >> (index)))
+ (memo-is {{:call {:--fun :module :fun 3} {1 1}}
+ << >>
+ {1 13}}
+ (lexer/value << "module/fun/3" >> (index)))
+ (memo-is {{:call {:--fun :module :fun} _}
+ << >>
+ {1 11}}
+ (lexer/value << "module/fun" >> (index)))
+ (memo-is {:fail
+ {:expected {:at-least-one
+ {:character-class "[0-9]"}} {1 1}}}
+ (lexer/value << "/2" >> (index)))
+ (memo-is {{:string " \" " {1 1}} << >> {1 7}}
+ (lexer/value << "\" \\\" \"" >> (index)))
+ (memo-is {{:string "\\" {1 1}} << >> {1 5}}
+ (lexer/value << "\"\\\\\"" >> (index)))
+ (memo-is {{:string "\f" {1 1}} << >> {1 5}}
+ (lexer/value << "\"\\f\"" >> (index)))
+ (memo-is {{:string "\t" {1 1}} << >> {1 5}}
+ (lexer/value << "\"\\t\"" >> (index)))
+ (memo-is {{:string "\n" {1 1}} << >> {1 5}}
+ (lexer/value << "\"\\n\"" >> (index)))
+ (memo-is {{:string "\r" {1 1}} << >> {1 5}}
+ (lexer/value << "\"\\r\"" >> (index)))
+ (memo-is {{:quote {:ident :ok {1 2}} {1 1}} << >> {1 4}}
+ (lexer/value << "'ok" >> (index)))
+ (memo-is {{:quote {:list [] {1 2}} {1 1}} << >> {1 4}}
+ (lexer/value << "'()" >> (index)))
+ (memo-is {{:quote {:literal-list [] {1 2}} {1 1}}
+ << >>
+ {1 4}}
+ (lexer/value << "'[]" >> (index)))
+ (memo-is {{:quote {:integer 123 {1 2}} {1 1}} << >> {1 5}}
+ (lexer/value << "'123" >> (index)))
+ (memo-is {{:quote {:list [{:integer 1 _}] {1 2}} {1 1}}
+ << >>
+ {1 5}}
+ (lexer/value << "'(1)" >> (index)))
+ (memo-is {{:quote {:tuple [{:ident :one _} {:ident :two _}]
+ {1 2}} {1 1}}
+ << >>
+ {1 11}}
+ (lexer/value << "'{one two}" >> (index)))
+ (memo-is {{:list [{:quote {:ident :ok _} {1 2}}] {1 1}}
+ << >>
+ {1 6}}
+ (lexer/value << "(:ok)" >> (index)))
+ (memo-is {{:list [{:integer 1 {1 2}}
+ {:integer 2 {1 4}}
+ {:integer 3 _}]
+ {1 1}}
+ << >>
+ {1 8}}
+ (lexer/value << "(1 2 3)" >> (index)))
+ (memo-is {{:literal-list
+ [{:integer 33 {1 2}}
+ {:quote {:ident :forty _} {1 5}}
+ {:list [{:integer 1 _}
+ {:integer 2 _}] _}
+ {:tuple [{:quote {:ident :hello _} _}]
+ _}]
+ {1 1}}
+ << >>
+ {1 27}}
+ (lexer/value << "[33 :forty (1 2) {:hello}]" >> (index)))
+ (memo-is {{:list
+ [{:list
+ [{:list [{:list [{:integer 123 _}] _}
+ {:integer 1 _}] _}
+ {:integer 2 _}] {1 2}}
+ {:integer 3 {1 16}}]
+ {1 1}}
+ << >>
+ {1 18}}
+ (lexer/value << "((((123) 1) 2) 3)" >> (index)))
+ (memo-is {{:list [] {1 1}} << >> {1 3}}
+ (lexer/value << "()" >> (index)))
+ (memo-is {{:list [{:list [{:list [] _}] {1 2}}] {1 1}}
+ << >>
+ {1 7}}
+ (lexer/value << "((()))" >> (index)))
+ (memo-is {{:tuple [{:quote {:ident :ok _} {1 2}}] {1 1}}
+ << >>
+ {1 6}}
+ (lexer/value << "{:ok}" >> (index)))
+ (memo-is {{:tuple [{:integer 1 {1 2}}