From 38ce556c6e3d21acdf53d6f8e9cfd80903360c8c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 3 Jul 2018 23:36:21 -0400 Subject: - Improved abstract types. - Got rid of "lux noop" translations. --- .../common-lisp/procedure/common.jvm.lux | 5 -- .../lang/translation/js/procedure/common.jvm.lux | 5 -- .../lang/translation/jvm/procedure/common.jvm.lux | 5 -- .../lang/translation/lua/procedure/common.jvm.lux | 5 -- .../lang/translation/php/procedure/common.jvm.lux | 5 -- .../translation/python/procedure/common.jvm.lux | 5 -- .../lang/translation/r/procedure/common.jvm.lux | 5 -- .../lang/translation/ruby/procedure/common.jvm.lux | 5 -- new-luxc/test/test/luxc/lang/translation/jvm.lux | 52 ++++++++--------- stdlib/source/lux/type/abstract.lux | 65 +++++++++------------- 10 files changed, 50 insertions(+), 107 deletions(-) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux index 43ef5c384..b7dd1b58a 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux @@ -105,10 +105,6 @@ Trinary (caseT.translate-if testO thenO elseO)) -(def: (lux//noop valueO) - Unary - valueO) - (exception: #export (Wrong-Syntax {message Text}) message) @@ -138,7 +134,6 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary runtimeT.lux//try)) (install "if" (trinary lux//if)) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux index 7b4a19b91..1d4e0e5c4 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -116,10 +116,6 @@ Unary (format runtimeT.lux//try "(" riskyJS ")")) -(def: (lux//noop valueJS) - Unary - valueJS) - (exception: #export (Wrong-Syntax {message Text}) message) @@ -413,7 +409,6 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary lux//try)) (install "if" (trinary lux//if)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 7daf35fb5..db92bc413 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -164,10 +164,6 @@ ($t.method (list $Function) (#.Some $Object-Array) (list)) false))) -(def: (lux//noop valueI) - Unary - valueI) - (exception: #export (Wrong-Syntax {message Text}) message) @@ -553,7 +549,6 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary lux//try)) (install "if" (trinary lux//if)) diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index b49d4951c..21baddcfc 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -108,10 +108,6 @@ Unary (runtimeT.lux//try riskyO)) -(def: (lux//noop valueO) - Unary - valueO) - (exception: #export (Wrong-Syntax {message Text}) message) @@ -402,7 +398,6 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary lux//try)) (install "if" (trinary lux//if)) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux index 0e0931b1e..8ce6fe1ef 100644 --- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux @@ -109,10 +109,6 @@ ## Unary ## (runtimeT.lux//try riskyO)) -## (def: (lux//noop valueO) -## Unary -## valueO) - ## (exception: #export (Wrong-Syntax {message Text}) ## message) @@ -142,7 +138,6 @@ ## (def: lux-procs ## Bundle ## (|> (dict.new text.Hash) -## (install "noop" (unary lux//noop)) ## (install "is" (binary lux//is)) ## (install "try" (unary lux//try)) ## (install "if" (trinary lux//if)) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index a83a897d1..f63371bd1 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -109,10 +109,6 @@ Unary (runtimeT.lux//try riskyO)) -(def: (lux//noop valueO) - Unary - valueO) - (exception: #export (Wrong-Syntax {message Text}) message) @@ -142,7 +138,6 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary lux//try)) (install "if" (trinary lux//if)) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index 885837078..022e1ea16 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -110,10 +110,6 @@ Unary (runtimeT.lux//try riskyO)) -(def: (lux//noop valueO) - Unary - valueO) - (exception: #export (Wrong-Syntax {message Text}) message) @@ -143,7 +139,6 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary lux//try)) (install "if" (trinary lux//if)) diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index f26cefad6..7a9dfcb08 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -108,10 +108,6 @@ Unary (runtimeT.lux//try riskyO)) -(def: (lux//noop valueO) - Unary - valueO) - (exception: #export (Wrong-Syntax {message Text}) message) @@ -141,7 +137,6 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "noop" (unary lux//noop)) (install "is" (binary lux//is)) (install "try" (unary lux//try)) (install "if" (trinary lux//if)) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm.lux index ae66b68af..6652c8484 100644 --- a/new-luxc/test/test/luxc/lang/translation/jvm.lux +++ b/new-luxc/test/test/luxc/lang/translation/jvm.lux @@ -130,9 +130,9 @@ (with-expansions [ (do-template [ ] [(test (|> (do macro.Monad - [sampleI (expressionT.translate (` ( ((~ (code.text )) - (
 (~ ( subject)))
-                                                                                                (
 (~ ( param)))))))]
