1 files changed, 0 insertions, 448 deletions
diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
deleted file mode 100644
index f22cdcdd1..000000000
--- a/new-luxc/source/luxc/lang/extension/analysis/common.lux
+++ /dev/null
@@ -1,448 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (concurrency [atom #+ Atom])
-       (data [text]
-             text/format
-             (coll [list "list/" Functor<List>]
-                   [array]
-                   (dictionary ["dict" unordered #+ Dict])))
-       [macro]
-       (macro [code])
-       (lang (type ["tc" check]))
-       [io])
-  (luxc ["&" lang]
-        (lang ["la" analysis]
-              (analysis ["&." common]
-                        [".A" function]
-                        [".A" case]
-                        [".A" type])))
-  [///])
-
-(do-template [<name>]
-  [(exception: #export (<name> {message Text})
-     message)]
-
-  [Incorrect-Procedure-Arity]
-  [Invalid-Syntax]
-  )
-
-## [Utils]
-(type: #export Bundle
-  (Dict Text (-> Text ///.Analysis)))
-
-(def: #export (install name unnamed)
-  (-> Text (-> Text ///.Analysis)
-      (-> Bundle Bundle))
-  (dict.put name unnamed))
-
-(def: #export (prefix prefix bundle)
-  (-> Text Bundle Bundle)
-  (|> bundle
-      dict.entries
-      (list/map (function (_ [key val]) [(format prefix " " key) val]))
-      (dict.from-list text.Hash<Text>)))
-
-(def: #export (wrong-arity proc expected actual)
-  (-> Text Nat Nat Text)
-  (format "      Procedure: " (%t proc) "\n"
-          " Expected Arity: " (|> expected nat-to-int %i) "\n"
-          "   Actual Arity: " (|> actual nat-to-int %i)))
-
-(def: (simple proc inputsT+ outputT)
-  (-> Text (List Type) Type ///.Analysis)
-  (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 @
-                              (function (_ [argT argC])
-                                (&.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)))))))
-
-(def: #export (nullary valueT proc)
-  (-> Type Text ///.Analysis)
-  (simple proc (list) valueT))
-
-(def: #export (unary inputT outputT proc)
-  (-> Type Type Text ///.Analysis)
-  (simple proc (list inputT) outputT))
-
-(def: #export (binary subjectT paramT outputT proc)
-  (-> Type Type Type Text ///.Analysis)
-  (simple proc (list subjectT paramT) outputT))
-
-(def: #export (trinary subjectT param0T param1T outputT proc)
-  (-> Type Type Type Type Text ///.Analysis)
-  (simple proc (list subjectT param0T param1T) outputT))
-
-## [Analysers]
-## "lux is" represents reference/pointer equality.
-(def: (lux//is proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (do macro.Monad<Meta>
-      [[var-id varT] (&.with-type-env tc.var)]
-      ((binary varT varT Bool proc)
-       analyse eval args))))
-
-## "lux try" provides a simple way to interact with the host platform's
-## error-handling facilities.
-(def: (lux//try proc)
-  (-> Text ///.Analysis)
-  (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))
-               (analyse opC))]
-        (wrap (la.procedure proc (list opA))))
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
-
-(def: (lux//function proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (case args
-      (^ (list [_ (#.Symbol ["" func-name])]
-               [_ (#.Symbol ["" arg-name])]
-               body))
-      (functionA.analyse-function analyse func-name arg-name body)
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list.size args))))))
-
-(def: (lux//case proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (case args
-      (^ (list input [_ (#.Record branches)]))
-      (caseA.analyse-case analyse input branches)
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))
-
-(def: (lux//in-module proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval argsC+)
-    (case argsC+
-      (^ (list [_ (#.Text module-name)] exprC))
-      (&.with-current-module module-name
-        (analyse exprC))
-      
-      _
-      (&.throw Invalid-Syntax (format "Procedure: " proc "\n"
-                                      "   Inputs:" (|> argsC+
-                                                       list.enumerate
-                                                       (list/map (function (_ [idx argC])
-                                                                   (format "\n  " (%n idx) " " (%code argC))))
-                                                       (text.join-with "")) "\n")))))
-
-(do-template [<name> <analyser>]
-  [(def: (<name> proc)
-     (-> Text ///.Analysis)
-     (function (_ analyse eval args)
-       (case args
-         (^ (list typeC valueC))
-         (<analyser> analyse eval typeC valueC)
-         
-         _
-         (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))]
-
-  [lux//check typeA.analyse-check]
-  [lux//coerce typeA.analyse-coerce])
-
-(def: (lux//check//type proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (case args
-      (^ (list valueC))
-      (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))))))
-
-(def: lux-procs
-  Bundle
-  (|> (dict.new text.Hash<Text>)
-      (install "is" lux//is)
-      (install "try" lux//try)
-      (install "function" lux//function)
-      (install "case" lux//case)
-      (install "check" lux//check)
-      (install "coerce" lux//coerce)
-      (install "check type" lux//check//type)
-      (install "in-module" lux//in-module)))
-
-(def: io-procs
-  Bundle
-  (<| (prefix "io")
-      (|> (dict.new text.Hash<Text>)
-          (install "log" (unary Text Any))
-          (install "error" (unary Text Nothing))
-          (install "exit" (unary Int Nothing))
-          (install "current-time" (nullary Int)))))
-
-(def: bit-procs
-  Bundle
-  (<| (prefix "bit")
-      (|> (dict.new text.Hash<Text>)
-          (install "and" (binary Nat Nat Nat))
-          (install "or" (binary Nat Nat Nat))
-          (install "xor" (binary Nat Nat Nat))
-          (install "left-shift" (binary Nat Nat Nat))
-          (install "logical-right-shift" (binary Nat Nat Nat))
-          (install "arithmetic-right-shift" (binary Int Nat Int))
-          )))
-
-(def: int-procs
-  Bundle
-  (<| (prefix "int")
-      (|> (dict.new text.Hash<Text>)
-          (install "+" (binary Int Int Int))
-          (install "-" (binary Int Int Int))
-          (install "*" (binary Int Int Int))
-          (install "/" (binary Int Int Int))
-          (install "%" (binary Int Int Int))
-          (install "=" (binary Int Int Bool))
-          (install "<" (binary Int Int Bool))
-          (install "min" (nullary Int))
-          (install "max" (nullary Int))
-          (install "to-nat" (unary Int Nat))
-          (install "to-frac" (unary Int Frac))
-          (install "char" (unary Int Text)))))
-
-(def: deg-procs
-  Bundle
-  (<| (prefix "deg")
-      (|> (dict.new text.Hash<Text>)
-          (install "+" (binary Deg Deg Deg))
-          (install "-" (binary Deg Deg Deg))
-          (install "*" (binary Deg Deg Deg))
-          (install "/" (binary Deg Deg Deg))
-          (install "%" (binary Deg Deg Deg))
-          (install "=" (binary Deg Deg Bool))
-          (install "<" (binary Deg Deg Bool))
-          (install "scale" (binary Deg Nat Deg))
-          (install "reciprocal" (binary Deg Nat Deg))
-          (install "min" (nullary Deg))
-          (install "max" (nullary Deg))
-          (install "to-frac" (unary Deg Frac)))))
-
-(def: frac-procs
-  Bundle
-  (<| (prefix "frac")
-      (|> (dict.new text.Hash<Text>)
-          (install "+" (binary Frac Frac Frac))
-          (install "-" (binary Frac Frac Frac))
-          (install "*" (binary Frac Frac Frac))
-          (install "/" (binary Frac Frac Frac))
-          (install "%" (binary Frac Frac Frac))
-          (install "=" (binary Frac Frac Bool))
-          (install "<" (binary Frac Frac Bool))
-          (install "smallest" (nullary Frac))
-          (install "min" (nullary Frac))
-          (install "max" (nullary Frac))
-          (install "not-a-number" (nullary Frac))
-          (install "positive-infinity" (nullary Frac))
-          (install "negative-infinity" (nullary Frac))
-          (install "to-deg" (unary Frac Deg))
-          (install "to-int" (unary Frac Int))
-          (install "encode" (unary Frac Text))
-          (install "decode" (unary Text (type (Maybe Frac)))))))
-
-(def: text-procs
-  Bundle
-  (<| (prefix "text")
-      (|> (dict.new text.Hash<Text>)
-          (install "=" (binary Text Text Bool))
-          (install "<" (binary Text Text Bool))
-          (install "concat" (binary Text Text Text))
-          (install "index" (trinary Text Text Nat (type (Maybe Nat))))
-          (install "size" (unary Text Nat))
-          (install "hash" (unary Text Nat))
-          (install "replace-once" (trinary Text Text Text Text))
-          (install "replace-all" (trinary Text Text Text Text))
-          (install "char" (binary Text Nat (type (Maybe Nat))))
-          (install "clip" (trinary Text Nat Nat (type (Maybe Text))))
-          )))
-
-(def: (array//get proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (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 ///.Analysis)
-  (function (_ analyse eval args)
-    (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 ///.Analysis)
-  (function (_ analyse eval args)
-    (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>)
-          (install "new" (unary Nat Array))
-          (install "get" array//get)
-          (install "put" array//put)
-          (install "remove" array//remove)
-          (install "size" (unary (type (Ex [a] (Array a))) Nat))
-          )))
-
-(def: math-procs
-  Bundle
-  (<| (prefix "math")
-      (|> (dict.new text.Hash<Text>)
-          (install "cos" (unary Frac Frac))
-          (install "sin" (unary Frac Frac))
-          (install "tan" (unary Frac Frac))
-          (install "acos" (unary Frac Frac))
-          (install "asin" (unary Frac Frac))
-          (install "atan" (unary Frac Frac))
-          (install "cosh" (unary Frac Frac))
-          (install "sinh" (unary Frac Frac))
-          (install "tanh" (unary Frac Frac))
-          (install "exp" (unary Frac Frac))
-          (install "log" (unary Frac Frac))
-          (install "ceil" (unary Frac Frac))
-          (install "floor" (unary Frac Frac))
-          (install "round" (unary Frac Frac))
-          (install "atan2" (binary Frac Frac Frac))
-          (install "pow" (binary Frac Frac Frac))
-          )))
-
-(def: (atom-new proc)
-  (-> Text ///.Analysis)
-  (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
-                 (analyse initC))]
-        (wrap (la.procedure proc (list initA))))
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
-
-(def: (atom-read proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (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 ///.Analysis)
-  (function (_ analyse eval args)
-    (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>)
-          (install "new" atom-new)
-          (install "read" atom-read)
-          (install "compare-and-swap" atom//compare-and-swap)
-          )))
-
-(type: (Box ! a)
-  (#.Primitive "#Box" (#.Cons ! (#.Cons a #.Nil))))
-
-(def: (box//new proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (case args
-      (^ (list initC))
-      (do macro.Monad<Meta>
-        [[var-id varT] (&.with-type-env tc.var)
-         _ (&.infer (type (All [!] (Box ! varT))))
-         initA (&.with-type varT
-                 (analyse initC))]
-        (wrap (la.procedure proc (list initA))))
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
-
-(def: (box//read proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (do macro.Monad<Meta>
-      [[thread-id threadT] (&.with-type-env tc.var)
-       [var-id varT] (&.with-type-env tc.var)]
-      ((unary (type (Box threadT varT)) varT proc)
-       analyse eval args))))
-
-(def: (box//write proc)
-  (-> Text ///.Analysis)
-  (function (_ analyse eval args)
-    (do macro.Monad<Meta>
-      [[thread-id threadT] (&.with-type-env tc.var)
-       [var-id varT] (&.with-type-env tc.var)]
-      ((binary varT (type (Box threadT varT)) Any proc)
-       analyse eval args))))
-
-(def: box-procs
-  Bundle
-  (<| (prefix "box")
-      (|> (dict.new text.Hash<Text>)
-          (install "new" box//new)
-          (install "read" box//read)
-          (install "write" box//write)
-          )))
-
-(def: process-procs
-  Bundle
-  (<| (prefix "process")
-      (|> (dict.new text.Hash<Text>)
-          (install "parallelism-level" (nullary Nat))
-          (install "schedule" (binary Nat (type (io.IO Any)) Any))
-          )))
-
-(def: #export procedures
-  Bundle
-  (<| (prefix "lux")
-      (|> (dict.new text.Hash<Text>)
-          (dict.merge lux-procs)
-          (dict.merge bit-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 box-procs)
-          (dict.merge process-procs)
-          (dict.merge io-procs))))