aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/base.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/base.lux53
1 files changed, 46 insertions, 7 deletions
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index 4c6202db1..28b5437e9 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -2,10 +2,12 @@
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
- (data [text "text/" Eq<Text>]
- text/format
+ (data [maybe]
[product]
- ["e" error])
+ ["e" error]
+ [text "text/" Eq<Text>]
+ text/format
+ (coll [list]))
[meta]
(meta (type ["tc" check])))
(luxc (lang ["la" analysis])))
@@ -16,8 +18,6 @@
(type: #export Analyser
(-> Code (Meta la;Analysis)))
-(type: #export Path Text)
-
(def: #export version Text "0.6.0")
(def: #export (fail message)
@@ -115,7 +115,7 @@
(#;Cons [k' v'] (pl-update key f table')))))
(def: #export (with-source-code source action)
- (All [a] (-> [Cursor Text] (Meta a) (Meta a)))
+ (All [a] (-> Source (Meta a) (Meta a)))
(function [compiler]
(let [old-source (get@ #;source compiler)]
(case (action (set@ #;source source compiler))
@@ -145,7 +145,7 @@
(def: fresh-scope
Scope
- {#;name (list)
+ {#;name (list "lux")
#;inner +0
#;locals fresh-bindings
#;captured fresh-bindings})
@@ -179,3 +179,42 @@
(#e;Error error)
(#e;Error error))))))
+
+(def: (normalize-char char)
+ (-> Nat Text)
+ (case char
+ (^ (char "*")) "_ASTER_"
+ (^ (char "+")) "_PLUS_"
+ (^ (char "-")) "_DASH_"
+ (^ (char "/")) "_SLASH_"
+ (^ (char "\\")) "_BSLASH_"
+ (^ (char "_")) "_UNDERS_"
+ (^ (char "%")) "_PERCENT_"
+ (^ (char "$")) "_DOLLAR_"
+ (^ (char "'")) "_QUOTE_"
+ (^ (char "`")) "_BQUOTE_"
+ (^ (char "@")) "_AT_"
+ (^ (char "^")) "_CARET_"
+ (^ (char "&")) "_AMPERS_"
+ (^ (char "=")) "_EQ_"
+ (^ (char "!")) "_BANG_"
+ (^ (char "?")) "_QM_"
+ (^ (char ":")) "_COLON_"
+ (^ (char ".")) "_PERIOD_"
+ (^ (char ",")) "_COMMA_"
+ (^ (char "<")) "_LT_"
+ (^ (char ">")) "_GT_"
+ (^ (char "~")) "_TILDE_"
+ (^ (char "|")) "_PIPE_"
+ _
+ (text;from-code char)))
+
+(def: underflow Nat (n.dec +0))
+
+(def: #export (normalize-name name)
+ (-> Text Text)
+ (loop [idx (n.dec (text;size name))
+ output ""]
+ (if (n.= underflow idx)
+ output
+ (recur (n.dec idx) (format (|> (text;nth idx name) maybe;assume normalize-char) output)))))