aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/security/capability.lux11
-rw-r--r--stdlib/source/lux/data/bit.lux4
-rw-r--r--stdlib/source/lux/data/collection/list.lux18
-rw-r--r--stdlib/source/lux/data/maybe.lux37
-rw-r--r--stdlib/source/lux/data/name.lux26
-rw-r--r--stdlib/source/lux/data/product.lux20
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/analysis.lux20
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux23
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/generation.lux65
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/runtime.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux23
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux81
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux21
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/synthesis.lux171
-rw-r--r--stdlib/source/lux/tool/compiler/reference.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/reference/variable.lux15
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/security/capability.lux45
-rw-r--r--stdlib/source/test/lux/world/file.lux5
37 files changed, 542 insertions, 238 deletions
diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux
index df875b1e9..54ea35281 100644
--- a/stdlib/source/lux/control/security/capability.lux
+++ b/stdlib/source/lux/control/security/capability.lux
@@ -3,12 +3,11 @@
[abstract
[monad (#+ do)]]
[control
- ["p" parser]
+ ["<>" parser
+ ["<c>" code]]
["." io (#+ IO)]
[concurrency
- ["." promise (#+ Promise)]]
- [parser
- ["s" code]]]
+ ["." promise (#+ Promise)]]]
[data
[text
["%" format (#+ format)]]
@@ -44,8 +43,8 @@
(syntax: #export (capability: {export reader.export}
{declaration reader.declaration}
- {annotations (p.maybe reader.annotations)}
- {[forge input output] (s.form ($_ p.and s.local-identifier s.any s.any))})
+ {annotations (<>.maybe reader.annotations)}
+ {[forge input output] (<c>.form ($_ <>.and <c>.local-identifier <c>.any <c>.any))})
(do {@ macro.monad}
[this-module macro.current-module-name
#let [[name vars] declaration]
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux
index d80606137..3c1bcc02d 100644
--- a/stdlib/source/lux/data/bit.lux
+++ b/stdlib/source/lux/data/bit.lux
@@ -23,8 +23,8 @@
(def: (hash value)
(case value
- #1 1
- #0 0)))
+ #0 2
+ #1 3)))
(template [<name> <identity> <op>]
[(structure: #export <name>
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index 5c117a857..070778080 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -5,6 +5,7 @@
[monoid (#+ Monoid)]
[apply (#+ Apply)]
[equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]
[fold (#+ Fold)]
[predicate (#+ Predicate)]
["." functor (#+ Functor)]
@@ -311,6 +312,23 @@
#0
)))
+(structure: #export (hash super)
+ (All [a] (-> (Hash a) (Hash (List a))))
+
+ (def: &equivalence
+ (..equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ #.Nil
+ 2
+
+ (#.Cons head tail)
+ ($_ n.* 3
+ (n.+ (:: super hash head)
+ (hash tail)))
+ )))
+
(structure: #export monoid
(All [a] (Monoid (List a)))
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index 6d425011c..2bde551e7 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -3,6 +3,7 @@
[abstract
[monoid (#+ Monoid)]
[equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]
[apply (#+ Apply)]
["." functor (#+ Functor)]
["." monad (#+ Monad do)]]])
@@ -11,7 +12,9 @@
## #.None
## (#.Some a))
-(structure: #export monoid (All [a] (Monoid (Maybe a)))
+(structure: #export monoid
+ (All [a] (Monoid (Maybe a)))
+
(def: identity #.None)
(def: (compose mx my)
@@ -22,13 +25,17 @@
(#.Some x)
(#.Some x))))
-(structure: #export functor (Functor Maybe)
+(structure: #export functor
+ (Functor Maybe)
+
(def: (map f ma)
(case ma
#.None #.None
(#.Some a) (#.Some (f a)))))
-(structure: #export apply (Apply Maybe)
+(structure: #export apply
+ (Apply Maybe)
+
(def: &functor ..functor)
(def: (apply ff fa)
@@ -39,7 +46,9 @@
_
#.None)))
-(structure: #export monad (Monad Maybe)
+(structure: #export monad
+ (Monad Maybe)
+
(def: &functor ..functor)
(def: (wrap x)
@@ -53,18 +62,34 @@
(#.Some mx)
mx)))
-(structure: #export (equivalence a-equivalence) (All [a] (-> (Equivalence a) (Equivalence (Maybe a))))
+(structure: #export (equivalence super)
+ (All [a] (-> (Equivalence a) (Equivalence (Maybe a))))
+
(def: (= mx my)
(case [mx my]
[#.None #.None]
#1
[(#.Some x) (#.Some y)]
- (:: a-equivalence = x y)
+ (:: super = x y)
_
#0)))
+(structure: #export (hash super)
+ (All [a] (-> (Hash a) (Hash (Maybe a))))
+
+ (def: &equivalence
+ (..equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ #.None
+ 2
+
+ (#.Some value)
+ (.nat ("lux i64 *" (.int 3) (.int (:: super hash value)))))))
+
(structure: #export (with monad)
(All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a))))))
diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux
index 897690144..e79398021 100644
--- a/stdlib/source/lux/data/name.lux
+++ b/stdlib/source/lux/data/name.lux
@@ -2,11 +2,12 @@
[lux #*
[abstract
[equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]
[order (#+ Order)]
- [codec (#+ Codec)]
- hash]
+ [codec (#+ Codec)]]
[data
- ["." text ("#@." monoid hash)]]])
+ ["." text ("#@." equivalence monoid)]
+ ["." product]]])
## (type: Name
## [Text Text])
@@ -20,12 +21,13 @@
[short short]
)
-(structure: #export equivalence
+(def: #export hash
+ (Hash Name)
+ (product.hash text.hash text.hash))
+
+(def: #export equivalence
(Equivalence Name)
-
- (def: (= [xmodule xname] [ymodule yname])
- (and (text@= xmodule ymodule)
- (text@= xname yname))))
+ (:: ..hash &equivalence))
(structure: #export order
(Order Name)
@@ -56,11 +58,3 @@
_
(#.Left (text@compose "Invalid format for Name: " input))))))
-
-(structure: #export hash
- (Hash Name)
-
- (def: &equivalence ..equivalence)
-
- (def: (hash [module name])
- ("lux i64 +" (text@hash module) (text@hash name))))
diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux
index 416aa4673..5c7475833 100644
--- a/stdlib/source/lux/data/product.lux
+++ b/stdlib/source/lux/data/product.lux
@@ -2,7 +2,8 @@
{#.doc "Functionality for working with tuples (particularly 2-tuples)."}
[lux #*
[abstract
- [equivalence (#+ Equivalence)]]])
+ [equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]]])
(template [<name> <type> <output>]
[(def: #export (<name> xy)
@@ -11,7 +12,8 @@
<output>))]
[left a x]
- [right b y])
+ [right b y]
+ )
(def: #export (curry f)
(All [a b c]
@@ -53,3 +55,17 @@
(def: (= [lP rP] [lS rS])
(and (l@= lP lS)
(r@= rP rS))))
+
+(structure: #export (hash leftH rightH)
+ (All [l r]
+ (-> (Hash l) (Hash r)
+ (Hash (& l r))))
+
+ (def: &equivalence
+ (..equivalence (:: leftH &equivalence)
+ (:: rightH &equivalence)))
+
+ (def: (hash [left right])
+ ("lux i64 +"
+ (:: leftH hash left)
+ (:: rightH hash right))))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index a1dff7792..f25f22035 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -248,8 +248,7 @@
(#.Right [[descriptor (document.write key analysis-module)]
(|> final-buffer
(row@map (function (_ [name directive])
- [(product.right name)
- (write-directive directive)])))])]))
+ [name (write-directive directive)])))])]))
(#.Some [source requirements temporary-payload])
(let [[temporary-buffer temporary-registry] temporary-payload]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
index ea62e77fb..598f34db5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
@@ -2,6 +2,7 @@
[lux (#- nat int rev)
[abstract
[equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]
[monad (#+ do)]]
[control
["." function]
@@ -140,6 +141,25 @@
_
false)))
+(structure: #export (composite-hash super)
+ (All [a] (-> (Hash a) (Hash (Composite a))))
+
+ (def: &equivalence
+ (..composite-equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ (#Variant [lefts right? value])
+ ($_ n.* 2
+ (:: n.hash hash lefts)
+ (:: bit.hash hash right?)
+ (:: super hash value))
+
+ (#Tuple members)
+ ($_ n.* 3
+ (:: (list.hash super) hash members))
+ )))
+
(structure: pattern-equivalence
(Equivalence Pattern)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux
index 2e42e2c45..5ef2dab10 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux
@@ -6,7 +6,9 @@
["." try]]
[data
["." text
- ["%" format (#+ format)]]]
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]]]
["." macro]]
[// (#+ Operation)
[macro (#+ Expander)]
@@ -18,7 +20,7 @@
["." type]]
[//
["." synthesis]
- ["." generation]
+ ["." generation (#+ Context)]
[///
["." phase]
[meta
@@ -28,13 +30,10 @@
(type: #export Eval
(-> Archive Nat Type Code (Operation Any)))
-(def: #export (id prefix module count)
- (-> Text Module Nat Text)
- (format prefix
- "$"
- (text.replace-all "/" "$" module)
- "$"
- (%.nat count)))
+(def: (context [module-id artifact-id])
+ (-> Context Context)
+ ## TODO: Find a better way that doesn't rely on clever tricks.
+ [(n.- module-id 0) artifact-id])
(def: #export (evaluator expander synthesis-state generation-state generate)
(All [anchor expression artifact]
@@ -54,6 +53,6 @@
[exprS (|> exprA (synthesisP.phase archive) (phase.run synthesis-state))]
(phase.run generation-state
(do phase.monad
- [exprO (generate archive exprS)]
- (generation.evaluate! (..id "analysis" module count)
- exprO)))))))))
+ [exprO (generate archive exprS)
+ module-id (generation.module-id module archive)]
+ (generation.evaluate! (..context [module-id count]) exprO)))))))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
index 2500af6d3..8a6e0825d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
@@ -9,7 +9,7 @@
[data
[binary (#+ Binary)]
["." product]
- ["." name ("#@." equivalence)]
+ ["." name]
["." text ("#@." equivalence)
["%" format (#+ format)]]
[number
@@ -29,25 +29,25 @@
["." artifact]]]]])
(type: #export Context [archive.ID artifact.ID])
-(type: #export (Buffer directive) (Row [Name directive]))
+(type: #export (Buffer directive) (Row [Text directive]))
(exception: #export (cannot-interpret {error Text})
(exception.report
["Error" error]))
(template [<name>]
- [(exception: #export (<name> {name Name})
+ [(exception: #export (<name> {name Text})
(exception.report
- ["Output" (%.name name)]))]
+ ["Output" (%.text name)]))]
[cannot-overwrite-output]
[no-buffer-for-saving-code]
)
(signature: #export (Host expression directive)
- (: (-> Text expression (Try Any))
+ (: (-> Context expression (Try Any))
evaluate!)
- (: (-> Text directive (Try Any))
+ (: (-> directive (Try Any))
execute!)
(: (-> Context expression (Try [Text Any directive]))
define!)
@@ -183,21 +183,27 @@
(Operation anchor expression directive Module))
(extension.read (get@ #module)))
-(template [<name> <inputT>]
- [(def: #export (<name> label code)
- (All [anchor expression directive]
- (-> Text <inputT> (Operation anchor expression directive Any)))
- (function (_ (^@ state+ [bundle state]))
- (case (:: (get@ #host state) <name> label code)
- (#try.Success output)
- (#try.Success [state+ output])
+(def: #export (evaluate! label code)
+ (All [anchor expression directive]
+ (-> Context expression (Operation anchor expression directive Any)))
+ (function (_ (^@ state+ [bundle state]))
+ (case (:: (get@ #host state) evaluate! label code)
+ (#try.Success output)
+ (#try.Success [state+ output])
- (#try.Failure error)
- (exception.throw ..cannot-interpret error))))]
+ (#try.Failure error)
+ (exception.throw ..cannot-interpret error))))
- [evaluate! expression]
- [execute! directive]
- )
+(def: #export (execute! code)
+ (All [anchor expression directive]
+ (-> directive (Operation anchor expression directive Any)))
+ (function (_ (^@ state+ [bundle state]))
+ (case (:: (get@ #host state) execute! code)
+ (#try.Success output)
+ (#try.Success [state+ output])
+
+ (#try.Failure error)
+ (exception.throw ..cannot-interpret error))))
(def: #export (define! context code)
(All [anchor expression directive]
@@ -210,19 +216,14 @@
(#try.Failure error)
(exception.throw ..cannot-interpret error))))
-(def: #export (save! execute? name code)
+(def: #export (save! name code)
(All [anchor expression directive]
- (-> Bit Name directive (Operation anchor expression directive Any)))
+ (-> Text directive (Operation anchor expression directive Any)))
(do {@ phase.monad}
- [_ (if execute?
- (do @
- [label (..gensym "save")]
- (execute! label code))
- (wrap []))
- ?buffer (extension.read (get@ #buffer))]
+ [?buffer (extension.read (get@ #buffer))]
(case ?buffer
(#.Some buffer)
- (if (row.any? (|>> product.left (name@= name)) buffer)
+ (if (row.any? (|>> product.left (text@= name)) buffer)
(phase.throw ..cannot-overwrite-output [name])
(extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
@@ -273,6 +274,14 @@
(exception: #export no-context)
+(def: #export (module-id module archive)
+ (All [anchor expression directive]
+ (-> Module Archive (Operation anchor expression directive archive.ID)))
+ (function (_ (^@ stateE [bundle state]))
+ (do try.monad
+ [module-id (archive.id module archive)]
+ (wrap [stateE module-id]))))
+
(def: #export (context archive)
(All [anchor expression directive]
(-> Archive (Operation anchor expression directive Context)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux
index 2cc5c42b8..3edad4d3b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux
@@ -2,12 +2,14 @@
[lux (#- Name)
[abstract
[equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]
["." monad (#+ do)]]
[control
["." function]
["." try (#+ Try)]
["." exception (#+ exception:)]]
[data
+ ["." product]
["." text ("#@." order)
["%" format (#+ Format format)]]
[collection
@@ -18,17 +20,21 @@
[meta
[archive (#+ Archive)]]])
-(type: #export Name Text)
+(type: #export Name
+ Text)
(type: #export (Extension a)
[Name (List a)])
-(structure: #export (equivalence input-equivalence)
+(def: #export equivalence
(All [a] (-> (Equivalence a) (Equivalence (Extension a))))
+ (|>> list.equivalence
+ (product.equivalence text.equivalence)))
- (def: (= [reference-name reference-inputs] [sample-name sample-inputs])
- (and (text@= reference-name sample-name)
- (:: (list.equivalence input-equivalence) = reference-inputs sample-inputs))))
+(def: #export hash
+ (All [a] (-> (Hash a) (Hash (Extension a))))
+ (|>> list.hash
+ (product.hash text.hash)))
(with-expansions [<Bundle> (as-is (Dictionary Name (Handler s i o)))]
(type: #export (Handler s i o)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 090f81842..b03dbd256 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -14,7 +14,9 @@
["." text
["%" format (#+ format)]]
[collection
- ["." dictionary]]]
+ ["." dictionary]]
+ [number
+ ["n" nat]]]
["." macro
["." code]]
["." type (#+ :share :by-example) ("#@." equivalence)
@@ -56,6 +58,11 @@
(#try.Failure error)
(phase.throw ///.invalid-syntax [extension-name %.code inputs]))))
+(def: (context [module-id artifact-id])
+ (-> Context Context)
+ ## TODO: Find a better way that doesn't rely on clever tricks.
+ [module-id (n.- (inc artifact-id) 0)])
+
## TODO: Inline "evaluate!'" into "evaluate!" ASAP
(def: (evaluate!' archive generate code//type codeS)
(All [anchor expression directive]
@@ -69,8 +76,8 @@
[module /////generation.module
id /////generation.next
codeG (generate archive codeS)
- codeV (/////generation.evaluate! (/////analysis/evaluation.id "directive" module id)
- codeG)]
+ module-id (/////generation.module-id module archive)
+ codeV (/////generation.evaluate! (..context [module-id id]) codeG)]
(wrap [code//type codeG codeV]))))
(def: #export (evaluate! archive type codeC)
@@ -105,7 +112,7 @@
id (/////generation.learn name)
module-id (phase.lift (archive.id module archive))
[target-name value directive] (/////generation.define! [module-id id] codeG)
- _ (/////generation.save! false [(%.nat module-id) (%.nat id)] directive)]
+ _ (/////generation.save! (%.nat id) directive)]
(wrap [code//type codeG value]))))
(def: (definition archive name expected codeC)
@@ -157,7 +164,7 @@
module-id (phase.lift (archive.id current-module archive))
id (<learn> extension)
[target-name value directive] (/////generation.define! [module-id id] codeG)
- _ (/////generation.save! false [(%.nat module-id) (%.nat id)] directive)]
+ _ (/////generation.save! (%.nat id) directive)]
(wrap [codeG value])))))
(def: #export (<full> archive extension codeT codeC)
@@ -382,7 +389,7 @@
(do phase.monad
[programG (generate archive programS)
artifact-id (/////generation.learn /////program.name)]
- (/////generation.save! false [(%.nat module-id) (%.nat artifact-id)] (program [module-id artifact-id] programG))))
+ (/////generation.save! (%.nat artifact-id) (program [module-id artifact-id] programG))))
(def: (def::program program)
(All [anchor expression directive]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index 0737d9772..935baa3db 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -1078,8 +1078,8 @@
(list& (..with-anonymous-init class total-environment super-class inputsTI)
method-definitions)
(row.row)))
- _ (//////generation.save! true ["" (%.nat artifact-id)]
- [anonymous-class-name bytecode])]
+ _ (//////generation.execute! [anonymous-class-name bytecode])
+ _ (//////generation.save! (%.nat artifact-id) [anonymous-class-name bytecode])]
(anonymous-instance generate archive class total-environment)))]))
(def: bundle::class
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/runtime.lux
index 19594bac9..dc8fe6e92 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/runtime.lux
@@ -278,6 +278,6 @@
(Operation Any)
(///.with-buffer
(do ////.monad
- [_ (///.save! true ["" ..prefix]
- ..runtime)]
+ [_ (///.execute! ..runtime)
+ _ (///.save! ..prefix ..runtime)]
(///.save-buffer! ..artifact))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
index 91689340f..54595bb75 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
@@ -115,5 +115,6 @@
(_.return (apply-poly (_.do "concat" (list @missing) @curried)
@self))))))))
))]
- _ (/////generation.save! true ["" (%.nat (product.right function-name))] definition)]
+ _ (/////generation.execute! definition)
+ _ (/////generation.save! (%.nat (product.right function-name)) definition)]
(wrap instantiation)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
index 78c6c94e1..ee594cde2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
@@ -772,7 +772,8 @@
(def: #export generate
(Operation [Registry Output])
(do ///////phase.monad
- [_ (/////generation.save! true ["" "0"] ..runtime)]
+ [_ (/////generation.execute! ..runtime)
+ _ (/////generation.save! "0" ..runtime)]
(wrap [(|> artifact.empty
artifact.resource
product.right)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
index 5c39d5d32..d52d8afbc 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
@@ -110,9 +110,9 @@
fields
methods
(row.row)))
- _ (generation.save! true ["" function-class]
- [function-class
- (format.run class.writer class)])]
+ #let [bytecode (format.run class.writer class)]
+ _ (generation.execute! [function-class bytecode])
+ _ (generation.save! function-class [function-class bytecode])]
(wrap instance)))
(def: #export (apply generate archive [abstractionS inputsS])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index 0df1a5812..224fba5b9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -530,8 +530,8 @@
..try::method))
(row.row)))]
(do ////.monad
- [_ (generation.execute! class [class bytecode])]
- (generation.save! .false ["" class] [class bytecode]))))
+ [_ (generation.execute! [class bytecode])]
+ (generation.save! class [class bytecode]))))
(def: generate-function
(Operation Any)
@@ -587,8 +587,8 @@
(list& <init>::method apply::method+)
(row.row)))]
(do ////.monad
- [_ (generation.execute! class [class bytecode])]
- (generation.save! .false ["" class] [class bytecode]))))
+ [_ (generation.execute! [class bytecode])]
+ (generation.save! class [class bytecode]))))
(def: #export generate
(Operation Any)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
index c99ec5d8f..755caf660 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
@@ -40,20 +40,21 @@
(case inits
#.Nil
(do ///////phase.monad
- [_ (/////generation.save! true ["" function-name]
- function-definition)]
+ [_ (/////generation.execute! function-definition)
+ _ (/////generation.save! function-name function-definition)]
(wrap (|> (_.var function-name) (_.apply/* inits))))
_
(do {@ ///////phase.monad}
[@closure (:: @ map _.var (/////generation.gensym "closure"))
- _ (/////generation.save! true ["" (_.code @closure)]
- (_.function @closure
- (|> (list.enumerate inits)
- (list@map (|>> product.left ..capture)))
- ($_ _.then
- function-definition
- (_.return (_.var function-name)))))]
+ #let [directive (_.function @closure
+ (|> (list.enumerate inits)
+ (list@map (|>> product.left ..capture)))
+ ($_ _.then
+ function-definition
+ (_.return (_.var function-name))))]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! (_.code @closure) directive)]
(wrap (_.apply/* inits @closure)))))
(def: input
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
index df70c74aa..06d187642 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
@@ -32,11 +32,12 @@
initsO+ (monad.map @ (generate archive) initsS+)
bodyO (/////generation.with-anchor @loop
(generate archive bodyS))
- _ (/////generation.save! true ["" (_.code @loop)]
- (_.function @loop (|> initsS+
- list.enumerate
- (list@map (|>> product.left (n.+ start) //case.register)))
- (_.return bodyO)))]
+ #let [directive (_.function @loop (|> initsS+
+ list.enumerate
+ (list@map (|>> product.left (n.+ start) //case.register)))
+ (_.return bodyO))]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! (_.code @loop) directive)]
(wrap (_.apply/* initsO+ @loop))))
(def: #export (recur generate archive argsS+)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
index e5011d01a..e62faf9c6 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
@@ -364,6 +364,6 @@
(Operation (Buffer Statement))
(/////generation.with-buffer
(do ///////phase.monad
- [_ (/////generation.save! true ["" ..prefix]
- ..runtime)]
+ [_ (/////generation.execute! ..runtime)
+ _ (/////generation.save! ..prefix ..runtime)]
/////generation.buffer)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
index bbe47a057..34368c147 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
@@ -233,16 +233,17 @@
(#reference.Foreign register)
(..capture register))])))]
- _ (///.save! true ["" @case]
- ($_ _.then
- (<| _.;
- (_.set @caseL)
- (_.closure (list (_.reference @caseL)) (list& [#0 @init]
- @dependencies+))
- ($_ _.then
- (_.; (_.set @cursor (_.array/* (list @init))))
- (_.; (_.set @savepoint (_.array/* (list))))
- pattern-matching!))
- (_.; (_.set @caseG @caseL))))]
+ #let [directive ($_ _.then
+ (<| _.;
+ (_.set @caseL)
+ (_.closure (list (_.reference @caseL)) (list& [#0 @init]
+ @dependencies+))
+ ($_ _.then
+ (_.; (_.set @cursor (_.array/* (list @init))))
+ (_.; (_.set @savepoint (_.array/* (list))))
+ pattern-matching!))
+ (_.; (_.set @caseG @caseL)))]
+ _ (///.execute! directive)
+ _ (///.save! @case directive)]
(wrap (_.apply/* (list& initG (list@map product.right @dependencies+))
@caseG))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux
index fe24f7911..d03d4babc 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux
@@ -61,44 +61,45 @@
(_.; (_.set (..input post) (_.nth (|> post .int _.int) @curried)))))
initialize-self!
(list.indices arity))]
- _ (///.save! true ["" function-name]
- ($_ _.then
- (<| _.;
- (_.set @selfL)
- (_.closure (list& (_.reference @selfL) closureG+) (list))
- ($_ _.then
- (_.echo (_.string "'ello, world! "))
- (_.; (_.set @num-args (_.func-num-args/0 [])))
- (_.echo @num-args) (_.echo (_.string " ~ ")) (_.echo arityG)
- (_.echo (_.string text.new-line))
- (_.; (_.set @curried (_.func-get-args/0 [])))
- (_.cond (list [(|> @num-args (_.= arityG))
- ($_ _.then
- initialize!
- (_.return bodyG))]
- [(|> @num-args (_.> arityG))
- (let [arity-inputs (_.array-slice/3 [@curried (_.int +0) arityG])
- extra-inputs (_.array-slice/2 [@curried arityG])
- next (_.call-user-func-array/2 [@selfL arity-inputs])
- done (_.call-user-func-array/2 [next extra-inputs])]
- ($_ _.then
- (_.echo (_.string "STAGED ")) (_.echo (_.count/1 arity-inputs))
- (_.echo (_.string " + ")) (_.echo (_.count/1 extra-inputs))
- (_.echo (_.string text.new-line))
- (_.echo (_.string "@selfL ")) (_.echo @selfL) (_.echo (_.string text.new-line))
- (_.echo (_.string " next ")) (_.echo next) (_.echo (_.string text.new-line))
- (_.echo (_.string " done ")) (_.echo done) (_.echo (_.string text.new-line))
- (_.return done)))])
- ## (|> @num-args (_.< arityG))
- (let [@missing (_.var "missing")]
- (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list))
- ($_ _.then
- (_.; (_.set @missing (_.func-get-args/0 [])))
- (_.echo (_.string "NEXT ")) (_.echo (_.count/1 @curried))
- (_.echo (_.string " ")) (_.echo (_.count/1 @missing))
- (_.echo (_.string " ")) (_.echo (_.count/1 (_.array-merge/+ @curried (list @missing))))
- (_.echo (_.string text.new-line))
- (_.return (_.call-user-func-array/2 [@selfL (_.array-merge/+ @curried (list @missing))])))))))
- ))
- (_.; (_.set @selfG @selfL))))]
+ #let [directive ($_ _.then
+ (<| _.;
+ (_.set @selfL)
+ (_.closure (list& (_.reference @selfL) closureG+) (list))
+ ($_ _.then
+ (_.echo (_.string "'ello, world! "))
+ (_.; (_.set @num-args (_.func-num-args/0 [])))
+ (_.echo @num-args) (_.echo (_.string " ~ ")) (_.echo arityG)
+ (_.echo (_.string text.new-line))
+ (_.; (_.set @curried (_.func-get-args/0 [])))
+ (_.cond (list [(|> @num-args (_.= arityG))
+ ($_ _.then
+ initialize!
+ (_.return bodyG))]
+ [(|> @num-args (_.> arityG))
+ (let [arity-inputs (_.array-slice/3 [@curried (_.int +0) arityG])
+ extra-inputs (_.array-slice/2 [@curried arityG])
+ next (_.call-user-func-array/2 [@selfL arity-inputs])
+ done (_.call-user-func-array/2 [next extra-inputs])]
+ ($_ _.then
+ (_.echo (_.string "STAGED ")) (_.echo (_.count/1 arity-inputs))
+ (_.echo (_.string " + ")) (_.echo (_.count/1 extra-inputs))
+ (_.echo (_.string text.new-line))
+ (_.echo (_.string "@selfL ")) (_.echo @selfL) (_.echo (_.string text.new-line))
+ (_.echo (_.string " next ")) (_.echo next) (_.echo (_.string text.new-line))
+ (_.echo (_.string " done ")) (_.echo done) (_.echo (_.string text.new-line))
+ (_.return done)))])
+ ## (|> @num-args (_.< arityG))
+ (let [@missing (_.var "missing")]
+ (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list))
+ ($_ _.then
+ (_.; (_.set @missing (_.func-get-args/0 [])))
+ (_.echo (_.string "NEXT ")) (_.echo (_.count/1 @curried))
+ (_.echo (_.string " ")) (_.echo (_.count/1 @missing))
+ (_.echo (_.string " ")) (_.echo (_.count/1 (_.array-merge/+ @curried (list @missing))))
+ (_.echo (_.string text.new-line))
+ (_.return (_.call-user-func-array/2 [@selfL (_.array-merge/+ @curried (list @missing))])))))))
+ ))
+ (_.; (_.set @selfG @selfL)))]
+ _ (///.execute! directive)
+ _ (///.save! function-name directive)]
(wrap @selfG)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
index 1b68c0b7a..19b3fa46d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
@@ -29,16 +29,17 @@
initsO+ (monad.map @ generate initsS+)
bodyO (///.with-anchor @loopL
(generate bodyS))
- _ (///.save! true ["" @loop]
- ($_ _.then
- (<| _.;
- (_.set @loopL)
- (_.closure (list (_.reference @loopL))
- (|> initsS+
- list.enumerate
- (list@map (|>> product.left (n.+ start) //case.register [#0])))
- (_.return bodyO)))
- (_.; (_.set @loopG @loopL))))]
+ #let [directive ($_ _.then
+ (<| _.;
+ (_.set @loopL)
+ (_.closure (list (_.reference @loopL))
+ (|> initsS+
+ list.enumerate
+ (list@map (|>> product.left (n.+ start) //case.register [#0])))
+ (_.return bodyO)))
+ (_.; (_.set @loopG @loopL)))]
+ _ (///.execute! directive)
+ _ (///.save! @loop directive)]
(wrap (_.apply/* initsO+ @loopG))))
(def: #export (recur generate argsS+)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
index 3adf01716..c7a8a4eeb 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
@@ -301,6 +301,6 @@
(Operation Any)
(///.with-buffer
(do ////.monad
- [_ (///.save! true ["" ..prefix]
- ..runtime)]
+ [_ (///.execute! ..runtime)
+ _ (///.save! ..prefix ..runtime)]
(///.save-buffer! ..artifact))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index 61796bb40..dd99cb47a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -229,10 +229,11 @@
(#///////reference.Foreign register)
(..capture register)))))]
- _ (/////generation.save! true ["" (_.code @case)]
- (_.def @case (list& @init @dependencies+)
- ($_ _.then
- (_.set (list @cursor) (_.list (list @init)))
- (_.set (list @savepoint) (_.list (list)))
- pattern-matching!)))]
+ #let [directive (_.def @case (list& @init @dependencies+)
+ ($_ _.then
+ (_.set (list @cursor) (_.list (list @init)))
+ (_.set (list @savepoint) (_.list (list)))
+ pattern-matching!))]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! (_.code @case) directive)]
(wrap (_.apply/* @case (list& initG @dependencies+)))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
index d10f54edc..cc3e27165 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
@@ -40,20 +40,21 @@
(case inits
#.Nil
(do ///////phase.monad
- [_ (/////generation.save! true ["" function-name]
- function-definition)]
+ [_ (/////generation.execute! function-definition)
+ _ (/////generation.save! function-name function-definition)]
(wrap (_.apply/* (_.var function-name) inits)))
_
(do {@ ///////phase.monad}
[@closure (:: @ map _.var (/////generation.gensym "closure"))
- _ (/////generation.save! true ["" (_.code @closure)]
- (_.def @closure
- (|> (list.enumerate inits)
- (list@map (|>> product.left ..capture)))
- ($_ _.then
- function-definition
- (_.return (_.var function-name)))))]
+ #let [directive (_.def @closure
+ (|> (list.enumerate inits)
+ (list@map (|>> product.left ..capture)))
+ ($_ _.then
+ function-definition
+ (_.return (_.var function-name))))]
+ _ (/////generation.execute! function-definition)
+ _ (/////generation.save! (_.code @closure) directive)]
(wrap (_.apply/* @closure inits)))))
(def: input
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
index 27c74faee..2edbab5ec 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
@@ -32,11 +32,12 @@
initsO+ (monad.map @ (generate archive) initsS+)
bodyO (/////generation.with-anchor @loop
(generate archive bodyS))
- _ (/////generation.save! true ["" (_.code @loop)]
- (_.def @loop (|> initsS+
- list.enumerate
- (list@map (|>> product.left (n.+ start) //case.register)))
- (_.return bodyO)))]
+ #let [directive (_.def @loop (|> initsS+
+ list.enumerate
+ (list@map (|>> product.left (n.+ start) //case.register)))
+ (_.return bodyO))]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! (_.code @loop) directive)]
(wrap (_.apply/* @loop initsO+))))
(def: #export (recur generate archive argsS+)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index d3d1d532a..aa49950f0 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -340,7 +340,8 @@
(Operation (Buffer (Statement Any)))
(/////generation.with-buffer
(do ///////phase.monad
- [_ (/////generation.save! true ["" ..prefix]
- (<| (_.comment "-*- coding: utf-8 -*-")
- ..runtime))]
+ [#let [directive (<| (_.comment "-*- coding: utf-8 -*-")
+ ..runtime)]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! ..prefix directive)]
/////generation.buffer)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
index 8d2e73a9d..eda4d8a60 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
@@ -296,6 +296,6 @@
(Operation (Buffer (Statement Any)))
(/////generation.with-buffer
(do ///////phase.monad
- [_ (/////generation.save! true ["" ..prefix]
- ..runtime)]
+ [_ (/////generation.execute! ..runtime)
+ _ (/////generation.save! ..prefix ..runtime)]
/////generation.buffer)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
index 992701393..34c1edeaf 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
@@ -136,16 +136,16 @@
(with-vars [error]
(_.with-exception-handler
(_.lambda [(list error) #.None]
- (..left error))
+ (..left error))
(_.lambda [(list) #.None]
- (..right (_.apply/* op (list ..unit)))))))
+ (..right (_.apply/* op (list ..unit)))))))
(runtime: (lux//program-args program-args)
(with-vars [@loop @input @output]
(_.letrec (list [@loop (_.lambda [(list @input @output) #.None]
- (_.if (_.eqv?/2 _.nil @input)
- @output
- (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))])
+ (_.if (_.eqv?/2 _.nil @input)
+ @output
+ (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))])
(_.apply/2 @loop (_.reverse/1 program-args) ..none))))
(def: runtime//lux
@@ -262,6 +262,6 @@
(Operation Any)
(///.with-buffer
(do ////.monad
- [_ (///.save! true ["" ..prefix]
- ..runtime)]
+ [_ (///.execute! ..runtime)
+ _ (///.save! ..prefix ..runtime)]
(///.save-buffer! ""))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
index 12be82b11..2c6b8ab6f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
@@ -9,6 +9,7 @@
["." exception (#+ exception:)]]
[data
["." sum]
+ ["." product]
["." maybe]
["." bit ("#@." equivalence)]
["." text ("#@." equivalence)
@@ -450,6 +451,10 @@
(Equivalence Member)
(sum.equivalence n.equivalence n.equivalence))
+(def: member-hash
+ (Hash Member)
+ (sum.hash n.hash n.hash))
+
(structure: #export access-equivalence
(Equivalence Access)
@@ -521,6 +526,51 @@
_
false)))
+(structure: (path'-hash super)
+ (All [a] (-> (Hash a) (Hash (Path' a))))
+
+ (def: &equivalence
+ (..path'-equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ #Pop
+ 2
+
+ (#Access access)
+ (n.* 3 (:: ..access-hash hash access))
+
+ (#Bind register)
+ (n.* 5 (:: n.hash hash register))
+
+ (#Bit-Fork when then else)
+ ($_ n.* 7
+ (:: bit.hash hash when)
+ (hash then)
+ (:: (maybe.hash (path'-hash super)) hash else))
+
+ (^template [<factor> <tag> <hash>]
+ (<tag> cons)
+ (let [case-hash (product.hash <hash>
+ (path'-hash super))
+ cons-hash (product.hash case-hash (list.hash case-hash))]
+ (n.* <factor> (:: cons-hash hash cons))))
+ ([11 #I64-Fork i64.hash]
+ [13 #F64-Fork f.hash]
+ [17 #Text-Fork text.hash])
+
+ (^template [<factor> <tag>]
+ (<tag> fork)
+ (let [recur-hash (path'-hash super)
+ fork-hash (product.hash recur-hash recur-hash)]
+ (n.* <factor> (:: fork-hash hash fork))))
+ ([19 #Alt]
+ [23 #Seq])
+
+ (#Then body)
+ (n.* 29 (:: super hash body))
+ )))
+
(structure: (branch-equivalence (^open "/@."))
(All [a] (-> (Equivalence a) (Equivalence (Branch a))))
@@ -551,6 +601,37 @@
_
false)))
+(structure: (branch-hash super)
+ (All [a] (-> (Hash a) (Hash (Branch a))))
+
+ (def: &equivalence
+ (..branch-equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ (#Let [input register body])
+ ($_ n.* 2
+ (:: super hash input)
+ (:: n.hash hash register)
+ (:: super hash body))
+
+ (#If [test then else])
+ ($_ n.* 3
+ (:: super hash test)
+ (:: super hash then)
+ (:: super hash else))
+
+ (#Get [path record])
+ ($_ n.* 5
+ (:: (list.hash ..member-hash) hash path)
+ (:: super hash record))
+
+ (#Case [input path])
+ ($_ n.* 7
+ (:: super hash input)
+ (:: (..path'-hash super) hash path))
+ )))
+
(structure: (loop-equivalence (^open "/@."))
(All [a] (-> (Equivalence a) (Equivalence (Loop a))))
@@ -568,6 +649,25 @@
_
false)))
+(structure: (loop-hash super)
+ (All [a] (-> (Hash a) (Hash (Loop a))))
+
+ (def: &equivalence
+ (..loop-equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ (#Scope [start inits iteration])
+ ($_ n.* 2
+ (:: n.hash hash start)
+ (:: (list.hash super) hash inits)
+ (:: super hash iteration))
+
+ (#Recur resets)
+ ($_ n.* 3
+ (:: (list.hash super) hash resets))
+ )))
+
(structure: (function-equivalence (^open "/@."))
(All [a] (-> (Equivalence a) (Equivalence (Function a))))
@@ -587,6 +687,26 @@
_
false)))
+(structure: (function-hash super)
+ (All [a] (-> (Hash a) (Hash (Function a))))
+
+ (def: &equivalence
+ (..function-equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ (#Abstraction [environment arity body])
+ ($_ n.* 2
+ (:: (list.hash super) hash environment)
+ (:: n.hash hash arity)
+ (:: super hash body))
+
+ (#Apply [abstraction arguments])
+ ($_ n.* 3
+ (:: super hash abstraction)
+ (:: (list.hash super) hash arguments))
+ )))
+
(structure: (control-equivalence (^open "/@."))
(All [a] (-> (Equivalence a) (Equivalence (Control a))))
@@ -602,6 +722,22 @@
_
false)))
+(structure: (control-hash super)
+ (All [a] (-> (Hash a) (Hash (Control a))))
+
+ (def: &equivalence
+ (..control-equivalence (:: super &equivalence)))
+
+ (def: (hash value)
+ (case value
+ (^template [<factor> <tag> <hash>]
+ (<tag> value)
+ (n.* <factor> (:: (<hash> super) hash value)))
+ ([2 #Branch ..branch-hash]
+ [3 #Loop ..loop-hash]
+ [5 #Function ..function-hash])
+ )))
+
(structure: #export equivalence
(Equivalence Synthesis)
@@ -623,25 +759,22 @@
(Equivalence Path)
(path'-equivalence equivalence))
-## (structure: #export hash
-## (Hash Synthesis)
-
-## (def: &equivalence ..equivalence)
-
-## (def: (hash value)
-## (case value
-## (case [reference sample]
-## (^template [<tag> <hash>]
-## [(<tag> value')]
-## (:: <hash> hash value'))
-## ([#Primitive ..primitive-hash]
-## [#Structure (analysis.composite-hash hash)]
-## [#Reference reference.hash]
-## [#Control (control-hash hash)]
-## [#Extension (extension.hash hash)])
-
-## _
-## false))))
+(structure: #export hash
+ (Hash Synthesis)
+
+ (def: &equivalence ..equivalence)
+
+ (def: (hash value)
+ (let [recur-hash [..equivalence hash]]
+ (case value
+ (^template [<tag> <hash>]
+ (<tag> value)
+ (:: <hash> hash value))
+ ([#Primitive ..primitive-hash]
+ [#Structure (analysis.composite-hash recur-hash)]
+ [#Reference reference.hash]
+ [#Control (..control-hash recur-hash)]
+ [#Extension (extension.hash recur-hash)])))))
(template: #export (!bind-top register thenP)
($_ ..path/seq
diff --git a/stdlib/source/lux/tool/compiler/reference.lux b/stdlib/source/lux/tool/compiler/reference.lux
index abcbe1162..e67b946b8 100644
--- a/stdlib/source/lux/tool/compiler/reference.lux
+++ b/stdlib/source/lux/tool/compiler/reference.lux
@@ -1,7 +1,8 @@
(.module:
[lux #*
[abstract
- [equivalence (#+ Equivalence)]]
+ [equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]]
[control
[pipe (#+ case>)]]
[data
@@ -34,6 +35,22 @@
_
false)))
+(structure: #export hash
+ (Hash Reference)
+
+ (def: &equivalence
+ ..equivalence)
+
+ (def: (hash value)
+ (case value
+ (^template [<factor> <tag> <hash>]
+ (<tag> value)
+ ($_ n.* <factor>
+ (:: <hash> hash value)))
+ ([2 #Variable /variable.hash]
+ [3 #Constant name.hash])
+ )))
+
(template [<name> <family> <tag>]
[(template: #export (<name> content)
(<| <family>
diff --git a/stdlib/source/lux/tool/compiler/reference/variable.lux b/stdlib/source/lux/tool/compiler/reference/variable.lux
index cea605e93..0350463bd 100644
--- a/stdlib/source/lux/tool/compiler/reference/variable.lux
+++ b/stdlib/source/lux/tool/compiler/reference/variable.lux
@@ -35,13 +35,16 @@
(structure: #export hash
(Hash Variable)
- (def: &equivalence ..equivalence)
+ (def: &equivalence
+ ..equivalence)
+
(def: hash
- (|>> (case> (#Local register)
- register
-
- (#Foreign register)
- (|> register .int (i.* -1) .nat)))))
+ (|>> (case> (^template [<factor> <tag>]
+ (<tag> register)
+ ($_ n.* <factor>
+ (:: n.hash hash register)))
+ ([2 #Local]
+ [3 #Foreign])))))
(template: #export (self)
(#..Local 0))
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index b3e55e901..50e737e98 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -34,7 +34,8 @@
["#." region]
["#." remember]
[security
- ["#." policy]]
+ ["#." policy]
+ ["#." capability]]
["#." state]
["#." thread]
["#." try]
@@ -81,6 +82,7 @@
Test
($_ _.and
/policy.test
+ /capability.test
))
(def: #export test
diff --git a/stdlib/source/test/lux/control/security/capability.lux b/stdlib/source/test/lux/control/security/capability.lux
new file mode 100644
index 000000000..b102c6a33
--- /dev/null
+++ b/stdlib/source/test/lux/control/security/capability.lux
@@ -0,0 +1,45 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io (#+ IO)]
+ [concurrency
+ ["." promise]]]
+ [data
+ [number
+ ["n" nat]]]
+ [math
+ ["." random]]]
+ {1
+ ["." /]})
+
+(/.capability: (Can-Shift a)
+ (can-shift [a Nat] [a Nat]))
+
+(/.capability: Can-IO
+ (can-io [] (IO Nat)))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do random.monad
+ [shift random.nat
+ base random.nat
+ #let [expected (n.+ shift base)]
+ pass-through (random.ascii 1)]
+ (_.with-cover [/.Capability]
+ ($_ _.and
+ (_.cover [/.capability: /.use]
+ (let [capability (..can-shift (function (_ [no-op raw])
+ [no-op (n.+ shift raw)]))
+ [untouched actual] (/.use capability [pass-through base])]
+ (and (is? pass-through untouched)
+ (n.= expected actual))))
+ (wrap (let [capability (..can-io (function (_ _) (io.io expected)))]
+ (do promise.monad
+ [actual (/.use (/.async capability) [])]
+ (_.claim [/.async]
+ (n.= expected actual)))))
+ )))))
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index 5f8d03273..0fd4d76f3 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -73,6 +73,7 @@
dataL (_binary.binary file-size)
dataR (_binary.binary file-size)
new-modified (|> r.int (:: @ map (|>> i.abs
+ (i.% +10,000,000,000,000)
truncate-millis
duration.from-millis
instant.absolute)))]
@@ -170,9 +171,9 @@
[file (!.use (:: /.system create-file) path)
_ (!.use (:: file over-write) dataL)
_ (!.use (:: file modify) new-modified)
- old-modified (!.use (:: file last-modified) [])
+ current-modified (!.use (:: file last-modified) [])
_ (!.use (:: file delete) [])]
- (wrap (:: instant.equivalence = new-modified old-modified))))]
+ (wrap (:: instant.equivalence = new-modified current-modified))))]
(_.assert "Can change the time of last modification."
(try.default #0 result))))
(wrap (do promise.monad