diff options
Diffstat (limited to 'stdlib/source/lux.lux')
| -rw-r--r-- | stdlib/source/lux.lux | 230 |
1 files changed, 112 insertions, 118 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index f96062238..e53709ce2 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -153,8 +153,8 @@ [dummy-cursor (+5 "Your standard, run-of-the-mill string values.")]] #Nil))))]) -("lux def" Ident - (+10 ["lux" "Ident"] +("lux def" Name + (+10 ["lux" "Name"] (+2 Text Text)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -201,7 +201,7 @@ ## (#UnivQ (List Type) Type) ## (#ExQ (List Type) Type) ## (#Apply Type Type) -## (#Named Ident Type) +## (#Named Name Type) ## ) ("lux def" Type (+10 ["lux" "Type"] @@ -231,7 +231,7 @@ (+1 ## "lux.Apply" Type-Pair ## "lux.Named" - (+2 Ident Type)))))))))))))} + (+2 Name Type)))))))))))))} ("lux check type" (+2 Type Type)))} ("lux check type" (+9 Type List)))} ("lux check type" (+9 (+4 +1) (+4 +0))))) @@ -311,8 +311,8 @@ ## (#Rev Rev) ## (#Frac Frac) ## (#Text Text) -## (#Symbol Ident) -## (#Tag Ident) +## (#Symbol Name) +## (#Tag Name) ## (#Form (List (w (Code' w)))) ## (#Tuple (List (w (Code' w)))) ## (#Record (List [(w (Code' w)) (w (Code' w))]))) @@ -334,9 +334,9 @@ (#Sum ## "lux.Text" Text (#Sum ## "lux.Symbol" - Ident + Name (#Sum ## "lux.Tag" - Ident + Name (#Sum ## "lux.Form" Code-List (#Sum ## "lux.Tuple" @@ -426,18 +426,18 @@ [dummy-cursor (#Record #Nil)]) ("lux def" symbol$ - ("lux check" (#Function Ident Code) - ([_ ident] (_ann (#Symbol ident)))) + ("lux check" (#Function Name Code) + ([_ name] (_ann (#Symbol name)))) [dummy-cursor (#Record #Nil)]) ("lux def" local-symbol$ ("lux check" (#Function Text Code) - ([_ ident] (_ann (#Symbol ["" ident])))) + ([_ name] (_ann (#Symbol ["" name])))) [dummy-cursor (#Record #Nil)]) ("lux def" tag$ - ("lux check" (#Function Ident Code) - ([_ ident] (_ann (#Tag ident)))) + ("lux check" (#Function Name Code) + ([_ name] (_ann (#Tag name)))) [dummy-cursor (#Record #Nil)]) ("lux def" form$ @@ -584,8 +584,8 @@ ## #module-aliases (List [Text Text]) ## #definitions (List [Text Definition]) ## #imports (List Text) -## #tags (List [Text [Nat (List Ident) Bit Type]]) -## #types (List [Text [(List Ident) Bit Type]]) +## #tags (List [Text [Nat (List Name) Bit Type]]) +## #types (List [Text [(List Name) Bit Type]]) ## #module-annotations (Maybe Code) ## #module-state Module-State}) ("lux def" Module @@ -601,13 +601,13 @@ (#Product ## "lux.tags" (#Apply (#Product Text (#Product Nat - (#Product (#Apply Ident List) + (#Product (#Apply Name List) (#Product Bit Type)))) List) (#Product ## "lux.types" (#Apply (#Product Text - (#Product (#Apply Ident List) + (#Product (#Apply Name List) (#Product Bit Type))) List) @@ -865,7 +865,7 @@ (record$ #Nil)) ("lux def" meta-code - ("lux check" (#Function Ident (#Function Code Code)) + ("lux check" (#Function Name (#Function Code Code)) ([_ tag] ([_ value] (tuple$ (#Cons cursor-code @@ -1770,17 +1770,17 @@ (-> Text Text Text) ("lux text concat" x y)) -(def:''' (ident/encode ident) +(def:''' (name/encode full-name) #Nil - (-> Ident Text) - (let' [[module name] ident] + (-> Name Text) + (let' [[module name] full-name] ({"" name _ ($_ text/compose module "." name)} module))) (def:''' (get-meta tag def-meta) #Nil - (-> Ident Code ($' Maybe Code)) + (-> Name Code ($' Maybe Code)) (let' [[prefix name] tag] ({[_ (#Record def-meta)] ({(#Cons [key value] def-meta') @@ -1805,10 +1805,10 @@ #None} def-meta))) -(def:''' (resolve-global-symbol ident state) +(def:''' (resolve-global-symbol full-name state) #Nil - (-> Ident ($' Meta Ident)) - (let' [[module name] ident + (-> Name ($' Meta Name)) + (let' [[module name] full-name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host #seed seed #expected expected #cursor cursor #extensions extensions @@ -1819,15 +1819,15 @@ (#Right [state real-name]) _ - (#Right [state ident])} + (#Right [state full-name])} (get-meta ["lux" "alias"] def-meta)) #None - (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))} + (#Left ($_ text/compose "Unknown definition: " (name/encode full-name)))} (get name definitions)) #None - (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))} + (#Left ($_ text/compose "Unknown module: " module " @ " (name/encode full-name)))} (get module modules)))) (def:''' (splice replace? untemplate elems) @@ -2105,9 +2105,9 @@ (-> (-> b c) (-> a b) (-> a c))) (function' [x] (f (g x)))) -(def:''' (get-ident x) +(def:''' (get-name x) #Nil - (-> Code ($' Maybe Ident)) + (-> Code ($' Maybe Name)) ({[_ (#Symbol sname)] (#Some sname) @@ -2117,7 +2117,7 @@ (def:''' (get-tag x) #Nil - (-> Code ($' Maybe Ident)) + (-> Code ($' Maybe Name)) ({[_ (#Tag sname)] (#Some sname) @@ -2125,7 +2125,7 @@ #None} x)) -(def:''' (get-name x) +(def:''' (get-short x) #Nil (-> Code ($' Maybe Text)) ({[_ (#Symbol "" sname)] @@ -2273,7 +2273,7 @@ _ (fail "Wrong syntax for do-template")} - [(monad/map Monad<Maybe> get-name bindings) + [(monad/map Monad<Maybe> get-short bindings) (monad/map Monad<Maybe> tuple->list data)]) _ @@ -2642,24 +2642,24 @@ (get-meta ["lux" "macro?"] def-meta))) )) -(def:''' (normalize ident) +(def:''' (normalize name) #Nil - (-> Ident ($' Meta Ident)) + (-> Name ($' Meta Name)) ({["" name] (do Monad<Meta> [module-name current-module-name] (wrap [module-name name])) _ - (return ident)} - ident)) + (return name)} + name)) -(def:''' (find-macro ident) +(def:''' (find-macro full-name) #Nil - (-> Ident ($' Meta ($' Maybe Macro))) + (-> Name ($' Meta ($' Maybe Macro))) (do Monad<Meta> [current-module current-module-name] - (let' [[module name] ident] + (let' [[module name] full-name] (function' [state] ({{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host @@ -2669,12 +2669,12 @@ (#Right state (find-macro' modules current-module module name))} state))))) -(def:''' (macro? ident) +(def:''' (macro? name) #Nil - (-> Ident ($' Meta Bit)) + (-> Name ($' Meta Bit)) (do Monad<Meta> - [ident (normalize ident) - output (find-macro ident)] + [name (normalize name) + output (find-macro name)] (wrap ({(#Some _) #1 #None #0} output)))) @@ -3431,7 +3431,7 @@ (list [(tag$ ["lux" "doc"]) (text$ "Macro-definition macro. - (macro: #export (ident-for tokens) + (macro: #export (name-for tokens) (case tokens (^template [<tag>] (^ (list [_ (<tag> [prefix name])])) @@ -3439,9 +3439,9 @@ ([#Symbol] [#Tag]) _ - (fail \"Wrong syntax for ident-for\")))")]) + (fail \"Wrong syntax for name-for\")))")]) (let [[exported? tokens] (export^ tokens) - name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) + name+args+meta+body?? (: (Maybe [Name (List Code) Code Code]) (case tokens (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] body)) (#Some [name args (` {}) body]) @@ -3489,7 +3489,7 @@ (: (-> a a Bit) >=))"} (let [[exported? tokens'] (export^ tokens) - ?parts (: (Maybe [Ident (List Code) Code (List Code)]) + ?parts (: (Maybe [Name (List Code) Code (List Code)]) (case tokens' (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) (#Some name args [meta-rec-cursor (#Record meta-rec-parts)] sigs) @@ -3791,7 +3791,7 @@ (find-module module-name))) (def: (resolve-tag [module name]) - (-> Ident (Meta [Nat (List Ident) Bit Type])) + (-> Name (Meta [Nat (List Name) Bit Type])) (do Monad<Meta> [=module (find-module module) #let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]] @@ -3800,10 +3800,10 @@ (return output) _ - (fail (text/compose "Unknown tag: " (ident/encode [module name])))))) + (fail (text/compose "Unknown tag: " (name/encode [module name])))))) (def: (resolve-type-tags type) - (-> Type (Meta (Maybe [(List Ident) (List Type)]))) + (-> Type (Meta (Maybe [(List Name) (List Type)]))) (case type (#Apply arg func) (resolve-type-tags func) @@ -3853,7 +3853,7 @@ [tokens' (monad/map Monad<Meta> macro-expand tokens) struct-type get-expected-type tags+type (resolve-type-tags struct-type) - tags (: (Meta (List Ident)) + tags (: (Meta (List Name)) (case tags+type (#Some [tags _]) (return tags) @@ -4339,7 +4339,7 @@ scopes))) (def: (find-def-type name state) - (-> Ident Lux (Maybe Type)) + (-> Name Lux (Maybe Type)) (let [[v-prefix v-name] name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host @@ -4358,7 +4358,7 @@ (#Some def-type))))) (def: (find-def-value name state) - (-> Ident (Meta [Type Any])) + (-> Name (Meta [Type Any])) (let [[v-prefix v-name] name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host @@ -4366,12 +4366,12 @@ #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None - (#Left (text/compose "Unknown definition: " (ident/encode name))) + (#Left (text/compose "Unknown definition: " (name/encode name))) (#Some {#definitions definitions #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) (case (get v-name definitions) #None - (#Left (text/compose "Unknown definition: " (ident/encode name))) + (#Left (text/compose "Unknown definition: " (name/encode name))) (#Some [def-type def-meta def-value]) (#Right [state [def-type def-value]]))))) @@ -4387,10 +4387,10 @@ bound (find-type-var idx bindings')))) -(def: (find-type ident) - (-> Ident (Meta Type)) +(def: (find-type full-name) + (-> Name (Meta Type)) (do Monad<Meta> - [#let [[module name] ident] + [#let [[module name] full-name] current-module current-module-name] (function (_ compiler) (let [temp (if (text/= "" module) @@ -4404,13 +4404,13 @@ (#Right [compiler struct-type]) _ - (#Left ($_ text/compose "Unknown var: " (ident/encode ident))))) - (case (find-def-type ident compiler) + (#Left ($_ text/compose "Unknown var: " (name/encode full-name))))) + (case (find-def-type full-name compiler) (#Some struct-type) (#Right [compiler struct-type]) _ - (#Left ($_ text/compose "Unknown var: " (ident/encode ident)))))] + (#Left ($_ text/compose "Unknown var: " (name/encode full-name)))))] (case temp (#Right [compiler (#Var type-id)]) (let [{#info _ #source _ #current-module _ #modules _ @@ -4511,7 +4511,7 @@ (#Some tags&members) (do Monad<Meta> - [full-body ((: (-> Ident [(List Ident) (List Type)] Code (Meta Code)) + [full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) (function (recur source [tags members] target) (let [pattern (record$ (list/map (function (_ [t-module t-name]) [(tag$ [t-module t-name]) @@ -4593,7 +4593,7 @@ g!output (gensym "")] (case (resolve-struct-type type) (#Some members) - (let [pattern (record$ (list/map (: (-> [Ident [Nat Type]] [Code Code]) + (let [pattern (record$ (list/map (: (-> [Name [Nat Type]] [Code Code]) (function (_ [[r-prefix r-name] [r-idx r-type]]) [(tag$ [r-prefix r-name]) (if (n/= idx r-idx) @@ -4622,7 +4622,7 @@ (fail "Wrong syntax for get@"))) (def: (open-field alias [module name] source type) - (-> Text Ident Code Type (Meta (List Code))) + (-> Text Name Code Type (Meta (List Code))) (do Monad<Meta> [output (resolve-type-tags type) #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]] @@ -4630,7 +4630,7 @@ (#Some [tags members]) (do Monad<Meta> [decls' (monad/map Monad<Meta> - (: (-> [Ident Type] (Meta (List Code))) + (: (-> [Name Type] (Meta (List Code))) (function (_ [sname stype]) (open-field alias sname source+ stype))) (zip2 tags members))] (return (list/join decls'))) @@ -4660,7 +4660,7 @@ (case output (#Some [tags members]) (do Monad<Meta> - [decls' (monad/map Monad<Meta> (: (-> [Ident Type] (Meta (List Code))) + [decls' (monad/map Monad<Meta> (: (-> [Name Type] (Meta (List Code))) (function (_ [sname stype]) (open-field alias sname source stype))) (zip2 tags members))] @@ -4829,26 +4829,20 @@ ## Examples (.module: {#.doc \"Some documentation...\"} - lux - (lux (control (monad #as M #refer #all)) - (data (text #open (\"text/\" Monoid<Text>)) - (collection (list #open (\"list/\" Monad<List>))) - maybe - (ident #open (\"ident/\" Codec<Text,Ident>))) - meta - (macro code)) - (// (type #open (\"\" Equivalence<Type>)))) - - (.module: {#.doc \"Some documentation...\"} - lux - (lux (control [\"M\" monad #*]) - (data [text \"text/\" Monoid<Text>] - (collection [list \"list/\" Monad<List>]) - maybe - [ident \"ident/\" Codec<Text,Ident>]) - meta - (macro code)) - (// [type \"\" Equivalence<Type>]))"} + [lux #* + [control + [\"M\" monad #*]] + [data + maybe + [\".\" name (\"name/.\" Codec<Text,Name>)] + [\".\" text (\"text/.\" Monoid<Text>)] + [collection + [list (\"list/.\" Monad<List>)]]] + meta + [macro + code]] + [// + [type (\".\" Equivalence<Type>)]])"} (do Monad<Meta> [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens @@ -4913,18 +4907,18 @@ (#Some members) (do Monad<Meta> [pattern' (monad/map Monad<Meta> - (: (-> [Ident [Nat Type]] (Meta [Ident Nat Code])) + (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r-slot-name [r-idx r-type]]) (do Monad<Meta> [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + (let [pattern (record$ (list/map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + output (record$ (list/map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) (if (n/= idx r-idx) @@ -5003,18 +4997,18 @@ (#Some members) (do Monad<Meta> [pattern' (monad/map Monad<Meta> - (: (-> [Ident [Nat Type]] (Meta [Ident Nat Code])) + (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r-slot-name [r-idx r-type]]) (do Monad<Meta> [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + (let [pattern (record$ (list/map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + output (record$ (list/map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) (if (n/= idx r-idx) @@ -5097,7 +5091,7 @@ branches)) (case (: (Maybe (List Code)) (do Monad<Maybe> - [bindings' (monad/map Monad<Maybe> get-name bindings) + [bindings' (monad/map Monad<Maybe> get-short bindings) data' (monad/map Monad<Maybe> tuple->list data)] (if (every? (n/= (list/size bindings')) (list/map list/size data')) (let [apply (: (-> RepEnv (List Code)) @@ -5189,8 +5183,8 @@ ) (def: tag/encode - (-> Ident Text) - (|>> ident/encode (text/compose "#"))) + (-> Name Text) + (|>> name/encode (text/compose "#"))) (do-template [<name> <to>] [(def: #export <name> @@ -5247,7 +5241,7 @@ [#Int int/encode] [#Frac frac/encode] [#Text text/encode] - [#Symbol ident/encode] + [#Symbol name/encode] [#Tag tag/encode]) (^template [<tag> <open> <close> <prep>] @@ -5389,8 +5383,8 @@ inits (list/map second pairs)] (if (every? symbol? inits) (do Monad<Meta> - [inits' (: (Meta (List Ident)) - (case (monad/map Monad<Maybe> get-ident inits) + [inits' (: (Meta (List Name)) + (case (monad/map Monad<Maybe> get-name inits) (#Some inits') (return inits') #None (fail "Wrong syntax for loop"))) init-types (monad/map Monad<Meta> find-type inits') @@ -5420,8 +5414,8 @@ (case tokens (^ (list& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches)) (do Monad<Meta> - [slots (: (Meta [Ident (List Ident)]) - (case (: (Maybe [Ident (List Ident)]) + [slots (: (Meta [Name (List Name)]) + (case (: (Maybe [Name (List Name)]) (do Monad<Maybe> [hslot (get-tag hslot') tslots (monad/map Monad<Maybe> get-tag tslots')] @@ -5437,10 +5431,10 @@ output (resolve-tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output - slot-pairings (list/map (: (-> Ident [Text Code]) + slot-pairings (list/map (: (-> Name [Text Code]) (function (_ [module name]) [name (symbol$ ["" name])])) (list& hslot tslots)) - pattern (record$ (list/map (: (-> Ident [Code Code]) + pattern (record$ (list/map (: (-> Name [Code Code]) (function (_ [module name]) (let [tag (tag$ [module name])] (case (get name slot-pairings) @@ -5559,7 +5553,7 @@ type)) (def: (anti-quote-def name) - (-> Ident (Meta Code)) + (-> Name (Meta Code)) (do Monad<Meta> [type+value (find-def-value name) #let [[type value] type+value]] @@ -5575,7 +5569,7 @@ ["Text" Text text$]) _ - (fail (text/compose "Cannot anti-quote type: " (ident/encode name)))))) + (fail (text/compose "Cannot anti-quote type: " (name/encode name)))))) (def: (anti-quote token) (-> Code (Meta Code)) @@ -5698,9 +5692,9 @@ _ (fail "Wrong syntax for ^multi"))) -(macro: #export (ident-for tokens) +(macro: #export (name-for tokens) {#.doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." - (ident-for #.doc) + (name-for #.doc) "=>" ["lux" "doc"])} (case tokens @@ -5710,7 +5704,7 @@ ([#Symbol] [#Tag]) _ - (fail "Wrong syntax for ident-for"))) + (fail "Wrong syntax for name-for"))) (do-template [<type> <even> <odd> <%> <=> <0> <2>] [(def: #export (<even> n) @@ -6069,8 +6063,8 @@ (fail "Wrong syntax for ``") )) -(def: (ident$ [module name]) - (-> Ident Code) +(def: (name$ [module name]) + (-> Name Code) (` [(~ (text$ module)) (~ (text$ name))])) (def: (untemplate-list& last inits) @@ -6090,14 +6084,14 @@ (do Monad<Meta> [g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))])))) - ([#Bit "Bit" bit$] - [#Nat "Nat" nat$] - [#Int "Int" int$] - [#Rev "Rev" rev$] - [#Frac "Frac" frac$] - [#Text "Text" text$] - [#Tag "Tag" ident$] - [#Symbol "Symbol" ident$]) + ([#Bit "Bit" bit$] + [#Nat "Nat" nat$] + [#Int "Int" int$] + [#Rev "Rev" rev$] + [#Frac "Frac" frac$] + [#Text "Text" text$] + [#Tag "Tag" name$] + [#Symbol "Symbol" name$]) [_ (#Record fields)] (do Monad<Meta> |