diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/procedure/common.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/common.lux | 168 |
1 files changed, 84 insertions, 84 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux index f5afca5bf..b003edfa7 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["ex" exception #+ exception:]) @@ -14,16 +14,16 @@ [io]) (luxc ["&" lang] (lang ["la" analysis] - (analysis ["&;" common] - [";A" function] - [";A" case] - [";A" type])))) + (analysis ["&." common] + [".A" function] + [".A" case] + [".A" type])))) (exception: #export Incorrect-Procedure-Arity) ## [Utils] (type: #export Proc - (-> &;Analyser &;Eval (List Code) (Meta la;Analysis))) + (-> &.Analyser &.Eval (List Code) (Meta la.Analysis))) (type: #export Bundle (Dict Text (-> Text Proc))) @@ -31,14 +31,14 @@ (def: #export (install name unnamed) (-> Text (-> Text Proc) (-> Bundle Bundle)) - (dict;put name unnamed)) + (dict.put name unnamed)) (def: #export (prefix prefix bundle) (-> Text Bundle Bundle) (|> bundle - dict;entries + dict.entries (list/map (function [[key val]] [(format prefix " " key) val])) - (dict;from-list text;Hash<Text>))) + (dict.from-list text.Hash<Text>))) (def: #export (wrong-arity proc expected actual) (-> Text Nat Nat Text) @@ -48,19 +48,19 @@ (def: (simple proc inputsT+ outputT) (-> Text (List Type) Type Proc) - (let [num-expected (list;size inputsT+)] + (let [num-expected (list.size inputsT+)] (function [analyse eval args] - (let [num-actual (list;size args)] - (if (n.= num-expected num-actual) - (do macro;Monad<Meta> - [_ (&;infer outputT) - argsA (monad;map @ + (let [num-actual (list.size args)] + (if (n/= num-expected num-actual) + (do macro.Monad<Meta> + [_ (&.infer outputT) + argsA (monad.map @ (function [[argT argC]] - (&;with-type argT + (&.with-type argT (analyse argC))) - (list;zip2 inputsT+ args))] - (wrap (la;procedure proc argsA))) - (&;throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual))))))) + (list.zip2 inputsT+ args))] + (wrap (la.procedure proc argsA))) + (&.throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual))))))) (def: #export (nullary valueT proc) (-> Type Text Proc) @@ -83,8 +83,8 @@ (def: (lux-is proc) (-> Text Proc) (function [analyse eval args] - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var)] + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var)] ((binary varT varT Bool proc) analyse eval args)))) @@ -95,37 +95,37 @@ (function [analyse eval args] (case args (^ (list opC)) - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var) - _ (&;infer (type (Either Text varT))) - opA (&;with-type (type (io;IO varT)) + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var) + _ (&.infer (type (Either Text varT))) + opA (&.with-type (type (io.IO varT)) (analyse opC))] - (wrap (la;procedure proc (list opA)))) + (wrap (la.procedure proc (list opA)))) _ - (&;throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list;size args)))))) + (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args)))))) (def: (lux//function proc) (-> Text Proc) (function [analyse eval args] (case args - (^ (list [_ (#;Symbol ["" func-name])] - [_ (#;Symbol ["" arg-name])] + (^ (list [_ (#.Symbol ["" func-name])] + [_ (#.Symbol ["" arg-name])] body)) - (functionA;analyse-function analyse func-name arg-name body) + (functionA.analyse-function analyse func-name arg-name body) _ - (&;throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list;size args)))))) + (&.throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list.size args)))))) (def: (lux//case proc) (-> Text Proc) (function [analyse eval args] (case args - (^ (list input [_ (#;Record branches)])) - (caseA;analyse-case analyse input branches) + (^ (list input [_ (#.Record branches)])) + (caseA.analyse-case analyse input branches) _ - (&;throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list;size args)))))) + (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args)))))) (do-template [<name> <analyser>] [(def: (<name> proc) @@ -136,28 +136,28 @@ (<analyser> analyse eval typeC valueC) _ - (&;throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list;size args))))))] + (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))] - [lux//check typeA;analyse-check] - [lux//coerce typeA;analyse-coerce]) + [lux//check typeA.analyse-check] + [lux//coerce typeA.analyse-coerce]) (def: (lux//check//type proc) (-> Text Proc) (function [analyse eval args] (case args (^ (list valueC)) - (do macro;Monad<Meta> - [_ (&;infer (type Type)) - valueA (&;with-type Type + (do macro.Monad<Meta> + [_ (&.infer (type Type)) + valueA (&.with-type Type (analyse valueC))] (wrap valueA)) _ - (&;throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list;size args)))))) + (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args)))))) (def: lux-procs Bundle - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "is" lux-is) (install "try" lux-try) (install "function" lux//function) @@ -169,7 +169,7 @@ (def: io-procs Bundle (<| (prefix "io") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "log" (unary Text Unit)) (install "error" (unary Text Bottom)) (install "exit" (unary Int Bottom)) @@ -178,7 +178,7 @@ (def: bit-procs Bundle (<| (prefix "bit") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "count" (unary Nat Nat)) (install "and" (binary Nat Nat Nat)) (install "or" (binary Nat Nat Nat)) @@ -191,7 +191,7 @@ (def: nat-procs Bundle (<| (prefix "nat") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "+" (binary Nat Nat Nat)) (install "-" (binary Nat Nat Nat)) (install "*" (binary Nat Nat Nat)) @@ -207,7 +207,7 @@ (def: int-procs Bundle (<| (prefix "int") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "+" (binary Int Int Int)) (install "-" (binary Int Int Int)) (install "*" (binary Int Int Int)) @@ -223,7 +223,7 @@ (def: deg-procs Bundle (<| (prefix "deg") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "+" (binary Deg Deg Deg)) (install "-" (binary Deg Deg Deg)) (install "*" (binary Deg Deg Deg)) @@ -240,7 +240,7 @@ (def: frac-procs Bundle (<| (prefix "frac") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "+" (binary Frac Frac Frac)) (install "-" (binary Frac Frac Frac)) (install "*" (binary Frac Frac Frac)) @@ -262,7 +262,7 @@ (def: text-procs Bundle (<| (prefix "text") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "=" (binary Text Text Bool)) (install "<" (binary Text Text Bool)) (install "concat" (binary Text Text Text)) @@ -280,31 +280,31 @@ (def: (array//get proc) (-> Text Proc) (function [analyse eval args] - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var)] + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var)] ((binary (type (Array varT)) Nat (type (Maybe varT)) proc) analyse eval args)))) (def: (array//put proc) (-> Text Proc) (function [analyse eval args] - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var)] + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var)] ((trinary (type (Array varT)) Nat varT (type (Array varT)) proc) analyse eval args)))) (def: (array//remove proc) (-> Text Proc) (function [analyse eval args] - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var)] + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var)] ((binary (type (Array varT)) Nat (type (Array varT)) proc) analyse eval args)))) (def: array-procs Bundle (<| (prefix "array") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "new" (unary Nat Array)) (install "get" array//get) (install "put" array//put) @@ -315,7 +315,7 @@ (def: math-procs Bundle (<| (prefix "math") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "cos" (unary Frac Frac)) (install "sin" (unary Frac Frac)) (install "tan" (unary Frac Frac)) @@ -341,36 +341,36 @@ (function [analyse eval args] (case args (^ (list initC)) - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var) - _ (&;infer (type (Atom varT))) - initA (&;with-type varT + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var) + _ (&.infer (type (Atom varT))) + initA (&.with-type varT (analyse initC))] - (wrap (la;procedure proc (list initA)))) + (wrap (la.procedure proc (list initA)))) _ - (&;throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list;size args)))))) + (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args)))))) (def: (atom-read proc) (-> Text Proc) (function [analyse eval args] - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var)] + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var)] ((unary (type (Atom varT)) varT proc) analyse eval args)))) (def: (atom//compare-and-swap proc) (-> Text Proc) (function [analyse eval args] - (do macro;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var)] + (do macro.Monad<Meta> + [[var-id varT] (&.with-type-env tc.var)] ((trinary (type (Atom varT)) varT varT Bool proc) analyse eval args)))) (def: atom-procs Bundle (<| (prefix "atom") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "new" atom-new) (install "read" atom-read) (install "compare-and-swap" atom//compare-and-swap) @@ -379,25 +379,25 @@ (def: process-procs Bundle (<| (prefix "process") - (|> (dict;new text;Hash<Text>) + (|> (dict.new text.Hash<Text>) (install "concurrency-level" (nullary Nat)) - (install "future" (unary (type (io;IO Top)) Unit)) - (install "schedule" (binary Nat (type (io;IO Top)) Unit)) + (install "future" (unary (type (io.IO Top)) Unit)) + (install "schedule" (binary Nat (type (io.IO Top)) Unit)) ))) (def: #export procedures Bundle (<| (prefix "lux") - (|> (dict;new text;Hash<Text>) - (dict;merge lux-procs) - (dict;merge bit-procs) - (dict;merge nat-procs) - (dict;merge int-procs) - (dict;merge deg-procs) - (dict;merge frac-procs) - (dict;merge text-procs) - (dict;merge array-procs) - (dict;merge math-procs) - (dict;merge atom-procs) - (dict;merge process-procs) - (dict;merge io-procs)))) + (|> (dict.new text.Hash<Text>) + (dict.merge lux-procs) + (dict.merge bit-procs) + (dict.merge nat-procs) + (dict.merge int-procs) + (dict.merge deg-procs) + (dict.merge frac-procs) + (dict.merge text-procs) + (dict.merge array-procs) + (dict.merge math-procs) + (dict.merge atom-procs) + (dict.merge process-procs) + (dict.merge io-procs)))) |