diff options
| -rw-r--r-- | lux-cl/source/program.lux | 4 | ||||
| -rw-r--r-- | lux-js/source/program.lux | 4 | ||||
| -rw-r--r-- | lux-jvm/source/program.lux | 2 | ||||
| -rw-r--r-- | lux-lua/source/program.lux | 4 | ||||
| -rw-r--r-- | lux-php/source/program.lux | 4 | ||||
| -rw-r--r-- | lux-python/source/program.lux | 4 | ||||
| -rw-r--r-- | lux-r/source/program.lux | 4 | ||||
| -rw-r--r-- | lux-ruby/source/program.lux | 4 | ||||
| -rw-r--r-- | lux-scheme/source/program.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/color/rgb.lux | 49 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler.lux | 46 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/meta/cache.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/library/lux/world/file.lux | 61 | ||||
| -rw-r--r-- | stdlib/source/program/compositor.lux | 313 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta.lux | 1094 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler.lux | 21 |
16 files changed, 922 insertions, 699 deletions
diff --git a/lux-cl/source/program.lux b/lux-cl/source/program.lux index d2ecadfbf..8b68a960d 100644 --- a/lux-cl/source/program.lux +++ b/lux-cl/source/program.lux @@ -434,9 +434,7 @@ _.code ..then ..scope) - (format (/cli.target service) - (of file.default separator) - "program" + (format "program" extension)])] (..declare_success! [])) (io.io []))))))) diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 6c3cbec26..527ca0b73 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -736,9 +736,7 @@ ..extender service [(packager.package _.use_strict _.code _.then ..scope) - (format (cli.target service) - (of (the platform.#file_system platform) separator) - "program" + (format "program" (the context.#artifact_extension context))])] (..declare_success! [])) (io.io []))))) diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index ee70d6680..e1a719718 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -179,6 +179,6 @@ ..extender service [(packager.package context) - (format (cli.target service) (of file.default separator) "program.jar")])] + "program.jar"])] (..declare_success! [])) (io.io []))))) diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index 00f7641b8..a1760781c 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -908,9 +908,7 @@ _.code _.then (|>>)) - (format (cli.target service) - (of file.default separator) - "program" + (format "program" (the context.#artifact_extension context))])] (..declare_success! [])) (io.io []))))))) diff --git a/lux-php/source/program.lux b/lux-php/source/program.lux index 555cd577b..573969067 100644 --- a/lux-php/source/program.lux +++ b/lux-php/source/program.lux @@ -584,9 +584,7 @@ _.code _.then (|>>)) - (format (/cli.target service) - (of file.default separator) - "program" + (format "program" extension)])] (..declare_success! [])) (io.io []))))))) diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 16e262360..75297c8c8 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -594,9 +594,7 @@ _.code _.then ..scope) - (format (cli.target service) - (of file.default separator) - "program" + (format "program" extension)])] (..declare_success! [])) (io.io []))))) diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux index 637ea2013..248f4b211 100644 --- a/lux-r/source/program.lux +++ b/lux-r/source/program.lux @@ -618,9 +618,7 @@ _.code _.then ..scope) - (format (/cli.target service) - (of file.default separator) - "program" + (format "program" extension)])] (..declare_success! [])) (io.io []))))))) diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux index 64a9ccb34..5febd0b8f 100644 --- a/lux-ruby/source/program.lux +++ b/lux-ruby/source/program.lux @@ -1005,8 +1005,6 @@ ..extender service [packager.package - (format (cli.target service) - (of file.default separator) - "program")])] + "program"])] (..declare_success! [])) (io.io [])))) diff --git a/lux-scheme/source/program.lux b/lux-scheme/source/program.lux index 71cc75ff5..4546feb68 100644 --- a/lux-scheme/source/program.lux +++ b/lux-scheme/source/program.lux @@ -477,8 +477,6 @@ ..extender service [(packager.package now) - (format (/cli.target service) - (of file.default separator) - "program.tar")])] + "program.tar"])] (..declare_success! [])) (io.io []))))))) diff --git a/stdlib/source/library/lux/data/color/rgb.lux b/stdlib/source/library/lux/data/color/rgb.lux index 4dff2eb5d..1a140c9a4 100644 --- a/stdlib/source/library/lux/data/color/rgb.lux +++ b/stdlib/source/library/lux/data/color/rgb.lux @@ -89,19 +89,18 @@ [#blue] ))])) -(def .public black - RGB - [#red ..least - #green ..least - #blue ..least]) - -(def .public white - RGB - [#red ..most - #green ..most - #blue ..most]) - -(with_template [<monoid> <identity> <composite> <left> <right>] +(with_template [<color> <value>] + [(def .public <color> + RGB + [#red <value> + #green <value> + #blue <value>])] + + [black ..least] + [white ..most] + ) + +(with_template [<identity> <composite> <monoid>] [(def .public <monoid> (Monoid RGB) (implementation @@ -109,19 +108,17 @@ <identity>) (def (composite left right) - (let [left (<left> left) - right (<right> right)] - (`` [(,, (with_template [<slot>] - [<slot> (<composite> (the <slot> left) - (the <slot> right))] - - [#red] - [#green] - [#blue] - ))])))))] - - [addition ..black n.max |> |>] - [subtraction ..white n.min ..complement |>] + (`` [(,, (with_template [<slot>] + [<slot> (<composite> (the <slot> left) + (the <slot> right))] + + [#red] + [#green] + [#blue] + ))]))))] + + [..black n.max addition] + [..white n.min subtraction] ) (def (ratio it) diff --git a/stdlib/source/library/lux/meta/compiler.lux b/stdlib/source/library/lux/meta/compiler.lux index 0bac9c1be..4721d1374 100644 --- a/stdlib/source/library/lux/meta/compiler.lux +++ b/stdlib/source/library/lux/meta/compiler.lux @@ -1,24 +1,21 @@ (.require [library - [lux (.except Module Code #module) + [lux (.except Code #module) [control - ["<>" parser (.only)] - ["[0]" try (.only Try)] + [try (.only Try)] ["[0]" exception (.only Exception)]] [data - ["[0]" text] - ["[0]" binary (.only Binary) + [binary [\\format (.only Format)] - ["<[1]>" \\parser (.only Parser)]]] + [\\parser (.only Parser)]]] [world - ["[0]" file (.only Path)]]]] + ["[0]" file]]]] [/ [meta - ["[0]" archive (.only Output Archive) + ["[0]" archive (.only Archive) [key (.only Key)] [module - [descriptor (.only Descriptor Module)] - [document (.only Document)]]]]]) + ["[0]" descriptor]]]]]) (type .public Code Text) @@ -28,20 +25,21 @@ (type .public Input (Record - [#module Module - #file Path + [#module descriptor.Module + #file file.Path #hash Nat #code Code])) -(type .public (Compilation s d) +(type .public (Compilation state document) (Record - [#dependencies (List Module) - #process (-> s Archive - (Try [s (Either (Compilation s d) - (archive.Entry d))]))])) + [#dependencies (List descriptor.Module) + #process (-> state Archive + (Try [state (Either (Compilation state document) + (archive.Entry document))]))])) -(type .public (Compiler s d) - (-> Input (Compilation s d))) +(type .public (Compiler state document) + (-> Input + (Compilation state document))) (type .public Custom (Ex (_ state document) @@ -49,12 +47,14 @@ (Key document) (Format document) (Parser document) - (-> Input (Try (Compilation state document)))])) + (-> Input + (Try (Compilation state document)))])) -(type .public (Instancer s d) - (-> (Key d) (List Parameter) (Compiler s d))) +(type .public (Instancer state document) + (-> (Key document) (List Parameter) + (Compiler state document))) (exception.def .public (cannot_compile module) - (Exception Module) + (Exception descriptor.Module) (exception.report (list ["Module" module]))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache.lux b/stdlib/source/library/lux/meta/compiler/meta/cache.lux index e4825872c..e2c09daa8 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache.lux @@ -18,8 +18,7 @@ (def .public (path fs context) (All (_ !) (-> (file.System !) Context file.Path)) (let [/ (of fs separator)] - (format (the context.#target context) - / (the context.#host context) + (format (the context.#host context) / (version.format //.version)))) (def .public (enabled? fs context) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 608d9689e..94bea7fad 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -83,7 +83,9 @@ )) (def (un_rooted fs path) - (All (_ !) (-> (System !) Path (Maybe [Path Text]))) + (All (_ !) + (-> (System !) Path + (Maybe [Path Text]))) (let [/ (of fs separator)] (when (text.last_index / path) {.#None} @@ -96,20 +98,25 @@ (in [parent child]))))) (def .public (parent fs path) - (All (_ !) (-> (System !) Path (Maybe Path))) + (All (_ !) + (-> (System !) Path + (Maybe Path))) (|> path (..un_rooted fs) (maybe#each product.left))) (def .public (name fs path) - (All (_ !) (-> (System !) Path Text)) + (All (_ !) + (-> (System !) Path + Text)) (|> path (..un_rooted fs) (maybe#each product.right) (maybe.else path))) (def .public (async fs) - (-> (System IO) (System Async)) + (-> (System IO) + (System Async)) (`` (implementation (def separator (of fs separator)) @@ -143,7 +150,9 @@ ))) (def .public (rooted fs parent child) - (All (_ !) (-> (System !) Path Text Path)) + (All (_ !) + (-> (System !) Path Text + Path)) (format parent (of fs separator) child)) (with_template [<name>] @@ -961,7 +970,9 @@ (these))) (def .public (exists? monad fs path) - (All (_ !) (-> (Monad !) (System !) Path (! Bit))) + (All (_ !) + (-> (Monad !) (System !) Path + (! Bit))) (do monad [verdict (of fs file? path)] (if verdict @@ -983,7 +994,8 @@ (dictionary.empty text.hash)) (def (retrieve_mock_file! separator path mock) - (-> Text Path Mock (Try [Text Mock_File])) + (-> Text Path Mock + (Try [Text Mock_File])) (loop (again [directory mock trail (text.all_split_by separator path)]) (when trail @@ -1007,7 +1019,8 @@ (exception.except ..cannot_find_file [path])))) (def (update_mock_file! / path now content mock) - (-> Text Path Instant Binary Mock (Try Mock)) + (-> Text Path Instant Binary Mock + (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail @@ -1046,7 +1059,8 @@ (exception.except ..cannot_find_file [path])))) (def (delete_mock_node! / path mock) - (-> Text Path Mock (Try Mock)) + (-> Text Path Mock + (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail @@ -1081,7 +1095,9 @@ (exception.except ..cannot_delete [path])))) (def (attempt! transform var) - (All (_ a) (-> (-> a (Try a)) (Var a) (STM (Try Any)))) + (All (_ of) + (-> (-> of (Try of)) (Var of) + (STM (Try Any)))) (do [! stm.monad] [|var| (stm.read var)] (when (transform |var|) @@ -1094,7 +1110,8 @@ (in {try.#Failure error})))) (def (make_mock_directory! / path mock) - (-> Text Path Mock (Try Mock)) + (-> Text Path Mock + (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail @@ -1122,7 +1139,8 @@ (exception.except ..cannot_make_directory [path])))) (def (retrieve_mock_directory! / path mock) - (-> Text Path Mock (Try Mock)) + (-> Text Path Mock + (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail @@ -1148,7 +1166,8 @@ (again sub_directory tail))))))) (def .public (mock separator) - (-> Text (System Async)) + (-> Text + (System Async)) (let [store (stm.var ..empty_mock)] (`` (implementation (def separator @@ -1288,7 +1307,9 @@ )))) (def (check_or_make_directory monad fs path) - (All (_ !) (-> (Monad !) (System !) Path (! (Try Any)))) + (All (_ !) + (-> (Monad !) (System !) Path + (! (Try Any)))) (do monad [? (of fs directory? path)] (if ? @@ -1296,7 +1317,9 @@ (of fs make_directory path)))) (def .public (make_directories monad fs path) - (All (_ !) (-> (Monad !) (System !) Path (! (Try Any)))) + (All (_ !) + (-> (Monad !) (System !) Path + (! (Try Any)))) (let [rooted? (text.starts_with? (of fs separator) path) segments (text.all_split_by (of fs separator) path)] (when (if rooted? @@ -1328,7 +1351,9 @@ (in {try.#Failure error})))))))) (def .public (make_file monad fs content path) - (All (_ !) (-> (Monad !) (System !) Binary Path (! (Try Any)))) + (All (_ !) + (-> (Monad !) (System !) Binary Path + (! (Try Any)))) (do monad [? (of fs file? path)] (if ? @@ -1336,7 +1361,9 @@ (of fs write path content)))) (def .public (copy monad fs from to) - (All (_ !) (-> (Monad !) (System !) Path Path (! (Try Any)))) + (All (_ !) + (-> (Monad !) (System !) Path Path + (! (Try Any)))) (do (try.with monad) [data (of fs read from)] (of fs write to data))) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 474a267a3..d6cd14da5 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -16,7 +16,11 @@ ["[0]" text (.only) ["%" \\format (.only format)]] [collection - ["[0]" dictionary (.only Dictionary)]]] + ["[0]" dictionary (.only Dictionary)] + ["[0]" sequence (.use "[1]#[0]" monoid mix)] + ["[0]" list (.use "[1]#[0]" mix)]] + [format + ["[0]" tar (.only Tar)]]] [meta [type (.only sharing)] ["@" target] @@ -37,12 +41,12 @@ ["[0]E" synthesis]]]]] [meta [packager (.only Packager)] - [context (.only Context)] + ["[0]" context (.only Context)] ["[0]" cli (.only Service)] ["[0]" import] ["[0]" export] - ["[0]" cache - ["[1]" archive]] + ["[0]" cache (.only) + ["[1]/[0]" archive]] [archive (.only Archive) ["[0]" unit] [module @@ -52,15 +56,17 @@ ... ["[0]" interpreter] ] ["[0]" world - ["[0]" file] ["[0]" console] ["[1]/[0]" environment] + ["[0]" file (.only) + ["[1]/[0]" extension]] [time ["[0]" instant]]]]]) (def (or_crash! failure_description action) - (All (_ a) - (-> Text (Async (Try a)) (Async a))) + (All (_ of) + (-> Text (Async (Try of)) + (Async of))) (do [! async.monad] [?output action] (when ?output @@ -85,8 +91,9 @@ (in output)))) (def (timed process) - (All (_ a) - (-> (Async (Try a)) (Async (Try a)))) + (All (_ of) + (-> (Async (Try of)) + (Async (Try of)))) (do async.monad [.let [start (io.run! instant.now)] output process @@ -96,27 +103,31 @@ (format "Duration: ")))]] (in output))) -(def (package! fs host_dependencies [packager package] archive context) - (-> (file.System Async) (Dictionary file.Path Binary) [Packager file.Path] Archive (Maybe unit.ID) (Async (Try Any))) - (when (packager host_dependencies archive context) - {try.#Success content} - (when content - {.#Left content} - (of fs write package content) +(def (package! file_context fs host_dependencies [packager package] archive context) + (-> Context (file.System Async) (Dictionary file.Path Binary) [Packager file.Path] Archive (Maybe unit.ID) + (Async (Try Any))) + (let [target_root (the context.#target file_context) + package (file.rooted fs target_root package)] + (when (packager host_dependencies archive context) + {try.#Success content} + (when content + {.#Left content} + (of fs write package content) + + {.#Right content} + (do [! (try.with async.monad)] + [_ (of fs make_directory package) + _ (monad.each ! (function (_ [name content]) + (of fs write (file.rooted fs package name) content)) + content)] + (in []))) - {.#Right content} - (do [! (try.with async.monad)] - [_ (of fs make_directory package) - _ (monad.each ! (function (_ [name content]) - (of fs write (file.rooted fs package name) content)) - content)] - (in []))) - - {try.#Failure error} - (of async.monad in {try.#Failure error}))) + {try.#Failure error} + (of async.monad in {try.#Failure error})))) (def (load_host_dependencies fs host_dependencies) - (-> (file.System Async) (List file.Path) (Async (Try (Dictionary file.Path Binary)))) + (-> (file.System Async) (List file.Path) + (Async (Try (Dictionary file.Path Binary)))) (do [! (try.with async.monad)] [] (loop (again [pending host_dependencies @@ -132,7 +143,172 @@ (again tail (dictionary.has head content output))))))) +(def (hybrid_fs cache host) + (-> (file.System Async) (file.System Async) + (file.System Async)) + (`` (implementation + (def separator + (of host separator)) + (,, (with_template [<name>] + [(def (<name> path) + (do async.monad + [?/0 (of cache <name> path) + ?/1 (of host <name> path)] + (in (or ?/0 ?/1))))] + + [file?] + [directory?] + )) + (,, (with_template [<name>] + [(def <name> + (of cache <name>))] + + [make_directory] + [directory_files] + [sub_directories] + + [file_size] + [last_modified] + [can_execute?] + [delete] + )) + (def (read path) + (do async.monad + [it (of cache read path)] + (when it + {try.#Failure _} + (of host read path) + + _ + (in it)))) + (,, (with_template [<name>] + [(def <name> + (of cache <name>))] + + [modify] + [write] + [append] + [move] + )) + ))) + +(def cache_mode + tar.Mode + (all tar.and + tar.execute_by_other + tar.write_by_other + tar.read_by_other + + tar.execute_by_group + tar.write_by_group + tar.read_by_group + + tar.execute_by_owner + tar.write_by_owner + tar.read_by_owner + + tar.save_text + tar.set_group_id_on_execution + tar.set_user_id_on_execution + )) + +(def (cache_tar context fs) + (-> Context (file.System Async) + (Async (Try Tar))) + (loop (again [root (cache.path fs context)]) + (do [! (try.with async.monad)] + [files (of fs directory_files root) + subs (of fs sub_directories root) + files (monad.each ! (function (_ path) + (do ! + [content (of fs read path) + [path content] (async#in (do try.monad + [path (tar.path path) + content (tar.content content)] + (in [path content])))] + (in {tar.#Normal [path instant.epoch ..cache_mode tar.no_ownership content]}))) + files) + subs (monad.each ! again subs)] + (in (list#mix sequence#composite + (sequence.of_list files) + subs))))) + +(def (cache_path fs context) + (-> (file.System Async) Context + file.Path) + (%.format (the context.#target context) + (of fs separator) + (the context.#host context) + file/extension.tape_archive)) + +(def (cached_file_path fs full_path) + (-> (file.System Async) file.Path + [file.Path file.Path]) + (<| maybe.trusted + (do maybe.monad + [.let [/ (of fs separator)] + @ (text.last_index / full_path) + [directory file] (text.split_at @ full_path)] + (in [directory (text.replaced_once / "" file)])))) + (with_expansions [<parameters> (these anchor expression artifact)] + (def (load_cache! host_fs cache_fs context) + (-> (file.System Async) (file.System Async) Context + (Async (Try Any))) + (do [! async.monad] + [tar (of host_fs read (cache_path host_fs context))] + (when tar + {try.#Failure _} + (in {try.#Success []}) + + {try.#Success tar} + (do [! (try.with !)] + [tar (async#in (of tar.codec decoded tar)) + _ (sequence#mix (function (_ entry then) + (when entry + {tar.#Normal [path instant mode ownership content]} + (do ! + [_ then + .let [path (tar.from_path path) + directory (maybe.else path (file.parent cache_fs path))] + _ (is (Async (Try Any)) + (file.make_directories async.monad cache_fs directory))] + (of cache_fs write path (tar.data content))) + + _ + then)) + (in []) + tar)] + (in []))))) + + (def (cache! original_fs context platform) + (All (_ <parameters>) + (-> (file.System Async) Context (Platform <parameters>) + (Async (Try Any)))) + (do (try.with async.monad) + [cache (cache_tar context (the platform.#file_system platform))] + (of original_fs write + (cache_path original_fs context) + (of tar.codec encoded cache)))) + + (def (with_caching it) + (All (_ <parameters>) + (-> (Platform <parameters>) + [(file.System Async) (Platform <parameters>)])) + (let [cache_fs (file.mock (of (the platform.#file_system it) separator)) + it (revised platform.#file_system (hybrid_fs cache_fs) it)] + [cache_fs it])) + + (def (enable_output! original_fs context) + (-> (file.System Async) Context + (Async (Try Any))) + (let [target_root (the context.#target context)] + (do async.monad + [? (of original_fs directory? target_root)] + (if ? + (in {try.#Success []}) + (of original_fs make_directory target_root))))) + (def .public (compiler lux_compiler file_context expander host_analysis platform translation_bundle host_declaration_bundle program global extender service @@ -156,8 +332,12 @@ {cli.#Compilation compilation} (<| (or_crash! "Compilation failed:") ..timed - (do (try.with async.monad) - [import (import.import (the platform.#file_system platform) (the cli.#libraries compilation)) + (do [! (try.with !)] + [.let [original_fs (the platform.#file_system platform) + [cache_fs platform] (with_caching platform)] + _ (enable_output! original_fs file_context) + _ (load_cache! original_fs cache_fs file_context) + import (import.import (the platform.#file_system platform) (the cli.#libraries compilation)) .let [all_extensions [(analysisE.bundle host_analysis) synthesisE.bundle translation_bundle @@ -178,40 +358,48 @@ (the cli.#sources compilation) (the cli.#configuration compilation) all_extensions)))) - [archive state] (sharing [<parameters>] - (is (Platform <parameters>) - platform) - (is (Async (Try [Archive (declaration.State <parameters>)])) - (as_expected (platform.compile program - global - lux_compiler - phase_wrapper - import - file_context - extender - expander - platform - compilation - [archive state] - all_extensions)))) - _ (cache.cache! (the platform.#file_system platform) (the cli.#configuration compilation) file_context archive) - host_dependencies (..load_host_dependencies (the platform.#file_system platform) - (the cli.#host_dependencies compilation)) - - _ (..package! (for @.old (file.async file.default) - @.jvm (file.async file.default) - ... TODO: Handle this in a safer manner. - ... This would crash if the compiler was run on a browser. - @.js (maybe.trusted file.default)) - host_dependencies - packager,package - archive - (try.maybe ($/program.context archive)))] - (in (debug.log! "Compilation complete!")))) + archive,state (do async.monad + [archive,state (sharing [<parameters>] + (is (Platform <parameters>) + platform) + (is (Async (Try [Archive (declaration.State <parameters>)])) + (as_expected (platform.compile program + global + lux_compiler + phase_wrapper + import + file_context + extender + expander + platform + compilation + [archive state] + all_extensions))))] + (in {try.#Success archive,state}))] + (when archive,state + {try.#Success [archive state]} + (do ! + [_ (cache/archive.cache! (the platform.#file_system platform) (the cli.#configuration compilation) file_context archive) + _ (cache! original_fs file_context platform) + host_dependencies (..load_host_dependencies (the platform.#file_system platform) + (the cli.#host_dependencies compilation)) + + _ (..package! file_context + original_fs + host_dependencies + packager,package + archive + (try.maybe ($/program.context archive)))] + (in (debug.log! "Compilation complete!"))) + + {try.#Failure error} + (do ! + [_ (cache! original_fs file_context platform)] + (async#in {try.#Failure error}))))) {cli.#Export export} (<| (or_crash! "Export failed:") - (do (try.with async.monad) + (do (try.with !) [_ (export.export (the platform.#file_system platform) export)] (in (debug.log! "Export complete!")))) @@ -220,9 +408,10 @@ ... TODO: Fix the interpreter... (undefined) ... (<| (or_crash! "Interpretation failed:") - ... (do [! async.monad] + ... (do ! ... [console (|> console.default ... async.future ... (of ! each (|>> try.trusted console.async)))] ... (interpreter.run! (try.with async.monad) console platform interpretation translation_bundle))) - )))) + ))) + ) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 2a2787429..75cb0d09b 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -37,7 +37,7 @@ ["[0]" / (.only) ["[0]" type (.use "[1]#[0]" equivalence)]]] ["[0]" / - ... ["[1][0]" code] + ["[1][0]" code] ... ["[1][0]" location] ... ["[1][0]" symbol] ... ["[1][0]" configuration] @@ -55,479 +55,480 @@ ... "Python" (.,, (.these ["[1]/[0]" python])) ... "Ruby" (.,, (.these ["[1]/[0]" ruby])) ... (.,, (.these))))] - ... ["[1][0]/" compiler - ... ["[1][0]" arity] - ... ["[1][0]" version] - ... ["[1][0]" reference] - ... ["[1][0]" phase] - ... [language - ... [lux - ... ... ["[1][0]" syntax] - ... ["[1][0]" analysis] - ... ["[1][0]" synthesis] - ... ["[1][0]" phase - ... ["[1]/[0]" extension] - ... ["[1]/[0]" analysis] - ... ... ["[1]/[0]" synthesis] - ... ]]] - ... ["[1][0]" meta - ... ["[1]/[0]" archive] - ... ["[1]/[0]" cli] - ... ["[1]/[0]" export] - ... ["[1]/[0]" import] - ... ["[1]/[0]" context] - ... ["[1]/[0]" cache]]] + ["[1][0]" compiler + ... ["[1]/[0]" arity] + ... ["[1]/[0]" version] + ... ["[1]/[0]" reference] + ... ["[1]/[0]" phase] + ... [language + ... [lux + ... ... ["[1]/[0]" syntax] + ... ["[1]/[0]" analysis] + ... ["[1]/[0]" synthesis] + ... ["[1]/[0]" phase + ... ["[1]/[0]" extension] + ... ["[1]/[0]" analysis] + ... ... ["[1]/[0]" synthesis] + ... ]]] + ... ["[1]/[0]" meta + ... ["[1]/[0]" archive] + ... ["[1]/[0]" cli] + ... ["[1]/[0]" export] + ... ["[1]/[0]" import] + ... ["[1]/[0]" context] + ... ["[1]/[0]" cache]] + ] ]))) -... (def !expect -... (template (_ <pattern> <value>) -... [(when <value> -... <pattern> true -... _ false)])) +(def !expect + (template (_ <pattern> <value>) + [(when <value> + <pattern> true + _ false)])) -... (def compiler_related -... Test -... (do random.monad -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... nominal_type (random.upper_cased 1) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... configuration_feature (random.upper_cased 1) -... configuration_value (random.upper_cased 1) -... .let [configuration (list [configuration_feature configuration_value]) -... expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration configuration] -... .#source [location.dummy 0 source_code] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules (list) -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#Some {.#Nominal nominal_type (list)}} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (all _.and -... (_.coverage [/.result] -... (|> (of /.monad in expected) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual))))) -... (_.coverage [/.result'] -... (|> (of /.monad in expected) -... (/.result' expected_lux) -... (!expect (^.multi {try.#Success [actual_lux actual]} -... (and (same? expected_lux actual_lux) -... (n.= expected actual)))))) -... (_.coverage [/.compiler_state] -... (|> /.compiler_state -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_lux} -... (same? expected_lux actual_lux))))) -... (_.coverage [/.version] -... (|> /.version -... (/.result expected_lux) -... (!expect (^.multi {try.#Success it} -... (same? version it))))) -... (_.coverage [/.configuration] -... (|> /.configuration -... (/.result expected_lux) -... (!expect (^.multi {try.#Success it} -... (same? configuration it))))) -... ))) +(def compiler_related + Test + (do random.monad + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + nominal_type (random.upper_cased 1) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + configuration_feature (random.upper_cased 1) + configuration_value (random.upper_cased 1) + .let [configuration (list [configuration_feature configuration_value]) + expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration configuration] + .#source [location.dummy 0 source_code] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some {.#Nominal nominal_type (list)}} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.coverage [/.result] + (|> (of /.monad in expected) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual))))) + (_.coverage [/.result'] + (|> (of /.monad in expected) + (/.result' expected_lux) + (!expect (^.multi {try.#Success [actual_lux actual]} + (and (same? expected_lux actual_lux) + (n.= expected actual)))))) + (_.coverage [/.compiler_state] + (|> /.compiler_state + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_lux} + (same? expected_lux actual_lux))))) + (_.coverage [/.version] + (|> /.version + (/.result expected_lux) + (!expect (^.multi {try.#Success it} + (same? version it))))) + (_.coverage [/.configuration] + (|> /.configuration + (/.result expected_lux) + (!expect (^.multi {try.#Success it} + (same? configuration it))))) + ))) -... (def error_handling -... Test -... (do random.monad -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... nominal_type (random.upper_cased 1) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... expected_error (random.upper_cased 1) -... .let [expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 source_code] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules (list) -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#Some {.#Nominal nominal_type (list)}} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (all _.and -... (_.coverage [/.failure] -... (|> (/.failure expected_error) -... (is (Meta Any)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Failure actual_error} -... (text#= (location.with location.dummy expected_error) -... actual_error))))) -... (_.coverage [/.assertion] -... (and (|> (/.assertion expected_error true) -... (is (Meta Any)) -... (/.result expected_lux) -... (!expect {try.#Success []})) -... (|> (/.assertion expected_error false) -... (/.result expected_lux) -... (!expect (^.multi {try.#Failure actual_error} -... (text#= expected_error actual_error)))))) -... (_.coverage [/.either] -... (and (|> (/.either (of /.monad in expected) -... (is (Meta Nat) -... (/.failure expected_error))) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual)))) -... (|> (/.either (is (Meta Nat) -... (/.failure expected_error)) -... (of /.monad in expected)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual)))) -... (|> (/.either (is (Meta Nat) -... (/.failure expected_error)) -... (is (Meta Nat) -... (/.failure expected_error))) -... (/.result expected_lux) -... (!expect (^.multi {try.#Failure actual_error} -... (text#= (location.with location.dummy expected_error) -... actual_error)))) -... (|> (/.either (of /.monad in expected) -... (of /.monad in dummy)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual)))) -... )) -... (_.coverage [/.try] -... (and (|> (/.try (/.failure expected_error)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success {try.#Failure actual_error}} -... (text#= (location.with location.dummy expected_error) -... actual_error)))) -... (|> (/.try (of /.monad in expected)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success {try.#Success actual}} -... (same? expected actual)))))) -... ))) +(def error_handling + Test + (do random.monad + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + nominal_type (random.upper_cased 1) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_error (random.upper_cased 1) + .let [expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 source_code] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some {.#Nominal nominal_type (list)}} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.coverage [/.failure] + (|> (/.failure expected_error) + (is (Meta Any)) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= (location.with location.dummy expected_error) + actual_error))))) + (_.coverage [/.assertion] + (and (|> (/.assertion expected_error true) + (is (Meta Any)) + (/.result expected_lux) + (!expect {try.#Success []})) + (|> (/.assertion expected_error false) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= expected_error actual_error)))))) + (_.coverage [/.either] + (and (|> (/.either (of /.monad in expected) + (is (Meta Nat) + (/.failure expected_error))) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + (|> (/.either (is (Meta Nat) + (/.failure expected_error)) + (of /.monad in expected)) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + (|> (/.either (is (Meta Nat) + (/.failure expected_error)) + (is (Meta Nat) + (/.failure expected_error))) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= (location.with location.dummy expected_error) + actual_error)))) + (|> (/.either (of /.monad in expected) + (of /.monad in dummy)) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + )) + (_.coverage [/.try] + (and (|> (/.try (/.failure expected_error)) + (/.result expected_lux) + (!expect (^.multi {try.#Success {try.#Failure actual_error}} + (text#= (location.with location.dummy expected_error) + actual_error)))) + (|> (/.try (of /.monad in expected)) + (/.result expected_lux) + (!expect (^.multi {try.#Success {try.#Success actual}} + (same? expected actual)))))) + ))) -... (def module_related -... Test -... (do random.monad -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... imported_module_name (random.only (|>> (text#= expected_current_module) not) -... (random.upper_cased 1)) -... nominal_type (random.upper_cased 1) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... expected_short (random.upper_cased 1) -... dummy_module (random.only (function (_ module) -... (not (or (text#= expected_current_module module) -... (text#= imported_module_name module)))) -... (random.upper_cased 1)) -... .let [imported_module [.#module_hash 0 -... .#module_aliases (list) -... .#definitions (list) -... .#imports (list) -... .#module_state {.#Active}] -... expected_module [.#module_hash 0 -... .#module_aliases (list) -... .#definitions (list) -... .#imports (list imported_module_name) -... .#module_state {.#Active}] -... expected_modules (list [expected_current_module -... expected_module] -... [imported_module_name -... imported_module]) -... expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 source_code] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules expected_modules -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#Some {.#Nominal nominal_type (list)}} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (<| (_.for [.Module]) -... (all _.and -... (_.coverage [/.current_module_name] -... (|> /.current_module_name -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_current_module} -... (text#= expected_current_module actual_current_module))))) -... (_.coverage [/.current_module] -... (|> /.current_module -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_module} -... (same? expected_module actual_module))))) -... (_.coverage [/.module] -... (|> (/.module expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_module} -... (same? expected_module actual_module))))) -... (_.coverage [/.module_exists?] -... (and (|> (/.module_exists? expected_current_module) -... (/.result expected_lux) -... (!expect {try.#Success .true})) -... (|> (/.module_exists? dummy_module) -... (/.result expected_lux) -... (!expect {try.#Success .false})))) -... (_.coverage [/.modules] -... (|> /.modules -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_modules} -... (same? expected_modules actual_modules))))) -... (_.coverage [/.imported_modules] -... (and (|> (/.imported_modules expected_current_module) -... (/.result expected_lux) -... (try#each (of (list.equivalence text.equivalence) = -... (list imported_module_name))) -... (try.else false)) -... (|> (/.imported_modules imported_module_name) -... (/.result expected_lux) -... (try#each (of (list.equivalence text.equivalence) = -... (list))) -... (try.else false)))) -... (_.coverage [/.imported_by?] -... (|> (/.imported_by? imported_module_name expected_current_module) -... (/.result expected_lux) -... (try.else false))) -... (_.coverage [/.imported?] -... (|> (/.imported? imported_module_name) -... (/.result expected_lux) -... (try.else false))) -... (_.coverage [/.normal] -... (and (|> (/.normal ["" expected_short]) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success [actual_module actual_short]} -... (and (text#= expected_current_module actual_module) -... (same? expected_short actual_short))))) -... (|> (/.normal [dummy_module expected_short]) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success [actual_module actual_short]} -... (and (text#= dummy_module actual_module) -... (same? expected_short actual_short))))))) -... )))) +(def module_related + Test + (do random.monad + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + imported_module_name (random.only (|>> (text#= expected_current_module) not) + (random.upper_cased 1)) + nominal_type (random.upper_cased 1) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_short (random.upper_cased 1) + dummy_module (random.only (function (_ module) + (not (or (text#= expected_current_module module) + (text#= imported_module_name module)))) + (random.upper_cased 1)) + .let [imported_module [.#module_hash 0 + .#module_aliases (list) + .#definitions (list) + .#imports (list) + .#module_state {.#Active}] + expected_module [.#module_hash 0 + .#module_aliases (list) + .#definitions (list) + .#imports (list imported_module_name) + .#module_state {.#Active}] + expected_modules (list [expected_current_module + expected_module] + [imported_module_name + imported_module]) + expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 source_code] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules expected_modules + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some {.#Nominal nominal_type (list)}} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (<| (_.for [.Module]) + (all _.and + (_.coverage [/.current_module_name] + (|> /.current_module_name + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_current_module} + (text#= expected_current_module actual_current_module))))) + (_.coverage [/.current_module] + (|> /.current_module + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_module} + (same? expected_module actual_module))))) + (_.coverage [/.module] + (|> (/.module expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_module} + (same? expected_module actual_module))))) + (_.coverage [/.module_exists?] + (and (|> (/.module_exists? expected_current_module) + (/.result expected_lux) + (!expect {try.#Success .true})) + (|> (/.module_exists? dummy_module) + (/.result expected_lux) + (!expect {try.#Success .false})))) + (_.coverage [/.modules] + (|> /.modules + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_modules} + (same? expected_modules actual_modules))))) + (_.coverage [/.imported_modules] + (and (|> (/.imported_modules expected_current_module) + (/.result expected_lux) + (try#each (of (list.equivalence text.equivalence) = + (list imported_module_name))) + (try.else false)) + (|> (/.imported_modules imported_module_name) + (/.result expected_lux) + (try#each (of (list.equivalence text.equivalence) = + (list))) + (try.else false)))) + (_.coverage [/.imported_by?] + (|> (/.imported_by? imported_module_name expected_current_module) + (/.result expected_lux) + (try.else false))) + (_.coverage [/.imported?] + (|> (/.imported? imported_module_name) + (/.result expected_lux) + (try.else false))) + (_.coverage [/.normal] + (and (|> (/.normal ["" expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_module actual_short]} + (and (text#= expected_current_module actual_module) + (same? expected_short actual_short))))) + (|> (/.normal [dummy_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_module actual_short]} + (and (text#= dummy_module actual_module) + (same? expected_short actual_short))))))) + )))) -... (def random_location -... (Random Location) -... (all random.and -... (random.upper_cased 1) -... random.nat -... random.nat)) +(def random_location + (Random Location) + (all random.and + (random.upper_cased 1) + random.nat + random.nat)) -... (def context_related -... (do [! random.monad] -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... expected_type (of ! each (function (_ name) -... {.#Nominal name (list)}) -... (random.upper_cased 1)) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... expected_location ..random_location -... .let [type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 source_code] -... .#location expected_location -... .#current_module {.#Some expected_current_module} -... .#modules (list) -... .#scopes (list) -... .#type_context type_context -... .#expected {.#Some expected_type} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (all _.and -... (_.coverage [/.target] -... (|> /.target -... (/.result expected_lux) -... (try#each (same? target)) -... (try.else false))) -... (_.coverage [/.seed] -... (|> (do /.monad -... [pre /.seed -... post /.seed] -... (in [pre post])) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success [actual_pre actual_post]} -... (and (n.= expected_seed actual_pre) -... (n.= (++ expected_seed) actual_post)))))) -... (_.coverage [/.location] -... (|> /.location -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_location} -... (same? expected_location actual_location))))) -... (_.coverage [/.expected_type] -... (|> /.expected_type -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_type} -... (same? expected_type actual_type))))) -... (_.coverage [.Type_Context /.type_context] -... (|> /.type_context -... (/.result expected_lux) -... (try#each (same? type_context)) -... (try.else false))) -... ))) +(def context_related + (do [! random.monad] + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + expected_type (of ! each (function (_ name) + {.#Nominal name (list)}) + (random.upper_cased 1)) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_location ..random_location + .let [type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 source_code] + .#location expected_location + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context type_context + .#expected {.#Some expected_type} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.coverage [/.target] + (|> /.target + (/.result expected_lux) + (try#each (same? target)) + (try.else false))) + (_.coverage [/.seed] + (|> (do /.monad + [pre /.seed + post /.seed] + (in [pre post])) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_pre actual_post]} + (and (n.= expected_seed actual_pre) + (n.= (++ expected_seed) actual_post)))))) + (_.coverage [/.location] + (|> /.location + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_location} + (same? expected_location actual_location))))) + (_.coverage [/.expected_type] + (|> /.expected_type + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_type} + (same? expected_type actual_type))))) + (_.coverage [.Type_Context /.type_context] + (|> /.type_context + (/.result expected_lux) + (try#each (same? type_context)) + (try.else false))) + ))) -... (def definition_related -... Test -... (do [! random.monad] -... [expected_current_module (random.upper_cased 1) -... expected_macro_module (random.only (|>> (text#= expected_current_module) not) -... (random.upper_cased 1)) -... expected_short (random.upper_cased 1) -... expected_type (of ! each (function (_ name) -... {.#Nominal name (list)}) -... (random.upper_cased 1)) -... expected_value (random.either (in .def) -... (in .macro)) -... .let [expected_lux -... (is (-> Bit (Maybe Type) -... [(List [Text .Global]) -... (List [Text .Global]) -... Lux]) -... (function (_ exported? def_type) -... (let [current_globals (is (List [Text .Global]) -... (list [expected_short -... {.#Alias [expected_macro_module expected_short]}])) -... macro_globals (is (List [Text .Global]) -... (when def_type -... {.#Some def_type} -... (list [expected_short -... {.#Definition [exported? def_type expected_value]}]) +(def definition_related + Test + (do [! random.monad] + [expected_current_module (random.upper_cased 1) + expected_macro_module (random.only (|>> (text#= expected_current_module) not) + (random.upper_cased 1)) + expected_short (random.upper_cased 1) + expected_type (of ! each (function (_ name) + {.#Nominal name (list)}) + (random.upper_cased 1)) + expected_value (random.either (in .def) + (in .macro)) + .let [expected_lux + (is (-> Bit (Maybe Type) + [(List [Text [Bit .Global]]) + (List [Text [Bit .Global]]) + Lux]) + (function (_ exported? def_type) + (let [current_globals (is (List [Text [Bit .Global]]) + (list [expected_short + [false {.#Alias [expected_macro_module expected_short]}]])) + macro_globals (is (List [Text [Bit .Global]]) + (when def_type + {.#Some def_type} + (list [expected_short + [exported? {.#Definition [def_type expected_value]}]]) -... {.#None} -... (list)))] -... [current_globals -... macro_globals -... [.#info [.#target "" -... .#version "" -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 ""] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules (list [expected_current_module -... [.#module_hash 0 -... .#module_aliases (list) -... .#definitions current_globals -... .#imports (list) -... .#module_state {.#Active}]] -... [expected_macro_module -... [.#module_hash 0 -... .#module_aliases (list) -... .#definitions macro_globals -... .#imports (list) -... .#module_state {.#Active}]]) -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#None} -... .#seed 0 -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]])))]] -... (all _.and -... (_.coverage [.Global .Alias /.globals] -... (let [[current_globals macro_globals expected_lux] -... (expected_lux true {.#Some .Macro}) + {.#None} + (list)))] + [current_globals + macro_globals + [.#info [.#target "" + .#version "" + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 ""] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules (list [expected_current_module + [.#module_hash 0 + .#module_aliases (list) + .#definitions current_globals + .#imports (list) + .#module_state {.#Active}]] + [expected_macro_module + [.#module_hash 0 + .#module_aliases (list) + .#definitions macro_globals + .#imports (list) + .#module_state {.#Active}]]) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#None} + .#seed 0 + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]])))]] + (all _.and + (_.coverage [.Global .Alias /.globals] + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro}) -... current_globals! -... (|> (/.globals expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_globals} -... (same? current_globals actual_globals)))) + current_globals! + (|> (/.globals expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_globals} + (same? current_globals actual_globals)))) -... macro_globals! -... (|> (/.globals expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_globals} -... (same? macro_globals actual_globals))))] -... (and current_globals! -... macro_globals!))) -... (_.coverage [.Definition /.definitions] -... (let [[current_globals macro_globals expected_lux] -... (expected_lux true {.#Some .Macro})] -... (and (|> (/.definitions expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... (|> (/.definitions expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 1 (list.size actual_definitions))))) -... ))) -... (_.coverage [/.exports] -... (and (let [[current_globals macro_globals expected_lux] -... (expected_lux true {.#Some .Macro})] -... (and (|> (/.exports expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... (|> (/.exports expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 1 (list.size actual_definitions))))) -... )) -... (let [[current_globals macro_globals expected_lux] -... (expected_lux false {.#Some .Macro})] -... (and (|> (/.exports expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... (|> (/.exports expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... )))) -... ))) + macro_globals! + (|> (/.globals expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_globals} + (same? macro_globals actual_globals))))] + (and current_globals! + macro_globals!))) + (_.coverage [.Definition /.definitions] + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (and (|> (/.definitions expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.definitions expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 1 (list.size actual_definitions))))) + ))) + (_.coverage [/.exports] + (and (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (and (|> (/.exports expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 1 (list.size actual_definitions))))) + )) + (let [[current_globals macro_globals expected_lux] + (expected_lux false {.#Some .Macro})] + (and (|> (/.exports expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + )))) + ))) ... (def search_related ... Test @@ -968,96 +969,100 @@ ... (try.else false)))) ... ))) -... (def injection -... (Injection Meta) -... (of /.monad in)) +(def injection + (Injection Meta) + (of /.monad in)) -... (def (comparison init) -... (-> Lux (Comparison Meta)) -... (function (_ == left right) -... (when [(/.result init left) -... (/.result init right)] -... [{try.#Success left} {try.#Success right}] -... (== left right) +(def (comparison init) + (-> Lux (Comparison Meta)) + (function (_ == left right) + (when [(/.result init left) + (/.result init right)] + [{try.#Success left} {try.#Success right}] + (== left right) -... _ -... false))) + _ + false))) (`` (`` (def .public test Test (<| (_.covering /._) - (_.for [.Meta .Lux]) + (_.for [.Meta .Lux + .#info .#source .#location .#current_module + .#modules .#scopes .#type_context .#expected + .#seed .#scope_type_vars .#extensions .#eval + .#host]) (all _.and - ... (do [! random.monad] - ... [target (random.upper_cased 1) - ... version (random.upper_cased 1) - ... source_code (random.upper_cased 1) - ... expected_current_module (random.upper_cased 1) - ... expected_type (of ! each (function (_ name) - ... {.#Nominal name (list)}) - ... (random.upper_cased 1)) - ... expected_seed random.nat - ... expected random.nat - ... dummy (random.only (|>> (n.= expected) not) random.nat) - ... expected_location ..random_location - ... .let [expected_lux [.#info [.#target target - ... .#version version - ... .#mode {.#Build} - ... .#configuration (list)] - ... .#source [expected_location 0 source_code] - ... .#location expected_location - ... .#current_module {.#Some expected_current_module} - ... .#modules (list) - ... .#scopes (list) - ... .#type_context [.#ex_counter 0 - ... .#var_counter 0 - ... .#var_bindings (list)] - ... .#expected {.#Some expected_type} - ... .#seed expected_seed - ... .#scope_type_vars (list) - ... .#extensions [] - ... .#eval (as (-> Type Code (Meta Any)) []) - ... .#host []]]] - ... (all _.and - ... (_.for [/.functor] - ... (functorT.spec ..injection (..comparison expected_lux) /.functor)) - ... (_.for [/.apply] - ... (applyT.spec ..injection (..comparison expected_lux) /.apply)) - ... (_.for [/.monad] - ... ($monad.spec ..injection (..comparison expected_lux) /.monad)) + (do [! random.monad] + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + expected_type (of ! each (function (_ name) + {.#Nominal name (list)}) + (random.upper_cased 1)) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_location ..random_location + .let [expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [expected_location 0 source_code] + .#location expected_location + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some expected_type} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.for [/.functor] + (functorT.spec ..injection (..comparison expected_lux) /.functor)) + (_.for [/.apply] + (applyT.spec ..injection (..comparison expected_lux) /.apply)) + (_.for [/.monad] + ($monad.spec ..injection (..comparison expected_lux) /.monad)) - ... (do random.monad - ... [expected_value random.nat - ... expected_error (random.upper_cased 1)] - ... (_.coverage [/.of_try] - ... (and (|> expected_error - ... {try.#Failure} - ... (is (Try Nat)) - ... /.of_try - ... (/.result expected_lux) - ... (!expect (^.multi {try.#Failure actual} - ... (text#= (location.with expected_location expected_error) - ... actual)))) - ... (|> expected_value - ... {try.#Success} - ... (is (Try Nat)) - ... /.of_try - ... (/.result expected_lux) - ... (!expect (^.multi {try.#Success actual} - ... (same? expected_value actual))))))) - - ... ..compiler_related - ... ..error_handling - ... ..module_related - ... ..context_related - ... ..definition_related - ... ..search_related - ... ..locals_related - ... (_.for [.Label] - ... ..label_related) - ... )) + (do random.monad + [expected_value random.nat + expected_error (random.upper_cased 1)] + (_.coverage [/.of_try] + (and (|> expected_error + {try.#Failure} + (is (Try Nat)) + /.of_try + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual} + (text#= (location.with expected_location expected_error) + actual)))) + (|> expected_value + {try.#Success} + (is (Try Nat)) + /.of_try + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (same? expected_value actual))))))) + + ..compiler_related + ..error_handling + ..module_related + ..context_related + ..definition_related + ... ..search_related + ... ..locals_related + ... (_.for [.Label] + ... ..label_related) + )) - ... /code.test + /code.test ... /location.test ... /symbol.test ... /configuration.test @@ -1076,6 +1081,7 @@ (,, (these /extension.test)))) /global.test + /compiler.test ... /compiler/arity.test ... /compiler/version.test ... /compiler/reference.test diff --git a/stdlib/source/test/lux/meta/compiler.lux b/stdlib/source/test/lux/meta/compiler.lux new file mode 100644 index 000000000..6e56ccfac --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler.lux @@ -0,0 +1,21 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [math + ["[0]" random (.only Random)]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (all _.and + (_.coverage [/.Code /.Parameter /.Input] + true) + ))) |