diff options
Diffstat (limited to '')
| -rw-r--r-- | documentation/research/Security.md | 3 | ||||
| -rw-r--r-- | documentation/research/math.md | 1 | ||||
| -rw-r--r-- | new-luxc/source/program.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/init.lux | 58 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 124 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/language/lux/generation.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/archive.lux | 104 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/context.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/program/compositor.lux | 10 |
10 files changed, 192 insertions, 134 deletions
diff --git a/documentation/research/Security.md b/documentation/research/Security.md index 2cc7cbc9b..33b37c373 100644 --- a/documentation/research/Security.md +++ b/documentation/research/Security.md @@ -77,3 +77,6 @@ 1. http://www.ranum.com/security/computer_security/editorials/dumb/index.html 1. [Information Technology — Programming languages — Guidance to avoiding vulnerabilities in programming languages](http://www.open-std.org/jtc1/sc22/wg23/docs/ISO-IECJTC1-SC22-WG23_N0751-tr24772-1-after-pre-meeting-51-webex-20171016.pdf) +# Control-flow integrity +1. [On the Effectiveness of Type-based Control Flow Integrity](https://sajjadium.github.io/files/acsac2018typecfi_paper.pdf) + diff --git a/documentation/research/math.md b/documentation/research/math.md index 417846aba..777a3c1d2 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -191,6 +191,7 @@ 1. [THE GEOMETRY OF REFLECTION GROUPS](http://people.mpim-bonn.mpg.de/geordie/mpg.pdf) 1. https://kubuszok.com/2018/algebras-we-love/ 1. [Notes on Computational Group Theory](https://www.math.colostate.edu/~hulpke/CGT/cgtnotes.pdf) +1. [An Invitation to General Algebra and Universal Constructions](https://math.berkeley.edu/~gbergman/245/) # Logic diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index fccc63d1a..5fbbd0537 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -12,6 +12,7 @@ [concurrency [promise (#+ Promise)]]] [data + ["." product] [text ["%" format (#+ format)]] [collection @@ -114,7 +115,8 @@ ## #platform.phase jvm.generate #platform.phase expression.translate ## #platform.runtime runtime.generate - #platform.runtime runtime.translate}))) + #platform.runtime runtime.translate + #platform.write product.right}))) (def: extender Extender @@ -149,11 +151,12 @@ (#/cli.Compilation configuration) configuration (#/cli.Interpretation configuration) configuration) jar-path (format target (:: file.system separator) "program.jar")] - (exec (/.compiler @.jvm + (exec (/.compiler target ".jvm" ..expander analysis.bundle ..platform + @.jvm ## generation.bundle translation.bundle (directive.bundle extender) diff --git a/stdlib/source/lux/tool/compiler.lux b/stdlib/source/lux/tool/compiler.lux index ca9ea4a0e..867fb4012 100644 --- a/stdlib/source/lux/tool/compiler.lux +++ b/stdlib/source/lux/tool/compiler.lux @@ -4,9 +4,10 @@ ["." try (#+ Try)] ["." exception (#+ exception:)]] [data + [binary (#+ Binary)] ["." text] [collection - ["." dictionary (#+ Dictionary)]]] + ["." row (#+ Row)]]] [world ["." file (#+ Path)]]] [/ @@ -28,18 +29,14 @@ #hash Nat #code Code}) -(type: #export (Output o) - (Dictionary Text o)) - -(def: #export empty-output - Output - (dictionary.new text.hash)) +(type: #export Output + (Row [Text Binary])) (type: #export (Compilation s d o) {#dependencies (List Module) #process (-> s Archive (Try [s (Either (Compilation s d o) - [[Descriptor (Document d)] (Output o)])]))}) + [[Descriptor (Document d)] Output])]))}) (type: #export (Compiler s d o) (-> Input (Compilation s d o))) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index baf1501aa..05293ad5a 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -6,17 +6,21 @@ ["." try (#+ Try)] ["ex" exception (#+ exception:)]] [data + [binary (#+ Binary)] ["." product] - ["." text ("#@." hash)] + ["." text ("#@." hash) + ["%" format (#+ format)]] [collection ["." list ("#@." functor)] ["." dictionary] - ["." set]]] + ["." set] + ["." row ("#@." functor)]]] ["." macro] [world ["." file]]] ["." // #_ ["/#" // (#+ Instancer) + ["#." phase] [language [lux ["#." version] @@ -36,9 +40,7 @@ [".E" analysis] [".E" synthesis] [directive - [".D" lux]]]] - [/// - ["#." phase]]]] + [".D" lux]]]]]] [meta [archive ["." signature] @@ -121,12 +123,19 @@ (wrap [source ///generation.empty-buffer])))) (def: (end module) - (-> Module (Operation Any)) + (-> Module + (All [anchor expression directive] + (///directive.Operation anchor expression directive [.Module (///generation.Buffer directive)]))) (do ///phase.monad [_ (///directive.lift-analysis - (module.set-compiled module))] - (///directive.lift-generation - (///generation.save-buffer! module)))) + (module.set-compiled module)) + final-buffer (///directive.lift-generation + (///generation.save-buffer! module)) + analysis-module (<| (: (Operation .Module)) + ///directive.lift-analysis + extension.lift + macro.current-module)] + (wrap [analysis-module final-buffer]))) ## TODO: Inline ASAP (def: (get-current-buffer old-buffer) @@ -194,9 +203,9 @@ (-> .Module Aliases) (|>> (get@ #.module-aliases) (dictionary.from-list text.hash))) -(def: #export (compiler expander prelude) - (-> Expander Module - (All [anchor expression directive] +(def: #export (compiler expander prelude write-directive) + (All [anchor expression directive] + (-> Expander Module (-> directive Binary) (Instancer (///directive.State+ anchor expression directive) .Module))) (let [execute! (directiveP.phase expander)] (function (_ key parameters input) @@ -211,17 +220,11 @@ (loop [iteration (<| (///phase.run' state) (..iterate expander module source buffer ///syntax.no-aliases))] (do @ - [[state ?source&requirements&buffer] iteration] - (case ?source&requirements&buffer + [[state ?source&requirements&temporary-buffer] iteration] + (case ?source&requirements&temporary-buffer #.None (do @ - [[state analysis-module] (<| (///phase.run' state) - (do ///phase.monad - [_ (..end module)] - (<| (: (Operation .Module)) - ///directive.lift-analysis - extension.lift - macro.current-module))) + [[state [analysis-module final-buffer]] (///phase.run' state (..end module)) #let [descriptor {#descriptor.hash hash #descriptor.name module #descriptor.file (get@ #///.file input) @@ -229,9 +232,12 @@ #descriptor.state #.Compiled}]] (wrap [state (#.Right [[descriptor (document.write key analysis-module)] - (dictionary.new text.hash)])])) + (|> final-buffer + (row@map (function (_ [name directive]) + [(product.right name) + (write-directive directive)])))])])) - (#.Some [source requirements buffer]) + (#.Some [source requirements temporary-buffer]) (wrap [state (#.Left {#///.dependencies (|> requirements (get@ #///directive.imports) @@ -244,10 +250,10 @@ extension.lift macro.current-module) _ (///directive.lift-generation - (///generation.set-buffer buffer)) + (///generation.set-buffer temporary-buffer)) _ (monad.map @ execute! (get@ #///directive.referrals requirements)) - buffer (..get-current-buffer buffer)] - (..iterate expander module source buffer (..module-aliases analysis-module))))))})]) + temporary-buffer (..get-current-buffer temporary-buffer)] + (..iterate expander module source temporary-buffer (..module-aliases analysis-module))))))})]) )))))})))) (def: #export key diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 36fc26363..a5e97d4b9 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -1,24 +1,27 @@ (.module: [lux (#- Module) [type (#+ :share)] + ["@" target (#+ Host)] [abstract ["." monad (#+ Monad do)]] [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise) ("#@." monad)]]] [data + [binary (#+ Binary)] ["." bit] ["." product] - [text + ["." text ["%" format (#+ format)]] [collection - ["." list]]] + ["." list] + ["." row ("#@." functor)]]] [world - ["." file (#+ File)]]] + ["." file (#+ Path)]]] ["." // #_ ["#." init] - ["/#" // + ["/#" // (#+ Output) ["#." phase] [language [lux @@ -36,7 +39,8 @@ ["." archive (#+ Archive) [descriptor (#+ Module)]] [io - ["." context]]]]] + ["." context] + ["ioW" archive]]]]] [program [compositor ["." cli (#+ Configuration)]]]) @@ -45,22 +49,38 @@ {#&file-system (file.System Promise) #host (///generation.Host expression directive) #phase (///generation.Phase anchor expression directive) - #runtime (///generation.Operation anchor expression directive Any)}) - -## (def: (write-module target-dir file-name module-name module outputs) -## (-> File Text Text Module Outputs (Process Any)) -## (do (try.with io.monad) -## [_ (monad.map @ (product.uncurry (&io.write target-dir)) -## (dictionary.entries outputs))] -## (&io.write target-dir -## (format module-name "/" cache.descriptor-name) -## (encoding.to-utf8 (%.code (cache/description.write file-name module)))))) + #runtime (///generation.Operation anchor expression directive Any) + #write (-> directive Binary)}) (with-expansions [<type-vars> (as-is [anchor expression directive]) <Platform> (as-is (Platform anchor expression directive)) <State+> (as-is (///directive.State+ anchor expression directive)) <Bundle> (as-is (///generation.Bundle anchor expression directive))] + (def: (cache-module platform host target-dir module-file-name module-name output ## module + ) + (All <type-vars> + (-> <Platform> Host Path Path Text Output ## Module + (Promise (Try Any)))) + (let [system (get@ #&file-system platform) + write-artifact! (: (-> [Text Binary] (Promise (Try Any))) + (function (_ [name content]) + (ioW.write system host target-dir module-name name content)))] + (do (try.with promise.monad) + [_ (ioW.prepare system host target-dir module-name) + _ (|> output + row.to-list + (monad.map promise.monad + write-artifact!) + (: (Promise (List (Try Any)))) + (promise@map (monad.seq try.monad)) + (: (Promise (Try (List Any)))))] + (wrap []) + ## (&io.write target-dir + ## (format module-name "/" cache.descriptor-name) + ## (encoding.to-utf8 (%.code (cache/description.write module-file-name module)))) + ))) + (def: pause-context (All <type-vars> (-> <State+> ///generation.Context)) @@ -90,10 +110,21 @@ (All <type-vars> (///generation.Operation anchor expression directive (Buffer directive))) (///generation.save-buffer! "")) + + (def: (ensure-target! platform target host) + (All <type-vars> + (-> <Platform> Path Host (Promise (Try Any)))) + (let [system (get@ #&file-system platform) + mkdir (: (-> Path (Promise (Try Any))) + (file.get-directory promise.monad system))] + (do (try.with promise.monad) + [_ (mkdir target)] + (mkdir (ioW.archive system host target))))) - (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender) + (def: #export (initialize target host expander host-analysis platform generation-bundle host-directive-bundle program extender) (All <type-vars> - (-> Text + (-> Path + Host Expander ///analysis.Bundle <Platform> @@ -102,7 +133,7 @@ (-> expression directive) Extender (Promise (Try <State+>)))) - (let [state (//init.state target + (let [state (//init.state host expander host-analysis (get@ #host platform) @@ -111,14 +142,17 @@ host-directive-bundle program extender)] - (|> (do ///phase.monad - [_ ..initialize-buffer! - _ (..compile-runtime! platform)] - ..save-runtime-buffer!) - ///directive.lift-generation - (///phase.run' state) - (:: try.functor map product.left) - (:: promise.monad wrap))) + (do (try.with promise.monad) + [_ (..ensure-target! platform target host)] + (|> (do ///phase.monad + [_ ..initialize-buffer! + _ (..compile-runtime! platform) + buffer ..save-runtime-buffer!] + (wrap [])) + ///directive.lift-generation + (///phase.run' state) + (:: try.functor map product.left) + promise@wrap))) ## (case (runtimeT.generate ## (initL.compiler (io.run js.init)) ## (initL.compiler (io.run hostL.init-host)) @@ -146,19 +180,19 @@ ## (io.fail error)) ) - (def: #export (compile partial-host-extension expander platform configuration archive state) + (def: #export (compile target partial-host-extension expander platform host configuration archive state) (All <type-vars> - (-> Text Expander <Platform> Configuration Archive <State+> (Promise (Try [Archive <State+>])))) + (-> Text Text Expander <Platform> Host Configuration Archive <State+> (Promise (Try [Archive <State+>])))) (let [source-module (get@ #cli.module configuration) compiler (:share <type-vars> {<State+> state} {(///.Compiler <State+> .Module Any) - ((//init.compiler expander syntax.prelude) //init.key (list))})] + ((//init.compiler expander syntax.prelude (get@ #write platform)) //init.key (list))})] (loop [module source-module [archive state] [archive state]] (if (archive.archived? archive module) - (:: promise.monad wrap (#try.Success [archive state])) + (promise@wrap (#try.Success [archive state])) (let [import! (:share <type-vars> {<Platform> platform} @@ -169,10 +203,7 @@ [input (context.read (get@ #&file-system platform) (get@ #cli.sources configuration) partial-host-extension - module) - ## _ (&io.prepare-module target-dir (get@ #cli.module configuration)) - ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs) - ] + module)] (loop [archive archive state (..resume-context (///generation.fresh-context module) state) compilation (compiler (:coerce ///.Input input))] @@ -216,13 +247,22 @@ (continue! archive state more) (#.Right [descriptor+document output]) - (case (archive.add module descriptor+document archive) - (#try.Success archive) - (wrap [archive state]) - - (#try.Failure error) - (:: promise.monad wrap (#try.Failure error)))) + (do (try.with promise.monad) + [_ (..cache-module platform + host + target + (get@ #///.file input) + module + output + ## module + )] + (case (archive.add module descriptor+document archive) + (#try.Success archive) + (wrap [archive state]) + + (#try.Failure error) + (promise@wrap (#try.Failure error))))) (#try.Failure error) - (:: promise.monad wrap (#try.Failure error))))))))))) + (promise@wrap (#try.Failure error))))))))))) ) diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index 334be5331..80e5f37e3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -261,7 +261,7 @@ (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) #.None - (phase.throw no-buffer-for-saving-code name)))) + (phase.throw ..no-buffer-for-saving-code name)))) (def: #export (save-buffer! target) (All [anchor expression directive] diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index 5b33e60a3..abb8b75c6 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -1,72 +1,78 @@ (.module: [lux (#- Module) + ["@" target (#+ Host)] + [abstract + [monad (#+ do)]] [control - monad - ["." try] - ["ex" exception (#+ exception:)]] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability (#+ capability:)]]] [data + [binary (#+ Binary)] ["." text ["%" format (#+ format)]]] [world - ["." file (#+ File System)] - [binary (#+ Binary)]]] - ["." // (#+ Module) - [/// - ["." host]]]) + ["." file (#+ Path File System)]]] + ["." // (#+ Module)]) -(type: #export Document File) +(exception: #export (cannot-prepare {archive Path} + {module Module} + {error Text}) + (exception.report + ["Archive" archive] + ["Module" module] + ["Error" error])) -(exception: #export (cannot-prepare {archive File} {module Module}) - (ex.report ["Archive" archive] - ["Module" module])) +(def: #export (archive system host root) + (-> (System Promise) Host Path Path) + (format root (:: system separator) host)) -(def: #export (archive System<m> root) - (All [m] (-> (System m) File File)) - (<| (format root (:: System<m> separator)) - (`` (for {(~~ (static host.common-lisp)) host.common-lisp - (~~ (static host.js)) host.js - (~~ (static host.old)) host.jvm - (~~ (static host.jvm)) host.jvm - (~~ (static host.lua)) host.lua - (~~ (static host.php)) host.php - (~~ (static host.python)) host.python - (~~ (static host.r)) host.r - (~~ (static host.ruby)) host.ruby - (~~ (static host.scheme)) host.scheme})))) +(def: #export (document system host root module) + (-> (System Promise) Host Path Module Path) + (format (..archive system host root) + (:: system separator) + (//.sanitize system module))) -(def: #export (document System<m> root module) - (All [m] (-> (System m) File Module Document)) - (let [archive (..archive System<m> root)] - (|> module - (//.sanitize System<m>) - (format archive (:: System<m> separator))))) +(def: #export (artifact system host root module name) + (-> (System Promise) Host Path Module Text Path) + (format (document system host root module) + (:: system separator) + (//.sanitize system name))) -(def: #export (prepare System<m> root module) - (All [m] (-> (System m) File Module (m Any))) - (do (:: System<m> &monad) - [#let [archive (..archive System<m> root) - document (..document System<m> root module)] - document-exists? (file.exists? System<m> document)] +(def: #export (prepare system host root module) + (-> (System Promise) Host Path Module (Promise (Try Any))) + (do promise.monad + [#let [document (..document system host root module)] + document-exists? (file.exists? promise.monad system document)] (if document-exists? - (wrap []) + (wrap (#try.Success [])) (do @ - [outcome (:: System<m> try (:: System<m> make-directory document))] + [outcome (!.use (:: system create-directory) document)] (case outcome (#try.Success output) - (wrap output) + (wrap (#try.Success [])) - (#try.Failure _) - (:: System<m> throw cannot-prepare [archive module])))))) + (#try.Failure error) + (wrap (exception.throw ..cannot-prepare [(..archive system host root) + module + error]))))))) -(def: #export (write System<m> root content name) - (All [m] (-> (System m) File Binary Text (m Any))) - (:: System<m> write content (..document System<m> root name))) +(def: #export (write system host root module name content) + (-> (System Promise) Host Path Module Text Binary (Promise (Try Any))) + (do (try.with promise.monad) + [artifact (: (Promise (Try (File Promise))) + (file.get-file promise.monad system + (..artifact system host root module name)))] + (!.use (:: artifact over-write) content))) -(def: #export (module System<m> root document) - (All [m] (-> (System m) File Document (Maybe Module))) - (case (text.split-with (..archive System<m> root) document) +(def: #export (module system host root document) + (-> (System Promise) Host Path Path (Maybe Module)) + (case (text.split-with (..archive system host root) document) (#.Some ["" post]) - (let [raw (text.replace-all (:: System<m> separator) "/" post)] + (let [raw (text.replace-all (:: system separator) "/" post)] (if (text.starts-with? "/" raw) (text.clip' 1 raw) (#.Some raw))) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index 1313386d5..dddac7e49 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -18,10 +18,10 @@ [world ["." file (#+ Path File)]]] ["." // (#+ Context Code) - ["#/" // #_ + ["/#" // #_ [archive [descriptor (#+ Module)]] - ["#/" // (#+ Input)]]]) + ["/#" // (#+ Input)]]]) (template [<name>] [(exception: #export (<name> {module Module}) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 7bcc07d7c..43e58cf50 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -1,6 +1,7 @@ (.module: [lux #* [type (#+ :share)] + ["@" target (#+ Host)] [abstract [monad (#+ do)]] [control @@ -87,15 +88,16 @@ (:: promise.monad wrap (#try.Failure error))))) (def: #export (compiler target partial-host-extension - expander host-analysis platform generation-bundle host-directive-bundle program extender + expander host-analysis platform host generation-bundle host-directive-bundle program extender service packager,package) (All [<parameters>] - (-> Text + (-> Path Text Expander analysis.Bundle (IO (Platform <parameters>)) + Host (generation.Bundle <parameters>) (directive.Bundle <parameters>) (-> expression artifact) @@ -116,12 +118,12 @@ {(Platform <parameters>) platform} {(Promise (Try (directive.State+ <parameters>))) - (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)}) + (platform.initialize target host expander host-analysis platform generation-bundle host-directive-bundle program extender)}) [archive state] (:share [<parameters>] {(Platform <parameters>) platform} {(Promise (Try [Archive (directive.State+ <parameters>)])) - (platform.compile partial-host-extension expander platform configuration archive.empty state)}) + (platform.compile target partial-host-extension expander platform host configuration archive.empty state)}) _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package) ## _ (cache/io.clean target ...) ] |