diff options
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/lang.lux | 145 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/common.lux | 9 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/primitive.lux | 30 |
3 files changed, 0 insertions, 184 deletions
diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux index bba58f421..1060eeb8e 100644 --- a/new-luxc/source/luxc/lang.lux +++ b/new-luxc/source/luxc/lang.lux @@ -16,72 +16,6 @@ (type: #export Eval (-> Type Code (Meta Top))) -(type: #export Analyser - (-> Code (Meta la.Analysis))) - -(def: #export version Text "0.6.0") - -(def: #export (fail message) - (All [a] (-> Text (Meta a))) - (do macro.Monad<Meta> - [[file line col] macro.cursor - #let [location (format file - "," (|> line nat-to-int %i) - "," (|> col nat-to-int %i))]] - (macro.fail (format message "\n\n" - "@ " location)))) - -(def: #export (throw exception message) - (All [e a] (-> (ex.Exception e) e (Meta a))) - (fail (ex.construct exception message))) - -(syntax: #export (assert exception message test) - (wrap (list (` (if (~ test) - (:: macro.Monad<Meta> (~' wrap) []) - (..throw (~ exception) (~ message))))))) - -(def: #export (with-type expected action) - (All [a] (-> Type (Meta a) (Meta a))) - (function (_ compiler) - (case (action (set@ #.expected (#.Some expected) compiler)) - (#e.Success [compiler' output]) - (let [old-expected (get@ #.expected compiler)] - (#e.Success [(set@ #.expected old-expected compiler') - output])) - - (#e.Error error) - (#e.Error error)))) - -(def: #export (with-type-env action) - (All [a] (-> (tc.Check a) (Meta a))) - (function (_ compiler) - (case (action (get@ #.type-context compiler)) - (#e.Error error) - ((fail error) compiler) - - (#e.Success [context' output]) - (#e.Success [(set@ #.type-context context' compiler) - output])))) - -(def: #export (with-fresh-type-env action) - (All [a] (-> (Meta a) (Meta a))) - (function (_ compiler) - (let [old (get@ #.type-context compiler)] - (case (action (set@ #.type-context tc.fresh-context compiler)) - (#e.Success [compiler' output]) - (#e.Success [(set@ #.type-context old compiler') - output]) - - output - output)))) - -(def: #export (infer actualT) - (-> Type (Meta Top)) - (do macro.Monad<Meta> - [expectedT macro.expected-type] - (with-type-env - (tc.check expectedT actualT)))) - (def: #export (pl-get key table) (All [a] (-> Text (List [Text a]) (Maybe a))) (case table @@ -126,85 +60,6 @@ (#.Cons [k' (f v')] table') (#.Cons [k' v'] (pl-update key f table'))))) -(def: #export (with-source-code source action) - (All [a] (-> Source (Meta a) (Meta a))) - (function (_ compiler) - (let [old-source (get@ #.source compiler)] - (case (action (set@ #.source source compiler)) - (#e.Error error) - (#e.Error error) - - (#e.Success [compiler' output]) - (#e.Success [(set@ #.source old-source compiler') - output]))))) - -(def: #export (with-stacked-errors handler action) - (All [a] (-> (-> [] Text) (Meta a) (Meta a))) - (function (_ compiler) - (case (action compiler) - (#e.Success [compiler' output]) - (#e.Success [compiler' output]) - - (#e.Error error) - (#e.Error (if (text/= "" error) - (handler []) - (format (handler []) "\n\n-----------------------------------------\n\n" error)))))) - -(def: fresh-bindings - (All [k v] (Bindings k v)) - {#.counter +0 - #.mappings (list)}) - -(def: fresh-scope - Scope - {#.name (list) - #.inner +0 - #.locals fresh-bindings - #.captured fresh-bindings}) - -(def: #export (with-scope action) - (All [a] (-> (Meta a) (Meta [Scope a]))) - (function (_ compiler) - (case (action (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler)) - (#e.Success [compiler' output]) - (case (get@ #.scopes compiler') - #.Nil - (#e.Error "Impossible error: Drained scopes!") - - (#.Cons head tail) - (#e.Success [(set@ #.scopes tail compiler') - [head output]])) - - (#e.Error error) - (#e.Error error)))) - -(def: #export (with-current-module name action) - (All [a] (-> Text (Meta a) (Meta a))) - (function (_ compiler) - (case (action (set@ #.current-module (#.Some name) compiler)) - (#e.Success [compiler' output]) - (#e.Success [(set@ #.current-module - (get@ #.current-module compiler) - compiler') - output]) - - (#e.Error error) - (#e.Error error)))) - -(def: #export (with-cursor cursor action) - (All [a] (-> Cursor (Meta a) (Meta a))) - (if (text/= "" (product.left cursor)) - action - (function (_ compiler) - (let [old-cursor (get@ #.cursor compiler)] - (case (action (set@ #.cursor cursor compiler)) - (#e.Success [compiler' output]) - (#e.Success [(set@ #.cursor old-cursor compiler') - output]) - - (#e.Error error) - (#e.Error error)))))) - (def: (normalize-char char) (-> Nat Text) (case char diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux index c4ff4bfde..072616cfa 100644 --- a/new-luxc/source/luxc/lang/analysis/common.lux +++ b/new-luxc/source/luxc/lang/analysis/common.lux @@ -10,15 +10,6 @@ (luxc ["&" lang] (lang analysis))) -(def: #export (with-unknown-type action) - (All [a] (-> (Meta a) (Meta [Type a]))) - (do macro.Monad<Meta> - [[_ varT] (&.with-type-env tc.var) - analysis (&.with-type varT - action) - knownT (&.with-type-env (tc.clean varT))] - (wrap [knownT analysis]))) - (exception: #export (Variant-Tag-Out-Of-Bounds {message Text}) message) diff --git a/new-luxc/source/luxc/lang/analysis/primitive.lux b/new-luxc/source/luxc/lang/analysis/primitive.lux deleted file mode 100644 index ff7908669..000000000 --- a/new-luxc/source/luxc/lang/analysis/primitive.lux +++ /dev/null @@ -1,30 +0,0 @@ -(.module: - lux - (lux (control monad) - [macro] - (macro [code]) - (lang (type ["tc" check]))) - (luxc ["&" lang] - (lang ["la" analysis #+ Analysis]))) - -## [Analysers] -(do-template [<name> <type> <tag>] - [(def: #export (<name> value) - (-> <type> (Meta Analysis)) - (do macro.Monad<Meta> - [_ (&.infer <type>)] - (wrap (<tag> value))))] - - [analyse-bool Bool code.bool] - [analyse-nat Nat code.nat] - [analyse-int Int code.int] - [analyse-deg Deg code.deg] - [analyse-frac Frac code.frac] - [analyse-text Text code.text] - ) - -(def: #export analyse-unit - (Meta Analysis) - (do macro.Monad<Meta> - [_ (&.infer Top)] - (wrap (` [])))) |