From 74a835634fc9ee5457f3cc7109af069dad9f2d2f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 11 Oct 2017 18:57:44 -0400 Subject: - Migrated new-luxc to latest version of stdlib. - Some refactoring. --- new-luxc/source/luxc/analyser/procedure/common.lux | 86 +++++++++++----------- 1 file changed, 43 insertions(+), 43 deletions(-) (limited to 'new-luxc/source/luxc/analyser/procedure/common.lux') diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux index ffb87a2ca..a0f739f3b 100644 --- a/new-luxc/source/luxc/analyser/procedure/common.lux +++ b/new-luxc/source/luxc/analyser/procedure/common.lux @@ -6,32 +6,32 @@ text/format (coll [list "list/" Functor] [array #+ Array] - ["d" dict])) + [dict #+ Dict])) [macro #+ Monad] - (type ["TC" check]) + (type ["tc" check]) [io]) (luxc ["&" base] - (lang ["la" analysis #+ Analysis]) + (lang ["la" analysis]) (analyser ["&;" common]))) ## [Utils] (type: #export Proc - (-> &;Analyser (List Code) (Lux Analysis))) + (-> &;Analyser (List Code) (Lux la;Analysis))) (type: #export Bundle - (d;Dict Text Proc)) + (Dict Text Proc)) (def: #export (install name unnamed) (-> Text (-> Text Proc) (-> Bundle Bundle)) - (d;put name (unnamed name))) + (dict;put name (unnamed name))) (def: #export (prefix prefix bundle) (-> Text Bundle Bundle) (|> bundle - d;entries + dict;entries (list/map (function [[key val]] [(format prefix " " key) val])) - (d;from-list text;Hash))) + (dict;from-list text;Hash))) (def: #export (wrong-arity proc expected actual) (-> Text Nat Nat Text) @@ -52,8 +52,8 @@ (analyse argC))) (list;zip2 input-types args)) expected macro;expected-type - _ (&;within-type-env - (TC;check expected output-type))] + _ (&;with-type-env + (tc;check expected output-type))] (wrap (#la;Procedure proc argsA))) (&;fail (wrong-arity proc num-expected num-actual))))))) @@ -95,11 +95,11 @@ (do Monad [opA (&;with-expected-type (type (io;IO varT)) (analyse opC)) - outputT (&;within-type-env - (TC;clean var-id (type (Either Text varT)))) + outputT (&;with-type-env + (tc;clean var-id (type (Either Text varT)))) expected macro;expected-type - _ (&;within-type-env - (TC;check expected outputT))] + _ (&;with-type-env + (tc;check expected outputT))] (wrap (#la;Procedure proc (list opA)))) _ @@ -107,14 +107,14 @@ (def: lux-procs Bundle - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "is" lux-is) (install "try" lux-try))) (def: io-procs Bundle (<| (prefix "io") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "log" (unary Text Unit)) (install "error" (unary Text Bottom)) (install "exit" (unary Nat Bottom)) @@ -123,7 +123,7 @@ (def: bit-procs Bundle (<| (prefix "bit") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "count" (unary Nat Nat)) (install "and" (binary Nat Nat Nat)) (install "or" (binary Nat Nat Nat)) @@ -136,7 +136,7 @@ (def: nat-procs Bundle (<| (prefix "nat") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "+" (binary Nat Nat Nat)) (install "-" (binary Nat Nat Nat)) (install "*" (binary Nat Nat Nat)) @@ -152,7 +152,7 @@ (def: int-procs Bundle (<| (prefix "int") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "+" (binary Int Int Int)) (install "-" (binary Int Int Int)) (install "*" (binary Int Int Int)) @@ -168,7 +168,7 @@ (def: deg-procs Bundle (<| (prefix "deg") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "+" (binary Deg Deg Deg)) (install "-" (binary Deg Deg Deg)) (install "*" (binary Deg Deg Deg)) @@ -185,7 +185,7 @@ (def: frac-procs Bundle (<| (prefix "frac") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "+" (binary Frac Frac Frac)) (install "-" (binary Frac Frac Frac)) (install "*" (binary Frac Frac Frac)) @@ -207,7 +207,7 @@ (def: text-procs Bundle (<| (prefix "text") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "=" (binary Text Text Bool)) (install "<" (binary Text Text Bool)) (install "prepend" (binary Text Text Text)) @@ -246,7 +246,7 @@ (def: array-procs Bundle (<| (prefix "array") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "new" (unary Nat Array)) (install "get" array-get) (install "put" array-put) @@ -257,7 +257,7 @@ (def: math-procs Bundle (<| (prefix "math") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "cos" (unary Frac Frac)) (install "sin" (unary Frac Frac)) (install "tan" (unary Frac Frac)) @@ -288,11 +288,11 @@ (do Monad [initA (&;with-expected-type varT (analyse initC)) - outputT (&;within-type-env - (TC;clean var-id (type (A;Atom varT)))) + outputT (&;with-type-env + (tc;clean var-id (type (A;Atom varT)))) expected macro;expected-type - _ (&;within-type-env - (TC;check expected outputT))] + _ (&;with-type-env + (tc;check expected outputT))] (wrap (#la;Procedure proc (list initA)))) _ @@ -317,7 +317,7 @@ (def: atom-procs Bundle (<| (prefix "atom") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "new" atom-new) (install "read" atom-read) (install "compare-and-swap" atom-compare-and-swap) @@ -326,7 +326,7 @@ (def: process-procs Bundle (<| (prefix "process") - (|> (d;new text;Hash) + (|> (dict;new text;Hash) (install "concurrency-level" (nullary Nat)) (install "future" (unary (type (io;IO Top)) Unit)) (install "schedule" (binary Nat (type (io;IO Top)) Unit)) @@ -335,16 +335,16 @@ (def: #export procedures Bundle (<| (prefix "lux") - (|> (d;new text;Hash) - (d;merge lux-procs) - (d;merge bit-procs) - (d;merge nat-procs) - (d;merge int-procs) - (d;merge deg-procs) - (d;merge frac-procs) - (d;merge text-procs) - (d;merge array-procs) - (d;merge math-procs) - (d;merge atom-procs) - (d;merge process-procs) - (d;merge io-procs)))) + (|> (dict;new text;Hash) + (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)))) -- cgit v1.2.3