From 7e4479b927f400e617602a8686683e14a7f2f74a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 4 Feb 2019 20:37:54 -0400
Subject: Re-implemented the IO type as an abstract type in order to avoid
 potential issues with sub-typing during type-checking.

---
 luxc/src/lux/type.clj          |   4 +-
 stdlib/source/lux/host.jvm.lux |  15 +++---
 stdlib/source/lux/io.lux       | 104 +++++++++++++++++++++++------------------
 3 files changed, 69 insertions(+), 54 deletions(-)

diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index 9a1e12e18..ec8849601 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -66,9 +66,9 @@
                     (&/$Parameter 1))))
 
 (def IO
-  (&/$Named (&/T ["lux/codata" "IO"])
+  (&/$Named (&/T ["lux/io" "IO"])
             (&/$UnivQ empty-env
-                      (&/$Function Nothing (&/$Parameter 1)))))
+                      (&/$Primitive "lux/type/abstract.Abstraction lux/io.IO" (&/|list (&/$Parameter 1))))))
 
 (def List
   (&/$Named (&/T ["lux" "List"])
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 7c27c9f63..c788380c8 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1430,13 +1430,16 @@
                      ("jvm object null")}
                     (~ expr)))))))
 
-(syntax: #export (try expr)
-  {#.doc (doc "Covers the expression in a try-catch block."
-              "If it succeeds, you get (#.Right result)."
-              "If it fails, you get (#.Left error+stack-traces-as-text)."
-              (try (risky-computation input)))}
+(syntax: #export (try expression)
+  {#.doc (doc (case (try (risky-computation input))
+                (#.Right success)
+                (do-something success)
+
+                (#.Left error)
+                (recover-from-failure error)))}
   (with-gensyms [g!_]
-    (wrap (list (`' ("lux try" (.function ((~ g!_) (~ g!_)) (~ expr))))))))
+    (wrap (list (` ("lux try" ((~! io.label) (.function ((~ g!_) (~ g!_))
+                                               (~ expression)))))))))
 
 (syntax: #export (check {#let [imports (class-imports *compiler*)]}
                         {class (generic-type^ imports (list))}
diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux
index 7fdccda95..4da9fe897 100644
--- a/stdlib/source/lux/io.lux
+++ b/stdlib/source/lux/io.lux
@@ -1,53 +1,65 @@
-## TODO: Make IO an abstract type.
 (.module: {#.doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."}
   [lux #*
    [control
     [functor (#+ Functor)]
     [apply (#+ Apply)]
-    [monad (#+ do Monad)]]])
+    [monad (#+ Monad do)]]
+   [type
+    abstract]
+   ["." macro (#+ with-gensyms)
+    ["s" syntax (#+ syntax:)]
+    ["." template]]])
 
-(type: #export (IO a)
+(abstract: #export (IO a)
   {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."}
-  (-> Nothing a))
-
-(macro: #export (io tokens state)
-  {#.doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'."
-              "Great for wrapping effectful computations (which will not be performed until the IO is 'run')."
-              (io (exec
-                    (log! msg)
-                    "Some value...")))}
-  (case tokens
-    (^ (list value))
-    (let [blank (: Code [["" 0 0] (#.Identifier ["" ""])])]
-      (#.Right [state (list (` ([(~ blank) (~ blank)] (~ value))))]))
-
-    _
-    (#.Left "Wrong syntax for io")))
-
-(structure: #export functor (Functor IO)
-  (def: (map f ma)
-    (io (f (ma (:coerce Nothing []))))))
-
-(structure: #export apply (Apply IO)
-  (def: &functor ..functor)
-
-  (def: (apply ff fa)
-    (io ((ff (:coerce Nothing [])) (fa (:coerce Nothing []))))))
-
-(structure: #export monad (Monad IO)
-  (def: &functor ..functor)
-
-  (def: (wrap x)
-    (io x))
-  
-  (def: (join mma)
-    (io ((mma (:coerce Nothing [])) (:coerce Nothing [])))))
-
-(def: #export (run action)
-  {#.doc "A way to execute IO computations and perform their side-effects."}
-  (All [a] (-> (IO a) a))
-  (action (:coerce Nothing [])))
-
-(def: #export (exit code)
-  (-> Int (IO Nothing))
-  (io ("lux io exit" code)))
+  (-> Nothing a)
+
+  (def: #export (label thunk)
+    (All [a] (-> (-> Nothing a) (IO a)))
+    (:abstraction thunk))
+
+  (template: (!io computation)
+    (:abstraction (template.with-locals [g!func g!arg]
+                    (function (g!func g!arg)
+                      computation))))
+
+  (template: (!execute io)
+    ## creatio ex nihilo
+    ((:representation io) (:coerce .Nothing [])))
+
+  (syntax: #export (io computation)
+    {#.doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'."
+                "Great for wrapping effectful computations (which will not be performed until the IO is 'run')."
+                (io (exec
+                      (log! msg)
+                      "Some value...")))}
+    (with-gensyms [g!func g!arg]
+      (wrap (list (` ((~! ..label) (function ((~ g!func) (~ g!arg))
+                                     (~ computation))))))))
+
+  (def: #export (exit code)
+    (-> Int (IO Nothing))
+    (!io ("lux io exit" code)))
+
+  (def: #export run
+    {#.doc "A way to execute IO computations and perform their side-effects."}
+    (All [a] (-> (IO a) a))
+    (|>> !execute))
+
+  (structure: #export functor (Functor IO)
+    (def: (map f)
+      (|>> !execute f !io)))
+
+  (structure: #export apply (Apply IO)
+    (def: &functor ..functor)
+
+    (def: (apply ff fa)
+      (!io ((!execute ff) (!execute fa)))))
+
+  (structure: #export monad (Monad IO)
+    (def: &functor ..functor)
+
+    (def: wrap (|>> !io))
+    
+    (def: join (|>> !execute !execute !io)))
+  )
-- 
cgit v1.2.3