- Fixes for pattern-matching (case) analysis.

- Small refactorings.
- Improved common procedures analysis.
- Can now handle tagged structures (variants & records).
- Tests for pattern-matching, functions (definition & application), and common procedures.

1 files changed, 0 insertions, 321 deletions

diff --git a/new-luxc/source/luxc/analyser/proc/lux.lux b/new-luxc/source/luxc/analyser/proc/lux.lux
deleted file mode 100644
index 8ad88baed..000000000
--- a/new-luxc/source/luxc/analyser/proc/lux.lux
+++ /dev/null
@@ -1,321 +0,0 @@
-(;module:
-  lux
-  (lux (control monad)
-       (concurrency ["A" atom])
-       (data [text]
-             text/format
-             (coll [list]
-                   [array #+ Array]
-                   ["D" dict]))
-       [macro #+ Monad<Lux>]
-       (type ["TC" check])
-       [io])
-  (luxc ["&" base]
-        (lang ["la" analysis #+ Analysis])
-        (analyser ["&;" common])))
-
-## [Utils]
-(type: Proc-Analyser
-  (-> &;Analyser (List Code) (Lux Analysis)))
-
-(type: Proc-Set
-  (D;Dict Text Proc-Analyser))
-
-(def: (wrong-amount-error proc expected actual)
-  (-> Ident Nat Nat Text)
-  (let [[proc-category proc-name] proc
-        proc-description (format "[" (%t proc-category) " " (%t proc-name) "]")]
-    (format "Wrong number of arguments for " proc-description "\n"
-            "Expected: " (|> expected nat-to-int %i) "\n"
-            "  Actual: " (|> actual nat-to-int %i))))
-
-(def: (simple-proc proc input-types output-type)
-  (-> Ident (List Type) Type Proc-Analyser)
-  (let [num-expected (list;size input-types)]
-    (function [analyse args]
-      (let [num-actual (list;size args)]
-        (if (n.= num-expected num-actual)
-          (do Monad<Lux>
-            [argsA (mapM @
-                         (function [[argT argC]]
-                           (&;with-expected-type argT
-                             (analyse argC)))
-                         (list;zip2 input-types args))
-             expected macro;expected-type
-             _ (&;within-type-env
-                (TC;check expected output-type))]
-            (wrap (#la;Procedure proc argsA)))
-          (&;fail (wrong-amount-error proc num-expected num-actual)))))))
-
-(def: (binary-operation proc subjectT paramT outputT)
-  (-> Ident Type Type Type Proc-Analyser)
-  (simple-proc proc (list subjectT paramT) outputT))
-
-(def: (trinary-operation proc subjectT param0T param1T outputT)
-  (-> Ident Type Type Type Type Proc-Analyser)
-  (simple-proc proc (list subjectT param0T param1T) outputT))
-
-(def: (unary-operation proc inputT outputT)
-  (-> Ident Type Type Proc-Analyser)
-  (simple-proc proc (list inputT) outputT))
-
-(def: (special-value proc valueT)
-  (-> Ident Type Proc-Analyser)
-  (simple-proc proc (list) valueT))
-
-(def: (converter proc fromT toT)
-  (-> Ident Type Type Proc-Analyser)
-  (simple-proc proc (list fromT) toT))
-
-## [Analysers]
-(def: (analyse-lux-is analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((binary-operation ["lux" "is"] varT varT Bool)
-       analyse args))))
-
-(def: (analyse-lux-try analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      (case args
-        (^ (list opC))
-        (do Monad<Lux>
-          [opA (&;with-expected-type (type (io;IO varT))
-                 (analyse opC))
-           outputT (&;within-type-env
-                    (TC;clean var-id (type (Either Text varT))))
-           expected macro;expected-type
-           _ (&;within-type-env
-              (TC;check expected outputT))]
-          (wrap (#la;Procedure ["lux" "try"] (list opA))))
-        
-        _
-        (&;fail (wrong-amount-error ["lux" "try"] +1 (list;size args)))))))
-
-(def: lux-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "is" analyse-lux-is)
-      (D;put "try" analyse-lux-try)))
-
-(def: io-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "log" (converter ["io" "log"] Text Unit))
-      (D;put "error" (converter ["io" "error"] Text Bottom))
-      (D;put "exit" (converter ["io" "exit"] Nat Bottom))
-      (D;put "current-time" (special-value ["io" "current-time"] Int))))
-
-(def: bit-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "count" (unary-operation ["bit" "count"] Nat Nat))
-      (D;put "and" (binary-operation ["bit" "and"] Nat Nat Nat))
-      (D;put "or" (binary-operation ["bit" "or"] Nat Nat Nat))
-      (D;put "xor" (binary-operation ["bit" "xor"] Nat Nat Nat))
-      (D;put "shift-left" (binary-operation ["bit" "shift-left"] Nat Nat Nat))
-      (D;put "unsigned-shift-right" (binary-operation ["bit" "unsigned-shift-right"] Nat Nat Nat))
-      (D;put "shift-right" (binary-operation ["bit" "shift-right"] Int Nat Int))
-      ))
-
-(def: nat-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["nat" "+"] Nat Nat Nat))
-      (D;put "-" (binary-operation ["nat" "-"] Nat Nat Nat))
-      (D;put "*" (binary-operation ["nat" "*"] Nat Nat Nat))
-      (D;put "/" (binary-operation ["nat" "/"] Nat Nat Nat))
-      (D;put "%" (binary-operation ["nat" "%"] Nat Nat Nat))
-      (D;put "=" (binary-operation ["nat" "="] Nat Nat Bool))
-      (D;put "<" (binary-operation ["nat" "<"] Nat Nat Bool))
-      (D;put "min-value" (special-value ["nat" "min-value"] Nat))
-      (D;put "max-value" (special-value ["nat" "max-value"] Nat))
-      (D;put "to-int" (converter ["nat" "to-int"] Nat Int))
-      (D;put "to-text" (converter ["nat" "to-text"] Nat Text))))
-
-(def: int-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["int" "+"] Int Int Int))
-      (D;put "-" (binary-operation ["int" "-"] Int Int Int))
-      (D;put "*" (binary-operation ["int" "*"] Int Int Int))
-      (D;put "/" (binary-operation ["int" "/"] Int Int Int))
-      (D;put "%" (binary-operation ["int" "%"] Int Int Int))
-      (D;put "=" (binary-operation ["int" "="] Int Int Bool))
-      (D;put "<" (binary-operation ["int" "<"] Int Int Bool))
-      (D;put "min-value" (special-value ["int" "min-value"] Int))
-      (D;put "max-value" (special-value ["int" "max-value"] Int))
-      (D;put "to-nat" (converter ["int" "to-nat"] Int Nat))
-      (D;put "to-real" (converter ["int" "to-real"] Int Real))))
-
-(def: deg-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["deg" "+"] Deg Deg Deg))
-      (D;put "-" (binary-operation ["deg" "-"] Deg Deg Deg))
-      (D;put "*" (binary-operation ["deg" "*"] Deg Deg Deg))
-      (D;put "/" (binary-operation ["deg" "/"] Deg Deg Deg))
-      (D;put "%" (binary-operation ["deg" "%"] Deg Deg Deg))
-      (D;put "=" (binary-operation ["deg" "="] Deg Deg Bool))
-      (D;put "<" (binary-operation ["deg" "<"] Deg Deg Bool))
-      (D;put "scale" (binary-operation ["deg" "scale"] Deg Nat Deg))
-      (D;put "reciprocal" (binary-operation ["deg" "scale"] Deg Nat Deg))
-      (D;put "min-value" (special-value ["deg" "min-value"] Deg))
-      (D;put "max-value" (special-value ["deg" "max-value"] Deg))
-      (D;put "to-real" (converter ["deg" "to-real"] Deg Real))))
-
-(def: real-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["real" "+"] Real Real Real))
-      (D;put "-" (binary-operation ["real" "-"] Real Real Real))
-      (D;put "*" (binary-operation ["real" "*"] Real Real Real))
-      (D;put "/" (binary-operation ["real" "/"] Real Real Real))
-      (D;put "%" (binary-operation ["real" "%"] Real Real Real))
-      (D;put "=" (binary-operation ["real" "="] Real Real Bool))
-      (D;put "<" (binary-operation ["real" "<"] Real Real Bool))
-      (D;put "smallest-value" (special-value ["real" "smallest-value"] Real))
-      (D;put "min-value" (special-value ["real" "min-value"] Real))
-      (D;put "max-value" (special-value ["real" "max-value"] Real))
-      (D;put "not-a-number" (special-value ["real" "not-a-number"] Real))
-      (D;put "positive-infinity" (special-value ["real" "positive-infinity"] Real))
-      (D;put "negative-infinity" (special-value ["real" "negative-infinity"] Real))
-      (D;put "to-deg" (converter ["real" "to-deg"] Real Deg))
-      (D;put "to-int" (converter ["real" "to-int"] Real Int))
-      (D;put "hash" (unary-operation ["real" "hash"] Real Nat))
-      (D;put "encode" (converter ["real" "encode"] Real Text))
-      (D;put "decode" (converter ["real" "decode"] Text (type (Maybe Real))))))
-
-(def: text-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "=" (binary-operation ["text" "="] Text Text Bool))
-      (D;put "<" (binary-operation ["text" "<"] Text Text Bool))
-      (D;put "prepend" (binary-operation ["text" "prepend"] Text Text Text))
-      (D;put "index" (trinary-operation ["text" "index"] Text Text Nat (type (Maybe Nat))))
-      (D;put "size" (unary-operation ["text" "size"] Text Nat))
-      (D;put "hash" (unary-operation ["text" "hash"] Text Nat))
-      (D;put "replace-once" (binary-operation ["text" "replace-once"] Text Text Text))
-      (D;put "replace-all" (binary-operation ["text" "replace-all"] Text Text Text))
-      (D;put "char" (binary-operation ["text" "char"] Text Nat Nat))
-      (D;put "clip" (trinary-operation ["text" "clip"] Text Nat Nat Text))
-      ))
-
-(def: (analyse-array-get analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((binary-operation ["lux" "get"] Nat (type (Array varT)) varT)
-       analyse args))))
-
-(def: (analyse-array-put analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((trinary-operation ["lux" "put"] Nat varT (type (Array varT)) (type (Array varT)))
-       analyse args))))
-
-(def: (analyse-array-remove analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((binary-operation ["lux" "remove"] Nat (type (Array varT)) (type (Array varT)))
-       analyse args))))
-
-(def: array-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "new" (unary-operation ["array" "hash"] Nat Array))
-      (D;put "get" analyse-array-get)
-      (D;put "put" analyse-array-put)
-      (D;put "remove" analyse-array-remove)
-      (D;put "size" (unary-operation ["array" "size"] (type (Ex [a] (Array a))) Nat))
-      ))
-
-(def: math-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "cos" (unary-operation ["math" "cos"] Real Real))
-      (D;put "sin" (unary-operation ["math" "sin"] Real Real))
-      (D;put "tan" (unary-operation ["math" "tan"] Real Real))
-      (D;put "acos" (unary-operation ["math" "acos"] Real Real))
-      (D;put "asin" (unary-operation ["math" "asin"] Real Real))
-      (D;put "atan" (unary-operation ["math" "atan"] Real Real))
-      (D;put "cosh" (unary-operation ["math" "cosh"] Real Real))
-      (D;put "sinh" (unary-operation ["math" "sinh"] Real Real))
-      (D;put "tanh" (unary-operation ["math" "tanh"] Real Real))
-      (D;put "exp" (unary-operation ["math" "exp"] Real Real))
-      (D;put "log" (unary-operation ["math" "log"] Real Real))
-      (D;put "root2" (unary-operation ["math" "root2"] Real Real))
-      (D;put "root3" (unary-operation ["math" "root3"] Real Real))
-      (D;put "ceil" (unary-operation ["math" "ceil"] Real Real))
-      (D;put "floor" (unary-operation ["math" "floor"] Real Real))
-      (D;put "round" (unary-operation ["math" "round"] Real Real))
-      (D;put "atan2" (binary-operation ["math" "atan2"] Real Real Real))
-      (D;put "pow" (binary-operation ["math" "pow"] Real Real Real))
-      ))
-
-(def: (analyse-atom-new analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      (case args
-        (^ (list initC))
-        (do Monad<Lux>
-          [initA (&;with-expected-type varT
-                   (analyse initC))
-           outputT (&;within-type-env
-                    (TC;clean var-id (type (A;Atom varT))))
-           expected macro;expected-type
-           _ (&;within-type-env
-              (TC;check expected outputT))]
-          (wrap (#la;Procedure ["atom" "new"] (list initA))))
-        
-        _
-        (&;fail (wrong-amount-error ["atom" "new"] +1 (list;size args)))))))
-
-(def: (analyse-atom-read analyse args)
-  (&common;with-var
-    (function [[var-id varT]]
-      ((unary-operation ["atom" "read"] (type (A;Atom varT)) varT)
-       analyse args))))
-
-(def: (analyse-atom-compare-and-swap analyse args)
-  (&common;with-var
-    (function [[var-id varT]]
-      ((trinary-operation ["atom" "compare-and-swap"] varT varT (type (A;Atom varT)) Bool)
-       analyse args))))
-
-(def: atom-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "new" analyse-atom-new)
-      (D;put "read" analyse-atom-read)
-      (D;put "compare-and-swap" analyse-atom-compare-and-swap)
-      ))
-
-(def: process-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "concurrency-level" (special-value ["process" "concurrency-level"] Nat))
-      (D;put "future" (unary-operation ["process" "future"] (type (io;IO Top)) Unit))
-      (D;put "schedule" (binary-operation ["process" "schedule"] Nat (type (io;IO Top)) Unit))
-      ))
-
-(def: #export procs
-  (D;Dict Text Proc-Set)
-  (|> (D;new text;Hash<Text>)
-      (D;put "lux" lux-procs)
-      (D;put "bit" bit-procs)
-      (D;put "nat" nat-procs)
-      (D;put "int" int-procs)
-      (D;put "deg" deg-procs)
-      (D;put "real" real-procs)
-      (D;put "text" text-procs)
-      (D;put "array" array-procs)
-      (D;put "math" math-procs)
-      (D;put "atom" atom-procs)
-      (D;put "process" process-procs)
-      (D;put "io" io-procs)))