+                                                    [sampleI (expressionT.translate ( ((code.text )
+                                                                                             (
 ( subject))
+                                                                                             (
 ( param)))))]
                                                     (evalT.eval sampleI))
                                                   (lang.with-current-module "")
                                                   (macro.run (io.run init-jvm))
@@ -154,9 +154,9 @@
                  )))))]
 
   ["int" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "jvm convert long-to-int" "jvm convert int-to-long"]
-  ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "lux noop" "lux noop"]
+  ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% id id]
   ["float" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "jvm convert double-to-float" "jvm convert float-to-double"]
-  ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "lux noop" "lux noop"]
+  ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% id id]
   )
 
 (do-template [  ]
@@ -169,9 +169,9 @@
                    (~~ (do-template [ ]
                          [(test 
                                 (|> (do macro.Monad
-                                      [sampleI (expressionT.translate (` ( ((~ (code.text ))
-                                                                                  ( (~ (code.nat subject)))
-                                                                                  ( (~ (code.nat param)))))))]
+                                      [sampleI (expressionT.translate ( ((code.text )
+                                                                               ( (code.nat subject))
+                                                                               ( (code.nat param)))))]
                                       (evalT.eval sampleI))
                                     (lang.with-current-module "")
                                     (macro.run (io.run init-jvm))
@@ -189,7 +189,7 @@
                    )))))]
 
   ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
-  ["long" "lux noop" "lux noop"]
+  ["long" id id]
   )
 
 (do-template [  ]
@@ -203,9 +203,9 @@
                    (~~ (do-template [     
]
                          [(test 
                                 (|> (do macro.Monad
-                                      [sampleI (expressionT.translate (` ( ((~ (code.text ))
-                                                                                  ( (~ (
 subject)))
-                                                                                  ("jvm convert long-to-int" (~ (code.nat shift)))))))]
+                                      [sampleI (expressionT.translate ( ((code.text )
+                                                                               ( (
 subject))
+                                                                               ("jvm convert long-to-int" (code.nat shift)))))]
                                       (evalT.eval sampleI))
                                     (lang.with-current-module "")
                                     (macro.run (io.run init-jvm))
@@ -223,7 +223,7 @@
                    )))))]
 
   ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
