diff options
Diffstat (limited to '')
76 files changed, 1056 insertions, 912 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index d4e8efda6..bd65c86da 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -21,7 +21,7 @@ ## (type: Any ## (Ex [a] a)) ("lux def" Any - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Any"] (8 #0 (0 #0) (4 #0 1)))) [dummy_location @@ -35,7 +35,7 @@ ## (type: Nothing ## (All [a] a)) ("lux def" Nothing - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Nothing"] (7 #0 (0 #0) (4 #0 1)))) [dummy_location @@ -67,7 +67,7 @@ #1) ("lux def" Bit - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Bit"] (0 #0 "#Bit" #Nil))) [dummy_location @@ -77,7 +77,7 @@ #1) ("lux def" I64 - ("lux check type" + ("lux type check type" (9 #1 ["lux" "I64"] (7 #0 (0 #0) (0 #0 "#I64" (#Cons (4 #0 1) #Nil))))) @@ -88,7 +88,7 @@ #1) ("lux def" Nat - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Nat"] (0 #0 "#I64" (#Cons (0 #0 "#Nat" #Nil) #Nil)))) [dummy_location @@ -100,7 +100,7 @@ #1) ("lux def" Int - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Int"] (0 #0 "#I64" (#Cons (0 #0 "#Int" #Nil) #Nil)))) [dummy_location @@ -110,7 +110,7 @@ #1) ("lux def" Rev - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Rev"] (0 #0 "#I64" (#Cons (0 #0 "#Rev" #Nil) #Nil)))) [dummy_location @@ -122,7 +122,7 @@ #1) ("lux def" Frac - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Frac"] (0 #0 "#Frac" #Nil))) [dummy_location @@ -132,7 +132,7 @@ #1) ("lux def" Text - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Text"] (0 #0 "#Text" #Nil))) [dummy_location @@ -142,7 +142,7 @@ #1) ("lux def" Name - ("lux check type" + ("lux type check type" (9 #1 ["lux" "Name"] (2 #0 Text Text))) [dummy_location @@ -212,9 +212,9 @@ Type_Pair ## "lux.Named" (2 #0 Name Type)))))))))))))} - ("lux check type" (2 #0 Type Type)))} - ("lux check type" (9 #0 Type List)))} - ("lux check type" (9 #0 (4 #0 1) (4 #0 0))))) + ("lux type check type" (2 #0 Type Type)))} + ("lux type check type" (9 #0 Type List)))} + ("lux type check type" (9 #0 (4 #0 1) (4 #0 0))))) [dummy_location (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] [dummy_location (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] @@ -297,10 +297,10 @@ (#Apply (#Product Code Code) List) )))))))))) )} - ("lux check type" (#Apply Code List)))} - ("lux check type" (#Apply (#Apply (#Parameter 1) - (#Parameter 0)) - (#Parameter 1))))) + ("lux type check type" (#Apply Code List)))} + ("lux type check type" (#Apply (#Apply (#Parameter 1) + (#Parameter 0)) + (#Parameter 1))))) [dummy_location (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "type-args"])] [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "w")] #Nil))]] @@ -314,7 +314,7 @@ (#Named ["lux" "Code"] ({w (#Apply (#Apply w Code') w)} - ("lux check type" (#Apply Location Ann)))) + ("lux type check type" (#Apply Location Ann)))) [dummy_location (#Record (#Cons [[dummy_location (#Tag ["lux" "doc"])] [dummy_location (#Text "The type of Code nodes for Lux syntax.")]] @@ -322,88 +322,89 @@ #1) ("lux def" _ann - ("lux check" (#Function (#Apply (#Apply Location Ann) - Code') - Code) + ("lux type check" + (#Function (#Apply (#Apply Location Ann) + Code') + Code) ([_ data] [dummy_location data])) [dummy_location (#Record #Nil)] #0) ("lux def" bit$ - ("lux check" (#Function Bit Code) + ("lux type check" (#Function Bit Code) ([_ value] (_ann (#Bit value)))) [dummy_location (#Record #Nil)] #0) ("lux def" nat$ - ("lux check" (#Function Nat Code) + ("lux type check" (#Function Nat Code) ([_ value] (_ann (#Nat value)))) [dummy_location (#Record #Nil)] #0) ("lux def" int$ - ("lux check" (#Function Int Code) + ("lux type check" (#Function Int Code) ([_ value] (_ann (#Int value)))) [dummy_location (#Record #Nil)] #0) ("lux def" rev$ - ("lux check" (#Function Rev Code) + ("lux type check" (#Function Rev Code) ([_ value] (_ann (#Rev value)))) [dummy_location (#Record #Nil)] #0) ("lux def" frac$ - ("lux check" (#Function Frac Code) + ("lux type check" (#Function Frac Code) ([_ value] (_ann (#Frac value)))) [dummy_location (#Record #Nil)] #0) ("lux def" text$ - ("lux check" (#Function Text Code) + ("lux type check" (#Function Text Code) ([_ text] (_ann (#Text text)))) [dummy_location (#Record #Nil)] #0) ("lux def" identifier$ - ("lux check" (#Function Name Code) + ("lux type check" (#Function Name Code) ([_ name] (_ann (#Identifier name)))) [dummy_location (#Record #Nil)] #0) ("lux def" local_identifier$ - ("lux check" (#Function Text Code) + ("lux type check" (#Function Text Code) ([_ name] (_ann (#Identifier ["" name])))) [dummy_location (#Record #Nil)] #0) ("lux def" tag$ - ("lux check" (#Function Name Code) + ("lux type check" (#Function Name Code) ([_ name] (_ann (#Tag name)))) [dummy_location (#Record #Nil)] #0) ("lux def" local_tag$ - ("lux check" (#Function Text Code) + ("lux type check" (#Function Text Code) ([_ name] (_ann (#Tag ["" name])))) [dummy_location (#Record #Nil)] #0) ("lux def" form$ - ("lux check" (#Function (#Apply Code List) Code) + ("lux type check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Form tokens)))) [dummy_location (#Record #Nil)] #0) ("lux def" tuple$ - ("lux check" (#Function (#Apply Code List) Code) + ("lux type check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Tuple tokens)))) [dummy_location (#Record #Nil)] #0) ("lux def" record$ - ("lux check" (#Function (#Apply (#Product Code Code) List) Code) + ("lux type check" (#Function (#Apply (#Product Code Code) List) Code) ([_ tokens] (_ann (#Record tokens)))) [dummy_location (#Record #Nil)] #0) @@ -411,7 +412,7 @@ ## (type: Definition ## [Bit Type Code Any]) ("lux def" Definition - ("lux check type" + ("lux type check type" (#Named ["lux" "Definition"] (#Product Bit (#Product Type (#Product Code Any))))) (record$ (#Cons [(tag$ ["lux" "doc"]) @@ -422,7 +423,7 @@ ## (type: Alias ## Name) ("lux def" Alias - ("lux check type" + ("lux type check type" (#Named ["lux" "Alias"] Name)) (record$ #Nil) @@ -493,7 +494,7 @@ #1) ("lux def" Code_List - ("lux check type" + ("lux type check type" (#Apply Code List)) (record$ #Nil) #0) @@ -520,7 +521,7 @@ ## (type: Source ## [Location Nat Text]) ("lux def" Source - ("lux check type" + ("lux type check type" (#Named ["lux" "Source"] (#Product Location (#Product Nat Text)))) (record$ #Nil) @@ -693,7 +694,7 @@ ## (type: (Meta a) ## (-> Lux (Either Text [Lux a]))) ("lux def" Meta - ("lux check type" + ("lux type check type" (#Named ["lux" "Meta"] (#UnivQ #Nil (#Function Lux @@ -711,7 +712,7 @@ ## (type: Macro' ## (-> (List Code) (Meta (List Code)))) ("lux def" Macro' - ("lux check type" + ("lux type check type" (#Named ["lux" "Macro'"] (#Function Code_List (#Apply Code_List Meta)))) (record$ #Nil) @@ -720,7 +721,7 @@ ## (type: Macro ## (primitive "#Macro")) ("lux def" Macro - ("lux check type" + ("lux type check type" (#Named ["lux" "Macro"] (#Primitive "#Macro" #Nil))) (record$ (#Cons [(tag$ ["lux" "doc"]) @@ -730,12 +731,13 @@ ## Base functions & macros ("lux def" return - ("lux check" (#UnivQ #Nil - (#Function (#Parameter 1) - (#Function Lux - (#Apply (#Product Lux - (#Parameter 1)) - (#Apply Text Either))))) + ("lux type check" + (#UnivQ #Nil + (#Function (#Parameter 1) + (#Function Lux + (#Apply (#Product Lux + (#Parameter 1)) + (#Apply Text Either))))) ([_ val] ([_ state] (#Right state val)))) @@ -743,12 +745,13 @@ #0) ("lux def" fail - ("lux check" (#UnivQ #Nil - (#Function Text - (#Function Lux - (#Apply (#Product Lux - (#Parameter 1)) - (#Apply Text Either))))) + ("lux type check" + (#UnivQ #Nil + (#Function Text + (#Function Lux + (#Apply (#Product Lux + (#Parameter 1)) + (#Apply Text Either))))) ([_ msg] ([_ state] (#Left msg)))) @@ -806,13 +809,13 @@ #0) ("lux def" location_code - ("lux check" Code + ("lux type check" Code (tuple$ (#Cons (text$ "") (#Cons (nat$ 0) (#Cons (nat$ 0) #Nil))))) (record$ #Nil) #0) ("lux def" meta_code - ("lux check" (#Function Name (#Function Code Code)) + ("lux type check" (#Function Name (#Function Code Code)) ([_ tag] ([_ value] (tuple$ (#Cons location_code @@ -822,7 +825,7 @@ #0) ("lux def" flag_meta - ("lux check" (#Function Text Code) + ("lux type check" (#Function Text Code) ([_ tag] (tuple$ (#Cons [(meta_code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) (#Cons [(meta_code ["lux" "Bit"] (bit$ #1)) @@ -831,27 +834,27 @@ #0) ("lux def" doc_meta - ("lux check" (#Function Text (#Product Code Code)) + ("lux type check" (#Function Text (#Product Code Code)) (function'' [doc] [(tag$ ["lux" "doc"]) (text$ doc)])) (record$ #Nil) #0) ("lux def" as_def - ("lux check" (#Function Code (#Function Code (#Function Code (#Function Bit Code)))) + ("lux type check" (#Function Code (#Function Code (#Function Code (#Function Bit Code)))) (function'' [name value annotations exported?] (form$ (#Cons (text$ "lux def") (#Cons name (#Cons value (#Cons annotations (#Cons (bit$ exported?) #Nil)))))))) (record$ #Nil) #0) ("lux def" as_checked - ("lux check" (#Function Code (#Function Code Code)) + ("lux type check" (#Function Code (#Function Code Code)) (function'' [type value] - (form$ (#Cons (text$ "lux check") (#Cons type (#Cons value #Nil)))))) + (form$ (#Cons (text$ "lux type check") (#Cons type (#Cons value #Nil)))))) (record$ #Nil) #0) ("lux def" as_function - ("lux check" (#Function Code (#Function (#Apply Code List) (#Function Code Code))) + ("lux type check" (#Function Code (#Function (#Apply Code List) (#Function Code Code))) (function'' [self inputs output] (form$ (#Cons (identifier$ ["lux" "function''"]) (#Cons self @@ -861,7 +864,7 @@ #0) ("lux def" as_macro - ("lux check" (#Function Code Code) + ("lux type check" (#Function Code Code) (function'' [expression] (form$ (#Cons (text$ "lux macro") (#Cons expression @@ -1038,7 +1041,7 @@ [meta (#Tuple (list\map (replace_syntax reps) members))] [meta (#Record slots)] - [meta (#Record (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + [meta (#Record (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [slot] ({[k v] [(replace_syntax reps k) (replace_syntax reps v)]} @@ -1052,10 +1055,10 @@ (def:'' (n/* param subject) (#.Cons (doc_meta "Nat(ural) multiplication.") #.Nil) (#Function Nat (#Function Nat Nat)) - ("lux coerce" Nat + ("lux type as" Nat ("lux i64 *" - ("lux coerce" Int param) - ("lux coerce" Int subject)))) + ("lux type as" Int param) + ("lux type as" Int subject)))) (def:'' (update_parameters code) #Nil @@ -1064,7 +1067,7 @@ (tuple$ (list\map update_parameters members)) [_ (#Record pairs)] - (record$ (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (record$ (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [pair] (let'' [name val] pair [name (update_parameters val)]))) @@ -1143,7 +1146,7 @@ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse_quantified_args args (function'' [names] - (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) + (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "UnivQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1187,7 +1190,7 @@ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse_quantified_args args (function'' [names] - (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) + (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "ExQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1215,7 +1218,7 @@ (def:'' (list\reverse list) #Nil (All [a] (#Function ($' List a) ($' List a))) - (list\fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) + (list\fold ("lux type check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) (function'' [head tail] (#Cons head tail))) #Nil list)) @@ -1229,7 +1232,7 @@ "## This is the type of a function that takes 2 Ints and returns an Int.")))] #Nil) ({(#Cons output inputs) - (return (#Cons (list\fold ("lux check" (#Function Code (#Function Code Code)) + (return (#Cons (list\fold ("lux type check" (#Function Code (#Function Code Code)) (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) output inputs) @@ -1342,7 +1345,7 @@ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) (return (list (form$ (list (text$ "lux def") name - (form$ (list (text$ "lux check") + (form$ (list (text$ "lux type check") type (form$ (list (identifier$ ["lux" "function'"]) name @@ -1356,7 +1359,7 @@ (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) (return (list (form$ (list (text$ "lux def") name - (form$ (list (text$ "lux check") + (form$ (list (text$ "lux type check") type body)) (form$ (#Cons (identifier$ ["lux" "record$"]) @@ -1368,7 +1371,7 @@ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) (return (list (form$ (list (text$ "lux def") name - (form$ (list (text$ "lux check") + (form$ (list (text$ "lux type check") type (form$ (list (identifier$ ["lux" "function'"]) name @@ -1382,7 +1385,7 @@ (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) (return (list (form$ (list (text$ "lux def") name - (form$ (list (text$ "lux check") type body)) + (form$ (list (text$ "lux type check") type body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -1404,8 +1407,8 @@ (macro:' (let' tokens) ({(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) - (return (list (list\fold ("lux check" (-> (& Code Code) Code - Code) + (return (list (list\fold ("lux type check" (-> (& Code Code) Code + Code) (function' [binding body] ({[label value] (form$ (list (record$ (list [label body])) value))} @@ -1567,7 +1570,7 @@ ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) (let' [g!wrap (local_identifier$ "wrap") g!bind (local_identifier$ " bind ") - body' (list\fold ("lux check" (-> (& Code Code) Code Code) + body' (list\fold ("lux type check" (-> (& Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] ({[_ (#Tag "" "let")] @@ -1740,7 +1743,7 @@ (let' [type (form$ (list (tag$ ["lux" "Apply"]) (identifier$ ["lux" "Code"]) (identifier$ ["lux" "List"])))] - (form$ (list (text$ "lux check") type expression)))) + (form$ (list (text$ "lux type check") type expression)))) (def:''' (splice replace? untemplate elems) #Nil @@ -1837,7 +1840,7 @@ (return (wrap_meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))]] - (return (form$ (list (text$ "lux check") + (return (form$ (list (text$ "lux type check") (identifier$ ["lux" "Code"]) unquoted))) @@ -1867,7 +1870,7 @@ [_ [_ (#Record fields)]] (do meta_monad [=fields (monad\map meta_monad - ("lux check" (-> (& Code Code) ($' Meta Code)) + ("lux type check" (-> (& Code Code) ($' Meta Code)) (function' [kv] (let' [[k v] kv] (do meta_monad @@ -1919,7 +1922,7 @@ (do meta_monad [current_module current_module_name =template (untemplate #1 current_module template)] - (wrap (list (form$ (list (text$ "lux check") + (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["lux" "Code"]) =template))))) @@ -1935,7 +1938,7 @@ ({(#Cons template #Nil) (do meta_monad [=template (untemplate #1 "" template)] - (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) + (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["lux" "Code"]) =template))))) _ (fail "Wrong syntax for `")} @@ -1949,7 +1952,7 @@ ({(#Cons template #Nil) (do meta_monad [=template (untemplate #0 "" template)] - (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) + (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["lux" "Code"]) =template))))) _ (fail "Wrong syntax for '")} @@ -1963,7 +1966,7 @@ "## =>" __paragraph "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) ({(#Cons [init apps]) - (return (list (list\fold ("lux check" (-> Code Code Code) + (return (list (list\fold ("lux type check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] (tuple$ (list\compose parts (list acc))) @@ -1989,7 +1992,7 @@ "## =>" __paragraph "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) ({(#Cons [init apps]) - (return (list (list\fold ("lux check" (-> Code Code Code) + (return (list (list\fold ("lux type check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] (tuple$ (list\compose parts (list acc))) @@ -2072,7 +2075,7 @@ [meta (#Form (list\map (apply_template env) elems))] [meta (#Record members)] - [meta (#Record (list\map ("lux check" (-> (& Code Code) (& Code Code)) + [meta (#Record (list\map ("lux type check" (-> (& Code Code) (& Code Code)) (function' [kv] (let' [[slot value] kv] [(apply_template env slot) (apply_template env value)]))) @@ -2139,7 +2142,7 @@ " " "[dec -1]"))]) ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] - (let' [apply ("lux check" (-> RepEnv ($' List Code)) + (let' [apply ("lux type check" (-> RepEnv ($' List Code)) (function' [env] (list\map (apply_template env) templates))) num_bindings (list\size bindings')] (if (every? (function' [size] ("lux i64 =" num_bindings size)) @@ -2162,17 +2165,17 @@ (def:''' (n// param subject) (list) (-> Nat Nat Nat) - (if ("lux i64 <" +0 ("lux coerce" Int param)) + (if ("lux i64 <" +0 ("lux type as" Int param)) (if (n/< param subject) 0 1) (let' [quotient (|> subject ("lux i64 right-shift" 1) - ("lux i64 /" ("lux coerce" Int param)) + ("lux i64 /" ("lux type as" Int param)) ("lux i64 left-shift" 1)) flat ("lux i64 *" - ("lux coerce" Int param) - ("lux coerce" Int quotient)) + ("lux type as" Int param) + ("lux type as" Int quotient)) remainder ("lux i64 -" flat subject)] (if (n/< param remainder) quotient @@ -2182,8 +2185,8 @@ (list) (-> Nat Nat Nat) (let' [flat ("lux i64 *" - ("lux coerce" Int param) - ("lux coerce" Int (n// param subject)))] + ("lux type as" Int param) + ("lux type as" Int (n// param subject)))] ("lux i64 -" flat subject))) (def:''' (n/min left right) @@ -2215,7 +2218,7 @@ "0" _ - (let' [loop ("lux check" (-> Nat Text Text) + (let' [loop ("lux type check" (-> Nat Text Text) (function' recur [input output] (if ("lux i64 =" 0 input) output @@ -2240,15 +2243,15 @@ (let' [sign (if ("lux i64 <" value +0) "+" "-")] - (("lux check" (-> Int Text Text) + (("lux type check" (-> Int Text Text) (function' recur [input output] (if ("lux i64 =" +0 input) (text\compose sign output) (recur ("lux i64 /" +10 input) - (text\compose (|> input ("lux i64 %" +10) ("lux coerce" Nat) digit::format) + (text\compose (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) output))))) (|> value ("lux i64 /" +10) int\abs) - (|> value ("lux i64 %" +10) int\abs ("lux coerce" Nat) digit::format))))) + (|> value ("lux i64 %" +10) int\abs ("lux type as" Nat) digit::format))))) (def:''' (frac\encode x) #Nil @@ -2286,7 +2289,7 @@ ($' Maybe Macro)) (do maybe_monad [$module (get module modules) - gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux check" Module $module)] + gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux type check" Module $module)] (get name bindings))] ({(#Left [r_module r_name]) (find_macro' modules current_module r_module r_name) @@ -2294,12 +2297,12 @@ (#Right [exported? def_type def_meta def_value]) (if (macro_type? def_type) (if exported? - (#Some ("lux coerce" Macro def_value)) + (#Some ("lux type as" Macro def_value)) (if (text\= module current_module) - (#Some ("lux coerce" Macro def_value)) + (#Some ("lux type as" Macro def_value)) #None)) #None)} - ("lux check" Global gdef)))) + ("lux type check" Global gdef)))) (def:''' (normalize name) #Nil @@ -2360,7 +2363,7 @@ [macro_name' (normalize macro_name) ?macro (find_macro macro_name')] ({(#Some macro) - (("lux coerce" Macro' macro) args) + (("lux type as" Macro' macro) args) #None (return (list token))} @@ -2379,7 +2382,7 @@ ?macro (find_macro macro_name')] ({(#Some macro) (do meta_monad - [expansion (("lux coerce" Macro' macro) args) + [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad macro_expand expansion)] (wrap (list\join expansion'))) @@ -2400,7 +2403,7 @@ ?macro (find_macro macro_name')] ({(#Some macro) (do meta_monad - [expansion (("lux coerce" Macro' macro) args) + [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad macro_expand_all expansion)] (wrap (list\join expansion'))) @@ -2459,7 +2462,7 @@ expression [_ (#Form (#Cons type_fn args))] - (list\fold ("lux check" (-> Code Code Code) + (list\fold ("lux type check" (-> Code Code Code) (function' [arg type_fn] (` (#.Apply (~ arg) (~ type_fn))))) (walk_type type_fn) (list\map walk_type args)) @@ -2493,22 +2496,22 @@ "## The type-annotation macro." __paragraph "(: (List Int) (list +1 +2 +3))"))]) ({(#Cons type (#Cons value #Nil)) - (return (list (` ("lux check" (type (~ type)) (~ value))))) + (return (list (` ("lux type check" (type (~ type)) (~ value))))) _ (fail "Wrong syntax for :")} tokens)) -(macro:' #export (:coerce tokens) +(macro:' #export (:as tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## The type-coercion macro." __paragraph - "(:coerce Dinosaur (list +1 +2 +3))"))]) + "(:as Dinosaur (list +1 +2 +3))"))]) ({(#Cons type (#Cons value #Nil)) - (return (list (` ("lux coerce" (type (~ type)) (~ value))))) + (return (list (` ("lux type as" (type (~ type)) (~ value))))) _ - (fail "Wrong syntax for :coerce")} + (fail "Wrong syntax for :as")} tokens)) (def:''' (empty? xs) @@ -2623,7 +2626,7 @@ "''YOLO'')"))]) ({(#Cons value actions) (let' [dummy (local_identifier$ "")] - (return (list (list\fold ("lux check" (-> Code Code Code) + (return (list (list\fold ("lux type check" (-> Code Code Code) (function' [pre post] (` ({(~ dummy) (~ post)} (~ pre))))) value @@ -3172,7 +3175,7 @@ (: (-> Code (Meta [Text Code])) (function (_ token) (case token - (^ [_ (#Form (list [_ (#Text "lux check")] type [_ (#Identifier ["" name])]))]) + (^ [_ (#Form (list [_ (#Text "lux type check")] type [_ (#Identifier ["" name])]))]) (wrap [name type]) _ @@ -3655,7 +3658,7 @@ _ (` ("lux def" (~ type_name) - ("lux check type" + ("lux type check type" (~ typeC)) (~ total_meta) (~ (bit$ exported?)))))))) @@ -3670,7 +3673,7 @@ (template [<name> <to>] [(def: #export (<name> value) (-> (I64 Any) <to>) - (:coerce <to> value))] + (:as <to> value))] [i64 I64] [nat Nat] @@ -5070,8 +5073,9 @@ #None (fail "Wrong syntax for loop"))) init_types (monad\map meta_monad find_type inits') expected get_expected_type] - (return (list (` (("lux check" (-> (~+ (list\map type_to_code init_types)) - (~ (type_to_code expected))) + (return (list (` (("lux type check" + (-> (~+ (list\map type_to_code init_types)) + (~ (type_to_code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) @@ -5238,7 +5242,7 @@ (case (flatten_alias type) (^template [<name> <type> <wrapper>] [(#Named ["lux" <name>] _) - (wrap (<wrapper> (:coerce <type> value)))]) + (wrap (<wrapper> (:as <type> value)))]) (["Bit" Bit bit$] ["Nat" Nat nat$] ["Int" Int int$] @@ -5376,7 +5380,7 @@ #None (case (~ g!temp) (~+ next_branches))} - ("lux check" (#.Apply (~ (type_to_code expected)) Maybe) + ("lux type check" (#.Apply (~ (type_to_code expected)) Maybe) (case (~ g!temp) (~+ (multi_level_case$ g!temp [mlc body])) @@ -5504,7 +5508,7 @@ (^ (list expr)) (do meta_monad [type get_expected_type] - (wrap (list (` ("lux coerce" (~ (type_to_code type)) (~ expr)))))) + (wrap (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) _ (fail (..wrong_syntax_error (name_of ..:assume))))) @@ -5690,7 +5694,7 @@ (case (..flatten_alias type) (^or (#Primitive "#Text" #Nil) (#Named ["lux" "Text"] (#Primitive "#Text" #Nil))) - (wrap (:coerce ..Text value)) + (wrap (:as ..Text value)) _ (fail ($_ text\compose diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index f4d63c00f..9e17193b2 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -9,7 +9,7 @@ ["." exception (#+ exception:)] ["." io (#+ IO io)] ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data ["." product] [text @@ -213,8 +213,8 @@ (def: actor_decl^ (Parser [Text (List Text)]) - (<>.either (<c>.form (<>.and <c>.local_identifier (<>.some <c>.local_identifier))) - (<>.and <c>.local_identifier (\ <>.monad wrap (list))))) + (<>.either (<code>.form (<>.and <code>.local_identifier (<>.some <code>.local_identifier))) + (<>.and <code>.local_identifier (\ <>.monad wrap (list))))) (type: On_MailC [[Text Text Text] Code]) @@ -224,15 +224,15 @@ (def: argument (Parser Text) - <c>.local_identifier) + <code>.local_identifier) (def: behavior^ (Parser BehaviorC) (let [on_mail_args ($_ <>.and ..argument ..argument ..argument)] ($_ <>.and - (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' on_mail)) on_mail_args)) - <c>.any))) - (<>.some <c>.any)))) + (<>.maybe (<code>.form (<>.and (<code>.form (<>.after (<code>.this! (' on_mail)) on_mail_args)) + <code>.any))) + (<>.some <code>.any)))) (def: (on_mail g!_ ?on_mail) (-> Code (Maybe On_MailC) Code) @@ -295,7 +295,7 @@ (~+ messages)))))))) - (syntax: #export (actor {[state_type init] (<c>.record (<>.and <c>.any <c>.any))} + (syntax: #export (actor {[state_type init] (<code>.record (<>.and <code>.any <code>.any))} {[?on_mail messages] behavior^}) (with_gensyms [g!_] (wrap (list (` (: ((~! io.IO) (..Actor (~ state_type))) @@ -315,18 +315,18 @@ (def: signature^ (Parser Signature) - (<c>.form ($_ <>.and - (<>.default (list) (<c>.tuple (<>.some <c>.local_identifier))) - <c>.local_identifier - (<>.some |input|.parser) - <c>.local_identifier - <c>.local_identifier - <c>.any))) + (<code>.form ($_ <>.and + (<>.default (list) (<code>.tuple (<>.some <code>.local_identifier))) + <code>.local_identifier + (<>.some |input|.parser) + <code>.local_identifier + <code>.local_identifier + <code>.any))) (def: reference^ (Parser [Name (List Text)]) - (<>.either (<c>.form (<>.and <c>.identifier (<>.some <c>.local_identifier))) - (<>.and <c>.identifier (\ <>.monad wrap (list))))) + (<>.either (<code>.form (<>.and <code>.identifier (<>.some <code>.local_identifier))) + (<>.and <code>.identifier (\ <>.monad wrap (list))))) (syntax: #export (message: {export |export|.parser} @@ -357,13 +357,13 @@ (..Message (~ (get@ #abstract.abstraction actor_scope)) (~ (get@ #output signature))))) (function ((~ g!_) (~ g!state) (~ g!self)) - (let [(~ g!state) (:coerce (~ (get@ #abstract.representation actor_scope)) - (~ g!state))] + (let [(~ g!state) (:as (~ (get@ #abstract.representation actor_scope)) + (~ g!state))] (|> (~ body) (: ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) (~ (get@ #output signature))]))) - (:coerce ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) - (~ (get@ #output signature))])))))))) + (:as ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) + (~ (get@ #output signature))])))))))) )))))) (type: #export Stop diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index e43ecb98e..d375059a4 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -92,8 +92,8 @@ (All [a] (-> (Var a) Tx (Maybe a))) (|> tx (list.find (function (_ [_var _original _current]) - (is? (:coerce (Var Any) var) - (:coerce (Var Any) _var)))) + (is? (:as (Var Any) var) + (:as (Var Any) _var)))) (\ maybe.monad map (function (_ [_var _original _current]) _current)) (:assume) @@ -118,11 +118,11 @@ #.Nil (#.Cons [_var _original _current] tx') - (if (is? (:coerce (Var Any) var) - (:coerce (Var Any) _var)) - (#.Cons {#var (:coerce (Var Any) _var) - #original (:coerce Any _original) - #current (:coerce Any value)} + (if (is? (:as (Var Any) var) + (:as (Var Any) _var)) + (#.Cons {#var (:as (Var Any) _var) + #original (:as Any _original) + #current (:as Any value)} tx') (#.Cons {#var _var #original _original diff --git a/stdlib/source/lux/control/function/mutual.lux b/stdlib/source/lux/control/function/mutual.lux index 6ccbd2e63..c1960253a 100644 --- a/stdlib/source/lux/control/function/mutual.lux +++ b/stdlib/source/lux/control/function/mutual.lux @@ -46,7 +46,7 @@ (.def: (macro g!context g!self) (-> Code Code Macro) - (<| (:coerce Macro) + (<| (:as Macro) (: Macro') (function (_ parameters) (\ meta.monad wrap (list (` (((~ g!self) (~ g!context)) (~+ parameters)))))))) diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux index 39acb2192..153fdc0ba 100644 --- a/stdlib/source/lux/control/thread.lux +++ b/stdlib/source/lux/control/thread.lux @@ -37,7 +37,7 @@ @.jvm ("jvm array read object" (|> 0 - (:coerce (primitive "java.lang.Long")) + (:as (primitive "java.lang.Long")) "jvm object cast" "jvm conversion long-to-int") (:representation box)) diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index 7e32772b7..a6f11ff5b 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -51,7 +51,7 @@ (def: i64 (-> (primitive "java.lang.Byte") I64) - (|>> ffi.byte_to_long (:coerce I64) (i64.and ..byte_mask))) + (|>> ffi.byte_to_long (:as I64) (i64.and ..byte_mask))) (def: byte (-> (I64 Any) (primitive "java.lang.Byte")) @@ -59,7 +59,7 @@ (|>> .int ffi.long_to_byte) @.jvm - (|>> .int (:coerce (primitive "java.lang.Long")) ffi.long_to_byte)})))] + (|>> .int (:as (primitive "java.lang.Long")) ffi.long_to_byte)})))] (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>) @@ -104,7 +104,7 @@ @.python (|> binary - (:coerce (array.Array (I64 Any))) + (:as (array.Array (I64 Any))) "python array length") @.scheme @@ -120,14 +120,14 @@ @.js (|> binary (: ..Binary) - (:coerce (array.Array .Frac)) + (:as (array.Array .Frac)) ("js array read" idx) f.nat .i64) @.python (|> binary - (:coerce (array.Array .I64)) + (:as (array.Array .I64)) ("python array read" idx)) @.scheme @@ -137,21 +137,21 @@ (|> binary (array.read idx) (maybe.default (: (I64 Any) 0)) - (:coerce I64)))) + (:as I64)))) (template: (!!write <byte_type> <post> <write> idx value binary) (|> binary (: ..Binary) - (:coerce (array.Array <byte_type>)) + (:as (array.Array <byte_type>)) (<write> idx (|> value .nat (n.% (hex "100")) <post>)) - (:coerce ..Binary))) + (:as ..Binary))) (template: (!write idx value binary) (for {@.old (ffi.array_write idx (..byte value) binary) @.jvm (ffi.array_write idx (..byte value) binary) @.js (!!write .Frac n.frac "js array write" idx value binary) - @.python (!!write (I64 Any) (:coerce (I64 Any)) "python array write" idx value binary) + @.python (!!write (I64 Any) (:as (I64 Any)) "python array write" idx value binary) @.scheme (exec (..bytevector-u8-set! [binary idx value]) binary)} @@ -171,8 +171,8 @@ (|>> n.frac ArrayBuffer::new Uint8Array::new) @.python - (|>> ("python apply" (:coerce ffi.Function ("python constant" "bytearray"))) - (:coerce Binary)) + (|>> ("python apply" (:as ffi.Function ("python constant" "bytearray"))) + (:as Binary)) @.scheme (|>> ..make-bytevector)} diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index bb19af564..0b2911c3e 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -16,7 +16,8 @@ [number ["n" nat]]]]) -(def: #export type_name "#Array") +(def: #export type_name + "#Array") (type: #export (Array a) {#.doc "Mutable arrays."} @@ -28,7 +29,7 @@ (for {@.jvm (template: (!int value) (|> value - (:coerce <index_type>) + (:as <index_type>) "jvm object cast" "jvm conversion long-to-int"))} (as_is)) @@ -59,12 +60,12 @@ @.jvm (|> array - (:coerce <array_type>) + (:as <array_type>) "jvm array length object" "jvm conversion int-to-long" "jvm object cast" (: <index_type>) - (:coerce Nat)) + (:as Nat)) @.js ("js array length" array) @.python ("python array length" array) @@ -91,7 +92,7 @@ @.jvm (let [value (|> array - (:coerce <array_type>) + (:as <array_type>) ("jvm array read object" (!int index)))] (if ("jvm object null?" value) #.None @@ -113,8 +114,8 @@ @.jvm (|> array - (:coerce <array_type>) - ("jvm array write object" (!int index) (:coerce <elem_type> value)) + (:as <array_type>) + ("jvm array write object" (!int index) (:as <elem_type> value)) :assume) @.js ("js array write" index value array) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index 65fb7b1a3..a33182f19 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -539,7 +539,7 @@ content (#.Some caption) - (..and (:coerce HTML caption) + (..and (:as HTML caption) content))] (..tag "table" attributes content))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 6bc7d5ebd..1c54218f9 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -198,32 +198,32 @@ (def: #export (replace_all pattern replacement template) (-> Text Text Text Text) (for {@.old - (:coerce Text - ("jvm invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence" - (:coerce (primitive "java.lang.String") template) - (:coerce (primitive "java.lang.CharSequence") pattern) - (:coerce (primitive "java.lang.CharSequence") replacement))) + (:as Text + ("jvm invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence" + (:as (primitive "java.lang.String") template) + (:as (primitive "java.lang.CharSequence") pattern) + (:as (primitive "java.lang.CharSequence") replacement))) @.jvm - (:coerce Text - ("jvm member invoke virtual" [] "java.lang.String" "replace" [] - (:coerce (primitive "java.lang.String") template) - ["Ljava/lang/CharSequence;" (:coerce (primitive "java.lang.CharSequence") pattern)] - ["Ljava/lang/CharSequence;" (:coerce (primitive "java.lang.CharSequence") replacement)])) + (:as Text + ("jvm member invoke virtual" [] "java.lang.String" "replace" [] + (:as (primitive "java.lang.String") template) + ["Ljava/lang/CharSequence;" (:as (primitive "java.lang.CharSequence") pattern)] + ["Ljava/lang/CharSequence;" (:as (primitive "java.lang.CharSequence") replacement)])) ## TODO: Comment/turn-off when generating a JS compiler using a JVM-based compiler because Nashorn's implementation of "replaceAll" is incorrect. @.js - (:coerce Text - ("js object do" "replaceAll" template [pattern replacement])) + (:as Text + ("js object do" "replaceAll" template [pattern replacement])) @.python - (:coerce Text - ("python object do" "replace" template pattern replacement)) + (:as Text + ("python object do" "replace" template pattern replacement)) ## TODO @.lua @.ruby - (:coerce Text - ("ruby object do" "gsub" template pattern replacement)) + (:as Text + ("ruby object do" "gsub" template pattern replacement)) @.php - (:coerce Text - ("php apply" (:assume ("php constant" "str_replace")) - pattern replacement template)) + (:as Text + ("php apply" (:assume ("php constant" "str_replace")) + pattern replacement template)) ## TODO @.scheme ## TODO @.common_lisp ## TODO @.r @@ -271,16 +271,16 @@ (: (primitive "java.lang.String")) "jvm invokevirtual:java.lang.String:hashCode:" "jvm convert int-to-long" - (:coerce Nat)) + (:as Nat)) @.jvm (|> input - (:coerce (primitive "java.lang.String")) + (:as (primitive "java.lang.String")) ("jvm member invoke virtual" [] "java.lang.String" "hashCode" []) "jvm conversion int-to-long" "jvm object cast" (: (primitive "java.lang.Long")) - (:coerce Nat))} + (:as Nat))} ## Platform-independent default. (let [length ("lux text size" input)] (loop [idx 0 @@ -335,45 +335,45 @@ (def: #export (lower_case value) (-> Text Text) (for {@.old - (:coerce Text - ("jvm invokevirtual:java.lang.String:toLowerCase:" - (:coerce (primitive "java.lang.String") value))) + (:as Text + ("jvm invokevirtual:java.lang.String:toLowerCase:" + (:as (primitive "java.lang.String") value))) @.jvm - (:coerce Text - ("jvm member invoke virtual" [] "java.lang.String" "toLowerCase" [] - (:coerce (primitive "java.lang.String") value))) + (:as Text + ("jvm member invoke virtual" [] "java.lang.String" "toLowerCase" [] + (:as (primitive "java.lang.String") value))) @.js - (:coerce Text - ("js object do" "toLowerCase" value [])) + (:as Text + ("js object do" "toLowerCase" value [])) @.python - (:coerce Text - ("python object do" "lower" value)) + (:as Text + ("python object do" "lower" value)) @.lua - (:coerce Text - ("lua apply" ("lua constant" "string.lower") value)) + (:as Text + ("lua apply" ("lua constant" "string.lower") value)) @.ruby - (:coerce Text - ("ruby object do" "downcase" value))})) + (:as Text + ("ruby object do" "downcase" value))})) (def: #export (upper_case value) (-> Text Text) (for {@.old - (:coerce Text - ("jvm invokevirtual:java.lang.String:toUpperCase:" - (:coerce (primitive "java.lang.String") value))) + (:as Text + ("jvm invokevirtual:java.lang.String:toUpperCase:" + (:as (primitive "java.lang.String") value))) @.jvm - (:coerce Text - ("jvm member invoke virtual" [] "java.lang.String" "toUpperCase" [] - (:coerce (primitive "java.lang.String") value))) + (:as Text + ("jvm member invoke virtual" [] "java.lang.String" "toUpperCase" [] + (:as (primitive "java.lang.String") value))) @.js - (:coerce Text - ("js object do" "toUpperCase" value [])) + (:as Text + ("js object do" "toUpperCase" value [])) @.python - (:coerce Text - ("python object do" "upper" value)) + (:as Text + ("python object do" "upper" value)) @.lua - (:coerce Text - ("lua apply" ("lua constant" "string.upper") value)) + (:as Text + ("lua apply" ("lua constant" "string.upper") value)) @.ruby - (:coerce Text - ("ruby object do" "upcase" value))})) + (:as Text + ("ruby object do" "upcase" value))})) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index fb90ab15e..d07b10567 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -66,7 +66,7 @@ append! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) (function (_ chunk builder) (exec - (java/lang/Appendable::append (:coerce java/lang/CharSequence chunk) + (java/lang/Appendable::append (:as java/lang/CharSequence chunk) builder) builder)))] (:abstraction [(n.+ (//.size chunk) capacity) diff --git a/stdlib/source/lux/data/text/encoding/utf8.lux b/stdlib/source/lux/data/text/encoding/utf8.lux index 84e0092c8..7b9e75524 100644 --- a/stdlib/source/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/lux/data/text/encoding/utf8.lux @@ -69,20 +69,20 @@ ## The coercion below may seem ## gratuitous, but removing it ## causes a grave compilation problem. - (:coerce java/lang/String value)) + (:as java/lang/String value)) @.jvm (java/lang/String::getBytes (//.name //.utf_8) value) @.js (cond ffi.on_nashorn? - (:coerce Binary ("js object do" "getBytes" value ["utf8"])) + (:as Binary ("js object do" "getBytes" value ["utf8"])) ffi.on_node_js? (|> (Buffer::from|encode [value "utf8"]) ## This coercion is valid as per NodeJS's documentation: ## https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays - (:coerce Uint8Array)) + (:as Uint8Array)) ## On the browser (|> (TextEncoder::new [(//.name //.utf_8)]) @@ -90,14 +90,14 @@ ) @.python - (:coerce Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8")) + (:as Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8")) @.lua ("lua utf8 encode" value) @.ruby (|> value - (:coerce RubyString) + (:as RubyString) (RubyString::encode ["UTF-8"]) (RubyString::bytes [])) @@ -105,7 +105,7 @@ (|> (..unpack [..php_byte_array_format value]) ..array_values ("php object new" "ArrayObject") - (:coerce Binary)) + (:as Binary)) @.scheme (..string->utf8 value)})) @@ -119,7 +119,7 @@ @.js (cond ffi.on_nashorn? (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) - (:coerce Text) + (:as Text) #try.Success) ffi.on_node_js? @@ -133,16 +133,16 @@ #try.Success)) @.python - (try (:coerce Text ("python object do" "decode" (:assume value) "utf-8"))) + (try (:as Text ("python object do" "decode" (:assume value) "utf-8"))) @.lua (#try.Success ("lua utf8 decode" value)) @.ruby (|> value - (:coerce RubyArray) + (:as RubyArray) (RubyArray::pack ["C*"]) - (:coerce RubyString) + (:as RubyString) (RubyString::force_encoding ["UTF-8"]) #try.Success) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 962ffeefe..cf6fb803c 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -132,7 +132,7 @@ (-> Inspector Inspector) (with_expansions [<adaption> (for {@.lua (~~ (as_is ..tuple_array))} (~~ (as_is)))] - (`` (|>> (:coerce (array.Array Any)) + (`` (|>> (:as (array.Array Any)) <adaption> array.to_list (list\map inspect) @@ -141,21 +141,21 @@ (def: #export (inspect value) Inspector - (with_expansions [<jvm> (let [object (:coerce java/lang/Object value)] + (with_expansions [<jvm> (let [object (:as java/lang/Object value)] (`` (<| (~~ (template [<class> <processing>] [(case (ffi.check <class> object) (#.Some value) (`` (|> value (~~ (template.splice <processing>)))) #.None)] - [java/lang/Boolean [(:coerce .Bit) %.bit]] - [java/lang/Long [(:coerce .Int) %.int]] + [java/lang/Boolean [(:as .Bit) %.bit]] + [java/lang/Long [(:as .Int) %.int]] [java/lang/Number [java/lang/Number::doubleValue %.frac]] - [java/lang/String [(:coerce .Text) %.text]] + [java/lang/String [(:as .Text) %.text]] )) (case (ffi.check [java/lang/Object] object) (#.Some value) - (let [value (:coerce (array.Array java/lang/Object) value)] + (let [value (:as (array.Array java/lang/Object) value)] (case (array.read 0 value) (^multi (#.Some tag) [(ffi.check java/lang/Integer tag) @@ -184,9 +184,9 @@ (^template [<type_of> <then>] [<type_of> (`` (|> value (~~ (template.splice <then>))))]) - (["boolean" [(:coerce .Bit) %.bit]] - ["number" [(:coerce .Frac) %.frac]] - ["string" [(:coerce .Text) %.text]] + (["boolean" [(:as .Bit) %.bit]] + ["number" [(:as .Frac) %.frac]] + ["string" [(:as .Text) %.text]] ["undefined" [JSON::stringify]]) "object" @@ -203,7 +203,7 @@ (not (or ("js object undefined?" ("js object get" "_lux_low" value)) ("js object undefined?" ("js object get" "_lux_high" value)))) - (|> value (:coerce .Int) %.int) + (|> value (:as .Int) %.int) (Array::isArray value) (inspect_tuple inspect value) @@ -219,17 +219,17 @@ (^template [<type_of> <class_of> <then>] [(^or <type_of> <class_of>) (`` (|> value (~~ (template.splice <then>))))]) - (["<type 'bool'>" "<class 'bool'>" [(:coerce .Bit) %.bit]] - ["<type 'int'>" "<class 'int'>" [(:coerce .Int) %.int]] - ["<type 'float'>" "<class 'float'>" [(:coerce .Frac) %.frac]] - ["<type 'str'>" "<class 'str'>" [(:coerce .Text) %.text]] - ["<type 'unicode'>" "<class 'unicode'>" [(:coerce .Text) %.text]]) + (["<type 'bool'>" "<class 'bool'>" [(:as .Bit) %.bit]] + ["<type 'int'>" "<class 'int'>" [(:as .Int) %.int]] + ["<type 'float'>" "<class 'float'>" [(:as .Frac) %.frac]] + ["<type 'str'>" "<class 'str'>" [(:as .Text) %.text]] + ["<type 'unicode'>" "<class 'unicode'>" [(:as .Text) %.text]]) (^or "<type 'list'>" "<class 'list'>") (inspect_tuple inspect value) (^or "<type 'tuple'>" "<type 'tuple'>") - (let [variant (:coerce (array.Array Any) value)] + (let [variant (:as (array.Array Any) value)] (case (array.size variant) 3 (let [variant_tag ("python array read" 0 variant) variant_flag ("python array read" 1 variant) @@ -237,7 +237,7 @@ (if (or ("python object none?" variant_tag) ("python object none?" variant_value)) (..str value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (|> variant_flag "python object none?" not %.bit) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -251,14 +251,14 @@ (^template [<type_of> <then>] [<type_of> (`` (|> value (~~ (template.splice <then>))))]) - (["boolean" [(:coerce .Bit) %.bit]] - ["string" [(:coerce .Text) %.text]] + (["boolean" [(:as .Bit) %.bit]] + ["string" [(:as .Text) %.text]] ["nil" [(new> "nil" [])]]) "number" (case (math::type [value]) - (#.Some "integer") (|> value (:coerce .Int) %.int) - (#.Some "float") (|> value (:coerce .Frac) %.frac) + (#.Some "integer") (|> value (:as .Int) %.int) + (#.Some "float") (|> value (:as .Frac) %.frac) _ (..tostring value)) @@ -270,7 +270,7 @@ (if (or ("lua object nil?" variant_tag) ("lua object nil?" variant_value)) (inspect_tuple inspect value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("lua object nil?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -281,17 +281,17 @@ @.ruby (template.let [(class_of <literal>) [(|> <literal> - (:coerce ..Object) + (:as ..Object) (Object::class []))] (to_s <object>) [(|> <object> - (:coerce ..Object) + (:as ..Object) (Object::to_s []))]] (let [value_class (class_of value)] (`` (cond (~~ (template [<literal> <type> <format>] [(is? (class_of <literal>) value_class) - (|> value (:coerce <type>) <format>)] + (|> value (:as <type>) <format>)] [#0 Bit %.bit] [#1 Bit %.bit] @@ -308,7 +308,7 @@ (if (or ("ruby object nil?" variant_tag) ("ruby object nil?" variant_value)) (inspect_tuple inspect value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("ruby object nil?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -324,10 +324,10 @@ (^template [<type_of> <then>] [<type_of> (`` (|> value (~~ (template.splice <then>))))]) - (["boolean" [(:coerce .Bit) %.bit]] - ["integer" [(:coerce .Int) %.int]] - ["double" [(:coerce .Frac) %.frac]] - ["string" [(:coerce .Text) %.text]] + (["boolean" [(:as .Bit) %.bit]] + ["integer" [(:as .Int) %.int]] + ["double" [(:as .Frac) %.frac]] + ["string" [(:as .Text) %.text]] ["NULL" [(new> "null" [])]] ["array" [(inspect_tuple inspect)]]) @@ -338,7 +338,7 @@ (if (or ("php object null?" variant_tag) ("php object null?" variant_value)) (..strval value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("php object null?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -351,10 +351,10 @@ [(<when> value) (`` (|> value (~~ (template.splice <then>))))] - [..boolean? [(:coerce .Bit) %.bit]] - [..integer? [(:coerce .Int) %.int]] - [..real? [(:coerce .Frac) %.frac]] - [..string? [(:coerce .Text) %.text]] + [..boolean? [(:as .Bit) %.bit]] + [..integer? [(:as .Int) %.int]] + [..real? [(:as .Frac) %.frac]] + [..string? [(:as .Text) %.text]] ["scheme object nil?" [(new> "()" [])]] [..vector? [(inspect_tuple inspect)]])) @@ -362,11 +362,11 @@ (let [variant_tag (..car value) variant_rest (..cdr value)] (if (and (..integer? variant_tag) - (i.> +0 (:coerce Int variant_tag)) + (i.> +0 (:as Int variant_tag)) (..pair? variant_rest)) (let [variant_flag (..car variant_rest) variant_value (..cdr variant_rest)] - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("scheme object nil?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"]))) @@ -394,7 +394,7 @@ (~~ (template [<type> <formatter>] [(do <>.monad [_ (<type>.sub <type>)] - (wrap (|>> (:coerce <type>) <formatter>)))] + (wrap (|>> (:as <type>) <formatter>)))] [Bit %.bit] [Nat %.nat] @@ -410,7 +410,7 @@ (~~ (template [<type> <formatter>] [(do <>.monad [_ (<type>.sub <type>)] - (wrap (|>> (:coerce <type>) <formatter>)))] + (wrap (|>> (:as <type>) <formatter>)))] [Ratio %.ratio] [Name %.name] @@ -431,12 +431,12 @@ (do <>.monad [[_ elemT] (<type>.apply (<>.and (<type>.exactly List) <type>.any)) elemR (<type>.local (list elemT) representation)] - (wrap (|>> (:coerce (List Any)) (%.list elemR)))) + (wrap (|>> (:as (List Any)) (%.list elemR)))) (do <>.monad [[_ elemT] (<type>.apply (<>.and (<type>.exactly Maybe) <type>.any)) elemR (<type>.local (list elemT) representation)] - (wrap (|>> (:coerce (Maybe Any)) + (wrap (|>> (:as (Maybe Any)) (%.maybe elemR))))))) (def: (variant_representation representation) @@ -449,7 +449,7 @@ variantV variantV] (case representations (#.Cons leftR (#.Cons rightR extraR+)) - (case (:coerce (| Any Any) variantV) + (case (:as (| Any Any) variantV) (#.Left left) [lefts #0 (leftR left)] @@ -480,7 +480,7 @@ (lastR tupleV) (#.Cons headR tailR) - (let [[leftV rightV] (:coerce [Any Any] tupleV)] + (let [[leftV rightV] (:as [Any Any] tupleV)] (%.format (headR leftV) " " (recur tailR rightV)))))] (%.format "[" tuple_body "]")))))) diff --git a/stdlib/source/lux/ffi.js.lux b/stdlib/source/lux/ffi.js.lux index 0625769cf..dd5f584c5 100644 --- a/stdlib/source/lux/ffi.js.lux +++ b/stdlib/source/lux/ffi.js.lux @@ -245,8 +245,8 @@ (if static? (` ((~! syntax:) ((~ (qualify field))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nullable_type fieldT)) - ("js constant" (~ (code.text (%.format real_class "." field)))))))))) + (list (` (.:as (~ (nullable_type fieldT)) + ("js constant" (~ (code.text (%.format real_class "." field)))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) @@ -310,7 +310,7 @@ #.None (~ g!_) - (#.Some (:coerce (~ type) (~ constant)))))))) + (#.Some (:as (~ type) (~ constant)))))))) (#.Cons [next tail]) (let [separator "."] @@ -344,8 +344,8 @@ Bit (case (..constant (Object Any) [process]) (#.Some process) - (case (:coerce Text - ("js apply" ("js constant" "Object.prototype.toString.call") process)) + (case (:as Text + ("js apply" ("js constant" "Object.prototype.toString.call") process)) "[object process]" true @@ -356,8 +356,8 @@ false)) (template: #export (closure <inputs> <output>) - (.:coerce ..Function - (`` ("js function" - (~~ (template.count <inputs>)) - (.function (_ [<inputs>]) - <output>))))) + (.:as ..Function + (`` ("js function" + (~~ (template.count <inputs>)) + (.function (_ [<inputs>]) + <output>))))) diff --git a/stdlib/source/lux/ffi.jvm.lux b/stdlib/source/lux/ffi.jvm.lux index c6187e73b..b9f1a3b7e 100644 --- a/stdlib/source/lux/ffi.jvm.lux +++ b/stdlib/source/lux/ffi.jvm.lux @@ -1323,8 +1323,8 @@ class_type (` (.primitive (~ (code.text class_name)))) check_type (` (.Maybe (~ class_type))) check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked)) - (#.Some (.:coerce (~ class_type) - (~ g!unchecked))) + (#.Some (.:as (~ class_type) + (~ g!unchecked))) #.None))] (case unchecked (#.Some unchecked) @@ -1424,8 +1424,8 @@ ## else (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] (` (let [(~ g!temp) (~ return_term)] - (if (not (..null? (:coerce (primitive "java.lang.Object") - (~ g!temp)))) + (if (not (..null? (:as (primitive "java.lang.Object") + (~ g!temp)))) (~ g!temp) (error! "Cannot produce null references from method calls.")))))) @@ -1489,29 +1489,29 @@ (` (.|> (~ unboxed/boxed) (~+ post))))))] [#1 auto_convert_input ..unbox - [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []] - [type.byte type.byte (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_byte)) []] - [type.short type.short (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_short)) []] - [type.int type.int (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_int)) []] - [type.long type.long (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []] - [type.float type.float (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double))))) (` ..double_to_float)) []] - [type.double type.double (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []] - [..$String ..$String (list (` (.: .Text)) (` (.:coerce (.primitive (~ (code.text (..reflection ..$String))))))) []] - [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []] - [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []] - [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []]]] + [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []] + [type.byte type.byte (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_byte)) []] + [type.short type.short (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_short)) []] + [type.int type.int (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_int)) []] + [type.long type.long (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long)))))) []] + [type.float type.float (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double))))) (` ..double_to_float)) []] + [type.double type.double (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double)))))) []] + [..$String ..$String (list (` (.: .Text)) (` (.:as (.primitive (~ (code.text (..reflection ..$String))))))) []] + [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []] + [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long)))))) []] + [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double)))))) []]]] [#0 auto_convert_output ..box - [[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:coerce .Bit))]] - [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]] - [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]] - [type.int type.long (list (` "jvm conversion int-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]] - [type.long type.long (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]] - [type.float type.double (list (` "jvm conversion float-to-double")) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]] - [type.double type.double (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]] - [..$String ..$String (list) [(` (.: (.primitive (~ (code.text (..reflection ..$String)))))) (` (.:coerce .Text))]] - [(type.class box.boolean (list)) (type.class box.boolean (list)) (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:coerce .Bit))]] - [(type.class box.long (list)) (type.class box.long (list)) (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]] - [(type.class box.double (list)) (type.class box.double (list)) (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]]] + [[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]] + [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]] + [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]] + [type.int type.long (list (` "jvm conversion int-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]] + [type.long type.long (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]] + [type.float type.double (list (` "jvm conversion float-to-double")) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:as .Frac))]] + [type.double type.double (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:as .Frac))]] + [..$String ..$String (list) [(` (.: (.primitive (~ (code.text (..reflection ..$String)))))) (` (.:as .Text))]] + [(type.class box.boolean (list)) (type.class box.boolean (list)) (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]] + [(type.class box.long (list)) (type.class box.long (list)) (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]] + [(type.class box.double (list)) (type.class box.double (list)) (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:as .Frac))]]]] ) (def: (un_quote quoted) @@ -1689,11 +1689,11 @@ (|>> ("jvm member invoke virtual" [] "java.lang.Class" "isInterface" []) "jvm object cast" (: ..Boolean) - (:coerce Bit))) + (:as Bit))) (def: load_class (-> External (Try (primitive "java.lang.Class" [Any]))) - (|>> (:coerce (primitive "java.lang.String")) + (|>> (:as (primitive "java.lang.String")) ["Ljava/lang/String;"] ("jvm member invoke static" [] "java.lang.Class" "forName" []) try)) @@ -1780,7 +1780,7 @@ (array java/lang/Object 10))} (let [g!size (` (|> (~ size) (.: .Nat) - (.:coerce (.primitive (~ (code.text box.long)))) + (.:as (.primitive (~ (code.text box.long)))) "jvm object cast" "jvm conversion long-to-int"))] (`` (cond (~~ (template [<primitive> <array_op>] @@ -1923,7 +1923,7 @@ "jvm conversion int-to-long" "jvm object cast" (.: (.primitive (~ (code.text box.long)))) - (.:coerce .Nat)))))) + (.:as .Nat)))))) _ (with_gensyms [g!array] @@ -1940,7 +1940,7 @@ array_jvm_type (lux_type->jvm_type array_type) #let [g!idx (` (.|> (~ idx) (.: .Nat) - (.:coerce (.primitive (~ (code.text box.long)))) + (.:as (.primitive (~ (code.text box.long)))) "jvm object cast" "jvm conversion long-to-int"))]] (`` (cond (~~ (template [<primitive> <extension> <box>] @@ -1978,7 +1978,7 @@ array_jvm_type (lux_type->jvm_type array_type) #let [g!idx (` (.|> (~ idx) (.: .Nat) - (.:coerce (.primitive (~ (code.text box.long)))) + (.:as (.primitive (~ (code.text box.long)))) "jvm object cast" "jvm conversion long-to-int"))]] (`` (cond (~~ (template [<primitive> <extension> <box>] @@ -1986,7 +1986,7 @@ (type.array <primitive>) array_jvm_type) (let [g!value (` (.|> (~ value) - (.:coerce (.primitive (~ (code.text <box>)))) + (.:as (.primitive (~ (code.text <box>)))) "jvm object cast"))] (wrap (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))] @@ -2020,8 +2020,8 @@ ["Signature" (..signature type)] ["Reflection" (..reflection type)])) -(syntax: #export (:as {type (..type^ (list))} - object) +(syntax: #export (:cast {type (..type^ (list))} + object) (case [(parser.array? type) (parser.class? type)] (^or [(#.Some _) _] [_ (#.Some _)]) diff --git a/stdlib/source/lux/ffi.lua.lux b/stdlib/source/lux/ffi.lua.lux index 946c6153a..61ee5b35c 100644 --- a/stdlib/source/lux/ffi.lua.lux +++ b/stdlib/source/lux/ffi.lua.lux @@ -7,7 +7,7 @@ [control ["." io] ["<>" parser ("#\." monad) - ["<code>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data ["." product] ["." maybe] @@ -208,7 +208,7 @@ (with_try try?) (without_nil g!temp outputT) (` ("lua apply" - (:coerce ..Function (~ source)) + (:as ..Function (~ source)) (~+ (list\map (with_nil g!temp) g!inputs))))))))))) (syntax: #export (import: {import ..import}) @@ -228,7 +228,7 @@ (#.Cons head tail) (list\fold (function (_ sub super) (` ("lua object get" (~ (code.text sub)) - (:coerce (..Object .Any) (~ super))))) + (:as (..Object .Any) (~ super))))) (` ("lua import" (~ (code.text head)))) tail) @@ -242,16 +242,16 @@ (if static? (` ((~! syntax:) ((~ (qualify field))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nilable_type fieldT)) - ("lua object get" (~ (code.text field)) - (:coerce (..Object .Any) (~ imported))))))))) + (list (` (.:as (~ (nilable_type fieldT)) + ("lua object get" (~ (code.text field)) + (:as (..Object .Any) (~ imported))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) (~ (nilable_type fieldT))) (:assume (~ (without_nil g!temp fieldT (` ("lua object get" (~ (code.text field)) - (:coerce (..Object .Any) (~ g!object)))))))))) + (:as (..Object .Any) (~ g!object)))))))))) (#Method method) (case method @@ -259,7 +259,7 @@ (..make_function (qualify (maybe.default method alias)) g!temp (` ("lua object get" (~ (code.text method)) - (:coerce (..Object .Any) (~ imported)))) + (:as (..Object .Any) (~ imported)))) inputsT io? try? @@ -297,13 +297,13 @@ (#Constant [_ name fieldT]) (wrap (list (` ((~! syntax:) ((~ (code.local_identifier name))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nilable_type fieldT)) - ("lua constant" (~ (code.text (text.replace_all "/" "." name)))))))))))) + (list (` (.:as (~ (nilable_type fieldT)) + ("lua constant" (~ (code.text (text.replace_all "/" "." name)))))))))))) ))) (template: #export (closure <inputs> <output>) - (.:coerce ..Function - (`` ("lua function" - (~~ (template.count <inputs>)) - (.function (_ [<inputs>]) - <output>))))) + (.:as ..Function + (`` ("lua function" + (~~ (template.count <inputs>)) + (.function (_ [<inputs>]) + <output>))))) diff --git a/stdlib/source/lux/ffi.old.lux b/stdlib/source/lux/ffi.old.lux index aa3252fc3..b5aac71bd 100644 --- a/stdlib/source/lux/ffi.old.lux +++ b/stdlib/source/lux/ffi.old.lux @@ -1321,8 +1321,8 @@ class_type (` (.primitive (~ (code.text class_name)))) check_type (` (.Maybe (~ class_type))) check_code (` (if ((~ (code.text (format "jvm instanceof" ":" class_name))) (~ g!unchecked)) - (#.Some (.:coerce (~ class_type) - (~ g!unchecked))) + (#.Some (.:as (~ class_type) + (~ g!unchecked))) #.None))] (case unchecked (#.Some unchecked) @@ -1416,8 +1416,8 @@ (` (??? (~ return_term))) (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] (` (let [(~ g!temp) (~ return_term)] - (if (not (..null? (:coerce (primitive "java.lang.Object") - (~ g!temp)))) + (if (not (..null? (:as (primitive "java.lang.Object") + (~ g!temp)))) (~ g!temp) (error! (~ (code.text (format "Cannot produce null references from method calls @ " (get@ #class_name class) diff --git a/stdlib/source/lux/ffi.php.lux b/stdlib/source/lux/ffi.php.lux index e26464f7a..08a837c44 100644 --- a/stdlib/source/lux/ffi.php.lux +++ b/stdlib/source/lux/ffi.php.lux @@ -228,7 +228,7 @@ (with_try try?) (without_null g!temp outputT) (` ("php apply" - (:coerce ..Function (~ source)) + (:as ..Function (~ source)) (~+ (list\map (with_null g!temp) g!inputs))))))))))) (syntax: #export (import: {import ..import}) @@ -252,15 +252,15 @@ (if static? (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nullable_type fieldT)) - ("php constant" (~ (code.text (%.format class "::" field)))))))))) + (list (` (.:as (~ (nullable_type fieldT)) + ("php constant" (~ (code.text (%.format class "::" field)))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) (~ (nullable_type fieldT))) (:assume (~ (without_null g!temp fieldT (` ("php object get" (~ (code.text field)) - (:coerce (..Object .Any) (~ g!object)))))))))) + (:as (..Object .Any) (~ g!object)))))))))) (#Method method) (case method @@ -268,8 +268,8 @@ (..make_function (qualify (maybe.default method alias)) g!temp (` ("php object get" (~ (code.text method)) - (:coerce (..Object .Any) - ("php constant" (~ (code.text (%.format class "::" method))))))) + (:as (..Object .Any) + ("php constant" (~ (code.text (%.format class "::" method))))))) inputsT io? try? @@ -309,5 +309,5 @@ (let [imported (` ("php constant" (~ (code.text name))))] (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nullable_type fieldT)) (~ imported)))))))))) + (list (` (.:as (~ (nullable_type fieldT)) (~ imported)))))))))) ))) diff --git a/stdlib/source/lux/ffi.py.lux b/stdlib/source/lux/ffi.py.lux index bf8e5facf..396cebf5c 100644 --- a/stdlib/source/lux/ffi.py.lux +++ b/stdlib/source/lux/ffi.py.lux @@ -7,7 +7,7 @@ [control ["." io] ["<>" parser - ["<code>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data ["." product] ["." maybe] @@ -208,7 +208,7 @@ (with_try try?) (without_none g!temp outputT) (` ("python apply" - (:coerce ..Function (~ source)) + (:as ..Function (~ source)) (~+ (list\map (with_none g!temp) g!inputs))))))))))) (syntax: #export (import: {import ..import}) @@ -228,7 +228,7 @@ (#.Cons head tail) (list\fold (function (_ sub super) (` ("python object get" (~ (code.text sub)) - (:coerce (..Object .Any) (~ super))))) + (:as (..Object .Any) (~ super))))) (` ("python import" (~ (code.text head)))) tail) @@ -246,23 +246,23 @@ (~ g!type)) (:assume ("python apply" - (:coerce ..Function (~ imported)) + (:as ..Function (~ imported)) (~+ (list\map (with_none g!temp) g!inputs))))))) (#Field [static? field fieldT]) (if static? (` ((~! syntax:) ((~ (qualify field))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (noneable_type fieldT)) - ("python object get" (~ (code.text field)) - (:coerce (..Object .Any) (~ imported))))))))) + (list (` (.:as (~ (noneable_type fieldT)) + ("python object get" (~ (code.text field)) + (:as (..Object .Any) (~ imported))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) (~ (noneable_type fieldT))) (:assume (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) - (:coerce (..Object .Any) (~ g!object)))))))))) + (:as (..Object .Any) (~ g!object)))))))))) (#Method method) (case method @@ -270,7 +270,7 @@ (..make_function (qualify (maybe.default method alias)) g!temp (` ("python object get" (~ (code.text method)) - (:coerce (..Object .Any) (~ imported)))) + (:as (..Object .Any) (~ imported)))) inputsT io? try? @@ -307,8 +307,8 @@ ))) (template: #export (lambda <inputs> <output>) - (.:coerce ..Function - (`` ("python function" - (~~ (template.count <inputs>)) - (.function (_ [<inputs>]) - <output>))))) + (.:as ..Function + (`` ("python function" + (~~ (template.count <inputs>)) + (.function (_ [<inputs>]) + <output>))))) diff --git a/stdlib/source/lux/ffi.rb.lux b/stdlib/source/lux/ffi.rb.lux index 4cbc50172..df71dcc18 100644 --- a/stdlib/source/lux/ffi.rb.lux +++ b/stdlib/source/lux/ffi.rb.lux @@ -221,7 +221,7 @@ (with_try try?) (without_nil g!temp outputT) (` ("ruby apply" - (:coerce ..Function (~ source)) + (:as ..Function (~ source)) (~+ (list\map (with_nil g!temp) g!inputs))))))))))) (syntax: #export (import: {[?module import] ..import}) @@ -252,17 +252,17 @@ (if static? (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nilable_type fieldT)) - (.exec - (~+ module_import) - ("ruby constant" (~ (code.text (%.format class "::" field))))))))))) + (list (` (.:as (~ (nilable_type fieldT)) + (.exec + (~+ module_import) + ("ruby constant" (~ (code.text (%.format class "::" field))))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) (~ (nilable_type fieldT))) (:assume (~ (without_nil g!temp fieldT (` ("ruby object get" (~ (code.text field)) - (:coerce (..Object .Any) (~ g!object)))))))))) + (:as (..Object .Any) (~ g!object)))))))))) (#Method method) (case method @@ -270,10 +270,10 @@ (..make_function (qualify (maybe.default method alias)) g!temp (` ("ruby object get" (~ (code.text method)) - (:coerce (..Object .Any) - (.exec - (~+ module_import) - ("ruby constant" (~ (code.text (%.format class "::" method)))))))) + (:as (..Object .Any) + (.exec + (~+ module_import) + ("ruby constant" (~ (code.text (%.format class "::" method)))))))) inputsT io? try? @@ -327,5 +327,5 @@ ("ruby constant" (~ (code.text name)))))] (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nilable_type fieldT)) (~ imported)))))))))) + (list (` (.:as (~ (nilable_type fieldT)) (~ imported)))))))))) ))) diff --git a/stdlib/source/lux/ffi.scm.lux b/stdlib/source/lux/ffi.scm.lux index 1dde8ab69..c6c447b72 100644 --- a/stdlib/source/lux/ffi.scm.lux +++ b/stdlib/source/lux/ffi.scm.lux @@ -1,7 +1,7 @@ (.module: [lux (#- Alias) - ["." meta] ["@" target] + ["." meta] [abstract [monad (#+ do)]] [control @@ -195,7 +195,7 @@ (with_try try?) (without_nil g!temp outputT) (` ("scheme apply" - (:coerce ..Function (~ source)) + (:as ..Function (~ source)) (~+ (list\map (with_nil g!temp) g!inputs))))))))))) (syntax: #export (import: {import ..import}) @@ -215,5 +215,5 @@ (let [imported (` ("scheme constant" (~ (code.text name))))] (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nilable_type fieldT)) (~ imported)))))))))) + (list (` (.:as (~ (nilable_type fieldT)) (~ imported)))))))))) ))) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index e5a9ff9ef..1b83d179a 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -27,7 +27,7 @@ [?macro (//.find_macro name)] (case ?macro (#.Some macro) - ((:coerce Macro' macro) args) + ((:as Macro' macro) args) #.None (\ //.monad wrap (list syntax)))) @@ -46,7 +46,7 @@ (case ?macro (#.Some macro) (do //.monad - [expansion ((:coerce Macro' macro) args) + [expansion ((:as Macro' macro) args) expansion' (monad.map //.monad expand expansion)] (wrap (list\join expansion'))) @@ -66,7 +66,7 @@ (case ?macro (#.Some macro) (do //.monad - [expansion ((:coerce Macro' macro) args) + [expansion ((:as Macro' macro) args) expansion' (monad.map //.monad expand_all expansion)] (wrap (list\join expansion'))) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index e8f1433c1..c7e709578 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -43,14 +43,14 @@ @.jvm (as_is (template: (!double value) (|> value - (:coerce (primitive "java.lang.Double")) + (:as (primitive "java.lang.Double")) "jvm object cast")) (template: (!frac value) (|> value "jvm object cast" (: (primitive "java.lang.Double")) - (:coerce Frac))) + (:as Frac))) (template [<name> <method>] [(def: #export <name> @@ -89,7 +89,7 @@ [(def: #export <name> (-> Frac Frac) (|>> ("js apply" ("js constant" <method>)) - (:coerce Frac)))] + (:as Frac)))] [cos "Math.cos"] [sin "Math.sin"] @@ -111,14 +111,14 @@ (def: #export (pow param subject) (-> Frac Frac Frac) - (:coerce Frac ("js apply" ("js constant" "Math.pow") subject param)))) + (:as Frac ("js apply" ("js constant" "Math.pow") subject param)))) @.python (as_is (template [<name> <method>] [(def: #export <name> (-> Frac Frac) (|>> ("python object do" <method> ("python import" "math")) - (:coerce Frac)))] + (:as Frac)))] [cos "cos"] [sin "sin"] @@ -139,7 +139,7 @@ (def: #export (pow param subject) (-> Frac Frac Frac) - (:coerce Frac ("python object do" "pow" ("python import" "math") subject param))) + (:as Frac ("python object do" "pow" ("python import" "math") subject param))) (def: #export root/3 (-> Frac Frac) @@ -150,7 +150,7 @@ [(def: #export <name> (-> Frac Frac) (|>> ("lua apply" ("lua constant" <method>)) - (:coerce Frac)))] + (:as Frac)))] [cos "math.cos"] [sin "math.sin"] @@ -182,7 +182,7 @@ [(def: #export <name> (-> Frac Frac) (|>> ("ruby apply" ("ruby constant" <method>)) - (:coerce Frac)))] + (:as Frac)))] [cos "Math.cos"] [sin "Math.sin"] @@ -203,7 +203,7 @@ [(def: #export <name> (-> Frac Frac) (|>> ("ruby object do" <method>) - (:coerce Int) + (:as Int) ("lux i64 f64")))] [ceil "ceil"] @@ -212,14 +212,14 @@ (def: #export (pow param subject) (-> Frac Frac Frac) - (:coerce Frac ("ruby object do" "**" subject param)))) + (:as Frac ("ruby object do" "**" subject param)))) @.php (as_is (template [<name> <method>] [(def: #export <name> (-> Frac Frac) (|>> ("php apply" ("php constant" <method>)) - (:coerce Frac)))] + (:as Frac)))] [cos "cos"] [sin "sin"] @@ -240,7 +240,7 @@ (def: #export (pow param subject) (-> Frac Frac Frac) - (:coerce Frac ("php apply" ("php constant" "pow") subject param))) + (:as Frac ("php apply" ("php constant" "pow") subject param))) (def: #export root/3 (-> Frac Frac) @@ -251,7 +251,7 @@ [(def: #export <name> (-> Frac Frac) (|>> ("scheme apply" ("scheme constant" <method>)) - (:coerce Frac)))] + (:as Frac)))] [cos "cos"] [sin "sin"] @@ -272,7 +272,7 @@ (def: #export (pow param subject) (-> Frac Frac Frac) - (:coerce Frac ("scheme apply" ("scheme constant" "expt") subject param))) + (:as Frac ("scheme apply" ("scheme constant" "expt") subject param))) (def: #export root/3 (-> Frac Frac) diff --git a/stdlib/source/lux/math/number/i64.lux b/stdlib/source/lux/math/number/i64.lux index 9d36e3bb1..a3b415287 100644 --- a/stdlib/source/lux/math/number/i64.lux +++ b/stdlib/source/lux/math/number/i64.lux @@ -100,7 +100,7 @@ (def: #export (set? idx input) (-> Nat (I64 Any) Bit) - (|> input (:coerce I64) (..and (..bit idx)) (n.= 0) .not)) + (|> input (:as I64) (..and (..bit idx)) (n.= 0) .not)) (def: #export (clear? idx input) (-> Nat (I64 Any) Bit) diff --git a/stdlib/source/lux/math/number/nat.lux b/stdlib/source/lux/math/number/nat.lux index 01a8cff2e..248c169ba 100644 --- a/stdlib/source/lux/math/number/nat.lux +++ b/stdlib/source/lux/math/number/nat.lux @@ -81,25 +81,25 @@ (def: #export (* parameter subject) {#.doc "Nat(ural) multiplication."} (-> Nat Nat Nat) - ("lux coerce" Nat - ("lux i64 *" - ("lux coerce" Int parameter) - ("lux coerce" Int subject)))) + (:as Nat + ("lux i64 *" + (:as Int parameter) + (:as Int subject)))) (def: #export (/ parameter subject) {#.doc "Nat(ural) division."} (-> Nat Nat Nat) - (if ("lux i64 <" +0 ("lux coerce" Int parameter)) + (if ("lux i64 <" +0 (:as Int parameter)) (if (..< parameter subject) 0 1) (let [quotient (|> subject ("lux i64 right-shift" 1) - ("lux i64 /" ("lux coerce" Int parameter)) + ("lux i64 /" (:as Int parameter)) ("lux i64 left-shift" 1)) flat ("lux i64 *" - ("lux coerce" Int parameter) - ("lux coerce" Int quotient)) + (:as Int parameter) + (:as Int quotient)) remainder ("lux i64 -" flat subject)] (if (..< parameter remainder) quotient @@ -110,16 +110,16 @@ (-> Nat Nat [Nat Nat]) (let [quotient (../ parameter subject) flat ("lux i64 *" - ("lux coerce" Int parameter) - ("lux coerce" Int quotient))] + (:as Int parameter) + (:as Int quotient))] [quotient ("lux i64 -" flat subject)])) (def: #export (% parameter subject) {#.doc "Nat(ural) remainder."} (-> Nat Nat Nat) (let [flat ("lux i64 *" - ("lux coerce" Int parameter) - ("lux coerce" Int (../ parameter subject)))] + (:as Int parameter) + (:as Int (../ parameter subject)))] ("lux i64 -" flat subject))) (def: #export (gcd a b) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index b9105fa45..a6877765b 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -179,7 +179,7 @@ (#.Definition [exported? def_type def_anns def_value]) (if (macro_type? def_type) - (#.Some (:coerce Macro def_value)) + (#.Some (:as Macro def_value)) #.None)))) (def: #export (find_macro full_name) @@ -386,7 +386,7 @@ (\ code.equivalence = (type_to_code .Type) (type_to_code def_type))) - (wrap (:coerce Type def_value)) + (wrap (:as Type def_value)) (..fail ($_ text\compose "Definition is not a type: " (name\encode name)))))))) (def: #export (globals module) diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index 503970d6a..551b51087 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -154,7 +154,7 @@ (def: #export monad (Monad Bytecode) - (<| (:coerce (Monad Bytecode)) + (<| (:as (Monad Bytecode)) (writer.with ..relative_monoid) (: (Monad (State' Try [Pool Environment Tracker]))) state.with @@ -508,17 +508,17 @@ (-> java/lang/Float Int) (|>> java/lang/Float::floatToRawIntBits ffi.int_to_long - (:coerce Int))) + (:as Int))) (def: negative_zero_float_bits - (|> -0.0 (:coerce java/lang/Double) ffi.double_to_float ..float_bits)) + (|> -0.0 (:as java/lang/Double) ffi.double_to_float ..float_bits)) (def: #export (float value) (-> java/lang/Float (Bytecode Any)) (if (i.= ..negative_zero_float_bits (..float_bits value)) (..arbitrary_float value) - (case (|> value ffi.float_to_double (:coerce Frac)) + (case (|> value ffi.float_to_double (:as Frac)) (^template [<special> <instruction>] [<special> (..bytecode $0 $1 @_ <instruction> [])]) ([+0.0 _.fconst_0] @@ -548,23 +548,23 @@ (def: (arbitrary_double value) (-> java/lang/Double (Bytecode Any)) (do ..monad - [index (..lift (//constant/pool.double (//constant.double (:coerce Frac value))))] + [index (..lift (//constant/pool.double (//constant.double (:as Frac value))))] (..bytecode $0 $2 @_ _.ldc2_w/double [index]))) (def: double_bits (-> java/lang/Double Int) (|>> java/lang/Double::doubleToRawLongBits - (:coerce Int))) + (:as Int))) (def: negative_zero_double_bits - (..double_bits (:coerce java/lang/Double -0.0))) + (..double_bits (:as java/lang/Double -0.0))) (def: #export (double value) (-> java/lang/Double (Bytecode Any)) (if (i.= ..negative_zero_double_bits (..double_bits value)) (..arbitrary_double value) - (case (:coerce Frac value) + (case (:as Frac value) (^template [<special> <instruction>] [<special> (..bytecode $0 $2 @_ <instruction> [])]) ([+0.0 _.dconst_0] diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux index d0280cb27..651f667ee 100644 --- a/stdlib/source/lux/target/jvm/constant.lux +++ b/stdlib/source/lux/target/jvm/constant.lux @@ -118,7 +118,7 @@ (~~ (template.splice <writer>)))))] [integer_writer Integer [] [binaryF.bits/32]] - [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:coerce I64)] [i32.i32 binaryF.bits/32]] + [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]] [long_writer Long [] [binaryF.bits/64]] [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] [string_writer String [] [//index.writer]] diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index 755f9526e..4ca391382 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -66,33 +66,33 @@ (def: java/lang/ClassLoader::defineClass java/lang/reflect/Method (let [signature (|> (ffi.array <elemT> 4) - (ffi.array_write 0 (:coerce <elemT> - (ffi.class_for java/lang/String))) + (ffi.array_write 0 (:as <elemT> + (ffi.class_for java/lang/String))) (ffi.array_write 1 (java/lang/Object::getClass (ffi.array byte 0))) - (ffi.array_write 2 (:coerce <elemT> - (java/lang/Integer::TYPE))) - (ffi.array_write 3 (:coerce <elemT> - (java/lang/Integer::TYPE))))] + (ffi.array_write 2 (:as <elemT> + (java/lang/Integer::TYPE))) + (ffi.array_write 3 (:as <elemT> + (java/lang/Integer::TYPE))))] (do_to (java/lang/Class::getDeclaredMethod "defineClass" signature (ffi.class_for java/lang/ClassLoader)) - (java/lang/reflect/AccessibleObject::setAccessible true))))) + (java/lang/reflect/AccessibleObject::setAccessible true))))) (def: #export (define class_name bytecode loader) (-> Text Binary java/lang/ClassLoader (Try java/lang/Object)) - (let [signature (array.from_list (list (:coerce java/lang/Object - class_name) - (:coerce java/lang/Object - bytecode) - (:coerce java/lang/Object - (|> 0 - (:coerce (primitive "java.lang.Long")) - ffi.long_to_int)) - (:coerce java/lang/Object - (|> bytecode - binary.size - (:coerce (primitive "java.lang.Long")) - ffi.long_to_int))))] + (let [signature (array.from_list (list (:as java/lang/Object + class_name) + (:as java/lang/Object + bytecode) + (:as java/lang/Object + (|> 0 + (:as (primitive "java.lang.Long")) + ffi.long_to_int)) + (:as java/lang/Object + (|> bytecode + binary.size + (:as (primitive "java.lang.Long")) + ffi.long_to_int))))] (java/lang/reflect/Method::invoke loader signature java/lang/ClassLoader::defineClass))) (def: #export (new_library _) @@ -112,7 +112,7 @@ (java/lang/ClassLoader (findClass self {class_name java/lang/String}) (java/lang/Class [? < java/lang/Object]) #throws [java/lang/ClassNotFoundException] - (let [class_name (:coerce Text class_name) + (let [class_name (:as Text class_name) classes (|> library atom.read io.run)] (case (dictionary.get class_name classes) (#.Some bytecode) diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 07afd5df0..02c6b0ab0 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -145,7 +145,7 @@ (<| (case (ffi.check java/lang/Class reflection) (#.Some class) (let [class_name (|> class - (:coerce (java/lang/Class java/lang/Object)) + (:as (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (`` (if (or (~~ (template [<reflection>] [(text\= (/reflection.reflection <reflection>) @@ -174,7 +174,7 @@ array.to_list (monad.map ! parameter))] (wrap (/.class (|> raw - (:coerce (java/lang/Class java/lang/Object)) + (:as (java/lang/Class java/lang/Object)) java/lang/Class::getName) paramsT))) @@ -224,7 +224,7 @@ (<| (case (ffi.check java/lang/Class reflection) (#.Some reflection) (let [class_name (|> reflection - (:coerce (java/lang/Class java/lang/Object)) + (:as (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (`` (cond (~~ (template [<reflection> <type>] [(text\= (/reflection.reflection <reflection>) @@ -259,7 +259,7 @@ (case (ffi.check java/lang/Class reflection) (#.Some class) (let [class_name (|> reflection - (:coerce (java/lang/Class java/lang/Object)) + (:as (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (if (text\= (/reflection.reflection /reflection.void) class_name) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index 38645ef06..0e3d9be92 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -170,8 +170,8 @@ [..float] [..double] [..char])))) - (|> type (:coerce (Type Primitive)) #.Right) - (|> type (:coerce (Type Object)) #.Left))) + (|> type (:as (Type Primitive)) #.Right) + (|> type (:as (Type Object)) #.Left))) (def: #export (void? type) (-> (Type Return) (Either (Type Value) @@ -180,8 +180,8 @@ [(\ ..equivalence = (: (Type Return) <type>) type)] [..void])))) - (|> type (:coerce (Type Void)) #.Right) - (|> type (:coerce (Type Value)) #.Left))) + (|> type (:as (Type Void)) #.Right) + (|> type (:as (Type Value)) #.Left))) ) (def: #export (class? type) diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 8554f48bf..c4e03914f 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -40,9 +40,9 @@ (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] (for {@.old (|>> (format text.new_line) - (:coerce java/lang/String) - (java/lang/String::replace (:coerce java/lang/CharSequence text.new_line) - (:coerce java/lang/CharSequence nested_new_line)))} + (:as java/lang/String) + (java/lang/String::replace (:as java/lang/CharSequence text.new_line) + (:as java/lang/CharSequence nested_new_line)))} (|>> (format text.new_line) (text.replace_all text.new_line nested_new_line))))) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 88171fd9f..2b7d657d0 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -10,7 +10,7 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] ["<>" parser - ["<t>" text (#+ Parser)]]] + ["<text>" text (#+ Parser)]]] [data ["." maybe] ["." text ("#\." monoid)] @@ -137,13 +137,13 @@ (def: parse_section (Parser Nat) - (<>.codec n.decimal (<t>.exactly 2 <t>.decimal))) + (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))) (def: parse_millis (Parser Nat) - (<>.either (|> (<t>.at_most 3 <t>.decimal) + (<>.either (|> (<text>.at_most 3 <text>.decimal) (<>.codec n.decimal) - (<>.after (<t>.this "."))) + (<>.after (<text>.this "."))) (\ <>.monad wrap 0))) (template [<minimum> <maximum> <parser> <exception>] @@ -169,9 +169,9 @@ (Parser Date) (do <>.monad [utc_year //year.parser - _ (<t>.this ..separator) + _ (<text>.this ..separator) utc_month ..parse_month - _ (<t>.this ..separator) + _ (<text>.this ..separator) #let [month (maybe.assume (dictionary.get utc_month ..month_by_number))] utc_day ..parse_section] (<>.lift (..date utc_year month utc_day)))) @@ -189,7 +189,7 @@ (Codec Text Date) (def: encode ..encode) - (def: decode (<t>.run ..parser))) + (def: decode (<text>.run ..parser))) (def: days_per_leap (|> //year.days @@ -273,7 +273,7 @@ (def: (civil_year utc_month utc_year) (-> Nat Year Int) (let [## Coercing, because the year is already in external form. - utc_year (:coerce Int utc_year)] + utc_year (:as Int utc_year)] (if (n.< ..first_month_of_civil_year utc_month) (dec utc_year) utc_year))) @@ -331,7 +331,7 @@ (inc year) year)] ## Coercing, because the year is already in internal form. - (try.assume (..date (:coerce Year year) + (try.assume (..date (:as Year year) (maybe.assume (dictionary.get month ..month_by_number)) day)))) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 61cadce14..05f54b30b 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -12,7 +12,7 @@ ["." try] ["." exception (#+ exception:)] ["<>" parser - ["<t>" text (#+ Parser)]]] + ["<.>" text (#+ Parser)]]] [data ["." maybe] ["." text ("#\." monoid)] @@ -132,9 +132,9 @@ (Parser Instant) (do {! <>.monad} [days (\ ! map date.to_days date.parser) - _ (<t>.this ..date_suffix) + _ (<text>.this ..date_suffix) time (\ ! map //.to_millis //.parser) - _ (<t>.this ..time_suffix)] + _ (<text>.this ..time_suffix)] (wrap (|> (if (i.< +0 days) (|> duration.day (duration.up (.nat (i.* -1 days))) @@ -149,7 +149,7 @@ (Codec Text Instant) (def: encode ..encode) - (def: decode (<t>.run ..parser))) + (def: decode (<text>.run ..parser))) (def: #export now (IO Instant) @@ -157,38 +157,38 @@ @.jvm (|> ("jvm member invoke static" [] "java.lang.System" "currentTimeMillis" []) ("jvm object cast") (: (primitive "java.lang.Long")) - (:coerce Int)) + (:as Int)) @.js (let [date ("js object new" ("js constant" "Date") [])] (|> ("js object do" "getTime" date []) - (:coerce Frac) + (:as Frac) "lux f64 i64")) @.python (let [time ("python import" "time")] (|> ("python object do" "time" time) - (:coerce Frac) + (:as Frac) (f.* +1,000.0) "lux f64 i64")) @.lua (|> ("lua constant" "os.time") "lua apply" - (:coerce Int) + (:as Int) (i.* +1,000)) @.ruby (let [% ("ruby constant" "Time") % ("ruby object do" "now" %)] (|> ("ruby object do" "to_f" %) - (:coerce Frac) + (:as Frac) (f.* +1,000.0) "lux f64 i64")) @.php (|> ("php constant" "time") "php apply" - (:coerce Int) + (:as Int) (i.* +1,000)) @.scheme (|> ("scheme constant" "current-second") - (:coerce Int) + (:as Int) (i.* +1,000) ("scheme apply" ("scheme constant" "exact")) ("scheme apply" ("scheme constant" "truncate"))) @.common_lisp (|> ("common_lisp constant" "get-universal-time") "common_lisp apply" - (:coerce Int) + (:as Int) (i.* +1,000)) })))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 1e7f643ac..605f1d1e2 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -80,8 +80,8 @@ ## TODO: Get rid of this (def: monad - (:coerce (Monad Action) - (try.with promise.monad))) + (:as (Monad Action) + (try.with promise.monad))) (with_expansions [<Platform> (as_is (Platform <type_vars>)) <State+> (as_is (///directive.State+ <type_vars>)) @@ -498,7 +498,7 @@ #extension.state] (function (_ analysis_state) (|> analysis_state - (:coerce .Lux) + (:as .Lux) (update@ #.modules (function (_ current) (list\compose (list.filter (|>> product.left (set.member? additions) @@ -539,7 +539,7 @@ (get@ #static.host_module_extension static) module)] (loop [[archive state] [archive state] - compilation (base_compiler (:coerce ///.Input input)) + compilation (base_compiler (:as ///.Input input)) all_dependencies (: (List Module) (list))] (let [new_dependencies (get@ #///.dependencies compilation) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index f48155088..41fad7934 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -5,7 +5,7 @@ ["." monad (#+ do)]] [control ["." try] - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data ["." product] ["." maybe] @@ -34,23 +34,26 @@ ["#" phase]]]]]]) (exception: #export (cannot_match_with_pattern {type Type} {pattern Code}) - (ex.report ["Type" (%.type type)] - ["Pattern" (%.code pattern)])) + (exception.report + ["Type" (%.type type)] + ["Pattern" (%.code pattern)])) (exception: #export (sum_has_no_case {case Nat} {type Type}) - (ex.report ["Case" (%.nat case)] - ["Type" (%.type type)])) + (exception.report + ["Case" (%.nat case)] + ["Type" (%.type type)])) (exception: #export (not_a_pattern {code Code}) - (ex.report ["Code" (%.code code)])) + (exception.report ["Code" (%.code code)])) (exception: #export (cannot_simplify_for_pattern_matching {type Type}) - (ex.report ["Type" (%.type type)])) + (exception.report ["Type" (%.type type)])) (exception: #export (non_exhaustive_pattern_matching {input Code} {branches (List [Code Code])} {coverage Coverage}) - (ex.report ["Input" (%.code input)] - ["Branches" (%.code (code.record branches))] - ["Coverage" (/coverage.%coverage coverage)])) + (exception.report + ["Input" (%.code input)] + ["Branches" (%.code (code.record branches))] + ["Coverage" (/coverage.%coverage coverage)])) (exception: #export (cannot_have_empty_branches {message Text}) message) @@ -209,8 +212,8 @@ (Operation [(List Pattern) a]))) (function (_ [memberT memberC] then) (do ! - [[memberP [memberP+ thenA]] ((:coerce (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) - analyse_pattern) + [[memberP [memberP+ thenA]] ((:as (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + analyse_pattern) #.None memberT memberC then)] (wrap [(list& memberP memberP+) thenA])))) (do ! diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 0c88ae795..66ef65e71 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -873,7 +873,7 @@ #.None (if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers from_class)) - (#.Cons (:coerce java/lang/reflect/Type (ffi.class_for java/lang/Object)) + (#.Cons (:as java/lang/reflect/Type (ffi.class_for java/lang/Object)) (array.to_list (java/lang/Class::getGenericInterfaces from_class))) (array.to_list (java/lang/Class::getGenericInterfaces from_class))))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 8c5cbcd09..a86295b2a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -157,14 +157,14 @@ _ (////analysis.throw ///.invalid_syntax [extension_name %.code argsC+])))) -(def: (lux::check eval) +(def: (lux::type::check eval) (-> Eval Handler) (function (_ extension_name analyse archive args) (case args (^ (list typeC valueC)) (do {! ////.monad} [count (///.lift meta.count) - actualT (\ ! map (|>> (:coerce Type)) + actualT (\ ! map (|>> (:as Type)) (eval archive count Type typeC)) _ (typeA.infer actualT)] (typeA.with_type actualT @@ -173,14 +173,14 @@ _ (////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) -(def: (lux::coerce eval) +(def: (lux::type::as eval) (-> Eval Handler) (function (_ extension_name analyse archive args) (case args (^ (list typeC valueC)) (do {! ////.monad} [count (///.lift meta.count) - actualT (\ ! map (|>> (:coerce Type)) + actualT (\ ! map (|>> (:as Type)) (eval archive count Type typeC)) _ (typeA.infer actualT) [valueT valueA] (typeA.with_inference @@ -212,7 +212,7 @@ [input_type (///.lift (meta.find_def (name_of .Macro')))] (case input_type (#.Definition [exported? def_type def_data def_value]) - (wrap (:coerce Type def_value)) + (wrap (:as Type def_value)) (#.Alias real_name) (recur real_name))))] @@ -225,10 +225,10 @@ (///bundle.install "syntax char case!" lux::syntax_char_case!) (///bundle.install "is" lux::is) (///bundle.install "try" lux::try) - (///bundle.install "check" (lux::check eval)) - (///bundle.install "coerce" (lux::coerce eval)) + (///bundle.install "type check" (lux::type::check eval)) + (///bundle.install "type as" (lux::type::as eval)) (///bundle.install "macro" ..lux::macro) - (///bundle.install "check type" (..caster .Type .Type)) + (///bundle.install "type check type" (..caster .Type .Type)) (///bundle.install "in-module" lux::in_module))) (def: bundle::io diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 4e33cbebc..9e405eb78 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -227,7 +227,7 @@ [type valueT value] (..definition archive full_name #.None valueC) [_ annotationsT annotations] (evaluate! archive Code annotationsC) _ (/////directive.lift_analysis - (module.define short_name (#.Right [exported? type (:coerce Code annotations) value]))) + (module.define short_name (#.Right [exported? type (:as Code annotations) value]))) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type)] (wrap /////directive.no_requirements)) @@ -245,12 +245,12 @@ (///.lift meta.current_module_name)) #let [full_name [current_module short_name]] [_ annotationsT annotations] (evaluate! archive Code annotationsC) - #let [annotations (:coerce Code annotations)] + #let [annotations (:as Code annotations)] [type valueT value] (..definition archive full_name (#.Some .Type) valueC) _ (/////directive.lift_analysis (do phase.monad [_ (module.define short_name (#.Right [exported? type annotations value]))] - (module.declare_tags tags exported? (:coerce Type value)))) + (module.declare_tags tags exported? (:as Type value)))) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type)] (wrap /////directive.no_requirements)))])) @@ -268,7 +268,7 @@ (function (_ extension_name phase archive [annotationsC imports]) (do {! phase.monad} [[_ annotationsT annotationsV] (evaluate! archive Code annotationsC) - #let [annotationsV (:coerce Code annotationsV)] + #let [annotationsV (:as Code annotationsV)] _ (/////directive.lift_analysis (do ! [_ (monad.map ! (function (_ [module alias]) @@ -322,11 +322,11 @@ (^ (list nameC valueC)) (do phase.monad [[_ _ name] (evaluate! archive Text nameC) - [_ handlerV] (<definer> archive (:coerce Text name) + [_ handlerV] (<definer> archive (:as Text name) (type <def_type>) valueC) _ (<| <scope> - (///.install extender (:coerce Text name)) + (///.install extender (:as Text name)) (:share [anchor expression directive] (Handler anchor expression directive) handler @@ -334,7 +334,7 @@ <type> (:assume handlerV))) _ (/////directive.lift_generation - (/////generation.log! (format <description> " " (%.text (:coerce Text name)))))] + (/////generation.log! (format <description> " " (%.text (:as Text name)))))] (wrap /////directive.no_requirements)) _ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux index b6fb709fb..b23d41726 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux @@ -109,7 +109,7 @@ _ (let [constantI (if (i.= ..d0-bits - (java/lang/Double::doubleToRawLongBits (:coerce java/lang/Double value))) + (java/lang/Double::doubleToRawLongBits (:as java/lang/Double value))) _.dconst-0 (_.double value))] (do _.monad diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index 488738c00..00d1497a1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -177,8 +177,8 @@ (-> Source (Either [Source Text] [Source a]))) (template: (!with_char+ @source_code_size @source_code @offset @char @else @body) - (if (!i/< (:coerce Int @source_code_size) - (:coerce Int @offset)) + (if (!i/< (:as Int @source_code_size) + (:as Int @offset)) (let [@char ("lux text char" @offset @source_code)] @body) @else)) diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index b6bf39c18..1ff603267 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -255,7 +255,7 @@ (do ! [value (\ host re_load context directive)] (wrap [definitions - [(dictionary.put extension (:coerce analysis.Handler value) analysers) + [(dictionary.put extension (:as analysis.Handler value) analysers) synthesizers generators directives]])) @@ -265,7 +265,7 @@ [value (\ host re_load context directive)] (wrap [definitions [analysers - (dictionary.put extension (:coerce synthesis.Handler value) synthesizers) + (dictionary.put extension (:as synthesis.Handler value) synthesizers) generators directives]])) @@ -275,7 +275,7 @@ (wrap [definitions [analysers synthesizers - (dictionary.put extension (:coerce generation.Handler value) generators) + (dictionary.put extension (:as generation.Handler value) generators) directives]])) (#artifact.Directive extension) @@ -285,7 +285,7 @@ [analysers synthesizers generators - (dictionary.put extension (:coerce directive.Handler value) directives)]])))) + (dictionary.put extension (:as directive.Handler value) directives)]])))) (#try.Success [definitions' bundles']) (recur input' definitions' bundles') diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 8142fc524..af6048ac9 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -8,8 +8,9 @@ ["." function] ["." exception (#+ exception:)] ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data + ["." product] ["." maybe] ["." text ("#\." monoid equivalence)] ["." name ("#\." equivalence codec)] @@ -351,11 +352,31 @@ _ #0)) -(def: #export (array depth elem_type) +(def: #export (array depth element_type) (-> Nat Type Type) (case depth - 0 elem_type - _ (|> elem_type (array (dec depth)) (list) (#.Primitive array.type_name)))) + 0 element_type + _ (|> element_type + (array (dec depth)) + (list) + (#.Primitive array.type_name)))) + +(def: #export (flatten_array type) + (-> Type [Nat Type]) + (case type + (^multi (^ (#.Primitive name (list element_type))) + (text\= array.type_name name)) + (let [[depth element_type] (flatten_array element_type)] + [(inc depth) element_type]) + + _ + [0 type])) + +(def: #export array? + (-> Type Bit) + (|>> ..flatten_array + product.left + (n.> 0))) (syntax: (new_secret_marker) (macro.with_gensyms [g!_secret_marker_] @@ -364,9 +385,9 @@ (def: secret_marker (`` (name_of (~~ (new_secret_marker))))) -(syntax: #export (:log! {input (<>.or (<>.and <c>.identifier - (<>.maybe (<>.after (<c>.identifier! ..secret_marker) <c>.any))) - <c>.any)}) +(syntax: #export (:log! {input (<>.or (<>.and <code>.identifier + (<>.maybe (<>.after (<code>.identifier! ..secret_marker) <code>.any))) + <code>.any)}) (case input (#.Left [valueN valueC]) (do meta.monad @@ -392,12 +413,12 @@ (def: type_parameters (Parser (List Text)) - (<c>.tuple (<>.some <c>.local_identifier))) + (<code>.tuple (<>.some <code>.local_identifier))) (syntax: #export (:cast {type_vars type_parameters} input output - {value (<>.maybe <c>.any)}) + {value (<>.maybe <code>.any)}) (let [casterC (` (: (All [(~+ (list\map code.local_identifier type_vars))] (-> (~ input) (~ output))) (|>> :assume)))] @@ -414,7 +435,7 @@ (def: typed (Parser Typed) - (<>.and <c>.any <c>.any)) + (<>.and <code>.any <code>.any)) ## TODO: Make sure the generated code always gets optimized away. (syntax: #export (:share {type_vars ..type_parameters} @@ -430,7 +451,7 @@ (syntax: #export (:by_example {type_vars ..type_parameters} {exemplar ..typed} - {extraction <c>.any}) + {extraction <code>.any}) (wrap (list (` (:of ((~! :share) [(~+ (list\map code.local_identifier type_vars))] diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 15534b996..c3121d7ff 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -62,7 +62,7 @@ (undefined) (#.Right [exported? frame_type frame_anns frame_value]) - (:coerce (Stack Frame) frame_value)))) + (:as (Stack Frame) frame_value)))) (def: (peek_frames reference definition_reference source) (-> Text Text (List [Text Module]) (Stack Frame)) @@ -122,7 +122,7 @@ (#.Right [exported? frames_type frames_anns - (..push frame (:coerce (Stack Frame) frames_value))])))) + (..push frame (:as (Stack Frame) frames_value))])))) (def: (push_frame [module_reference definition_reference] frame source) (-> Name Frame (List [Text Module]) (List [Text Module])) @@ -148,7 +148,7 @@ (#.Right [exported? frames_type frames_anns - (let [current_frames (:coerce (Stack Frame) frames_value)] + (let [current_frames (:as (Stack Frame) frames_value)] (case (..pop current_frames) (#.Some current_frames') current_frames' diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux index d50fefc27..754e682f2 100644 --- a/stdlib/source/lux/type/dynamic.lux +++ b/stdlib/source/lux/type/dynamic.lux @@ -40,7 +40,7 @@ (: ((~! try.Try) (~ type)) (if (\ (~! type.equivalence) (~' =) (.type (~ type)) (~ g!type)) - (#try.Success (:coerce (~ type) (~ g!value))) + (#try.Success (:as (~ type) (~ g!value))) ((~! exception.throw) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) (def: #export (format value) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index ade8e367f..fade9ad67 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -368,7 +368,7 @@ (template [<name> <module> <type>] [(def: (<name> _) (-> [] <type>) - (:coerce <type> (..require [] <module>)))] + (:as <type> (..require [] <module>)))] [node_fs "fs" ..Fs] [node_path "path" ..JsPath] @@ -794,7 +794,7 @@ ## [(def: (<name> data) ## (do {! (try.with io.monad)} ## [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] - ## (if (bit\= false (:coerce Bit outcome)) + ## (if (bit\= false (:as Bit outcome)) ## (\ io.monad wrap (exception.throw ..cannot_write_to_file [path])) ## (wrap []))))] @@ -805,7 +805,7 @@ ## (def: (content _) ## (do {! (try.with io.monad)} ## [data (..file_get_contents [path])] - ## (if (bit\= false (:coerce Bit data)) + ## (if (bit\= false (:as Bit data)) ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) ## (wrap (..unpack [..byte_array_format data]))))) @@ -816,7 +816,7 @@ ## [(def: (<name> _) ## (do {! (try.with io.monad)} ## [value (<ffi> [path])] - ## (if (bit\= false (:coerce Bit value)) + ## (if (bit\= false (:as Bit value)) ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) ## (wrap (`` (|> value (~~ (template.splice <pipeline>))))))))] @@ -830,21 +830,21 @@ ## (def: (modify moment) ## (do {! (try.with io.monad)} ## [verdict (..touch [path (|> moment instant.relative duration.to_millis (i./ +1,000))])] - ## (if (bit\= false (:coerce Bit verdict)) + ## (if (bit\= false (:as Bit verdict)) ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) ## (wrap [])))) ## (def: (move destination) ## (do {! (try.with io.monad)} ## [verdict (..rename [path destination])] - ## (if (bit\= false (:coerce Bit verdict)) + ## (if (bit\= false (:as Bit verdict)) ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) ## (wrap (file destination))))) ## (def: (delete _) ## (do (try.with io.monad) ## [verdict (..unlink [path])] - ## (if (bit\= false (:coerce Bit verdict)) + ## (if (bit\= false (:as Bit verdict)) ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) ## (wrap [])))) ## )) @@ -884,7 +884,7 @@ ## (def: (discard _) ## (do (try.with io.monad) ## [verdict (..rmdir [path])] - ## (if (bit\= false (:coerce Bit verdict)) + ## (if (bit\= false (:as Bit verdict)) ## (\ io.monad wrap (exception.throw ..cannot_find_directory [path])) ## (wrap [])))) ## )) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 488f40e02..f1415da80 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -301,8 +301,8 @@ (def: (default_event_concern event) (All [a] (-> (java/nio/file/WatchEvent a) Concern)) - (let [kind (:coerce (java/nio/file/WatchEvent$Kind java/nio/file/Path) - (java/nio/file/WatchEvent::kind event))] + (let [kind (:as (java/nio/file/WatchEvent$Kind java/nio/file/Path) + (java/nio/file/WatchEvent::kind event))] (cond (is? (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE) kind) ..creation @@ -379,9 +379,9 @@ (do ! [#let [path (|> key java/nio/file/WatchKey::watchable - (:coerce java/nio/file/Path) + (:as java/nio/file/Path) java/nio/file/Path::toString - (:coerce //.Path))] + (:as //.Path))] concern (..default_key_concern key)] (recur (#.Cons [concern path] output))) @@ -394,13 +394,13 @@ (-> Concern (List Watch_Event)) ($_ list\compose (if (..creation? concern) - (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) + (list (:as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) (list)) (if (..modification? concern) - (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) + (list (:as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) (list)) (if (..deletion? concern) - (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) + (list (:as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) (list)) )) diff --git a/stdlib/source/lux/world/net/http/client.lux b/stdlib/source/lux/world/net/http/client.lux index eae724365..986ef0c89 100644 --- a/stdlib/source/lux/world/net/http/client.lux +++ b/stdlib/source/lux/world/net/http/client.lux @@ -176,7 +176,7 @@ (: (IO (Try (//.Response IO))) (do {! (try.with io.monad)} [connection (|> url java/net/URL::new java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] + #let [connection (:as java/net/HttpURLConnection connection)] _ (java/net/HttpURLConnection::setRequestMethod (..jvm_method method) connection) _ (monad.map ! (function (_ [name value]) (java/net/URLConnection::setRequestProperty name value connection)) diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 7b15dcbbc..6d916c466 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -43,9 +43,9 @@ available_variables) (: (-> Text (! (Try Text))) variable) - (: (-> Any (! Path)) + (: Path home) - (: (-> Any (! Path)) + (: Path directory) (: (-> Exit (! Nothing)) exit)) @@ -72,12 +72,18 @@ (~~ (template [<method>] [(def: <method> + (\ program <method>))] + + [home] + [directory] + )) + + (~~ (template [<method>] + [(def: <method> (|>> (\ program <method>) promise.future))] [available_variables] [variable] - [home] - [directory] [exit] )))) @@ -95,9 +101,9 @@ #.None (exception.throw ..unknown_environment_variable [name])))) (def: home - (function.constant (io.io home))) + home) (def: directory - (function.constant (io.io directory))) + directory) (def: (exit code) (io.io (error! (%.int code))))))) @@ -307,7 +313,7 @@ ## ..array_keys ## array.to_list ## (list\map (function (_ variable) - ## [variable ("php array read" (:coerce Nat variable) environment)])) + ## [variable ("php array read" (:as Nat variable) environment)])) ## (dictionary.from_list text.hash)))) ## @.scheme (do io.monad ## [input (..get-environment-variables [])] @@ -336,8 +342,8 @@ @.js (io.io (if ffi.on_node_js? (case (do maybe.monad [process/env (ffi.constant Object [process env])] - (array.read (:coerce Nat name) - (:coerce (Array Text) process/env))) + (array.read (:as Nat name) + (:as (Array Text) process/env))) (#.Some value) (#try.Success value) @@ -349,57 +355,59 @@ @.ruby (!fetch RubyEnv::fetch) })))) - (def: (home _) - (with_expansions [<default> (io.io "~") - <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] - (for {@.old <jvm> - @.jvm <jvm> - @.js (if ffi.on_node_js? - (|> (..require "os") - (:coerce NodeJs_OS) - (NodeJs_OS::homedir [])) - <default>) - @.python (os/path::expanduser ["~"]) - @.lua (..run_command "~" "echo ~") - @.ruby (RubyDir::home []) - ## @.php (do io.monad - ## [output (..getenv/1 ["HOME"])] - ## (wrap (if (bit\= false (:coerce Bit output)) - ## "~" - ## output))) - } - ## TODO: Replace dummy implementation. - <default>))) - - (def: (directory _) - (with_expansions [<default> "." - <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] - (for {@.old <jvm> - @.jvm <jvm> - @.js (if ffi.on_node_js? - (case (ffi.constant ..NodeJs_Process [process]) - (#.Some process) - (NodeJs_Process::cwd [] process) - - #.None - (io.io <default>)) - (io.io <default>)) - @.python (os::getcwd []) - @.lua (do io.monad - [#let [default <default>] - on_windows (..run_command default "cd")] - (if (is? default on_windows) - (..run_command default "pwd") - (wrap on_windows))) - @.ruby (RubyFileUtils::pwd []) - ## @.php (do io.monad - ## [output (..getcwd [])] - ## (wrap (if (bit\= false (:coerce Bit output)) - ## "." - ## output))) - } - ## TODO: Replace dummy implementation. - (io.io <default>)))) + (def: home + (io.run + (with_expansions [<default> (io.io "~") + <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] + (for {@.old <jvm> + @.jvm <jvm> + @.js (if ffi.on_node_js? + (|> (..require "os") + (:as NodeJs_OS) + (NodeJs_OS::homedir [])) + <default>) + @.python (os/path::expanduser ["~"]) + @.lua (..run_command "~" "echo ~") + @.ruby (RubyDir::home []) + ## @.php (do io.monad + ## [output (..getenv/1 ["HOME"])] + ## (wrap (if (bit\= false (:as Bit output)) + ## "~" + ## output))) + } + ## TODO: Replace dummy implementation. + <default>)))) + + (def: directory + (io.run + (with_expansions [<default> "." + <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] + (for {@.old <jvm> + @.jvm <jvm> + @.js (if ffi.on_node_js? + (case (ffi.constant ..NodeJs_Process [process]) + (#.Some process) + (NodeJs_Process::cwd [] process) + + #.None + (io.io <default>)) + (io.io <default>)) + @.python (os::getcwd []) + @.lua (do io.monad + [#let [default <default>] + on_windows (..run_command default "cd")] + (if (is? default on_windows) + (..run_command default "pwd") + (wrap on_windows))) + @.ruby (RubyFileUtils::pwd []) + ## @.php (do io.monad + ## [output (..getcwd [])] + ## (wrap (if (bit\= false (:as Bit output)) + ## "." + ## output))) + } + ## TODO: Replace dummy implementation. + (io.io <default>))))) (def: (exit code) (with_expansions [<jvm> (do io.monad diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index d250acfcf..254e813ad 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -175,7 +175,7 @@ (product.right (list\fold (function (_ argument [idx output]) [(inc idx) (jvm.array_write idx - (:coerce java/lang/String argument) + (:as java/lang/String argument) output)]) [0 (jvm.array java/lang/String (list.size arguments))] arguments))) @@ -189,8 +189,8 @@ (java/util/Map java/lang/String java/lang/String) (java/util/Map java/lang/String java/lang/String)) (list\fold (function (_ [key value] target') - (exec (java/util/Map::put (:coerce java/lang/String key) - (:coerce java/lang/String value) + (exec (java/util/Map::put (:as java/lang/String key) + (:as java/lang/String value) target') target')) target diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 572ebf0f0..ea2637d54 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -174,8 +174,8 @@ (#.Some program_module) (do promise.monad [environment (program.environment promise.monad program) - home (\ program home []) - working_directory (\ program directory [])] + #let [home (\ program home) + working_directory (\ program directory)]] (do ///action.monad [[resolution compiler] (promise\wrap (..compiler resolution)) #let [[[command compiler_params] output] (case compiler diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index e4881986b..416544e01 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -39,7 +39,9 @@ (def: #export (do! console local remotes new_repository profile) (-> (Console Promise) (Repository Promise) (List (Repository Promise)) (-> URL (Repository Promise)) (Command Resolution)) (do promise.monad - [#let [dependencies (set.to_list (get@ #///.dependencies profile))] + [#let [dependencies (|> (get@ #///.dependencies profile) + set.to_list + (#.Cons (get@ #///.compiler profile)))] [local_successes local_failures cache] (///dependency/resolution.all console (list local) new_repository diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 64830c4d2..39bdea8b2 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -10,7 +10,6 @@ [data [binary (#+ Binary)] [text - ["%" format (#+ format)] [encoding ["." utf8]]] [collection diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index e8b5a2a23..9ac6b9c10 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -34,7 +34,7 @@ (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any)) (do promise.monad [environment (program.environment promise.monad program) - working_directory (\ program directory [])] + #let [working_directory (\ program directory)]] (do ///action.monad [[compiler program] (//build.do! console program fs shell resolution (set@ #///.program (get@ #///.test profile) profile)) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 2cbb469ab..698678f41 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -82,9 +82,9 @@ (case ?actual (#try.Success actual) (wrap (do {! try.monad} - [output (\ ! map (|>> (:coerce java/lang/String) + [output (\ ! map (|>> (:as java/lang/String) java/lang/String::trim - (:coerce Text)) + (:as Text)) (\ utf8.codec decode actual)) actual (|> output (text.split_all_with " ") diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index 7778e7641..9b44eced5 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -139,6 +139,7 @@ (..on_maybe "info" (get@ #/.info value) ..info) (..on_set "repositories" (get@ #/.repositories value) code.text) (..on_set "dependencies" (get@ #/.dependencies value) ..dependency) + (dictionary.put "compiler" (..dependency (get@ #/.compiler value))) (..on_set "sources" (get@ #/.sources value) code.text) (dictionary.put "target" (code.text (get@ #/.target value))) (..on_maybe "program" (get@ #/.program value) code.text) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 835b03729..8d0fcdf73 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -196,6 +196,9 @@ (|> (..plural input "dependencies" ..dependency) (\ ! map (set.from_list //dependency.hash)) (<>.default (set.new //dependency.hash)))) + ^compiler (|> ..dependency + (..singular input "compiler") + (<>.default /.default_compiler)) ^sources (: (Parser (Set /.Source)) (|> (..plural input "sources" ..source) (\ ! map (set.from_list text.hash)) @@ -220,6 +223,7 @@ ^info ^repositories ^dependencies + ^compiler ^sources ^target ^program diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index eb686cc15..d31d0aca9 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -22,11 +22,17 @@ [archive [descriptor (#+ Module)]]]]]] [// - ["." artifact (#+ Artifact)] - ["." dependency] + ["." dependency (#+ Dependency) ("#\." equivalence)] + ["." artifact (#+ Artifact) + ["." type]] [repository [remote (#+ Address)]]]) +(def: #export default_compiler + Dependency + {#dependency.artifact ["com.github.luxlang" "lux-jvm" "0.6.0-SNAPSHOT"] + #dependency.type type.jvm_library}) + (type: #export Distribution #Repo #Manual) @@ -148,7 +154,8 @@ #identity (Maybe Artifact) #info (Maybe Info) #repositories (Set Address) - #dependencies (Set dependency.Dependency) + #dependencies (Set Dependency) + #compiler Dependency #sources (Set Source) #target Target #program (Maybe Module) @@ -168,6 +175,8 @@ set.equivalence ## #dependencies set.equivalence + ## #compiler + dependency.equivalence ## #sources set.equivalence ## #target @@ -188,6 +197,7 @@ #info #.None #repositories (set.new text.hash) #dependencies (set.new dependency.hash) + #compiler default_compiler #sources (set.new text.hash) #target ..default_target #program #.None @@ -200,6 +210,9 @@ #info (maybe\compose (get@ #info override) (get@ #info baseline)) #repositories (set.union (get@ #repositories baseline) (get@ #repositories override)) #dependencies (set.union (get@ #dependencies baseline) (get@ #dependencies override)) + #compiler (if (dependency\= ..default_compiler (get@ #compiler override)) + (get@ #compiler baseline) + (get@ #compiler override)) #sources (set.union (get@ #sources baseline) (get@ #sources override)) #target (if (text\= ..default_target (get@ #target baseline)) (get@ #target override) diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux index b4ba0e22c..b68425609 100644 --- a/stdlib/source/program/aedifex/repository/local.lux +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -19,32 +19,35 @@ ["#." local] ["#." metadata]]]) -(def: (root /) - (-> Text file.Path) - (text.replace_all uri.separator / ///local.repository)) +(def: (root program /) + (-> (Program Promise) Text file.Path) + (|> ///local.repository + (text.replace_all uri.separator /) + (format (\ program home) /))) (def: (path /) (-> Text (-> URI file.Path)) (text.replace_all uri.separator /)) -(def: (absolute_path /) - (-> Text (-> URI file.Path)) +(def: (absolute_path program /) + (-> (Program Promise) Text (-> URI file.Path)) (|>> ///metadata.local_uri (..path /) - (format (..root /) /))) + (format (..root program /) /))) (implementation: #export (repository program fs) (-> (Program Promise) (file.System Promise) (//.Repository Promise)) (def: description - (..root (\ fs separator))) + (..root program (\ fs separator))) + (def: download - (|>> (..absolute_path (\ fs separator)) + (|>> (..absolute_path program (\ fs separator)) (\ fs read))) (def: (upload uri content) (do {! promise.monad} - [#let [absolute_path (..absolute_path (\ fs separator) uri)] + [#let [absolute_path (..absolute_path program (\ fs separator) uri)] ? (\ fs file? absolute_path) _ (if ? (wrap []) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index a32a14f8f..0d86b0f1c 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -280,7 +280,7 @@ (cond (type\= .Type def-type) (update@ #types (: (Mutation (List Value)) - (|>> (#.Cons [name def-annotations (:coerce Type def-value)]))) + (|>> (#.Cons [name def-annotations (:as Type def-value)]))) organization) (type\= .Macro def-type) diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux index 958110ce4..4f45a480c 100644 --- a/stdlib/source/spec/compositor/generation/case.lux +++ b/stdlib/source/spec/compositor/generation/case.lux @@ -41,7 +41,7 @@ (def: #export (verify expected) (-> Frac (Try Any) Bit) (|>> (case> (#try.Success actual) - (f.= expected (:coerce Frac actual)) + (f.= expected (:as Frac actual)) (#try.Failure _) false))) diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index baa32674a..3d377b7ca 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -43,7 +43,7 @@ (synthesis.i64 subject))) (run (..sanitize <extension>)) (case> (#try.Success valueT) - (n.= (<reference> param subject) (:coerce Nat valueT)) + (n.= (<reference> param subject) (:as Nat valueT)) (#try.Failure _) false) @@ -55,22 +55,22 @@ ["lux i64 left-shift" i64.left-shift (n.% 64 param)] ["lux i64 logical-right-shift" i64.logic-right-shift (n.% 64 param)] )] - ($_ _.and - <binary> - (_.test "lux i64 arithmetic-right-shift" - (|> (#synthesis.Extension "lux i64 arithmetic-right-shift" - (list (synthesis.i64 subject) - (synthesis.i64 param))) - (run (..sanitize "lux i64 arithmetic-right-shift")) - (case> (#try.Success valueT) - ("lux i64 =" - (i64.arithmetic-right-shift param subject) - (:coerce I64 valueT)) - - (#try.Failure _) - false) - (let [param (n.% 64 param)]))) - )))) + ($_ _.and + <binary> + (_.test "lux i64 arithmetic-right-shift" + (|> (#synthesis.Extension "lux i64 arithmetic-right-shift" + (list (synthesis.i64 subject) + (synthesis.i64 param))) + (run (..sanitize "lux i64 arithmetic-right-shift")) + (case> (#try.Success valueT) + ("lux i64 =" + (i64.arithmetic-right-shift param subject) + (:as I64 valueT)) + + (#try.Failure _) + false) + (let [param (n.% 64 param)]))) + )))) (def: (i64 run) (-> Runner Test) @@ -83,17 +83,17 @@ (|> (#synthesis.Extension <extension> (list (synthesis.i64 subject))) (run (..sanitize <extension>)) (case> (#try.Success valueT) - (<comp> (<prepare> subject) (:coerce <type> valueT)) + (<comp> (<prepare> subject) (:as <type> valueT)) (#try.Failure _) false) (let [subject <subject-expr>])))] ["lux i64 f64" Frac i.frac f.= subject] - ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text\= (|> subject - (:coerce Nat) - (n.% (i64.left-shift 8 1)) - (:coerce Int))] + ["lux i64 char" Text (|>> (:as Nat) text.from-code) text\= (|> subject + (:as Nat) + (n.% (i64.left-shift 8 1)) + (:as Int))] )) (~~ (template [<extension> <reference> <outputT> <comp>] [(_.test <extension> @@ -101,7 +101,7 @@ (synthesis.i64 subject))) (run (..sanitize <extension>)) (case> (#try.Success valueT) - (<comp> (<reference> param subject) (:coerce <outputT> valueT)) + (<comp> (<reference> param subject) (:as <outputT> valueT)) (#try.Failure _) false)))] @@ -146,7 +146,7 @@ (run (..sanitize <extension>)) (case> (#try.Success valueV) (bit\= (<text> param subject) - (:coerce Bit valueV)) + (:as Bit valueV)) _ false)))] @@ -194,14 +194,14 @@ (and (|> (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS)) (run (..sanitize "lux text =")) (case> (#try.Success valueV) - (:coerce Bit valueV) + (:as Bit valueV) _ false)) (|> (#synthesis.Extension "lux text =" (list sample-upperS sample-lowerS)) (run (..sanitize "lux text =")) (case> (#try.Success valueV) - (not (:coerce Bit valueV)) + (not (:as Bit valueV)) _ false)))) @@ -209,7 +209,7 @@ (|> (#synthesis.Extension "lux text <" (list sample-lowerS sample-upperS)) (run (..sanitize "lux text <")) (case> (#try.Success valueV) - (:coerce Bit valueV) + (:as Bit valueV) (#try.Failure _) false))) @@ -217,7 +217,7 @@ (|> (#synthesis.Extension "lux text size" (list sample-lowerS)) (run (..sanitize "lux text size")) (case> (#try.Success valueV) - (n.= sample-size (:coerce Nat valueV)) + (n.= sample-size (:as Nat valueV)) _ false))) @@ -225,7 +225,7 @@ (|> (#synthesis.Extension "lux text size" (list concatenatedS)) (run (..sanitize "lux text size")) (case> (#try.Success valueV) - (n.= (n.* 2 sample-size) (:coerce Nat valueV)) + (n.= (n.* 2 sample-size) (:as Nat valueV)) _ false))) @@ -235,7 +235,7 @@ (synthesis.i64 +0))) (run (..sanitize "lux text index")) (case> (^multi (#try.Success valueV) - [(:coerce (Maybe Nat) valueV) (#.Some valueV)]) + [(:as (Maybe Nat) valueV) (#.Some valueV)]) (n.= 0 valueV) _ @@ -245,7 +245,7 @@ (synthesis.i64 +0))) (run (..sanitize "lux text index")) (case> (^multi (#try.Success valueV) - [(:coerce (Maybe Nat) valueV) (#.Some valueV)]) + [(:as (Maybe Nat) valueV) (#.Some valueV)]) (n.= sample-size valueV) _ @@ -258,7 +258,7 @@ (synthesis.i64 length))) (run (..sanitize "lux text clip")) (case> (^multi (#try.Success valueV) - [(:coerce (Maybe Text) valueV) (#.Some valueV)]) + [(:as (Maybe Text) valueV) (#.Some valueV)]) (text\= expected valueV) _ @@ -272,7 +272,7 @@ (synthesis.i64 char-idx))) (run (..sanitize "lux text char")) (case> (^multi (#try.Success valueV) - [(:coerce (Maybe Int) valueV) (#.Some valueV)]) + [(:as (Maybe Int) valueV) (#.Some valueV)]) (text.contains? ("lux i64 char" valueV) sample-lower) @@ -303,7 +303,7 @@ (list (synthesis.text message)))}))) (run (..sanitize "lux try")) (case> (^multi (#try.Success valueV) - [(:coerce (Try Text) valueV) (#try.Failure error)]) + [(:as (Try Text) valueV) (#try.Failure error)]) (text.contains? message error) _ @@ -315,7 +315,7 @@ #synthesis.body (synthesis.text message)}))) (run (..sanitize "lux try")) (case> (^multi (#try.Success valueV) - [(:coerce (Try Text) valueV) (#try.Success valueV)]) + [(:as (Try Text) valueV) (#try.Success valueV)]) (text\= message valueV) _ @@ -325,7 +325,7 @@ (#synthesis.Extension "lux io current-time" (list)))) (run (..sanitize "lux io current-time")) (case> (#try.Success valueV) - (let [[pre post] (:coerce [Nat Nat] valueV)] + (let [[pre post] (:as [Nat Nat] valueV)] (n.>= pre post)) (#try.Failure _) diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux index a94824f28..665175ab4 100644 --- a/stdlib/source/spec/compositor/generation/reference.lux +++ b/stdlib/source/spec/compositor/generation/reference.lux @@ -32,7 +32,7 @@ (_.test "Definitions." (|> (define name (synthesis.f64 expected)) (case> (#try.Success actual) - (f.= expected (:coerce Frac actual)) + (f.= expected (:as Frac actual)) (#try.Failure _) false))))) @@ -48,7 +48,7 @@ (synthesis.variable/local register)]) (run "variable") (case> (#try.Success actual) - (f.= expected (:coerce Frac actual)) + (f.= expected (:as Frac actual)) (#try.Failure _) false))))) diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux index 237ff5024..7c45d2a9b 100644 --- a/stdlib/source/spec/compositor/generation/structure.lux +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -43,19 +43,19 @@ #analysis.value (synthesis.i64 value-in)}) (run "variant") (case> (#try.Success valueT) - (let [valueT (:coerce (Array Any) valueT)] + (let [valueT (:as (Array Any) valueT)] (and (n.= 3 (array.size valueT)) - (let [tag-out (:coerce java/lang/Integer (maybe.assume (array.read 0 valueT))) + (let [tag-out (:as java/lang/Integer (maybe.assume (array.read 0 valueT))) last?-out (array.read 1 valueT) - value-out (:coerce Any (maybe.assume (array.read 2 valueT))) - same-tag? (|> tag-out ffi.int-to-long (:coerce Nat) (n.= tag-in)) + value-out (:as Any (maybe.assume (array.read 2 valueT))) + same-tag? (|> tag-out ffi.int-to-long (:as Nat) (n.= tag-in)) same-flag? (case last?-out (#.Some last?-out') - (and last?-in (text\= "" (:coerce Text last?-out'))) + (and last?-in (text\= "" (:as Text last?-out'))) #.None (not last?-in)) - same-value? (|> value-out (:coerce Int) (i.= value-in))] + same-value? (|> value-out (:as Int) (i.= value-in))] (and same-tag? same-flag? same-value?)))) @@ -72,10 +72,10 @@ (|> (synthesis.tuple (list\map (|>> synthesis.i64) tuple-in)) (run "tuple") (case> (#try.Success tuple-out) - (let [tuple-out (:coerce (Array Any) tuple-out)] + (let [tuple-out (:as (Array Any) tuple-out)] (and (n.= size (array.size tuple-out)) (list.every? (function (_ [left right]) - (i.= left (:coerce Int right))) + (i.= left (:as Int right))) (list.zip/2 tuple-in (array.to-list tuple-out))))) (#try.Failure _) diff --git a/stdlib/source/spec/lux/world/program.lux b/stdlib/source/spec/lux/world/program.lux index 939445169..85db051f0 100644 --- a/stdlib/source/spec/lux/world/program.lux +++ b/stdlib/source/spec/lux/world/program.lux @@ -22,12 +22,10 @@ (do random.monad [exit random.int] (wrap (do {! promise.monad} - [environment (/.environment ! subject) - home (\ subject home []) - directory (\ subject directory [])] + [environment (/.environment ! subject)] (_.cover' [/.Program] (and (not (dictionary.empty? environment)) (list.every? (|>> text.empty? not) (dictionary.keys environment)) - (not (text.empty? home)) - (not (text.empty? directory)))))))) + (not (text.empty? (\ subject home))) + (not (text.empty? (\ subject directory))))))))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 5800bca6d..0e8a95526 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -67,10 +67,11 @@ sample (\ ! map (set@ #///.identity (#.Some identity)) $profile.random) home (random.ascii/alpha 5) - working_directory (random.ascii/alpha 5)] + working_directory (random.ascii/alpha 5) + #let [/ (\ file.default separator)]] ($_ _.and (wrap (do {! promise.monad} - [#let [fs (file.mock (\ file.default separator)) + [#let [fs (file.mock /) program (program.async (program.mock environment.empty home working_directory)) artifact_path (///local.uri (get@ #///artifact.version identity) identity) @@ -80,9 +81,11 @@ [succeeded! (\ ! map (text\= /.success) (..execute! program fs sample)) library_exists! (|> library_path + (format home /) (\ fs file?) (\ promise.monad map exception.return)) pom_exists! (|> pom_path + (format home /) (\ fs file?) (\ promise.monad map exception.return))] (wrap (and succeeded! @@ -91,7 +94,7 @@ (_.cover' [/.do! /.success] (try.default false verdict)))) (wrap (do {! promise.monad} - [#let [fs (file.mock (\ file.default separator)) + [#let [fs (file.mock /) program (program.async (program.mock environment.empty home working_directory))] logging (..execute! program fs (set@ #///.identity #.None sample))] (_.cover' [/.failure] diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index 3410255f5..0a0ba8642 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -124,6 +124,7 @@ (random.maybe ..info) (..set_of text.hash ..repository) (..set_of //dependency.hash @dependency.random) + @dependency.random (..set_of text.hash ..source) ..target (random.maybe (random.ascii/alpha 1)) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index d16734a60..f9a4eeda6 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -24,6 +24,7 @@ ["." / #_ ["#." identity] ["#." origin] + ["#." local] ["#." remote] [// ["@." artifact]]] @@ -100,5 +101,6 @@ /identity.test /origin.test + /local.test /remote.test ))) diff --git a/stdlib/source/test/aedifex/repository/local.lux b/stdlib/source/test/aedifex/repository/local.lux new file mode 100644 index 000000000..946494437 --- /dev/null +++ b/stdlib/source/test/aedifex/repository/local.lux @@ -0,0 +1,51 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + [parser + ["." environment]] + [concurrency + ["." promise]]] + [data + ["." binary ("#\." equivalence)] + [text + [encoding + ["." utf8]]]] + [math + ["." random]] + [world + ["." file] + ["." program]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [/ (random.ascii/upper 1) + home (random.ascii/lower 10) + working_directory (random.ascii/lower 10) + #let [fs (file.mock /) + program (program.async (program.mock environment.empty home working_directory)) + repo (/.repository program fs)] + + uri (random.ascii/lower 10) + expected (\ ! map (\ utf8.codec encode) + (random.ascii/lower 10))] + ($_ _.and + (wrap (do promise.monad + [before_upload (\ repo download uri) + _ (\ repo upload uri expected) + actual (\ repo download uri)] + (_.cover' [/.repository] + (and (case before_upload + (#try.Success _) false + (#try.Failure _) true) + (|> actual + (try\map (binary\= expected)) + (try.default false)))))) + )))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index b320841c5..415bb3500 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -58,8 +58,9 @@ (def: identity Test (do {! random.monad} - [#let [object (: (Random (Atom Text)) - (\ ! map atom.atom (random.unicode 1)))] + [value random.nat + #let [object (: (Random (Atom Nat)) + (\ ! map atom.atom (wrap value)))] self object] ($_ _.and (_.test "Every value is identical to itself." diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index 9835e52e4..8af4be0fd 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -68,9 +68,9 @@ (let [encoding "utf8"] (text\= string (cond /.on_nashorn? - (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))] + (let [binary (java/lang/String::getBytes [encoding] (:as java/lang/String string))] (|> (java/lang/String::new [binary encoding]) - (:coerce Text))) + (:as Text))) /.on_node_js? (|> (Buffer::from [string encoding]) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index d2686f3ba..0c618bfac 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -81,9 +81,9 @@ (`` ($_ _.and (~~ (template [<to> <from> <message>] [(_.test <message> - (or (|> sample (:coerce java/lang/Long) <to> <from> (:coerce Int) (i.= sample)) - (let [capped_sample (|> sample (:coerce java/lang/Long) <to> <from>)] - (|> capped_sample <to> <from> (:coerce Int) (i.= (:coerce Int capped_sample))))))] + (or (|> sample (:as java/lang/Long) <to> <from> (:as Int) (i.= sample)) + (let [capped_sample (|> sample (:as java/lang/Long) <to> <from>)] + (|> capped_sample <to> <from> (:as Int) (i.= (:as Int capped_sample))))))] [/.long_to_byte /.byte_to_long "Can succesfully convert to/from byte."] [/.long_to_short /.short_to_long "Can succesfully convert to/from short."] @@ -97,7 +97,7 @@ (def: miscellaneous Test (do {! r.monad} - [sample (\ ! map (|>> (:coerce java/lang/Object)) + [sample (\ ! map (|>> (:as java/lang/Object)) (r.ascii 1))] ($_ _.and (_.test "Can check if an object is of a certain class." @@ -130,7 +130,7 @@ (do {! r.monad} [size (|> r.nat (\ ! map (|>> (n.% 100) (n.max 1)))) idx (|> r.nat (\ ! map (n.% size))) - value (\ ! map (|>> (:coerce java/lang/Long)) r.int)] + value (\ ! map (|>> (:as java/lang/Long)) r.int)] ($_ _.and (_.test "Can create arrays of some length." (n.= size (/.array_length (/.array java/lang/Long size)))) @@ -138,8 +138,8 @@ (_.test "Can set and get array values." (let [arr (/.array java/lang/Long size)] (exec (/.array_write idx value arr) - (i.= (:coerce Int value) - (:coerce Int (/.array_read idx arr))))))))) + (i.= (:as Int value) + (:as Int (/.array_read idx arr))))))))) (def: #export test ($_ _.and diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index c3d984854..e02b1197a 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -590,7 +590,7 @@ (and (bit\= expected_exported? actual_exported?) (is? expected_type actual_type) (is? expected_annotations actual_annotations) - (is? (:coerce Any expected_value) actual_value))))) + (is? (:as Any expected_value) actual_value))))) alias! (|> (/.find_def [expected_current_module expected_short]) @@ -625,13 +625,13 @@ (|> (/.find_type_def [expected_macro_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_value) - (is? (:coerce .Type expected_value) actual_value)))) + (is? (:as .Type expected_value) actual_value)))) alias! (|> (/.find_type_def [expected_current_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_value) - (is? (:coerce .Type expected_value) actual_value))))] + (is? (:as .Type expected_value) actual_value))))] (and definition! alias!))) ))) diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index 973216d84..e7d4a4767 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -44,14 +44,14 @@ (..actual_program <program>)) inputs)] (list\= (list.reverse inputs) - (:coerce (List Text) (io.run outcome))))) + (:as (List Text) (io.run outcome))))) (with_expansions [<program> (/.program: [{all_arguments (<>.many <cli>.any)}] (io.io all_arguments))] (let [outcome ((: (-> (List Text) (io.IO Any)) (..actual_program <program>)) inputs)] (list\= inputs - (:coerce (List Text) (io.run outcome))))) + (:as (List Text) (io.run outcome))))) (with_expansions [<program> (/.program: [arg/0 arg/1 arg/2 arg/3] (io.io []))] (case (try ((: (-> (List Text) (io.IO Any)) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index acdeaf653..173e9624f 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -143,12 +143,12 @@ (/type.class "java.lang.Boolean" (list))) (def: $Boolean::wrap (/.invokestatic ..$Boolean "valueOf" (/type.method [(list /type.boolean) ..$Boolean (list)]))) -(def: $Boolean::random (:coerce (Random java/lang/Boolean) random.bit)) +(def: $Boolean::random (:as (Random java/lang/Boolean) random.bit)) (def: !false (|> 0 .i64 i32.i32 /.int)) (def: !true (|> 1 .i64 i32.i32 /.int)) (def: ($Boolean::literal value) (-> java/lang/Boolean (Bytecode Any)) - (if (:coerce Bit value) + (if (:as Bit value) ..!true ..!false)) (def: $Boolean::primitive @@ -165,10 +165,10 @@ (/.invokestatic ..$Byte "valueOf" (/type.method [(list /type.byte) ..$Byte (list)]))) (def: $Byte::random (Random java/lang/Byte) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_byte) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_byte) random.int)) (def: $Byte::literal (-> java/lang/Byte (Bytecode Any)) - (|>> ffi.byte_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.byte_to_long (:as I64) i32.i32 /.int)) (def: $Byte::primitive (Primitive java/lang/Byte) {#unboxed /type.byte @@ -183,10 +183,10 @@ (/.invokestatic ..$Short "valueOf" (/type.method [(list /type.short) ..$Short (list)]))) (def: $Short::random (Random java/lang/Short) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_short) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_short) random.int)) (def: $Short::literal (-> java/lang/Short (Bytecode Any)) - (|>> ffi.short_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.short_to_long (:as I64) i32.i32 /.int)) (def: $Short::primitive (Primitive java/lang/Short) {#unboxed /type.short @@ -201,10 +201,10 @@ (/.invokestatic ..$Integer "valueOf" (/type.method [(list /type.int) ..$Integer (list)]))) (def: $Integer::random (Random java/lang/Integer) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_int) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_int) random.int)) (def: $Integer::literal (-> java/lang/Integer (Bytecode Any)) - (|>> ffi.int_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.int_to_long (:as I64) i32.i32 /.int)) (def: $Integer::primitive (Primitive java/lang/Integer) {#unboxed /type.int @@ -215,8 +215,8 @@ (def: $Long (/type.class "java.lang.Long" (list))) (def: $Long::wrap (/.invokestatic ..$Long "valueOf" (/type.method [(list /type.long) ..$Long (list)]))) -(def: $Long::random (:coerce (Random java/lang/Long) random.int)) -(def: $Long::literal (-> java/lang/Long (Bytecode Any)) (|>> (:coerce Int) /.long)) +(def: $Long::random (:as (Random java/lang/Long) random.int)) +(def: $Long::literal (-> java/lang/Long (Bytecode Any)) (|>> (:as Int) /.long)) (def: $Long::primitive (Primitive java/lang/Long) {#unboxed /type.long @@ -230,12 +230,12 @@ (def: $Float::random (Random java/lang/Float) (\ random.monad map - (|>> (:coerce java/lang/Double) ffi.double_to_float) + (|>> (:as java/lang/Double) ffi.double_to_float) random.frac)) (def: $Float::literal /.float) (def: valid_float (Random java/lang/Float) - (random.filter (|>> ffi.float_to_double (:coerce Frac) f.not_a_number? not) + (random.filter (|>> ffi.float_to_double (:as Frac) f.not_a_number? not) ..$Float::random)) (def: $Float::primitive (Primitive java/lang/Float) @@ -247,13 +247,13 @@ (def: $Double (/type.class "java.lang.Double" (list))) (def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))) -(def: $Double::random (:coerce (Random java/lang/Double) random.frac)) +(def: $Double::random (:as (Random java/lang/Double) random.frac)) (def: $Double::literal (-> java/lang/Double (Bytecode Any)) /.double) (def: valid_double (Random java/lang/Double) - (random.filter (|>> (:coerce Frac) f.not_a_number? not) + (random.filter (|>> (:as Frac) f.not_a_number? not) ..$Double::random)) (def: $Double::primitive (Primitive java/lang/Double) @@ -269,10 +269,10 @@ (/.invokestatic ..$Character "valueOf" (/type.method [(list /type.char) ..$Character (list)]))) (def: $Character::random (Random java/lang/Character) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) (def: $Character::literal (-> java/lang/Character (Bytecode Any)) - (|>> ffi.char_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.char_to_long (:as I64) i32.i32 /.int)) (def: $Character::primitive (Primitive java/lang/Character) {#unboxed /type.char @@ -285,12 +285,12 @@ (/type.class "java.lang.String" (list))) (def: $String::random - (:coerce (Random java/lang/String) - (random.ascii/alpha 10))) + (:as (Random java/lang/String) + (random.ascii/alpha 10))) (def: $String::literal (-> java/lang/String (Bytecode Any)) - (|>> (:coerce Text) /.string)) + (|>> (:as Text) /.string)) (def: $String::primitive (Primitive java/lang/String) @@ -307,9 +307,9 @@ [expected (\ ! map (i64.and (i64.mask <bits>)) random.nat)] (<| (_.lift <message>) (..bytecode (for {@.old - (|>> (:coerce <type>) <to_long> ("jvm leq" expected)) + (|>> (:as <type>) <to_long> ("jvm leq" expected)) @.jvm - (|>> (:coerce <type>) <to_long> "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) + (|>> (:as <type>) <to_long> "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))})) (do /.monad [_ (<push> (|> expected .int <signed> try.assume))] <wrap>))))] @@ -352,10 +352,10 @@ (let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit)) (function (_ expected bytecode) (<| (..bytecode (for {@.old - (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)) + (|>> (:as java/lang/Integer) ("jvm ieq" expected)) @.jvm - (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))})) (do /.monad [_ bytecode] ..$Integer::wrap)))) @@ -382,7 +382,7 @@ shift (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do {! random.monad} - [parameter (\ ! map (|>> (n.% 32) .int (:coerce java/lang/Long) ffi.long_to_int) random.nat) + [parameter (\ ! map (|>> (n.% 32) .int (:as java/lang/Long) ffi.long_to_int) random.nat) subject ..$Integer::random] (int (reference parameter subject) (do /.monad @@ -390,13 +390,13 @@ _ (..$Integer::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "ICONST_M1" (int (ffi.long_to_int (:coerce java/lang/Long -1)) /.iconst_m1)) - (_.lift "ICONST_0" (int (ffi.long_to_int (:coerce java/lang/Long +0)) /.iconst_0)) - (_.lift "ICONST_1" (int (ffi.long_to_int (:coerce java/lang/Long +1)) /.iconst_1)) - (_.lift "ICONST_2" (int (ffi.long_to_int (:coerce java/lang/Long +2)) /.iconst_2)) - (_.lift "ICONST_3" (int (ffi.long_to_int (:coerce java/lang/Long +3)) /.iconst_3)) - (_.lift "ICONST_4" (int (ffi.long_to_int (:coerce java/lang/Long +4)) /.iconst_4)) - (_.lift "ICONST_5" (int (ffi.long_to_int (:coerce java/lang/Long +5)) /.iconst_5)) + (_.lift "ICONST_M1" (int (ffi.long_to_int (:as java/lang/Long -1)) /.iconst_m1)) + (_.lift "ICONST_0" (int (ffi.long_to_int (:as java/lang/Long +0)) /.iconst_0)) + (_.lift "ICONST_1" (int (ffi.long_to_int (:as java/lang/Long +1)) /.iconst_1)) + (_.lift "ICONST_2" (int (ffi.long_to_int (:as java/lang/Long +2)) /.iconst_2)) + (_.lift "ICONST_3" (int (ffi.long_to_int (:as java/lang/Long +3)) /.iconst_3)) + (_.lift "ICONST_4" (int (ffi.long_to_int (:as java/lang/Long +4)) /.iconst_4)) + (_.lift "ICONST_5" (int (ffi.long_to_int (:as java/lang/Long +5)) /.iconst_5)) (_.lift "LDC_W/INTEGER" (do random.monad [expected ..$Integer::random] @@ -410,7 +410,7 @@ (_.lift "INEG" (unary (function (_ value) ((int/2 "jvm isub" "jvm int -") value - (ffi.long_to_int (:coerce java/lang/Long +0)))) + (ffi.long_to_int (:as java/lang/Long +0)))) /.ineg))) bitwise ($_ _.and (_.lift "IAND" (binary (int/2 "jvm iand" "jvm int and") /.iand)) @@ -433,10 +433,10 @@ (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit)) (function (_ expected bytecode) (<| (..bytecode (for {@.old - (|>> (:coerce Int) (i.= expected)) + (|>> (:as Int) (i.= expected)) @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) (do /.monad [_ bytecode] ..$Long::wrap)))) @@ -461,7 +461,7 @@ shift (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do {! random.monad} - [parameter (\ ! map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat) + [parameter (\ ! map (|>> (n.% 64) (:as java/lang/Long)) random.nat) subject ..$Long::random] (long (reference (ffi.long_to_int parameter) subject) (do /.monad @@ -469,8 +469,8 @@ _ (..$Integer::literal (ffi.long_to_int parameter))] instruction))))) literal ($_ _.and - (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst_0)) - (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst_1)) + (_.lift "LCONST_0" (long (:as java/lang/Long +0) /.lconst_0)) + (_.lift "LCONST_1" (long (:as java/lang/Long +1) /.lconst_1)) (_.lift "LDC2_W/LONG" (do random.monad [expected ..$Long::random] @@ -484,7 +484,7 @@ (_.lift "LNEG" (unary (function (_ value) ((long/2 "jvm lsub" "jvm long -") value - (:coerce java/lang/Long +0))) + (:as java/lang/Long +0))) /.lneg))) bitwise ($_ _.and (_.lift "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) @@ -497,19 +497,19 @@ (do random.monad [reference ..$Long::random subject ..$Long::random - #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long +0) + #let [expected (cond (i.= (:as Int reference) (:as Int subject)) + (:as java/lang/Long +0) - (i.> (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long +1) + (i.> (:as Int reference) (:as Int subject)) + (:as java/lang/Long +1) - ## (i.< (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long -1))]] + ## (i.< (:as Int reference) (:as Int subject)) + (:as java/lang/Long -1))]] (<| (..bytecode (for {@.old - (|>> (:coerce Int) (i.= expected)) + (|>> (:as Int) (i.= expected)) @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) (do /.monad [_ (..$Long::literal subject) _ (..$Long::literal reference) @@ -533,15 +533,15 @@ (function (_ expected bytecode) (<| (..bytecode (for {@.old (function (_ actual) - (or (|> actual (:coerce java/lang/Float) ("jvm feq" expected)) - (and (f.not_a_number? (:coerce Frac (ffi.float_to_double expected))) - (f.not_a_number? (:coerce Frac (ffi.float_to_double (:coerce java/lang/Float actual))))))) + (or (|> actual (:as java/lang/Float) ("jvm feq" expected)) + (and (f.not_a_number? (:as Frac (ffi.float_to_double expected))) + (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual))))))) @.jvm (function (_ actual) - (or (|> actual (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected))) - (and (f.not_a_number? (:coerce Frac (ffi.float_to_double expected))) - (f.not_a_number? (:coerce Frac (ffi.float_to_double (:coerce java/lang/Float actual)))))))})) + (or (|> actual (:as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected))) + (and (f.not_a_number? (:as Frac (ffi.float_to_double expected))) + (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual)))))))})) (do /.monad [_ bytecode] ..$Float::wrap)))) @@ -568,9 +568,9 @@ _ (..$Float::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "FCONST_0" (float (ffi.double_to_float (:coerce java/lang/Double +0.0)) /.fconst_0)) - (_.lift "FCONST_1" (float (ffi.double_to_float (:coerce java/lang/Double +1.0)) /.fconst_1)) - (_.lift "FCONST_2" (float (ffi.double_to_float (:coerce java/lang/Double +2.0)) /.fconst_2)) + (_.lift "FCONST_0" (float (ffi.double_to_float (:as java/lang/Double +0.0)) /.fconst_0)) + (_.lift "FCONST_1" (float (ffi.double_to_float (:as java/lang/Double +1.0)) /.fconst_1)) + (_.lift "FCONST_2" (float (ffi.double_to_float (:as java/lang/Double +2.0)) /.fconst_2)) (_.lift "LDC_W/FLOAT" (do random.monad [expected ..$Float::random] @@ -584,12 +584,12 @@ (_.lift "FNEG" (unary (function (_ value) ((float/2 "jvm fsub" "jvm float -") value - (ffi.double_to_float (:coerce java/lang/Double +0.0)))) + (ffi.double_to_float (:as java/lang/Double +0.0)))) /.fneg))) comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [#let [valid_float (random.filter (|>> ffi.float_to_double (:coerce Frac) f.not_a_number? not) + [#let [valid_float (random.filter (|>> ffi.float_to_double (:as Frac) f.not_a_number? not) ..$Float::random)] reference valid_float subject valid_float @@ -602,7 +602,7 @@ (if (standard reference subject) +1 -1))]] - (<| (..bytecode (|>> (:coerce Int) (i.= expected))) + (<| (..bytecode (|>> (:as Int) (i.= expected))) (do /.monad [_ (..$Float::literal subject) _ (..$Float::literal reference) @@ -634,15 +634,15 @@ (function (_ expected bytecode) (<| (..bytecode (for {@.old (function (_ actual) - (or (|> actual (:coerce java/lang/Double) ("jvm deq" expected)) - (and (f.not_a_number? (:coerce Frac expected)) - (f.not_a_number? (:coerce Frac actual))))) + (or (|> actual (:as java/lang/Double) ("jvm deq" expected)) + (and (f.not_a_number? (:as Frac expected)) + (f.not_a_number? (:as Frac actual))))) @.jvm (function (_ actual) - (or (|> actual (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))) - (and (f.not_a_number? (:coerce Frac expected)) - (f.not_a_number? (:coerce Frac actual)))))})) + (or (|> actual (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))) + (and (f.not_a_number? (:as Frac expected)) + (f.not_a_number? (:as Frac actual)))))})) (do /.monad [_ bytecode] ..$Double::wrap)))) @@ -665,8 +665,8 @@ _ (..$Double::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst_0)) - (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst_1)) + (_.lift "DCONST_0" (double (:as java/lang/Double +0.0) /.dconst_0)) + (_.lift "DCONST_1" (double (:as java/lang/Double +1.0) /.dconst_1)) (_.lift "LDC2_W/DOUBLE" (do random.monad [expected ..$Double::random] @@ -680,7 +680,7 @@ (_.lift "DNEG" (unary (function (_ value) ((double/2 "jvm dsub" "jvm double -") value - (:coerce java/lang/Double +0.0))) + (:as java/lang/Double +0.0))) /.dneg))) comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) @@ -696,7 +696,7 @@ (if (standard reference subject) +1 -1))]] - (<| (..bytecode (|>> (:coerce Int) (i.= expected))) + (<| (..bytecode (|>> (:as Int) (i.= expected))) (do /.monad [_ (..$Double::literal subject) _ (..$Double::literal reference) @@ -749,7 +749,7 @@ (/.invokespecial ..$Object "<init>" (/type.method [(list) /type.void (list)]))))] ($_ _.and (<| (_.lift "ACONST_NULL") - (..bytecode (|>> (:coerce Bit) not)) + (..bytecode (|>> (:as Bit) not)) (do /.monad [_ /.aconst_null _ (/.instanceof ..$String)] @@ -757,13 +757,13 @@ (<| (_.lift "INSTANCEOF") (do random.monad [value ..$String::random]) - (..bytecode (|>> (:coerce Bit))) + (..bytecode (|>> (:as Bit))) (do /.monad - [_ (/.string (:coerce Text value)) + [_ (/.string (:as Text value)) _ (/.instanceof ..$String)] ..$Boolean::wrap)) (<| (_.lift "NEW & CHECKCAST") - (..bytecode (|>> (:coerce Bit))) + (..bytecode (|>> (:as Bit))) (do /.monad [_ !object _ (/.checkcast ..$Object) @@ -772,9 +772,9 @@ (<| (_.lift "MONITORENTER & MONITOREXIT") (do random.monad [value ..$String::random]) - (..bytecode (|>> (:coerce Bit))) + (..bytecode (|>> (:as Bit))) (do /.monad - [_ (/.string (:coerce Text value)) + [_ (/.string (:as Text value)) _ /.dup _ /.monitorenter _ /.dup _ /.monitorexit _ (/.instanceof ..$String)] @@ -786,20 +786,20 @@ ($_ _.and (<| (_.lift "INVOKESTATIC") (do random.monad - [expected (random.filter (|>> (:coerce Frac) f.not_a_number? not) + [expected (random.filter (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) (..bytecode (for {@.old - (|>> (:coerce java/lang/Double) ("jvm deq" expected)) + (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) (do /.monad [_ (/.double expected)] (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))) (<| (_.lift "INVOKEVIRTUAL") (do random.monad [expected ..$Double::random]) - (..bytecode (|>> (:coerce Bit) (bit\= (f.not_a_number? (:coerce Frac expected))))) + (..bytecode (|>> (:as Bit) (bit\= (f.not_a_number? (:as Frac expected))))) (do /.monad [_ (/.double expected) _ ..$Double::wrap @@ -807,13 +807,13 @@ ..$Boolean::wrap)) (<| (_.lift "INVOKESPECIAL") (do random.monad - [expected (random.filter (|>> (:coerce Frac) f.not_a_number? not) + [expected (random.filter (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) (..bytecode (for {@.old - (|>> (:coerce java/lang/Double) ("jvm deq" expected)) + (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) (do /.monad [_ (/.new ..$Double) _ /.dup @@ -822,9 +822,9 @@ (<| (_.lift "INVOKEINTERFACE") (do random.monad [subject ..$String::random]) - (..bytecode (|>> (:coerce Nat) (n.= (text.size (:coerce Text subject))))) + (..bytecode (|>> (:as Nat) (n.= (text.size (:as Text subject))))) (do /.monad - [_ (/.string (:coerce Text subject)) + [_ (/.string (:as Text subject)) _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) /type.int (list)])) _ /.i2l] ..$Long::wrap)) @@ -894,9 +894,9 @@ class (io.run (/loader.load class_name loader)) method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] - (wrap (:coerce Int output))) + (wrap (:as Int output))) (#try.Success actual) - (i.= (:coerce Int expected) (:coerce Int actual)) + (i.= (:as Int expected) (:as Int actual)) (#try.Failure error) false)))) @@ -906,7 +906,7 @@ (let [!length (: (-> Nat (Bytecode Any)) (function (_ size) (do /.monad - [_ ($Long::literal (:coerce java/lang/Long size))] + [_ ($Long::literal (:as java/lang/Long size))] /.l2i))) ?length (: (Bytecode Any) (do /.monad @@ -914,7 +914,7 @@ /.i2l)) length (: (-> Nat (Bytecode Any) (Random Bit)) (function (_ size constructor) - (<| (..bytecode (|>> (:coerce Nat) (n.= size))) + (<| (..bytecode (|>> (:as Nat) (n.= size))) (do /.monad [_ (!length size) _ constructor @@ -927,7 +927,7 @@ (-> a Any Bit) (Random Bit))) (function (_ size constructor value literal [*store *load *wrap] test) - (let [!index ($Integer::literal (ffi.long_to_int (:coerce java/lang/Long +0)))] + (let [!index ($Integer::literal (ffi.long_to_int (:as java/lang/Long +0)))] (<| (..bytecode (test value)) (do /.monad [_ (!length size) @@ -952,66 +952,66 @@ ($_ _.and (_.context "boolean" (array (/.newarray /instruction.t_boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] - (function (_ expected) (|>> (:coerce Bit) (bit\= (:coerce Bit expected)))))) + (function (_ expected) (|>> (:as Bit) (bit\= (:as Bit expected)))))) (_.context "byte" (array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) @.jvm - (|>> (:coerce java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:coerce java/lang/Byte expected)))))})))) + (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))})))) (_.context "short" (array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) @.jvm - (|>> (:coerce java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:coerce java/lang/Short expected)))))})))) + (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))})))) (_.context "int" (array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Integer) ("jvm ieq" (:coerce java/lang/Integer expected))) + (|>> (:as java/lang/Integer) ("jvm ieq" (:as java/lang/Integer expected))) @.jvm - (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:coerce java/lang/Integer expected))))})))) + (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:as java/lang/Integer expected))))})))) (_.context "long" (array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Long) ("jvm leq" expected)) + (|>> (:as java/lang/Long) ("jvm leq" expected)) @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})))) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))})))) (_.context "float" (array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Float) ("jvm feq" expected)) + (|>> (:as java/lang/Float) ("jvm feq" expected)) @.jvm - (|>> (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:coerce java/lang/Float expected))))})))) + (|>> (:as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:as java/lang/Float expected))))})))) (_.context "double" (array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Double) ("jvm deq" expected)) + (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:coerce java/lang/Double expected))))})))) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:as java/lang/Double expected))))})))) (_.context "char" (array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Character) ("jvm ceq" expected)) + (|>> (:as java/lang/Character) ("jvm ceq" expected)) @.jvm - (|>> (:coerce java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (:coerce java/lang/Character expected))))})))) + (|>> (:as java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (:as java/lang/Character expected))))})))) (_.context "object" (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] - (function (_ expected) (|>> (:coerce Text) (text\= (:coerce Text expected)))))) + (function (_ expected) (|>> (:as Text) (text\= (:as Text expected)))))) (<| (_.context "multi") (do {! random.monad} [#let [size (\ ! map (|>> (n.% 5) (n.+ 1)) @@ -1026,9 +1026,9 @@ 0 type _ (recur (dec dimensions) (/type.array type))))]] (<| (_.lift "MULTIANEWARRAY") - (..bytecode (|>> (:coerce Nat) (n.= sizesH))) + (..bytecode (|>> (:as Nat) (n.= sizesH))) (do {! /.monad} - [_ (monad.map ! (|>> (:coerce java/lang/Long) ffi.long_to_int ..$Integer::literal) + [_ (monad.map ! (|>> (:as java/lang/Long) ffi.long_to_int ..$Integer::literal) (#.Cons sizesH sizesT)) _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume)) _ ?length] @@ -1039,10 +1039,10 @@ (: (-> <type> Any Bit) (function (_ expected) (for {@.old - (|>> (:coerce <type>) (<old> expected)) + (|>> (:as <type>) (<old> expected)) @.jvm - (|>> (:coerce <type>) "jvm object cast" (<new> ("jvm object cast" (:coerce <type> expected))))})))) + (|>> (:as <type>) "jvm object cast" (<new> ("jvm object cast" (:as <type> expected))))})))) (def: conversion Test @@ -1070,19 +1070,19 @@ (_.lift "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) @.jvm - (|>> (:coerce java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:coerce java/lang/Byte expected)))))})))) + (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))})))) (_.lift "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> ffi.int_to_char) (!::= java/lang/Character "jvm ceq" "jvm char ="))) (_.lift "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> ffi.int_to_short) (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) @.jvm - (|>> (:coerce java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:coerce java/lang/Short expected)))))})))))) + (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))})))))) (<| (_.context "long") ($_ _.and (_.lift "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=)) @@ -1163,8 +1163,8 @@ ("jvm object cast" ("jvm long +" ("jvm object cast" (ffi.byte_to_long base)) - ("jvm object cast" (:coerce java/lang/Long (/unsigned.value increment)))))}))]] - (..bytecode (|>> (:coerce Int) (i.= (:coerce Int expected))) + ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))}))]] + (..bytecode (|>> (:as Int) (i.= (:as Int expected))) (do /.monad [_ (..$Byte::literal base) _ /.istore_0 @@ -1214,7 +1214,7 @@ (<| (_.context "object") (let [test (: (-> java/lang/String Any Bit) (function (_ expected actual) - (|> actual (:coerce Text) (text\= (:coerce Text expected)))))] + (|> actual (:as Text) (text\= (:as Text expected)))))] ($_ _.and (_.lift "ASTORE_0/ALOAD_0" (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_0) (function.constant /.aload_0)] test)) @@ -1233,7 +1233,7 @@ (do random.monad [expected/1 $String::random #let [object_test (: (-> Any Bit) - (|>> (:coerce Text) (text\= (:coerce Text expected/1))))] + (|>> (:as Text) (text\= (:as Text expected/1))))] dummy/1 $String::random #let [single ($_ _.and (<| (_.lift "DUP & POP") @@ -1268,7 +1268,7 @@ )] expected/2 $Long::random #let [long_test (: (-> Any Bit) - (|>> (:coerce Int) (i.= (:coerce Int expected/2))))] + (|>> (:as Int) (i.= (:as Int expected/2))))] dummy/2 $Long::random #let [double ($_ _.and (<| (_.lift "DUP2") @@ -1370,7 +1370,7 @@ (_.lift "LRETURN" (primitive_return ..$Long::primitive /.lreturn #.None (!::= java/lang/Long "jvm leq" "jvm long ="))) (_.lift "FRETURN" (primitive_return ..$Float::primitive /.freturn #.None (!::= java/lang/Float "jvm feq" "jvm float ="))) (_.lift "DRETURN" (primitive_return ..$Double::primitive /.dreturn #.None (!::= java/lang/Double "jvm deq" "jvm double ="))) - (_.lift "ARETURN" (primitive_return ..$String::primitive /.areturn #.None (function (_ expected actual) (text\= (:coerce Text expected) (:coerce Text actual))))) + (_.lift "ARETURN" (primitive_return ..$String::primitive /.areturn #.None (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) (_.lift "RETURN" (primitive_return (: (Primitive java/lang/String) {#unboxed /type.void #boxed ..$String @@ -1379,7 +1379,7 @@ #literal (function.constant /.nop)}) /.return (#.Some ..$String::literal) - (function (_ expected actual) (text\= (:coerce Text expected) (:coerce Text actual))))) + (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) ))) (def: branching @@ -1498,7 +1498,7 @@ random.nat) choice (\ ! map (n.% options) random.nat) options (|> random.int - (\ ! map (|>> (:coerce java/lang/Long) ffi.long_to_int ffi.int_to_long (:coerce Int))) + (\ ! map (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_long (:as Int))) (random.set i.hash options) (\ ! map set.to_list)) #let [choice (maybe.assume (list.nth choice options))] @@ -1509,7 +1509,7 @@ [@right /.new_label @wrong /.new_label @return /.new_label - _ (..$Integer::literal (ffi.long_to_int (:coerce java/lang/Long choice))) + _ (..$Integer::literal (ffi.long_to_int (:as java/lang/Long choice))) _ (/.lookupswitch @wrong (list\map (function (_ option) [(|> option /signed.s4 try.assume) (if (i.= choice option) @right @wrong)]) @@ -1596,11 +1596,11 @@ part3 ..$Long::random part4 ..$Long::random #let [expected ($_ i.+ - (:coerce Int part0) - (:coerce Int part1) - (:coerce Int part2) - (:coerce Int part3) - (:coerce Int part4)) + (:as Int part0) + (:as Int part1) + (:as Int part2) + (:as Int part3) + (:as Int part4)) $Concrete (/type.class concrete_class (list)) $Abstract (/type.class abstract_class (list)) $Interface (/type.class interface_class (list)) @@ -1711,9 +1711,9 @@ class (io.run (/loader.load concrete_class loader)) method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] - (wrap (:coerce Int output))) + (wrap (:as Int output))) (#try.Success actual) - (i.= (:coerce Int expected) (:coerce Int actual)) + (i.= (:as Int expected) (:as Int actual)) (#try.Failure error) false)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index 69f087de7..be4542936 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -50,7 +50,7 @@ (is? (|> expected <post-analysis>) (|> actual <post-synthesis>))] - [#////analysis.Unit (:coerce Text) #////synthesis.Text (|>)] + [#////analysis.Unit (:as Text) #////synthesis.Text (|>)] [#////analysis.Bit (|>) #////synthesis.Bit (|>)] [#////analysis.Nat .i64 #////synthesis.I64 .i64] [#////analysis.Int .i64 #////synthesis.I64 .i64] diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 86e7a63e5..933edbfa3 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -1,17 +1,21 @@ (.module: - [lux (#- type) - ["%" data/text/format (#+ format)] + [lux #* ["_" test (#+ Test)] [abstract - ["." monad (#+ do)]] + ["." monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] [control - pipe] + [pipe (#+ case>)]] [data ["." maybe] + ["." text ("#\." equivalence)] [collection - ["." list]]] + ["." list] + ["." array]]] [math - ["." random (#+ Random)] + ["." random (#+ Random) ("#\." monad)] [number ["n" nat]]]] {1 @@ -39,57 +43,45 @@ (def: #export random (Random Type) - (let [(^open "random\.") random.monad] - (random.rec (function (_ recur) - (let [pairG (random.and recur recur) - idG random.nat - quantifiedG (random.and (random\wrap (list)) recur)] - ($_ random.or - (random.and ..short (random\wrap (list))) - pairG - pairG - pairG - idG - idG - idG - quantifiedG - quantifiedG - pairG - (random.and ..name recur) - )))))) + (random.rec + (function (_ recur) + (let [pairG (random.and recur recur) + idG random.nat + quantifiedG (random.and (random\wrap (list)) recur)] + ($_ random.or + (random.and ..short (random\wrap (list))) + pairG + pairG + pairG + idG + idG + idG + quantifiedG + quantifiedG + pairG + (random.and ..name recur) + ))))) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) ($_ _.and - (do random.monad - [sample ..random] - (_.test "Every type is equal to itself." - (\ /.equivalence = sample sample))) - (_.test "Can apply quantified types (universal and existential quantification)." - (and (maybe.default #0 - (do maybe.monad - [partial (/.apply (list Bit) Ann) - full (/.apply (list Int) partial)] - (wrap (\ /.equivalence = full (#.Product Bit Int))))) - (|> (/.apply (list Bit) Text) - (case> #.None #1 _ #0)))) - (let [base (#.Named ["" "a"] (#.Product Bit Int)) - aliased (#.Named ["" "c"] - (#.Named ["" "b"] - base))] + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do {! random.monad} + [anonymousT (random.filter (|>> (case> (#.Named _ _) false + _ true)) + ..random) + name/0 ..name + name/1 ..name + #let [namedT (#.Named name/0 anonymousT) + aliasedT (#.Named name/1 namedT)]] ($_ _.and - (_.test "Can remove aliases from an already-named type." - (\ /.equivalence = - base - (/.un_alias aliased))) - (_.test "Can remove all names from a type." - (and (not (\ /.equivalence = - base - (/.un_name aliased))) - (\ /.equivalence = - (/.un_name base) - (/.un_name aliased)))))) + (_.cover [/.un_alias] + (\ /.equivalence = namedT (/.un_alias aliasedT))) + (_.cover [/.un_name] + (\ /.equivalence = anonymousT (/.un_name aliasedT))))) (do {! random.monad} [size (|> random.nat (\ ! map (n.% 3))) members (|> ..random @@ -105,17 +97,25 @@ #let [(^open "/\.") /.equivalence (^open "list\.") (list.equivalence /.equivalence)]] (`` ($_ _.and - (~~ (template [<desc> <ctor> <dtor> <unit>] - [(_.test (format "Can build and tear-down " <desc> " types.") - (let [flat (|> members <ctor> <dtor>)] - (or (list\= members flat) - (and (list\= (list) members) - (list\= (list <unit>) flat)))))] + (~~ (template [<ctor> <dtor> <unit>] + [(_.cover [<ctor> <dtor>] + (let [flat (|> members <ctor> <dtor>)] + (or (list\= members flat) + (and (list\= (list) members) + (list\= (list <unit>) flat)))))] - ["variant" /.variant /.flatten_variant Nothing] - ["tuple" /.tuple /.flatten_tuple Any] + [/.variant /.flatten_variant Nothing] + [/.tuple /.flatten_tuple Any] )) ))) + (_.cover [/.apply] + (and (<| (maybe.default #0) + (do maybe.monad + [partial (/.apply (list Bit) Ann) + full (/.apply (list Int) partial)] + (wrap (\ /.equivalence = full (#.Product Bit Int))))) + (|> (/.apply (list Bit) Text) + (case> #.None #1 _ #0)))) (do {! random.monad} [size (|> random.nat (\ ! map (n.% 3))) members (monad.seq ! (list.repeat size ..random)) @@ -130,46 +130,75 @@ #let [(^open "/\.") /.equivalence (^open "list\.") (list.equivalence /.equivalence)]] ($_ _.and - (_.test "Can build and tear-down function types." - (let [[inputs output] (|> (/.function members extra) /.flatten_function)] - (and (list\= members inputs) - (/\= extra output)))) - - (_.test "Can build and tear-down application types." - (let [[tfunc tparams] (|> extra (/.application members) /.flatten_application)] - (n.= (list.size members) (list.size tparams)))) + (_.cover [/.function /.flatten_function] + (let [[inputs output] (|> (/.function members extra) /.flatten_function)] + (and (list\= members inputs) + (/\= extra output)))) + (_.cover [/.application /.flatten_application] + (let [[tfunc tparams] (|> extra (/.application members) /.flatten_application)] + (n.= (list.size members) (list.size tparams)))) )) (do {! random.monad} - [size (|> random.nat (\ ! map (n.% 3))) - extra (|> ..random - (random.filter (function (_ type) - (case type - (^or (#.UnivQ _) (#.ExQ _)) - #0 + [size (|> random.nat (\ ! map (|>> (n.% 3) inc))) + body_type (|> ..random + (random.filter (function (_ type) + (case type + (^or (#.UnivQ _) (#.ExQ _)) + #0 - _ - #1)))) + _ + #1)))) #let [(^open "/\.") /.equivalence]] (`` ($_ _.and - (~~ (template [<desc> <ctor> <dtor>] - [(_.test (format "Can build and tear-down " <desc> " types.") - (let [[flat_size flat_body] (|> extra (<ctor> size) <dtor>)] - (and (n.= size flat_size) - (/\= extra flat_body))))] + (~~ (template [<ctor> <dtor>] + [(_.cover [<ctor> <dtor>] + (let [[flat_size flat_body] (|> body_type (<ctor> size) <dtor>)] + (and (n.= size flat_size) + (/\= body_type flat_body))))] - ["universally-quantified" /.univ_q /.flatten_univ_q] - ["existentially-quantified" /.ex_q /.flatten_ex_q] + [/.univ_q /.flatten_univ_q] + [/.ex_q /.flatten_ex_q] )) + (_.cover [/.quantified?] + (and (not (/.quantified? body_type)) + (|> body_type (/.univ_q size) /.quantified?) + (|> body_type (/.ex_q size) /.quantified?))) ))) - (_.test (%.name (name_of /.:by_example)) - (let [example (: (Maybe Nat) - #.None)] - (/\= (.type (List Nat)) - (/.:by_example [a] - (Maybe a) - example - - (List a))))) + (do {! random.monad} + [depth (|> random.nat (\ ! map (|>> (n.% 3) inc))) + element_type (|> ..random + (random.filter (function (_ type) + (case type + (^ (#.Primitive name (list element_type))) + (not (text\= array.type_name name)) + + _ + #1)))) + #let [(^open "/\.") /.equivalence]] + ($_ _.and + (_.cover [/.array /.flatten_array] + (let [[flat_depth flat_element] (|> element_type (/.array depth) /.flatten_array)] + (and (n.= depth flat_depth) + (/\= element_type flat_element)))) + (_.cover [/.array?] + (and (not (/.array? element_type)) + (/.array? (/.array depth element_type)))) + )) + (_.cover [/.:by_example] + (let [example (: (Maybe Nat) + #.None)] + (/\= (.type (List Nat)) + (/.:by_example [a] + (Maybe a) + example + + (List a))))) + (do {! random.monad} + [sample random.nat] + (_.cover [/.:log!] + (exec + (/.:log! sample) + true))) /abstract.test /check.test |