diff options
Diffstat (limited to '')
4 files changed, 65 insertions, 116 deletions
diff --git a/stdlib/source/lux/target/common_lisp.lux b/stdlib/source/lux/target/common_lisp.lux index 766c63a6d..f68d28c28 100644 --- a/stdlib/source/lux/target/common_lisp.lux +++ b/stdlib/source/lux/target/common_lisp.lux @@ -236,7 +236,8 @@ [char-code/1 "char-code"] [string/1 "string"] [write-line/1 "write-line"] - [pprint/1 "pprint"]]] + [pprint/1 "pprint"] + [identity/1 "identity"]]] [call/2 [in0 in1] [(Expression Any) (Expression Any)] [[apply/2 "apply"] [append/2 "append"] @@ -428,6 +429,10 @@ (-> Label (Expression Any) (Computation Any)) (..form (list (..var "return-from") (:transmutation target) value))) + (def: #export (return value) + (-> (Expression Any) (Computation Any)) + (..form (list (..var "return") value))) + (def: #export (cond clauses else) (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any)) (..form (list& (..var "cond") diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/primitive.lux index 7840ccccc..9357156f2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/primitive.lux @@ -1,11 +1,7 @@ (.module: [lux (#- i64) - [control - [pipe (#+ cond> new>)]] [target - ["_" common_lisp (#+ Expression)]]] - ["." // #_ - ["#." runtime]]) + ["_" common_lisp (#+ Expression)]]]) (def: #export bit (-> Bit (Expression Any)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux index 73f885ebd..cc50cc49f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux @@ -13,7 +13,7 @@ ["%" format (#+ format)] ["." encoding]] [collection - ["." list ("#\." functor)] + ["." list ("#\." functor monoid)] ["." row]]] ["." macro [syntax (#+ syntax:)] @@ -157,8 +157,9 @@ ..none)])))) (def: runtime//lux - (_.progn (list @lux//try - @lux//program_args))) + (List (Expression Any)) + (list @lux//try + @lux//program_args)) (def: last_index (|>> _.length/1 [(_.int +1)] _.-/2)) @@ -194,37 +195,35 @@ ## does a linear search, and is thus expensive. (runtime: (sum//get sum wantsLast wantedTag) (with_vars [sum_tag sum_flag] - (let [@exit (_.label "exit") - return! (_.return-from @exit) - no_match! (return! sum) + (let [no_match! (_.return sum) sum_value (_.nth/2 [(_.int +2) sum]) test_recursion! (_.if sum_flag ## Must iterate. (_.progn (list (_.setq wantedTag (_.-/2 [sum_tag wantedTag])) (_.setq sum sum_value))) no_match!)] - (_.progn (list (_.setq sum_tag (_.nth/2 [(_.int +0) sum])) - (_.setq sum_flag (_.nth/2 [(_.int +1) sum])) - (_.block @exit - (list (_.while (_.bool true) - (_.cond (list [(_.=/2 [sum_tag wantedTag]) - (_.if (_.equal/2 [wantsLast sum_flag]) - (return! sum_value) - test_recursion!)] + (_.while (_.bool true) + (_.let (list [sum_tag (_.nth/2 [(_.int +0) sum])] + [sum_flag (_.nth/2 [(_.int +1) sum])]) + (list (_.cond (list [(_.=/2 [sum_tag wantedTag]) + (_.if (_.equal/2 [wantsLast sum_flag]) + (_.return sum_value) + test_recursion!)] - [(_.>/2 [sum_tag wantedTag]) - test_recursion!] + [(_.>/2 [sum_tag wantedTag]) + test_recursion!] - [(_.and (_.</2 [sum_tag wantedTag]) - wantsLast) - (return! (variant' (_.-/2 [wantedTag sum_tag]) sum_flag sum_value))]) + [(_.and (_.</2 [sum_tag wantedTag]) + wantsLast) + (_.return (variant' (_.-/2 [wantedTag sum_tag]) sum_flag sum_value))]) - no_match!))))))))) + no_match!))))))) (def: runtime//adt - (_.progn (list @tuple//left - @tuple//right - @sum//get))) + (List (Expression Any)) + (list @tuple//left + @tuple//right + @sum//get)) (runtime: (i64//right_shift shift input) (_.if (_.=/2 [(_.int +0) shift]) @@ -238,7 +237,8 @@ [mask] _.logand/2)))) (def: runtime//i64 - @i64//right_shift) + (List (Expression Any)) + (list @i64//right_shift)) (runtime: (text//clip offset length text) (_.subseq/3 [text offset (_.+/2 [offset length])])) @@ -251,8 +251,9 @@ ..none))))) (def: runtime//text - (_.progn (list @text//index - @text//clip))) + (List (Expression Any)) + (list @text//index + @text//clip)) (runtime: (io//exit code) (_.progn (list (_.conditional+ (list "sbcl") @@ -270,15 +271,17 @@ (_.get-universal-time/0 [])])) (def: runtime//io - (_.progn (list @io//exit - @io//current_time))) + (List (Expression Any)) + (list @io//exit + @io//current_time)) (def: runtime - (_.progn (list runtime//adt - runtime//lux - runtime//i64 - runtime//text - runtime//io))) + (_.progn ($_ list\compose + runtime//adt + runtime//lux + runtime//i64 + runtime//text + runtime//io))) (def: #export generate (Operation [Registry Output]) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 48a024400..fa92a673a 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -54,13 +54,8 @@ (can_delete [] (! (Try Any)))) (`` (signature: #export (File !) - (~~ (template [<name> <output>] - [(: (Can_See <output>) - <name>)] - - [name Text] - [path Path] - )) + (: (Can_See Path) + path) (~~ (template [<name> <output>] [(: (Can_Query ! <output>) @@ -116,25 +111,27 @@ separator) )) +(def: #export (name system path) + (All [!] (-> (System !) Path Text)) + (|> path + (text.split_all_with (\ system separator)) + list.reverse + list.head + (maybe.default path))) + (def: (async_file file) (-> (File IO) (File Promise)) (`` (structure - (~~ (template [<forge> <name>+] - [(with_expansions [<rows> (template.splice <name>+)] - (template [<name>] - [(def: <name> (<forge> (|>> (!.use (\ file <name>)))))] - - <rows>))] - - [..can_see - [[name] [path]]] - - )) + (def: path + (..can_see + (|>> (!.use (\ file path))))) (~~ (template [<forge> <name>+] [(with_expansions [<rows> (template.splice <name>+)] (template [<name>] - [(def: <name> (<forge> (|>> (!.use (\ file <name>)) promise.future)))] + [(def: <name> + (<forge> + (|>> (!.use (\ file <name>)) promise.future)))] <rows>))] @@ -244,7 +241,6 @@ [isFile] [isDirectory] [canRead] [canWrite] [canExecute])) - (getName [] java/lang/String) (length [] #io #try long) (listFiles [] #io #try #? [java/io/File]) (getAbsolutePath [] #io #try java/lang/String) @@ -315,13 +311,6 @@ (wrap data) (\ io.monad wrap (exception.throw ..cannot_read_all_data path))))))) - (def: name - (..can_see - (function (name _) - (|> path - java/io/File::new - java/io/File::getName)))) - (def: path (..can_see (function (_ _) @@ -476,8 +465,7 @@ (rmdirSync [ffi.String] #io #try Any)) (ffi.import: JsPath - (sep ffi.String) - (basename [ffi.String] ffi.String)) + (sep ffi.String)) (template [<name> <path>] [(def: (<name> _) @@ -527,11 +515,6 @@ (function (_ _) (Fs::readFileSync [path] (..node_fs []))))) - (def: name - (..can_see - (function (_ _) - (JsPath::basename path (..node_path []))))) - (def: path (..can_see (function (_ _) @@ -711,7 +694,6 @@ (#static isfile [ffi.String] #io #try ffi.Boolean) (#static isdir [ffi.String] #io #try ffi.Boolean) (#static sep ffi.String) - (#static basename [ffi.String] ffi.String) (#static getsize [ffi.String] #io #try ffi.Integer) (#static getmtime [ffi.String] #io #try ffi.Float)) @@ -741,11 +723,6 @@ _ (PyFile::close [] file)] (wrap data))))) - (def: name - (..can_see - (function (_ _) - (os/path::basename [path])))) - (def: path (..can_see (function (_ _) @@ -973,15 +950,6 @@ #.None (wrap (exception.throw ..cannot_read_all_data [path]))))))) - (def: name - (..can_see - (function (_ _) - (|> path - (text.split_all_with ..default_separator) - list.reverse - list.head - (maybe.default path))))) - (def: path (..can_see (function (_ _) @@ -1209,15 +1177,6 @@ _ (RubyFile::close [] file)] (wrap data))))) - (def: name - (..can_see - (function (_ _) - (|> path - (text.split_all_with ..default_separator) - list.reverse - list.head - (maybe.default path))))) - (def: path (..can_see (function (_ _) @@ -1419,15 +1378,6 @@ (\ io.monad wrap (exception.throw ..cannot_find_file [path])) (wrap (..unpack [..byte_array_format data]))))))) - (def: name - (..can_see - (function (_ _) - (|> path - (text.split_all_with ..default_separator) - list.reverse - list.head - (maybe.default path))))) - (def: path (..can_see (function (_ _) @@ -1752,13 +1702,9 @@ (#try.Failure error) (wrap (#try.Failure error))))) -(def: (mock_file separator name path store) - (-> Text Text Path (Var Mock) (File Promise)) +(def: (mock_file separator path store) + (-> Text Path (Var Mock) (File Promise)) (structure - (def: name - (..can_see - (function.constant name))) - (def: path (..can_see (function.constant path))) @@ -1854,7 +1800,7 @@ |store| (..delete_mock_file! separator path |store|) [name |store|] (..create_mock_file! separator path (get@ #mock_last_modified file) |store|) |store| (..update_mock_file! separator path (get@ #mock_last_modified file) (get@ #mock_content file) |store|)] - (wrap [|store| (mock_file separator name path store)])) + (wrap [|store| (mock_file separator path store)])) (#try.Success [|store| moved]) (do ! [_ (stm.write |store| store)] @@ -1966,7 +1912,6 @@ (case node (#.Left file) (#.Some (..mock_file separator - node_name (format path separator node_name) store)) @@ -2023,7 +1968,7 @@ [|store| (stm.read store)] (wrap (do try.monad [[name file] (..retrieve_mock_file! separator path |store|)] - (wrap (..mock_file separator name path store))))))))) + (wrap (..mock_file separator path store))))))))) (def: create_file (..can_open @@ -2037,7 +1982,7 @@ (#try.Success [name |store|]) (do ! [_ (stm.write |store| store)] - (wrap (#try.Success (..mock_file separator name path store)))) + (wrap (#try.Success (..mock_file separator path store)))) (#try.Failure error) (wrap (#try.Failure error))))))))) |