-  ["long" "lux noop" "lux noop"]
+  ["long" id id]
   )
 
 (do-template [   <=> <<> 
]
@@ -235,9 +235,9 @@
            (with-expansions [ (do-template [ ]
                                        [(test 
                                               (|> (do macro.Monad
-                                                    [sampleI (expressionT.translate (` ((~ (code.text ))
-                                                                                        (
 (~ ( subject)))
-                                                                                        (
 (~ ( param))))))]
+                                                    [sampleI (expressionT.translate ((code.text )
+                                                                                     (
 ( subject))
+                                                                                     (
 ( param))))]
                                                     (evalT.eval sampleI))
                                                   (lang.with-current-module "")
                                                   (macro.run (io.run init-jvm))
@@ -256,9 +256,9 @@
                  )))))]
 
   ["int" gen-int code.int i/= i/< "jvm convert long-to-int"]
-  ["long" gen-int code.int i/= i/< "lux noop"]
+  ["long" gen-int code.int i/= i/< id]
   ["float" gen-frac code.frac f/= f/< "jvm convert double-to-float"]
-  ["double" gen-frac code.frac f/= f/< "lux noop"]
+  ["double" gen-frac code.frac f/= f/< id]
   ["char" gen-int code.int i/= i/< "jvm convert long-to-char"]
   )
 
@@ -293,9 +293,7 @@
                                                  [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
                                                                                      (jvm//array//write  idx )
                                                                                      (jvm//array//read  idx)
-                                                                                     (~)
-                                                                                     
-                                                                                     (`)))]
+                                                                                     ))]
                                                  (evalT.eval sampleI))
                                                (lang.with-current-module "")
                                                (macro.run (io.run init-jvm))
@@ -306,7 +304,7 @@
                                                       false)))]
 
                                     ["boolean" Bool valueZ bool/= (code.bool valueZ)
-                                     "lux noop"]
+                                     id]
                                     ["byte" Int valueB i/= (|> (code.int valueB) (~) "jvm convert long-to-byte" (`))
                                      "jvm convert byte-to-long"]
                                     ["short" Int valueS i/= (|> (code.int valueS) (~) "jvm convert long-to-short" (`))
@@ -314,11 +312,11 @@
                                     ["int" Int valueI i/= (|> (code.int valueI) (~) "jvm convert long-to-int" (`))
                                      "jvm convert int-to-long"]
                                     ["long" Int valueL i/= (code.int valueL)
-                                     "lux noop"]
+                                     id]
                                     ["float" Frac valueF f/= (|> (code.frac valueF) (~) "jvm convert double-to-float" (`))
                                      "jvm convert float-to-double"]
                                     ["double" Frac valueD f/= (code.frac valueD)
-                                     "lux noop"]
+                                     id]
                                     )]
           ($_ seq
               
@@ -343,9 +341,7 @@
                                                  [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
                                                                                      (jvm//array//write  idx )
                                                                                      (jvm//array//read  idx)
-                                                                                     (~)
-                                                                                     
-                                                                                     (`)))]
+                                                                                     ))]
                                                  (evalT.eval sampleI))
                                                (lang.with-current-module "")
                                                (macro.run (io.run init-jvm))
@@ -360,7 +356,7 @@
                                      "jvm convert char-to-long"]
                                     ["java.lang.Long" Int valueL i/=
                                      (code.int valueL)
-                                     "lux noop"]
+                                     id]
                                     )]
           ($_ seq
               
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 0cbe49087..70a71c60b 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -3,9 +3,9 @@
   (lux (control [monad #+ do Monad]
                 ["p" parser])
        (data [text "text/" Eq Monoid]
-             ["E" error]
+             [error]
              (coll [list "list/" Functor Monoid]))
-       [macro]
+       [macro #+ "meta/" Monad]
        (macro [code]
               ["s" syntax #+ syntax:]
               (syntax ["cs" common]
@@ -57,43 +57,36 @@
   (|>> ($_ text/compose "{" kind "@" module "}")
        (let [[module kind] (ident-for #..Representation)])))
 
+(def: (cast name type-vars input-declaration output-declaration)
+  (-> Text (List Code) Code Code Macro)
+  (function (_ tokens)
+    (case tokens
+      (^ (list value))
+      (meta/wrap (list (` ((: (All [(~+ type-vars)]
+                                (-> (~ input-declaration) (~ output-declaration)))
+                              (|>> :assume))
+                           (~ value)))))
+
+      _
+      (macro.fail ($_ text/compose "Wrong syntax for " name)))))
+
 (def: (install-casts' this-module-name name type-vars)
   (-> Text Text (List Text) (Meta Any))
   (do macro.Monad
     [this-module (macro.find-module this-module-name)
      #let [type-varsC (list/map code.local-symbol type-vars)
-           abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
+           abstraction-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
            representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~+ type-varsC)))
            this-module (|> this-module
                            (update@ #.definitions (put down-cast (: Definition
                                                                     [Macro macro-anns
-                                                                     (: Macro
-                                                                        (function (_ tokens)
-                                                                          (case tokens
-                                                                            (^ (list value))
-                                                                            (wrap (list (` ((: (All [(~+ type-varsC)]
-                                                                                                 (-> (~ representation-declaration) (~ abstract-declaration)))
-                                                                                               (|>> :assume))
-                                                                                            (~ value)))))
-
-                                                                            _
-                                                                            (macro.fail ($_ text/compose "Wrong syntax for " down-cast)))))])))
+                                                                     (cast down-cast type-varsC representation-declaration abstraction-declaration)])))
                            (update@ #.definitions (put up-cast (: Definition
                                                                   [Macro macro-anns
-                                                                   (: Macro
-                                                                      (function (_ tokens)
-                                                                        (case tokens
-                                                                          (^ (list value))
-                                                                          (wrap (list (` ((: (All [(~+ type-varsC)]
-                                                                                               (-> (~ abstract-declaration) (~ representation-declaration)))
-                                                                                             (|>> :assume))
-                                                                                          (~ value)))))
-
-                                                                          _
-                                                                          (macro.fail ($_ text/compose "Wrong syntax for " up-cast)))))]))))]]
+                                                                   (cast up-cast type-varsC abstraction-declaration representation-declaration)]))))]]
     (function (_ compiler)
-      (#E.Success [(update@ #.modules (put this-module-name this-module) compiler)
-                   []]))))
+      (#error.Success [(update@ #.modules (put this-module-name this-module) compiler)
+                       []]))))
 
 (def: (un-install-casts' this-module-name)
   (-> Text (Meta Any))
@@ -103,8 +96,8 @@
                            (update@ #.definitions (remove down-cast))
                            (update@ #.definitions (remove up-cast)))]]
     (function (_ compiler)
-      (#E.Success [(update@ #.modules (put this-module-name this-module) compiler)
-                   []]))))
+      (#error.Success [(update@ #.modules (put this-module-name this-module) compiler)
+                       []]))))
 
 (syntax: (install-casts {name s.local-symbol}
                         {type-vars (s.tuple (p.some s.local-symbol))})
@@ -119,10 +112,7 @@
         (wrap (list)))
 
       _
