From 5883c0d11c21a74ba493ea369ff01d7baed80a41 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 15 Dec 2014 00:56:48 -0400
Subject: Added tuples.

---
 src/lang.clj          | 93 +--------------------------------------------------
 src/lang/analyser.clj |  6 ++++
 src/lang/compiler.clj | 14 ++++++++
 3 files changed, 21 insertions(+), 92 deletions(-)

(limited to 'src')

diff --git a/src/lang.clj b/src/lang.clj
index f68d6eeb3..c497c9923 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -11,92 +11,7 @@
     (.write stream data)))
 
 (comment
-  (let [source-code (slurp "test2.lang")
-        tokens (&lexer/lex source-code)
-        ;; _ (prn 'tokens tokens)
-        syntax (&parser/parse tokens)
-        ;; _ (prn 'syntax syntax)
-        class-data (&compiler/compile "test2" syntax)]
-    (write-file "test2.class" class-data))
-
-  (->> (slurp "test2.lang")
-       &lexer/lex
-       &parser/parse
-       (&compiler/compile "test2")
-       (write-file "test2.class"))
-
-  (->> (slurp "test2.lang")
-       &lexer/lex
-       &parser/parse
-       (&analyser/analyse "test2"))
-
-  (let [source-code (slurp "test2.lang")
-        tokens (&lexer/lex source-code)
-        ;; _ (prn 'tokens tokens)
-        syntax (&parser/parse tokens)
-        ;; _ (prn 'syntax syntax)
-        ann-syntax (&analyser/analyse "test2" syntax)
-        _ (prn 'ann-syntax ann-syntax)
-        class-data (&compiler/compile "test2" syntax)]
-    (write-file "test2.class" class-data))
-
-  (let [source-code (slurp "test2.lang")
-        tokens (&lexer/lex source-code)
-        ;; _ (prn 'tokens tokens)
-        syntax (&parser/parse tokens)
-        ;; _ (prn 'syntax syntax)
-        ann-syntax (&analyser/analyse "test2" syntax)
-        ;; _ (prn 'ann-syntax ann-syntax)
-        class-data (&compiler/compile "test2" ann-syntax)]
-    (write-file "test2.class" class-data))
-
-  (let y ...
-       (lambda x (* x y)))
-
-  (let y ...
-       (proxy Function1
-         (apply1 [_ x] (* x y))))
-
-  (def (foo w x y z)
-    ($ * w x y z))
-  =>
-  (let f1 (proxy Function1 [w x y]
-                 (apply1 [_ z]
-                   (STATIC-METHOD w x y z)))
-       (let f2 (proxy Function2 [w x]
-                      (apply1 [_ y]
-                        f1)
-                      (apply2 [_ y z]
-                        (STATIC-METHOD w x y z)))
-            (proxy Function4
-              (apply1 [_ w x]
-                      (proxy Function3 [w]
-                             (apply1 [_ x]
-                               f2)
-                             (apply2 [_ x y]
-                               f1)
-                             (apply3 [_ x y z]
-                               (STATIC-METHOD w x y z))))
-              (apply2 [_ w x]
-                f2)
-              (apply3 [_ w x y]
-                f1)
-              (apply4 [_ w x y z]
-                (STATIC-METHOD w x y z)))))
-
-  <OR AS...>
-  (proxy Function []
-         (apply [_ w]
-           (proxy Function [w]
-                  (apply [_ x]
-                    (proxy Function [w x]
-                           (apply [_ y]
-                             (proxy Function [w x y]
-                                    (apply [_ z]
-                                      (STATIC-METHOD w x y z)))))))))
-  
-
-  ;; TODO: Add tuples.
+  ;; TODO: Add lambdas.
   ;; TODO: Add pattern-matching.
   ;; TODO: Add thunks.
   ;; TODO: Add Java-interop.
@@ -108,7 +23,6 @@
   ;; TODO: Re-implement compiler in language.
   ;; TODO: Add all the missing literal types.
   ;; TODO: Allow strings to have escape characters.
-  ;; TODO: Add lambdas.
   ;; TODO: Add "do" expressions.
   ;; TODO: Fold all closure classes into one.
   ;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly.
@@ -126,11 +40,6 @@
         class-data (&compiler/compile "test2" ann-syntax)]
     (write-file "test2.class" class-data))
   
-  ;; jar cvf test2.jar test2 test2.class
-  ;; java -cp "test2.jar" test2
-  ;; jar cvf test2.jar test2 test2.class && java -cp "test2.jar" test2
-  ;; jar cvf test2.jar test2 test2.class another.class && java -cp "test2.jar" test2
-
   ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2
 
   )
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 115204570..122d6353d 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -96,6 +96,11 @@
   (exec [=value (analyse-form* ?value)]
     (return (annotated [::variant ?tag =value] [::&type/variant ?tag (:type =value)]))))
 
+(defanalyser analyse-tuple
+  [::&parser/tuple ?elems]
+  (exec [=elems (map-m analyse-form* ?elems)]
+    (return (annotated [::tuple =elems] [::&type/tuple (mapv :type =elems)]))))
+
 (defanalyser analyse-ident
   [::&parser/ident ?ident]
   (resolve ?ident))
@@ -211,6 +216,7 @@
   (try-all-m [analyse-boolean
               analyse-string
               analyse-variant
+              analyse-tuple
               analyse-ident
               analyse-ann-class
               analyse-static-access
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index fc164d9d1..e8f0207b3 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -79,6 +79,19 @@
         :else
         (assert false (str "[Unknown literal type] " ?literal " : " (class ?literal)))))
 
+(defcompiler ^:private compile-tuple
+  [::&analyser/tuple ?elems]
+  (let [num-elems (count ?elems)]
+    (let [tuple-class (str "test2/Tuple" num-elems)]
+      (doto *writer*
+        (.visitTypeInsn Opcodes/NEW tuple-class)
+        (.visitInsn Opcodes/DUP)
+        (.visitMethodInsn Opcodes/INVOKESPECIAL tuple-class "<init>" "()V"))
+      (dotimes [idx num-elems]
+        (.visitInsn *writer* Opcodes/DUP)
+        (compile-form (assoc *state* :form (nth ?elems idx)))
+        (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str "_" idx) "Ljava/lang/Object;")))))
+
 (defcompiler ^:private compile-local
   [::&analyser/local ?idx]
   (do ;; (prn 'LOCAL ?idx)
@@ -329,6 +342,7 @@
 
 (let [+compilers+ [compile-literal
                    compile-variant
+                   compile-tuple
                    compile-local
                    compile-global
                    compile-call
-- 
cgit v1.2.3