From 65c182755954f64fd112284a5336ba05547a4283 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 3 Jul 2017 18:15:24 -0400 Subject: - Tested the compilation for "nat" procedures. - Expanded the runtime. - Some bug-fixes and refactorings. --- new-luxc/source/luxc/analyser/procedure/common.lux | 64 +++++++++++----------- 1 file changed, 32 insertions(+), 32 deletions(-) (limited to 'new-luxc/source/luxc/analyser/procedure') diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux index e96874960..1976d266d 100644 --- a/new-luxc/source/luxc/analyser/procedure/common.lux +++ b/new-luxc/source/luxc/analyser/procedure/common.lux @@ -15,15 +15,15 @@ (analyser ["&;" common]))) ## [Utils] -(type: Proc-Analyser +(type: Proc (-> &;Analyser (List Code) (Lux Analysis))) -(type: Proc-Set - (D;Dict Text Proc-Analyser)) +(type: Bundle + (D;Dict Text Proc)) (def: (install name unnamed) - (-> Text (-> Text Proc-Analyser) - (-> Proc-Set Proc-Set)) + (-> Text (-> Text Proc) + (-> Bundle Bundle)) (D;put name (unnamed name))) (def: (wrong-amount-error proc expected actual) @@ -33,7 +33,7 @@ " Actual: " (|> actual nat-to-int %i))) (def: (simple-proc proc input-types output-type) - (-> Text (List Type) Type Proc-Analyser) + (-> Text (List Type) Type Proc) (let [num-expected (list;size input-types)] (function [analyse args] (let [num-actual (list;size args)] @@ -51,29 +51,29 @@ (&;fail (wrong-amount-error proc num-expected num-actual))))))) (def: (binary-operation subjectT paramT outputT proc) - (-> Type Type Type Text Proc-Analyser) + (-> Type Type Type Text Proc) (simple-proc proc (list subjectT paramT) outputT)) (def: (trinary-operation subjectT param0T param1T outputT proc) - (-> Type Type Type Type Text Proc-Analyser) + (-> Type Type Type Type Text Proc) (simple-proc proc (list subjectT param0T param1T) outputT)) (def: (unary-operation inputT outputT proc) - (-> Type Type Text Proc-Analyser) + (-> Type Type Text Proc) (simple-proc proc (list inputT) outputT)) (def: (special-value valueT proc) - (-> Type Text Proc-Analyser) + (-> Type Text Proc) (simple-proc proc (list) valueT)) (def: (converter fromT toT proc) - (-> Type Type Text Proc-Analyser) + (-> Type Type Text Proc) (simple-proc proc (list fromT) toT)) ## [Analysers] ## "lux is" represents reference/pointer equality. (def: (analyse-lux-is proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -83,7 +83,7 @@ ## "lux try" provides a simple way to interact with the host platform's ## error-handling facilities. (def: (analyse-lux-try proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -103,13 +103,13 @@ (&;fail (wrong-amount-error proc +1 (list;size args)))))))) (def: lux-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "lux is" analyse-lux-is) (install "lux try" analyse-lux-try))) (def: io-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "io log" (converter Text Unit)) (install "io error" (converter Text Bottom)) @@ -117,7 +117,7 @@ (install "io current-time" (special-value Int)))) (def: bit-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "bit count" (unary-operation Nat Nat)) (install "bit and" (binary-operation Nat Nat Nat)) @@ -129,7 +129,7 @@ )) (def: nat-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "nat +" (binary-operation Nat Nat Nat)) (install "nat -" (binary-operation Nat Nat Nat)) @@ -144,7 +144,7 @@ (install "nat to-text" (converter Nat Text)))) (def: int-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "int +" (binary-operation Int Int Int)) (install "int -" (binary-operation Int Int Int)) @@ -159,7 +159,7 @@ (install "int to-real" (converter Int Real)))) (def: deg-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "deg +" (binary-operation Deg Deg Deg)) (install "deg -" (binary-operation Deg Deg Deg)) @@ -175,7 +175,7 @@ (install "deg to-real" (converter Deg Real)))) (def: real-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "real +" (binary-operation Real Real Real)) (install "real -" (binary-operation Real Real Real)) @@ -196,7 +196,7 @@ (install "real from-text" (converter Text (type (Maybe Real)))))) (def: text-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "text =" (binary-operation Text Text Bool)) (install "text <" (binary-operation Text Text Bool)) @@ -210,7 +210,7 @@ )) (def: (analyse-array-get proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -218,7 +218,7 @@ analyse args))))) (def: (analyse-array-put proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -226,7 +226,7 @@ analyse args))))) (def: (analyse-array-remove proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -234,7 +234,7 @@ analyse args))))) (def: array-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "array new" (unary-operation Nat Array)) (install "array get" analyse-array-get) @@ -244,7 +244,7 @@ )) (def: math-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "math cos" (unary-operation Real Real)) (install "math sin" (unary-operation Real Real)) @@ -267,7 +267,7 @@ )) (def: (analyse-atom-new proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -287,7 +287,7 @@ (&;fail (wrong-amount-error proc +1 (list;size args)))))))) (def: (analyse-atom-read proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -295,7 +295,7 @@ analyse args))))) (def: (analyse-atom-compare-and-swap proc) - (-> Text Proc-Analyser) + (-> Text Proc) (function [analyse args] (&common;with-var (function [[var-id varT]] @@ -303,7 +303,7 @@ analyse args))))) (def: atom-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "atom new" analyse-atom-new) (install "atom read" analyse-atom-read) @@ -311,7 +311,7 @@ )) (def: process-procs - Proc-Set + Bundle (|> (D;new text;Hash) (install "process concurrency-level" (special-value Nat)) (install "process future" (unary-operation (type (io;IO Top)) Unit)) @@ -319,7 +319,7 @@ )) (def: #export procedures - Proc-Set + Bundle (|> (D;new text;Hash) (D;merge lux-procs) (D;merge bit-procs) -- cgit v1.2.3