aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--documentation/bookmark/tool/text_editor.md1
-rw-r--r--lux-ruby/commands.md2
-rw-r--r--lux-ruby/project.clj2
-rw-r--r--lux-ruby/source/program.lux413
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/platform.lux216
5 files changed, 343 insertions, 291 deletions
diff --git a/documentation/bookmark/tool/text_editor.md b/documentation/bookmark/tool/text_editor.md
index c8d43be64..43db79a29 100644
--- a/documentation/bookmark/tool/text_editor.md
+++ b/documentation/bookmark/tool/text_editor.md
@@ -227,6 +227,7 @@
## Structured editing
+1. [The Animated Guide to Symex](https://countvajhula.com/2021/09/25/the-animated-guide-to-symex/)
1. [Leo](https://www.leoeditor.com/)
1. [Inspiring a future Clojure editor with forgotten Lisp UX - Shaun Lebron](https://www.youtube.com/watch?v=K0Tsa3smr1w)
1. [Dion Systems - The How And Why Of Reinventing The Wheel](https://vimeo.com/485177664)
diff --git a/lux-ruby/commands.md b/lux-ruby/commands.md
index 2503b550d..e5eaf2372 100644
--- a/lux-ruby/commands.md
+++ b/lux-ruby/commands.md
@@ -34,6 +34,6 @@ cd ~/lux/stdlib/ \
```
cd ~/lux/lux-ruby/ \
-&& mvn install:install-file -Dfile=target/program.jar -DgroupId=com.github.luxlang -DartifactId=lux-ruby -Dversion=0.6.3 -Dpackaging=jar
+&& mvn install:install-file -Dfile=target/program.jar -DgroupId=com.github.luxlang -DartifactId=lux-ruby -Dversion=0.6.4-SNAPSHOT -Dpackaging=jar
```
diff --git a/lux-ruby/project.clj b/lux-ruby/project.clj
index 4a1029887..3b66aef9d 100644
--- a/lux-ruby/project.clj
+++ b/lux-ruby/project.clj
@@ -3,7 +3,7 @@
(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/")
(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/")
-(defproject com.github.luxlang/lux-ruby #=(identity version)
+(defproject com.github.luxlang/lux-ruby "0.6.4-SNAPSHOT" ;; #=(identity version)
:description "A Ruby compiler for Lux."
:url ~repo
:license {:name "Lux License v0.1.2"
diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux
index ee569e392..7e3f4ef91 100644
--- a/lux-ruby/source/program.lux
+++ b/lux-ruby/source/program.lux
@@ -1,81 +1,84 @@
(.using
- [library
- [lux "*"
- [program {"+" program:}]
- ["[0]" debug]
- ["[0]" ffi {"+" import:}]
- ["[0]" meta]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- [pipe {"+" new>}]
- ["[0]" maybe]
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- ["[0]" io {"+" IO io}]
- ["[0]" function]
- [concurrency
- ["[0]" async {"+" Async}]]
- ["<>" parser
- ["<[0]>" code]]]
- [data
- ["[0]" text ("[1]#[0]" hash)
- ["%" format {"+" format}]
- [encoding
- ["[0]" utf8]]]
- [collection
- ["[0]" array {"+" Array}]
- ["[0]" list]]]
- ["[0]" macro
- [syntax {"+" syntax:}]
- ["[0]" template]]
- [math
- [number {"+" hex}
- ["n" nat]
- ["i" int]
- ["[0]" i64]]]
- ["[0]" world "_"
- ["[0]" file]
- ["[1]/[0]" program]]
- ["@" target
- ["_" ruby]]
- [tool
- [compiler
- ["[0]" phase {"+" Operation Phase}]
- [reference
- [variable {"+" Register}]]
- [language
- [lux
- [program {"+" Program}]
- [generation {"+" Context Host}]
- ["[0]" synthesis]
- [analysis
- [macro {"+" Expander}]]
- [phase
- ["[0]" extension {"+" Extender Handler}
- ["[1]/[0]" bundle]
- ["[0]" analysis "_"
- ["[1]" ruby]]
- ["[0]" generation "_"
- ["[1]" ruby]]]
- [generation
- ["[0]" reference]
- ["[0]" ruby
- ["[0]" runtime]]]]]]
- [default
- ["[0]" platform {"+" Platform}]]
- [meta
- [archive {"+" Archive}]
- ["[0]" packager "_"
- ["[1]" script]]]]]]]
- [program
- ["/" compositor
- ["/[0]" cli]
- ["/[0]" static]]])
+ [library
+ [lux "*"
+ [program {"+" program:}]
+ ["[0]" debug]
+ ["[0]" ffi {"+" import:}]
+ ["[0]" meta]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ [pipe {"+" new>}]
+ ["[0]" maybe]
+ ["[0]" try {"+" Try}]
+ ["[0]" exception {"+" exception:}]
+ ["[0]" io {"+" IO io}]
+ ["[0]" function]
+ [concurrency
+ ["[0]" async {"+" Async}]]
+ ["<>" parser
+ ["<[0]>" code]]]
+ [data
+ ["[0]" text ("[1]#[0]" hash)
+ ["%" format {"+" format}]
+ [encoding
+ ["[0]" utf8]]]
+ [collection
+ ["[0]" array {"+" Array}]
+ ["[0]" list]]]
+ ["[0]" macro
+ [syntax {"+" syntax:}]
+ ["[0]" template]]
+ [math
+ [number {"+" hex}
+ ["n" nat]
+ ["i" int]
+ ["[0]" i64]]]
+ ["[0]" world "_"
+ ["[0]" file]
+ ["[1]/[0]" program]]
+ ["@" target
+ ["_" ruby]]
+ [tool
+ [compiler
+ ["[0]" phase {"+" Operation Phase}]
+ [reference
+ [variable {"+" Register}]]
+ [language
+ [lux
+ [program {"+" Program}]
+ [generation {"+" Context Host}]
+ ["[0]" synthesis]
+ [analysis
+ [macro {"+" Expander}]]
+ [phase
+ ["[0]" extension {"+" Extender Handler}
+ ["[1]/[0]" bundle]
+ ["[0]" analysis "_"
+ ["[1]" ruby]]
+ ["[0]" generation "_"
+ ["[1]" ruby]]]
+ [generation
+ ["[0]" reference]
+ ["[0]" ruby
+ ["[0]" runtime]]]]]]
+ [default
+ ["[0]" platform {"+" Platform}]]
+ [meta
+ [archive {"+" Archive}]
+ ["[0]" packager "_"
+ ["[1]" script]]]]]]]
+ [program
+ ["/" compositor
+ ["/[0]" cli]
+ ["/[0]" static]]])
(import: java/lang/String)
-(import: (java/lang/Class a))
+(import: (java/lang/Class a)
+ ["[1]::[0]"
+ (getSuperclass [] (java/lang/Class ?))
+ (isInstance [java/lang/Object] boolean)])
(import: java/lang/Object
["[1]::[0]"
@@ -242,6 +245,17 @@
(again (++ idx) (array.write! idx lux_value output))))
{try.#Success output}))))
+(def: function_abstract_class
+ (|> ..read_tuple
+ (:as java/lang/Object)
+ java/lang/Object::getClass
+ java/lang/Class::getSuperclass))
+
+(def: (function? value)
+ (-> Any Bit)
+ (java/lang/Class::isInstance (:as java/lang/Object value)
+ ..function_abstract_class))
+
(exception: (unknown_kind_of_object [object java/lang/Object])
(exception.report
["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
@@ -252,18 +266,18 @@
(case [(org/jruby/RubyHash::get (:as java/lang/String runtime.variant_tag_field) host_object)
(org/jruby/RubyHash::get (:as java/lang/String runtime.variant_flag_field) host_object)
(org/jruby/RubyHash::get (:as java/lang/String runtime.variant_value_field) host_object)]
- (^multi [{.#Some tag} ?flag {.#Some value}]
- [(read value)
- {try.#Success value}])
- {try.#Success [(:as Any (java/lang/Long::intValue (:as java/lang/Long tag)))
- (:as Any
- (case ?flag
- {.#Some _}
- ""
-
- {.#None}
- (ffi.null)))
- (:as Any value)]}
+ [{.#Some tag} ?flag {.#Some value}]
+ (do try.monad
+ [value (read value)]
+ (in [(:as Any (java/lang/Long::intValue (:as java/lang/Long tag)))
+ (:as Any
+ (case ?flag
+ {.#Some _}
+ ""
+
+ {.#None}
+ (ffi.null)))
+ (:as Any value)]))
_
(exception.except ..unknown_kind_of_object [(:as java/lang/Object host_object)])))
@@ -285,6 +299,7 @@
[java/lang/Long [{try.#Success}]]
[java/lang/Double [{try.#Success}]]
[java/lang/String [{try.#Success}]]
+ [org/jruby/RubyString [org/jruby/RubyString::asJavaString {try.#Success}]]
[[java/lang/Object] [{try.#Success}]]
[org/jruby/RubyArray [(read_tuple read)]]
[org/jruby/RubyHash [(read_variant read)]]
@@ -292,7 +307,8 @@
[org/jruby/RubyProc [{try.#Success}]]
[org/jruby/java/proxies/JavaProxy [org/jruby/java/proxies/JavaProxy::getObject {try.#Success}]]
))
- (exception.except ..unknown_kind_of_object [host_object])
+ ... (exception.except ..unknown_kind_of_object [host_object])
+ {try.#Success host_object}
)))
(def: ruby_nil
@@ -303,44 +319,36 @@
org/jruby/RubyString
(org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime ""))
-(def: (wrapped_lux_value lux_structure value)
- (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
+(def: (wrapped_lux_value useful_object_class lux_structure)
+ (-> (-> (-> java/lang/Object org/jruby/runtime/builtin/IRubyObject)
+ (Array java/lang/Object)
+ org/jruby/RubyClass)
+ (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
(-> java/lang/Object org/jruby/runtime/builtin/IRubyObject))
- (<| (case (ffi.check [java/lang/Object] value)
- {.#Some value}
- (|> value (:as (Array java/lang/Object)) lux_structure)
-
- {.#None})
- (case (ffi.check java/lang/Boolean value)
- {.#Some value}
- (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime value)
-
- {.#None})
- (case (ffi.check java/lang/Long value)
- {.#Some value}
- (org/jruby/RubyFixnum::new ..initial_ruby_runtime value)
-
- {.#None})
- (case (ffi.check java/lang/Double value)
- {.#Some value}
- (org/jruby/RubyFloat::new ..initial_ruby_runtime value)
-
- {.#None})
- (case (ffi.check java/lang/String value)
- {.#Some value}
- (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime value)
-
- {.#None})
- (:as org/jruby/runtime/builtin/IRubyObject value)))
+ (function (again value)
+ (`` (<| (~~ (template [<when> <then>]
+ [(case (ffi.check <when> value)
+ {.#Some value}
+ (|> value <then>)
+
+ {.#None})]
+
+ [[java/lang/Object] (<| lux_structure (:as (Array java/lang/Object)))]
+ [java/lang/Boolean (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime)]
+ [java/lang/Long (org/jruby/RubyFixnum::new ..initial_ruby_runtime)]
+ [java/lang/Double (org/jruby/RubyFloat::new ..initial_ruby_runtime)]
+ [java/lang/String (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime)]
+ [org/jruby/runtime/builtin/IRubyObject (<|)]
+ ))
+ ... (:as org/jruby/runtime/builtin/IRubyObject value)
+ (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime
+ (useful_object_class again (:as (Array java/lang/Object) value))
+ (:as java/lang/Object value))))))
(exception: (invalid_variant_access [field Text])
(exception.report
["Field" (%.text field)]))
-(exception: (invalid_tuple_access [index Nat])
- (exception.report
- ["Index" (%.nat index)]))
-
(exception: (invalid_index [index java/lang/Object])
(exception.report
["Class" (|> index
@@ -353,8 +361,11 @@
["[1]::[0]"
("static" [t] copyOfRange [[t] int int] [t])])
-(def: (lux_wrapper_access lux_structure value)
- (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
+(def: (lux_wrapper_access useful_object_class lux_structure value)
+ (-> (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
+ (Array java/lang/Object)
+ org/jruby/RubyClass)
+ (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
(-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod))
(ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod []
[java/lang/String "[]"]
@@ -368,61 +379,70 @@
block org/jruby/runtime/Block])
org/jruby/runtime/builtin/IRubyObject
(let [member (ffi.read! 0 args)]
- (<| (case (ffi.check org/jruby/RubyFixnum member)
- {.#Some member}
- (case (array.read! (org/jruby/RubyFixnum::getLongValue member) value)
- {.#Some value}
- (wrapped_lux_value lux_structure value)
-
- {.#None}
- (panic! (exception.error ..invalid_tuple_access [(org/jruby/RubyFixnum::getLongValue member)])))
-
- {.#None})
- (case (ffi.check org/jruby/RubyString member)
- {.#Some member}
- (case (:as Text (org/jruby/RubyString::asJavaString member))
- (^ (static runtime.variant_tag_field))
- (|> value
- (array.read! 0)
- maybe.trusted
- (:as java/lang/Integer)
- java/lang/Integer::longValue
- (org/jruby/RubyFixnum::new ..initial_ruby_runtime))
-
- (^ (static runtime.variant_flag_field))
- (case (array.read! 1 value)
- {.#None}
- ..ruby_nil
-
- {.#Some flag}
- ..lux_unit)
-
- (^ (static runtime.variant_value_field))
- (case (array.read! 2 value)
+ (if (function? value)
+ (case (..read (:as java/lang/Object member))
+ {try.#Success input}
+ (|> ((:as (-> Any Any) value) input)
+ (:as java/lang/Object)
+ (wrapped_lux_value useful_object_class lux_structure))
+
+ {try.#Failure error}
+ (panic! error))
+ (<| (case (ffi.check org/jruby/RubyFixnum member)
+ {.#Some member}
+ (case (array.read! (org/jruby/RubyFixnum::getLongValue member) value)
{.#Some value}
- (wrapped_lux_value lux_structure value)
+ (wrapped_lux_value useful_object_class lux_structure value)
{.#None}
- (panic! (exception.error ..nil_has_no_lux_representation [])))
+ ..ruby_nil)
+
+ {.#None})
+ (case (ffi.check org/jruby/RubyString member)
+ {.#Some member}
+ (case (:as Text (org/jruby/RubyString::asJavaString member))
+ (^ (static runtime.variant_tag_field))
+ (|> value
+ (array.read! 0)
+ maybe.trusted
+ (:as java/lang/Integer)
+ java/lang/Integer::longValue
+ (org/jruby/RubyFixnum::new ..initial_ruby_runtime))
+
+ (^ (static runtime.variant_flag_field))
+ (case (array.read! 1 value)
+ {.#None}
+ ..ruby_nil
+
+ {.#Some flag}
+ ..lux_unit)
+
+ (^ (static runtime.variant_value_field))
+ (case (array.read! 2 value)
+ {.#Some value}
+ (wrapped_lux_value useful_object_class lux_structure value)
- field
- (panic! (exception.error ..invalid_variant_access [field])))
-
- {.#None})
- (case (ffi.check org/jruby/RubyRange member)
- {.#Some member}
- (case [(|> member (org/jruby/RubyRange::first thread_context) (ffi.check org/jruby/RubyFixnum))
- (|> member (org/jruby/RubyRange::size thread_context) (ffi.check org/jruby/RubyFixnum))]
- [{.#Some first} {.#Some size}]
- (let [first (org/jruby/RubyFixnum::getLongValue first)
- size (org/jruby/RubyFixnum::getLongValue size)]
- (lux_structure (java/util/Arrays::copyOfRange value first (i.+ first size))))
-
- _
- (panic! (exception.error ..invalid_index (:as java/lang/Object member))))
-
- {.#None})
- (panic! (exception.error ..invalid_index (:as java/lang/Object member))))))))
+ {.#None}
+ (panic! (exception.error ..nil_has_no_lux_representation [])))
+
+ field
+ (panic! (exception.error ..invalid_variant_access [field])))
+
+ {.#None})
+ (case (ffi.check org/jruby/RubyRange member)
+ {.#Some member}
+ (case [(|> member (org/jruby/RubyRange::first thread_context) (ffi.check org/jruby/RubyFixnum))
+ (|> member (org/jruby/RubyRange::size thread_context) (ffi.check org/jruby/RubyFixnum))]
+ [{.#Some first} {.#Some size}]
+ (let [first (org/jruby/RubyFixnum::getLongValue first)
+ size (org/jruby/RubyFixnum::getLongValue size)]
+ (lux_structure (java/util/Arrays::copyOfRange value first (i.+ first size))))
+
+ _
+ (panic! (exception.error ..invalid_index (:as java/lang/Object member))))
+
+ {.#None})
+ (panic! (exception.error ..invalid_index (:as java/lang/Object member)))))))))
(def: (lux_wrapper_equality value)
(-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod)
@@ -521,33 +541,40 @@
(exception.report
["Method" (%.text method)]))
-(def: (lux_structure value)
- (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
- (let [meta_class (ffi.object [] org/jruby/RubyClass []
- [org/jruby/Ruby ..initial_ruby_runtime]
+(def: (useful_object_class lux_structure value)
+ (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
+ (Array java/lang/Object)
+ org/jruby/RubyClass)
+ (ffi.object [] org/jruby/RubyClass []
+ [org/jruby/Ruby ..initial_ruby_runtime]
+
+ (org/jruby/RubyClass
+ [] (searchWithCache self [method java/lang/String])
+ org/jruby/runtime/callsite/CacheEntry
+ (case (:as Text method)
+ "[]"
+ (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_access useful_object_class lux_structure value) 0)
- (org/jruby/RubyClass
- [] (searchWithCache self [method java/lang/String])
- org/jruby/runtime/callsite/CacheEntry
- (case (:as Text method)
- "[]"
- (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_access lux_structure value) 0)
+ (^or "==" "equal?")
+ (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_equality value) 1)
- (^or "==" "equal?")
- (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_equality value) 1)
+ (^or "count" "length" "size")
+ (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_length value) 2)
- "length"
- (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_length value) 2)
+ (^or "to_s" "inspect")
+ (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_to_s value) 3)
- (^or "to_s" "inspect")
- (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_to_s value) 3)
+ "respond_to?"
+ (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_respond_to? value) 4)
- "respond_to?"
- (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_respond_to? value) 4)
+ _
+ (panic! (exception.error ..unknown_method [(:as Text method)]))))))
- _
- (panic! (exception.error ..unknown_method [(:as Text method)])))))]
- (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime meta_class (:as java/lang/Object value))))
+(def: (lux_structure value)
+ (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
+ (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime
+ (useful_object_class lux_structure value)
+ (:as java/lang/Object value)))
(exception: (cannot_apply_a_non_function [object java/lang/Object])
(exception.report
diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux
index d5ab85c58..6c38763b0 100644
--- a/stdlib/source/library/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux
@@ -574,103 +574,127 @@
try.trusted
product.left))
+ ... TODO: Come up with a less hacky way to prevent duplicate imports.
+ ... This currently assumes that all imports will be specified once in a single .using form.
+ ... This might not be the case in the future.
+ (def: (with_new_dependencies new_dependencies all_dependencies)
+ (-> (List Module) (Set Module) [(Set Module) (Set Module)])
+ (let [[all_dependencies duplicates _] (: [(Set Module) (Set Module) Bit]
+ (list#mix (function (_ new [all duplicates seen_prelude?])
+ (if (set.member? all new)
+ (if (text#= .prelude_module new)
+ (if seen_prelude?
+ [all (set.has new duplicates) seen_prelude?]
+ [all duplicates true])
+ [all (set.has new duplicates) seen_prelude?])
+ [(set.has new all) duplicates seen_prelude?]))
+ (: [(Set Module) (Set Module) Bit]
+ [all_dependencies ..empty (set.empty? all_dependencies)])
+ new_dependencies))]
+ [all_dependencies duplicates]))
+
+ (def: (after_imports import! module duplicates new_dependencies [archive state])
+ (All (_ <type_vars>)
+ (-> <Importer> Module (Set Module) (List Module) <Context> <Return>))
+ (do [! (try.with async.monad)]
+ []
+ (if (set.empty? duplicates)
+ (case new_dependencies
+ {.#End}
+ (in [archive state])
+
+ {.#Item _}
+ (do !
+ [archive,document+ (|> new_dependencies
+ (list#each (import! module))
+ (monad.all ..monad))
+ .let [archive (|> archive,document+
+ (list#each product.left)
+ (list#mix archive.merged archive))]]
+ (in [archive (try.trusted
+ (..updated_state archive
+ (list#each product.right archive,document+)
+ state))])))
+ (async#in (exception.except ..cannot_import_twice [module duplicates])))))
+
+ (def: (next_compilation module [archive state] compilation)
+ (All (_ <type_vars>)
+ (-> Module <Context> (///.Compilation <State+> .Module Any)
+ (Try [<State+> (Either (///.Compilation <State+> .Module Any)
+ [Descriptor (Document .Module) Output])])))
+ ((value@ ///.#process compilation)
+ ... TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP.
+ ... TODO: The context shouldn't need to be re-set either.
+ (|> (///directive.set_current_module module)
+ (///phase.result' state)
+ try.trusted
+ product.left)
+ archive))
+
+ (def: (compiler phase_wrapper expander platform)
+ (All (_ <type_vars>)
+ (-> ///phase.Wrapper Expander <Platform>
+ (///.Compiler <State+> .Module Any)))
+ (let [instancer (//init.compiler phase_wrapper expander syntax.prelude (value@ #write platform))]
+ (instancer $.key (list))))
+
+ (def: (serial_compiler import static platform compilation_sources compiler)
+ (All (_ <type_vars>)
+ (-> Import Static <Platform> (List Context) (///.Compiler <State+> .Module Any)
+ <Compiler>))
+ (function (_ importer import! module_id [archive state] module)
+ (do [! (try.with async.monad)]
+ [input (context.read (value@ #&file_system platform)
+ importer
+ import
+ compilation_sources
+ (value@ static.#host_module_extension static)
+ module)]
+ (loop [[archive state] [archive (..set_current_module module state)]
+ compilation (compiler input)
+ all_dependencies (: (Set Module)
+ (set.of_list text.hash (list)))]
+ (do !
+ [.let [new_dependencies (value@ ///.#dependencies compilation)
+ [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)]
+ [archive state] (after_imports import! module duplicates new_dependencies [archive state])]
+ (case (next_compilation module [archive state] compilation)
+ {try.#Success [state more|done]}
+ (case more|done
+ {.#Left more}
+ (let [continue! (:sharing [<type_vars>]
+ <Platform>
+ platform
+
+ (-> <Context> (///.Compilation <State+> .Module Any) (Set Module)
+ (Action [Archive <State+>]))
+ (:expected again))]
+ (continue! [archive state] more all_dependencies))
+
+ {.#Right [descriptor document output]}
+ (do !
+ [.let [_ (debug.log! (..module_compilation_log module state))
+ descriptor (with@ descriptor.#references all_dependencies descriptor)]
+ _ (..cache_module static platform module_id [descriptor document output])]
+ (case (archive.has module [descriptor document output] archive)
+ {try.#Success archive}
+ (in [archive
+ (..with_reset_log state)])
+
+ {try.#Failure error}
+ (async#in {try.#Failure error}))))
+
+ {try.#Failure error}
+ (do !
+ [_ (ioW.freeze (value@ #&file_system platform) static archive)]
+ (async#in {try.#Failure error}))))))))
+
(def: .public (compile phase_wrapper import static expander platform compilation context)
(All (_ <type_vars>)
(-> ///phase.Wrapper Import Static Expander <Platform> Compilation <Context> <Return>))
- (let [[compilation_sources compilation_host_dependencies compilation_libraries compilation_target compilation_module] compilation
- base_compiler (:sharing [<type_vars>]
- <Context>
- context
-
- (///.Compiler <State+> .Module Any)
- (:expected
- ((//init.compiler phase_wrapper expander syntax.prelude (value@ #write platform)) $.key (list))))
- compiler (..parallel
- context
- (function (_ importer import! module_id [archive state] module)
- (do [! (try.with async.monad)]
- [.let [state (..set_current_module module state)]
- input (context.read (value@ #&file_system platform)
- importer
- import
- compilation_sources
- (value@ static.#host_module_extension static)
- module)]
- (loop [[archive state] [archive state]
- compilation (base_compiler (:as ///.Input input))
- all_dependencies (: (Set Module)
- (set.of_list text.hash (list)))]
- (do !
- [.let [new_dependencies (value@ ///.#dependencies compilation)
- continue! (:sharing [<type_vars>]
- <Platform>
- platform
-
- (-> <Context> (///.Compilation <State+> .Module Any) (Set Module)
- (Action [Archive <State+>]))
- (:expected again))
- ... TODO: Come up with a less hacky way to prevent duplicate imports.
- ... This currently assumes that all imports will be specified once in a single .using form.
- ... This might not be the case in the future.
- [all_dependencies duplicates _] (: [(Set Module) (Set Module) Bit]
- (list#mix (function (_ new [all duplicates seen_prelude?])
- (if (set.member? all new)
- (if (text#= .prelude_module new)
- (if seen_prelude?
- [all (set.has new duplicates) seen_prelude?]
- [all duplicates true])
- [all (set.has new duplicates) seen_prelude?])
- [(set.has new all) duplicates seen_prelude?]))
- (: [(Set Module) (Set Module) Bit]
- [all_dependencies ..empty (set.empty? all_dependencies)])
- new_dependencies))]
- [archive state] (if (set.empty? duplicates)
- (case new_dependencies
- {.#End}
- (in [archive state])
-
- {.#Item _}
- (do !
- [archive,document+ (|> new_dependencies
- (list#each (import! module))
- (monad.all ..monad))
- .let [archive (|> archive,document+
- (list#each product.left)
- (list#mix archive.merged archive))]]
- (in [archive (try.trusted
- (..updated_state archive
- (list#each product.right archive,document+)
- state))])))
- (async#in (exception.except ..cannot_import_twice [module duplicates])))]
- (case ((value@ ///.#process compilation)
- ... TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP.
- ... TODO: The context shouldn't need to be re-set either.
- (|> (///directive.set_current_module module)
- (///phase.result' state)
- try.trusted
- product.left)
- archive)
- {try.#Success [state more|done]}
- (case more|done
- {.#Left more}
- (continue! [archive state] more all_dependencies)
-
- {.#Right [descriptor document output]}
- (do !
- [.let [_ (debug.log! (..module_compilation_log module state))
- descriptor (with@ descriptor.#references all_dependencies descriptor)]
- _ (..cache_module static platform module_id [descriptor document output])]
- (case (archive.has module [descriptor document output] archive)
- {try.#Success archive}
- (in [archive
- (..with_reset_log state)])
-
- {try.#Failure error}
- (async#in {try.#Failure error}))))
-
- {try.#Failure error}
- (do !
- [_ (ioW.freeze (value@ #&file_system platform) static archive)]
- (async#in {try.#Failure error}))))))))]
- (compiler archive.runtime_module compilation_module)))
+ (let [[sources host_dependencies libraries target module] compilation
+ compiler (|> (..compiler phase_wrapper expander platform)
+ (serial_compiler import static platform sources)
+ (..parallel context))]
+ (compiler archive.runtime_module module)))
)))