aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2022-12-18 18:55:32 -0400
committerEduardo Julian2022-12-18 18:55:32 -0400
commitc2830c26e55da02ac628be9a220cd824264cdc9e (patch)
tree40a0208ada85f7a6883b1fb48a7f10adbd22feb6 /stdlib
parent549cb9623c560fec165b9e88f112a406614f598e (diff)
Caching compiler artifacts into TAR files, instead of huge directories.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux/data/color/rgb.lux49
-rw-r--r--stdlib/source/library/lux/meta/compiler.lux46
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/cache.lux3
-rw-r--r--stdlib/source/library/lux/world/file.lux61
-rw-r--r--stdlib/source/program/compositor.lux313
-rw-r--r--stdlib/source/test/lux/meta.lux1094
-rw-r--r--stdlib/source/test/lux/meta/compiler.lux21
7 files changed, 913 insertions, 674 deletions
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)
+ )))