diff options
Diffstat (limited to 'stdlib/source')
5 files changed, 56 insertions, 48 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/extension.lux b/stdlib/source/lux/tool/compiler/phase/extension.lux index 43df97b9e..3b247eda9 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension.lux @@ -4,7 +4,7 @@ [monad (#+ do)]] [control ["." function] - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data ["." error (#+ Error)] ["." text ("#@." order) @@ -38,29 +38,35 @@ (type: #export (Phase s i o) (//.Phase (State s i o) i o)) -(template [<name>] - [(exception: #export (<name> {name Name}) - (ex.report ["Extension" (%t name)]))] +(exception: #export (cannot-overwrite {name Name}) + (exception.report + ["Extension" (%t name)])) - [cannot-overwrite] - [invalid-syntax] - ) +(exception: #export (invalid-syntax {name Name} {inputs (List Code)}) + (exception.report + ["Extension" (%t name)] + ["Inputs" (|> inputs + (list@map %code) + (text.join-with text.new-line))])) (exception: #export [s i o] (unknown {name Name} {bundle (Bundle s i o)}) - (ex.report ["Extension" (%t name)] - ["Available" (|> bundle - dictionary.keys - (list.sort text@<) - (list@map (|>> %t (format text.new-line text.tab))) - (text.join-with ""))])) + (exception.report + ["Extension" (%t name)] + ["Available" (|> bundle + dictionary.keys + (list.sort text@<) + (list@map %t) + (text.join-with text.new-line))])) (exception: #export (incorrect-arity {name Name} {arity Nat} {args Nat}) - (ex.report ["Extension" (%t name)] - ["Expected" (%n arity)] - ["Actual" (%n args)])) + (exception.report + ["Extension" (%t name)] + ["Expected" (%n arity)] + ["Actual" (%n args)])) (exception: #export (incorrect-syntax {name Name}) - (ex.report ["Extension" (%t name)])) + (exception.report + ["Extension" (%t name)])) (def: #export (install name handler) (All [s i o] @@ -72,7 +78,7 @@ []]) _ - (ex.throw cannot-overwrite name)))) + (exception.throw cannot-overwrite name)))) (def: #export (apply phase [name parameters]) (All [s i o] @@ -84,7 +90,7 @@ stateE) #.None - (ex.throw unknown [name bundle])))) + (exception.throw unknown [name bundle])))) (def: #export (localized get set transform) (All [s s' i o v] diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux index f62b1031b..4f11e47fb 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux @@ -92,7 +92,7 @@ (analyse exprC)) _ - (/////analysis.throw ///.invalid-syntax [extension-name])))) + (/////analysis.throw ///.invalid-syntax [extension-name argsC+])))) (template [<name> <type>] [(def: (<name> eval) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux index f3b6552c0..13762272e 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux @@ -533,7 +533,7 @@ (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class))))) _ - (/////analysis.throw ///.invalid-syntax extension-name)) + (/////analysis.throw ///.invalid-syntax [extension-name args])) _ (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) @@ -556,7 +556,7 @@ (/////analysis.throw cannot-possibly-be-an-instance (format object-class " !<= " class)))) _ - (/////analysis.throw ///.invalid-syntax extension-name)) + (/////analysis.throw ///.invalid-syntax [extension-name args])) _ (/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) @@ -756,7 +756,7 @@ " For value: " (%code valueC) text.new-line)))) _ - (/////analysis.throw ///.invalid-syntax extension-name)))) + (/////analysis.throw ///.invalid-syntax [extension-name args])))) (def: bundle::object Bundle @@ -845,7 +845,7 @@ (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field))))) _ - (/////analysis.throw ///.invalid-syntax extension-name)) + (/////analysis.throw ///.invalid-syntax [extension-name args])) _ (/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) @@ -867,7 +867,7 @@ (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) valueA)))) _ - (/////analysis.throw ///.invalid-syntax extension-name)) + (/////analysis.throw ///.invalid-syntax [extension-name args])) _ (/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)])))) @@ -886,7 +886,7 @@ (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) objectA)))) _ - (/////analysis.throw ///.invalid-syntax extension-name)) + (/////analysis.throw ///.invalid-syntax [extension-name args])) _ (/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)])))) @@ -910,7 +910,7 @@ (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) valueA objectA)))) _ - (/////analysis.throw ///.invalid-syntax extension-name)) + (/////analysis.throw ///.invalid-syntax [extension-name args])) _ (/////analysis.throw ///.incorrect-arity [extension-name 4 (list.size args)])))) @@ -1185,7 +1185,7 @@ (/////analysis.text outputJC) (decorate-inputs argsT argsA))))) _ - (/////analysis.throw ///.invalid-syntax extension-name)))) + (/////analysis.throw ///.invalid-syntax [extension-name args])))) (def: invoke::virtual Handler @@ -1208,7 +1208,7 @@ (/////analysis.text outputJC) objectA (decorate-inputs argsT argsA))))) _ - (/////analysis.throw ///.invalid-syntax extension-name)))) + (/////analysis.throw ///.invalid-syntax [extension-name args])))) (def: invoke::special Handler @@ -1225,7 +1225,7 @@ (/////analysis.text outputJC) (decorate-inputs argsT argsA))))) _ - (/////analysis.throw ///.invalid-syntax extension-name)))) + (/////analysis.throw ///.invalid-syntax [extension-name args])))) (def: invoke::interface Handler @@ -1246,7 +1246,7 @@ (decorate-inputs argsT argsA))))) _ - (/////analysis.throw ///.invalid-syntax extension-name)))) + (/////analysis.throw ///.invalid-syntax [extension-name args])))) (def: invoke::constructor Handler @@ -1261,7 +1261,7 @@ (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (decorate-inputs argsT argsA))))) _ - (/////analysis.throw ///.invalid-syntax extension-name)))) + (/////analysis.throw ///.invalid-syntax [extension-name args])))) (def: bundle::member Bundle diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index f5c52bfc4..030bc5a2b 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -6,6 +6,7 @@ [io (#+ IO)] ["p" parser]] [data + ["." maybe] ["." error] [text format] @@ -145,15 +146,13 @@ (wrap ////statement.no-requirements)) _ - (///.throw //.invalid-syntax [extension-name])))) + (///.throw //.invalid-syntax [extension-name inputsC+])))) (def: imports (Syntax (List Import)) (|> (s.tuple (p.and s.text s.text)) p.some - s.tuple - (p.after (s.this (' #.imports))) - s.record)) + s.tuple)) (def: def::module Handler @@ -162,13 +161,16 @@ (^ (list annotationsC)) (do ///.monad [[_ annotationsT annotationsV] (evaluate! Code annotationsC) - imports (case (s.run (list (:coerce Code annotationsV)) + #let [annotationsV (:coerce Code annotationsV)] + imports (case (s.run (list (|> annotationsV + (macro.get-ann (name-of #.imports)) + (maybe.default (' [])))) ..imports) (#error.Success imports) (wrap imports) (#error.Failure error) - (///.throw //.invalid-syntax [extension-name])) + (///.throw //.invalid-syntax [extension-name (list annotationsV)])) _ (////statement.lift-analysis (do @ [_ (monad.map @ (function (_ [module alias]) @@ -178,12 +180,12 @@ "" (wrap []) _ (module.alias alias module)))) imports)] - (module.set-annotations (:coerce Code annotationsV))))] + (module.set-annotations annotationsV)))] (wrap {#////statement.imports imports #////statement.referrals (list)})) _ - (///.throw //.invalid-syntax [extension-name])))) + (///.throw //.invalid-syntax [extension-name inputsC+])))) ## TODO: Reify aliasing as a feature of the compiler, instead of ## manifesting it implicitly through definition annotations. @@ -213,7 +215,7 @@ (wrap ////statement.no-requirements)) _ - (///.throw //.invalid-syntax [extension-name])))) + (///.throw //.invalid-syntax [extension-name inputsC+])))) (template [<mame> <type> <scope>] [(def: <mame> @@ -238,7 +240,7 @@ (wrap ////statement.no-requirements)) _ - (///.throw //.invalid-syntax [extension-name]))))] + (///.throw //.invalid-syntax [extension-name inputsC+]))))] [def::analysis ////analysis.Handler ////statement.lift-analysis] [def::synthesis ////synthesis.Handler ////statement.lift-synthesis] @@ -291,7 +293,7 @@ (wrap ////statement.no-requirements)) _ - (///.throw //.invalid-syntax [extension-name])))) + (///.throw //.invalid-syntax [extension-name inputsC+])))) (def: (bundle::def program) (All [anchor expression statement] diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux index 8d345dae2..252344cb6 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux @@ -100,19 +100,19 @@ (<| (_.context (%name (name-of /.apply))) ($_ _.and (_.test "Can analyse monomorphic type application." - (|> (/.apply _primitive.phase funcT dummy-function inputsC) + (|> (/.apply _primitive.phase funcT dummy-function (' []) inputsC) (check-apply outputT full-args))) (_.test "Can partially apply functions." - (|> (/.apply _primitive.phase funcT dummy-function (list.take partial-args inputsC)) + (|> (/.apply _primitive.phase funcT dummy-function (' []) (list.take partial-args inputsC)) (check-apply partialT partial-args))) (_.test "Can apply polymorphic functions." - (|> (/.apply _primitive.phase polyT dummy-function inputsC) + (|> (/.apply _primitive.phase polyT dummy-function (' []) inputsC) (check-apply poly-inputT full-args))) (_.test "Polymorphic partial application propagates found type-vars." - (|> (/.apply _primitive.phase polyT dummy-function (list.take (inc var-idx) inputsC)) + (|> (/.apply _primitive.phase polyT dummy-function (' []) (list.take (inc var-idx) inputsC)) (check-apply partial-polyT1 (inc var-idx)))) (_.test "Polymorphic partial application preserves quantification for type-vars." - (|> (/.apply _primitive.phase polyT dummy-function (list.take var-idx inputsC)) + (|> (/.apply _primitive.phase polyT dummy-function (' []) (list.take var-idx inputsC)) (check-apply partial-polyT2 var-idx))) )))) |