diff options
author | Eduardo Julian | 2017-11-29 22:49:56 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-29 22:49:56 -0400 |
commit | 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 (patch) | |
tree | 0c166db6e01b41dfadd01801b5242967f2363b7d /new-luxc/source/luxc/lang.lux | |
parent | 77c113a3455cdbc4bb485a94f67f392480cdcfbf (diff) |
- Adapted main codebase to the latest syntatic changes.
Diffstat (limited to 'new-luxc/source/luxc/lang.lux')
-rw-r--r-- | new-luxc/source/luxc/lang.lux | 172 |
1 files changed, 86 insertions, 86 deletions
diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux index b85409fb9..5a00794f8 100644 --- a/new-luxc/source/luxc/lang.lux +++ b/new-luxc/source/luxc/lang.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["ex" exception #+ exception:]) @@ -17,59 +17,59 @@ (-> Type Code (Meta Top))) (type: #export Analyser - (-> Code (Meta la;Analysis))) + (-> 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 + (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" + (macro.fail (format message "\n\n" "@ " location)))) (def: #export (throw exception message) - (All [a] (-> ex;Exception Text (Meta a))) + (All [a] (-> ex.Exception Text (Meta a))) (fail (exception message))) (syntax: #export (assert exception message test) (wrap (list (` (if (~ test) - (:: macro;Monad<Meta> (~' wrap) []) - (;;throw (~ exception) (~ message))))))) + (:: 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') + (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)))) + (#e.Error error) + (#e.Error error)))) (def: #export (with-type-env action) - (All [a] (-> (tc;Check a) (Meta a))) + (All [a] (-> (tc.Check a) (Meta a))) (function [compiler] - (case (action (get@ #;type-context compiler)) - (#e;Error error) + (case (action (get@ #.type-context compiler)) + (#e.Error error) ((fail error) compiler) - (#e;Success [context' output]) - (#e;Success [(set@ #;type-context context' 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') + (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 @@ -77,133 +77,133 @@ (def: #export (infer actualT) (-> Type (Meta Unit)) - (do macro;Monad<Meta> - [expectedT macro;expected-type] + (do macro.Monad<Meta> + [expectedT macro.expected-type] (with-type-env - (tc;check expectedT actualT)))) + (tc.check expectedT actualT)))) (def: #export (pl-get key table) (All [a] (-> Text (List [Text a]) (Maybe a))) (case table - #;Nil - #;None + #.Nil + #.None - (#;Cons [k' v'] table') + (#.Cons [k' v'] table') (if (text/= key k') - (#;Some v') + (#.Some v') (pl-get key table')))) (def: #export (pl-contains? key table) (All [a] (-> Text (List [Text a]) Bool)) (case (pl-get key table) - (#;Some _) + (#.Some _) true - #;None + #.None false)) (def: #export (pl-put key val table) (All [a] (-> Text a (List [Text a]) (List [Text a]))) (case table - #;Nil + #.Nil (list [key val]) - (#;Cons [k' v'] table') + (#.Cons [k' v'] table') (if (text/= key k') - (#;Cons [key val] + (#.Cons [key val] table') - (#;Cons [k' v'] + (#.Cons [k' v'] (pl-put key val table'))))) (def: #export (pl-update key f table) (All [a] (-> Text (-> a a) (List [Text a]) (List [Text a]))) (case table - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [k' v'] table') + (#.Cons [k' v'] table') (if (text/= key k') - (#;Cons [k' (f v')] table') - (#;Cons [k' v'] (pl-update key f table'))))) + (#.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) + (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') + (#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.Success [compiler' output]) + (#e.Success [compiler' output]) - (#e;Error error) - (#e;Error (if (text/= "" error) + (#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)}) + {#.counter +0 + #.mappings (list)}) (def: fresh-scope Scope - {#;name (list) - #;inner +0 - #;locals fresh-bindings - #;captured fresh-bindings}) + {#.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') + (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)))) + (#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) + (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)))) + (#e.Error error) + (#e.Error error)))) (def: #export (with-cursor cursor action) (All [a] (-> Cursor (Meta a) (Meta a))) - (if (text/= "" (product;left cursor)) + (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') + (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)))))) + (#e.Error error) + (#e.Error error)))))) (def: (normalize-char char) (-> Nat Text) @@ -232,17 +232,17 @@ (^ (char "~")) "_TILDE_" (^ (char "|")) "_PIPE_" _ - (text;from-code char))) + (text.from-code char))) -(def: underflow Nat (n.dec +0)) +(def: underflow Nat (n/dec +0)) (def: #export (normalize-name name) (-> Text Text) - (loop [idx (n.dec (text;size name)) + (loop [idx (n/dec (text.size name)) output ""] - (if (n.= underflow idx) + (if (n/= underflow idx) output - (recur (n.dec idx) (format (|> (text;nth idx name) maybe;assume normalize-char) output))))) + (recur (n/dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output))))) (exception: #export Error) @@ -250,7 +250,7 @@ (All [a] (-> (Meta a) (Meta a))) (function [compiler] (case (action compiler) - (#e;Error error) + (#e.Error error) ((throw Error error) compiler) output |