diff options
Diffstat (limited to 'new-luxc')
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/case.lux | 105 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/inference.lux | 38 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/common.lux | 28 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/loop.lux | 20 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux | 232 |
6 files changed, 242 insertions, 184 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux index 5d4c592aa..949e18a26 100644 --- a/new-luxc/source/luxc/lang/analysis/case.lux +++ b/new-luxc/source/luxc/lang/analysis/case.lux @@ -35,6 +35,15 @@ (format " Type: " (%type type) "\n" "Pattern: " (%code pattern))) +(def: (re-quantify envs baseT) + (-> (List (List Type)) Type Type) + (case envs + #;Nil + baseT + + (#;Cons head tail) + (re-quantify tail (#;UnivQ head baseT)))) + ## Type-checking on the input value is done during the analysis of a ## "case" expression, to ensure that the patterns being used make ## sense for the type of the input value. @@ -44,52 +53,74 @@ ## type-check the input with respect to the patterns. (def: (simplify-case-type caseT) (-> Type (Meta Type)) - (case caseT - (#;Var id) - (do macro;Monad<Meta> - [?caseT' (&;with-type-env - (tc;read id))] - (case ?caseT' - (#;Some caseT') - (simplify-case-type caseT') + (loop [envs (: (List (List Type)) + (list)) + caseT caseT] + (case caseT + (#;Var id) + (do macro;Monad<Meta> + [?caseT' (&;with-type-env + (tc;read id))] + (case ?caseT' + (#;Some caseT') + (recur envs caseT') - _ - (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))) + _ + (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))) - (#;Named name unnamedT) - (simplify-case-type unnamedT) + (#;Named name unnamedT) + (recur envs unnamedT) - (^or (#;UnivQ _) (#;ExQ _)) - (do macro;Monad<Meta> - [[ex-id exT] (&;with-type-env - tc;existential)] - (simplify-case-type (maybe;assume (type;apply (list exT) caseT)))) + (#;UnivQ env unquantifiedT) + (recur (#;Cons env envs) unquantifiedT) - (#;Apply inputT funcT) - (case funcT - (#;Var funcT-id) + ## (^template [<tag> <instancer>] + ## (<tag> _) + ## (do macro;Monad<Meta> + ## [[_ instanceT] (&;with-type-env + ## <instancer>)] + ## (recur (maybe;assume (type;apply (list instanceT) caseT))))) + ## ([#;UnivQ tc;var] + ## [#;ExQ tc;existential]) + + (#;ExQ _) (do macro;Monad<Meta> - [funcT' (&;with-type-env - (do tc;Monad<Check> - [?funct' (tc;read funcT-id)] - (case ?funct' - (#;Some funct') - (wrap funct') + [[ex-id exT] (&;with-type-env + tc;existential)] + (recur envs (maybe;assume (type;apply (list exT) caseT)))) - _ - (tc;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))))] - (simplify-case-type (#;Apply inputT funcT'))) + (#;Apply inputT funcT) + (case funcT + (#;Var funcT-id) + (do macro;Monad<Meta> + [funcT' (&;with-type-env + (do tc;Monad<Check> + [?funct' (tc;read funcT-id)] + (case ?funct' + (#;Some funct') + (wrap funct') - _ - (case (type;apply (list inputT) funcT) - (#;Some outputT) - (:: macro;Monad<Meta> wrap outputT) + _ + (tc;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))))] + (recur envs (#;Apply inputT funcT'))) - #;None - (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))) + _ + (case (type;apply (list inputT) funcT) + (#;Some outputT) + (recur envs outputT) - _ - (:: macro;Monad<Meta> wrap caseT))) + #;None + (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))) + + (#;Product _) + (|> caseT + type;flatten-tuple + (list/map (re-quantify envs)) + type;tuple + (:: macro;Monad<Meta> wrap)) + + _ + (:: macro;Monad<Meta> wrap (re-quantify envs caseT))))) ## This function handles several concerns at once, but it must be that ## way because those concerns are interleaved when doing diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux index c6f0323f7..e89ab2e1e 100644 --- a/new-luxc/source/luxc/lang/analysis/inference.lux +++ b/new-luxc/source/luxc/lang/analysis/inference.lux @@ -132,9 +132,9 @@ )) ## Turns a record type into the kind of function type suitable for inference. -(def: #export (record type) +(def: #export (record inferT) (-> Type (Meta Type)) - (case type + (case inferT (#;Named name unnamedT) (record unnamedT) @@ -146,17 +146,25 @@ ([#;UnivQ] [#;ExQ]) + (#;Apply inputT funcT) + (case (type;apply (list inputT) funcT) + (#;Some outputT) + (record outputT) + + #;None + (&;throw Invalid-Type-Application (%type inferT))) + (#;Product _) - (macro/wrap (type;function (type;flatten-tuple type) type)) + (macro/wrap (type;function (type;flatten-tuple inferT) inferT)) _ - (&;throw Not-A-Record-Type (%type type)))) + (&;throw Not-A-Record-Type (%type inferT)))) ## Turns a variant type into the kind of function type suitable for inference. -(def: #export (variant tag expected-size type) +(def: #export (variant tag expected-size inferT) (-> Nat Nat Type (Meta Type)) (loop [depth +0 - currentT type] + currentT inferT] (case currentT (#;Named name unnamedT) (do macro;Monad<Meta> @@ -182,12 +190,12 @@ (#;Some caseT) (macro/wrap (if (n.= +0 depth) (type;function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] + (let [replace! (replace-bound (|> depth n.dec (n.* +2)) inferT)] (type;function (list (replace! caseT)) (replace! currentT))))) #;None - (&common;variant-out-of-bounds-error type expected-size tag)) + (&common;variant-out-of-bounds-error inferT expected-size tag)) (n.< expected-size actual-size) (&;throw Smaller-Variant-Than-Expected @@ -198,12 +206,20 @@ (let [caseT (type;variant (list;drop boundary cases))] (macro/wrap (if (n.= +0 depth) (type;function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] + (let [replace! (replace-bound (|> depth n.dec (n.* +2)) inferT)] (type;function (list (replace! caseT)) (replace! currentT)))))) ## else - (&common;variant-out-of-bounds-error type expected-size tag))) + (&common;variant-out-of-bounds-error inferT expected-size tag))) + + (#;Apply inputT funcT) + (case (type;apply (list inputT) funcT) + (#;Some outputT) + (variant tag expected-size outputT) + + #;None + (&;throw Invalid-Type-Application (%type inferT))) _ - (&;throw Not-A-Variant-Type (%type type))))) + (&;throw Not-A-Variant-Type (%type inferT))))) diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux index 489414c2a..f5afca5bf 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux @@ -172,7 +172,7 @@ (|> (dict;new text;Hash<Text>) (install "log" (unary Text Unit)) (install "error" (unary Text Bottom)) - (install "exit" (unary Nat Bottom)) + (install "exit" (unary Int Bottom)) (install "current-time" (nullary Int))))) (def: bit-procs @@ -202,7 +202,7 @@ (install "min" (nullary Nat)) (install "max" (nullary Nat)) (install "to-int" (unary Nat Int)) - (install "to-text" (unary Nat Text))))) + (install "char" (unary Nat Text))))) (def: int-procs Bundle @@ -277,28 +277,28 @@ (install "lower" (unary Text Text)) ))) -(def: (array-get proc) +(def: (array//get proc) (-> Text Proc) (function [analyse eval args] (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] - ((binary Nat (type (Array varT)) varT proc) + ((binary (type (Array varT)) Nat (type (Maybe varT)) proc) analyse eval args)))) -(def: (array-put proc) +(def: (array//put proc) (-> Text Proc) (function [analyse eval args] (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] - ((trinary Nat varT (type (Array varT)) (type (Array varT)) proc) + ((trinary (type (Array varT)) Nat varT (type (Array varT)) proc) analyse eval args)))) -(def: (array-remove proc) +(def: (array//remove proc) (-> Text Proc) (function [analyse eval args] (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] - ((binary Nat (type (Array varT)) (type (Array varT)) proc) + ((binary (type (Array varT)) Nat (type (Array varT)) proc) analyse eval args)))) (def: array-procs @@ -306,9 +306,9 @@ (<| (prefix "array") (|> (dict;new text;Hash<Text>) (install "new" (unary Nat Array)) - (install "get" array-get) - (install "put" array-put) - (install "remove" array-remove) + (install "get" array//get) + (install "put" array//put) + (install "remove" array//remove) (install "size" (unary (type (Ex [a] (Array a))) Nat)) ))) @@ -359,12 +359,12 @@ ((unary (type (Atom varT)) varT proc) analyse eval args)))) -(def: (atom-compare-and-swap proc) +(def: (atom//compare-and-swap proc) (-> Text Proc) (function [analyse eval args] (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] - ((trinary varT varT (type (Atom varT)) Bool proc) + ((trinary (type (Atom varT)) varT varT Bool proc) analyse eval args)))) (def: atom-procs @@ -373,7 +373,7 @@ (|> (dict;new text;Hash<Text>) (install "new" atom-new) (install "read" atom-read) - (install "compare-and-swap" atom-compare-and-swap) + (install "compare-and-swap" atom//compare-and-swap) ))) (def: process-procs diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux index ac72e69b2..a5da743d5 100644 --- a/new-luxc/source/luxc/lang/synthesis/loop.lux +++ b/new-luxc/source/luxc/lang/synthesis/loop.lux @@ -152,7 +152,7 @@ _ _var)) environment))] - (~ (recur bodyS)))) + (~ bodyS))) (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))]) (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS)))) @@ -160,15 +160,7 @@ (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))]) (` ("lux recur" (~@ (list/map recur argsS)))) - (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]) - (` ((~ (code;text procedure)) (~@ (list/map recur argsS)))) - - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (if (variableL;captured? var) - (` ((~ (code;int (resolve-captured var))))) - (` ((~ (code;int (|> offset nat-to-int (i.+ var))))))) - - (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS bodyS))]) + (^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ bodyS))) (` ("lux let" (~ (code;nat (n.+ offset register))) (~ (recur inputS)) (~ (recur bodyS)))) @@ -183,6 +175,14 @@ [(~@ (list/map recur initsS))] (~ (recur bodyS)))) + (^ [_ (#;Form (list [_ (#;Int var)]))]) + (if (variableL;captured? var) + (` ((~ (code;int (resolve-captured var))))) + (` ((~ (code;int (|> offset nat-to-int (i.+ var))))))) + + (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]) + (` ((~ (code;text procedure)) (~@ (list/map recur argsS)))) + _ exprS )))) diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index fbecf2da5..80484b7e8 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -128,8 +128,9 @@ (analyse valueC)))) valueT (&;with-type-env (tc;clean valueT)) - ## #let [_ (if (or (text/= "list/size" def-name)) + ## #let [_ (if (or (text/= "string~" def-name)) ## (log! (format "{" def-name "}\n" + ## " TYPE: " (%type valueT) "\n" ## " ANALYSIS: " (%code valueA) "\n" ## "SYNTHESIS: " (%code (expressionS;synthesize valueA)))) ## [])] diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux index 6c1b18932..01f2a33c7 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux @@ -224,7 +224,7 @@ ## [[Arrays]] (def: (array//new lengthI) Unary - (|>. lengthI jvm-intI ($i;ANEWARRAY ($t;descriptor $Object)))) + (|>. lengthI jvm-intI ($i;ANEWARRAY ($t;binary-name "java.lang.Object")))) (def: (array//get [arrayI idxI]) Binary @@ -348,9 +348,8 @@ (|>. inputI <prepare> <transform>))] [nat//to-int id id] - [nat//to-char ($i;unwrap #$;Long) - (<| ($i;INVOKESTATIC "java.lang.Character" "toString" ($t;method (list $t;char) (#;Some $String) (list)) false) - $i;I2C $i;L2I)] + [nat//char ($i;unwrap #$;Long) + ((|>. $i;L2I $i;I2C ($i;INVOKESTATIC "java.lang.Character" "toString" ($t;method (list $t;char) (#;Some $String) (list)) false)))] [int//to-nat id id] [int//to-frac ($i;unwrap #$;Long) (<| ($i;wrap #$;Double) $i;L2D)] @@ -397,7 +396,7 @@ ($i;wrap #$;Boolean)] [text//lt ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") ($i;INVOKEVIRTUAL "java.lang.String" "compareTo" ($t;method (list $String) (#;Some $t;int) (list)) false) - (predicateI $i;IF_ICMPEQ)] + (<| (predicateI $i;IF_ICMPEQ) ($i;int -1))] [text//concat ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false) id] @@ -563,7 +562,8 @@ ## [[Processes]] (def: (process//concurrency-level []) Nullary - (|>. ($i;GETSTATIC hostL;runtime-class "concurrency_level" $t;int) + (|>. ($i;INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t;method (list) (#;Some ($t;class "java.lang.Runtime" (list))) (list)) false) + ($i;INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t;method (list) (#;Some $t;int) (list)) false) lux-intI)) (def: (process//future procedureI) @@ -593,82 +593,87 @@ (def: bit-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "bit count" (unary bit//count)) - (install "bit and" (binary bit//and)) - (install "bit or" (binary bit//or)) - (install "bit xor" (binary bit//xor)) - (install "bit shift-left" (binary bit//shift-left)) - (install "bit unsigned-shift-right" (binary bit//unsigned-shift-right)) - (install "bit shift-right" (binary bit//shift-right)) - )) + (<| (prefix "bit") + (|> (dict;new text;Hash<Text>) + (install "count" (unary bit//count)) + (install "and" (binary bit//and)) + (install "or" (binary bit//or)) + (install "xor" (binary bit//xor)) + (install "shift-left" (binary bit//shift-left)) + (install "unsigned-shift-right" (binary bit//unsigned-shift-right)) + (install "shift-right" (binary bit//shift-right)) + ))) (def: nat-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "nat +" (binary nat//add)) - (install "nat -" (binary nat//sub)) - (install "nat *" (binary nat//mul)) - (install "nat /" (binary nat//div)) - (install "nat %" (binary nat//rem)) - (install "nat =" (binary nat//eq)) - (install "nat <" (binary nat//lt)) - (install "nat min" (nullary nat//min)) - (install "nat max" (nullary nat//max)) - (install "nat to-int" (unary nat//to-int)) - (install "nat to-char" (unary nat//to-char)))) + (<| (prefix "nat") + (|> (dict;new text;Hash<Text>) + (install "+" (binary nat//add)) + (install "-" (binary nat//sub)) + (install "*" (binary nat//mul)) + (install "/" (binary nat//div)) + (install "%" (binary nat//rem)) + (install "=" (binary nat//eq)) + (install "<" (binary nat//lt)) + (install "min" (nullary nat//min)) + (install "max" (nullary nat//max)) + (install "to-int" (unary nat//to-int)) + (install "char" (unary nat//char))))) (def: int-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "int +" (binary int//add)) - (install "int -" (binary int//sub)) - (install "int *" (binary int//mul)) - (install "int /" (binary int//div)) - (install "int %" (binary int//rem)) - (install "int =" (binary int//eq)) - (install "int <" (binary int//lt)) - (install "int min" (nullary int//min)) - (install "int max" (nullary int//max)) - (install "int to-nat" (unary int//to-nat)) - (install "int to-frac" (unary int//to-frac)))) + (<| (prefix "int") + (|> (dict;new text;Hash<Text>) + (install "+" (binary int//add)) + (install "-" (binary int//sub)) + (install "*" (binary int//mul)) + (install "/" (binary int//div)) + (install "%" (binary int//rem)) + (install "=" (binary int//eq)) + (install "<" (binary int//lt)) + (install "min" (nullary int//min)) + (install "max" (nullary int//max)) + (install "to-nat" (unary int//to-nat)) + (install "to-frac" (unary int//to-frac))))) (def: deg-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "deg +" (binary deg//add)) - (install "deg -" (binary deg//sub)) - (install "deg *" (binary deg//mul)) - (install "deg /" (binary deg//div)) - (install "deg %" (binary deg//rem)) - (install "deg =" (binary deg//eq)) - (install "deg <" (binary deg//lt)) - (install "deg scale" (binary deg//scale)) - (install "deg reciprocal" (binary deg//reciprocal)) - (install "deg min" (nullary deg//min)) - (install "deg max" (nullary deg//max)) - (install "deg to-frac" (unary deg//to-frac)))) + (<| (prefix "deg") + (|> (dict;new text;Hash<Text>) + (install "+" (binary deg//add)) + (install "-" (binary deg//sub)) + (install "*" (binary deg//mul)) + (install "/" (binary deg//div)) + (install "%" (binary deg//rem)) + (install "=" (binary deg//eq)) + (install "<" (binary deg//lt)) + (install "scale" (binary deg//scale)) + (install "reciprocal" (binary deg//reciprocal)) + (install "min" (nullary deg//min)) + (install "max" (nullary deg//max)) + (install "to-frac" (unary deg//to-frac))))) (def: frac-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "frac +" (binary frac//add)) - (install "frac -" (binary frac//sub)) - (install "frac *" (binary frac//mul)) - (install "frac /" (binary frac//div)) - (install "frac %" (binary frac//rem)) - (install "frac =" (binary frac//eq)) - (install "frac <" (binary frac//lt)) - (install "frac smallest" (nullary frac//smallest)) - (install "frac min" (nullary frac//min)) - (install "frac max" (nullary frac//max)) - (install "frac not-a-number" (nullary frac//not-a-number)) - (install "frac positive-infinity" (nullary frac//positive-infinity)) - (install "frac negative-infinity" (nullary frac//negative-infinity)) - (install "frac to-deg" (unary frac//to-deg)) - (install "frac to-int" (unary frac//to-int)) - (install "frac encode" (unary frac//encode)) - (install "frac decode" (unary frac//decode)))) + (<| (prefix "frac") + (|> (dict;new text;Hash<Text>) + (install "+" (binary frac//add)) + (install "-" (binary frac//sub)) + (install "*" (binary frac//mul)) + (install "/" (binary frac//div)) + (install "%" (binary frac//rem)) + (install "=" (binary frac//eq)) + (install "<" (binary frac//lt)) + (install "smallest" (nullary frac//smallest)) + (install "min" (nullary frac//min)) + (install "max" (nullary frac//max)) + (install "not-a-number" (nullary frac//not-a-number)) + (install "positive-infinity" (nullary frac//positive-infinity)) + (install "negative-infinity" (nullary frac//negative-infinity)) + (install "to-deg" (unary frac//to-deg)) + (install "to-int" (unary frac//to-int)) + (install "encode" (unary frac//encode)) + (install "decode" (unary frac//decode))))) (def: text-procs Bundle @@ -690,59 +695,64 @@ (def: array-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "array new" (unary array//new)) - (install "array get" (binary array//get)) - (install "array put" (trinary array//put)) - (install "array remove" (binary array//remove)) - (install "array size" (unary array//size)) - )) + (<| (prefix "array") + (|> (dict;new text;Hash<Text>) + (install "new" (unary array//new)) + (install "get" (binary array//get)) + (install "put" (trinary array//put)) + (install "remove" (binary array//remove)) + (install "size" (unary array//size)) + ))) (def: math-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "math cos" (unary math//cos)) - (install "math sin" (unary math//sin)) - (install "math tan" (unary math//tan)) - (install "math acos" (unary math//acos)) - (install "math asin" (unary math//asin)) - (install "math atan" (unary math//atan)) - (install "math cosh" (unary math//cosh)) - (install "math sinh" (unary math//sinh)) - (install "math tanh" (unary math//tanh)) - (install "math exp" (unary math//exp)) - (install "math log" (unary math//log)) - (install "math root2" (unary math//root2)) - (install "math root3" (unary math//root3)) - (install "math ceil" (unary math//ceil)) - (install "math floor" (unary math//floor)) - (install "math round" (unary math//round)) - (install "math atan2" (binary math//atan2)) - (install "math pow" (binary math//pow)) - )) + (<| (prefix "math") + (|> (dict;new text;Hash<Text>) + (install "cos" (unary math//cos)) + (install "sin" (unary math//sin)) + (install "tan" (unary math//tan)) + (install "acos" (unary math//acos)) + (install "asin" (unary math//asin)) + (install "atan" (unary math//atan)) + (install "cosh" (unary math//cosh)) + (install "sinh" (unary math//sinh)) + (install "tanh" (unary math//tanh)) + (install "exp" (unary math//exp)) + (install "log" (unary math//log)) + (install "root2" (unary math//root2)) + (install "root3" (unary math//root3)) + (install "ceil" (unary math//ceil)) + (install "floor" (unary math//floor)) + (install "round" (unary math//round)) + (install "atan2" (binary math//atan2)) + (install "pow" (binary math//pow)) + ))) (def: io-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "io log" (unary io//log)) - (install "io error" (unary io//error)) - (install "io exit" (unary io//exit)) - (install "io current-time" (nullary io//current-time)))) + (<| (prefix "io") + (|> (dict;new text;Hash<Text>) + (install "log" (unary io//log)) + (install "error" (unary io//error)) + (install "exit" (unary io//exit)) + (install "current-time" (nullary io//current-time))))) (def: atom-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "atom new" (unary atom//new)) - (install "atom read" (unary atom//read)) - (install "atom compare-and-swap" (trinary atom//compare-and-swap)))) + (<| (prefix "atom") + (|> (dict;new text;Hash<Text>) + (install "new" (unary atom//new)) + (install "read" (unary atom//read)) + (install "compare-and-swap" (trinary atom//compare-and-swap))))) (def: process-procs Bundle - (|> (dict;new text;Hash<Text>) - (install "process concurrency-level" (nullary process//concurrency-level)) - (install "process future" (unary process//future)) - (install "process schedule" (binary process//schedule)) - )) + (<| (prefix "process") + (|> (dict;new text;Hash<Text>) + (install "concurrency-level" (nullary process//concurrency-level)) + (install "future" (unary process//future)) + (install "schedule" (binary process//schedule)) + ))) (def: #export procedures Bundle |