-      (macro.fail ($_ text/compose
-                      "Cannot temporarily define casting functions ("
-                      down-cast " & " up-cast
-                      ") because definitions like that already exist.")))))
+      (macro.fail ($_ text/compose "Cannot temporarily define casting functions (" down-cast " & " up-cast ") because definitions like that already exist.")))))
 
 (syntax: (un-install-casts)
   (do macro.Monad
@@ -136,10 +126,7 @@
         (wrap (list)))
 
       _
-      (macro.fail ($_ text/compose
-                      "Cannot un-define casting functions ("
-                      down-cast " & " up-cast
-                      ") because they do not exist.")))))
+      (macro.fail ($_ text/compose "Cannot un-define casting functions (" down-cast " & " up-cast ") because they do not exist.")))))
 
 (def: declaration
   (s.Syntax [Text (List Text)])
@@ -154,9 +141,9 @@
                    {primitives (p.some s.any)})
   (let [hidden-name (representation-name name)
         type-varsC (list/map code.local-symbol type-vars)
-        abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
+        abstraction-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
         representation-declaration (` ((~ (code.local-symbol hidden-name)) (~+ type-varsC)))]
-    (wrap (list& (` (type: (~+ (csw.export export)) (~ abstract-declaration)
+    (wrap (list& (` (type: (~+ (csw.export export)) (~ abstraction-declaration)
                       (~ (csw.annotations annotations))
                       (primitive (~ (code.text hidden-name)) [(~+ type-varsC)])))
                  (` (type: (~+ (csw.export export)) (~ representation-declaration)
-- 
cgit v1.2.3