aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lang.clj93
-rw-r--r--src/lang/analyser.clj6
-rw-r--r--src/lang/compiler.clj14
-rw-r--r--test2.lang6
4 files changed, 26 insertions, 93 deletions
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
diff --git a/test2.lang b/test2.lang
index 58079e172..e52e667d7 100644
--- a/test2.lang
+++ b/test2.lang
@@ -16,6 +16,10 @@
(definterface Function
(: apply (-> [java.lang.Object] java.lang.Object)))
+(defclass Tuple0 [])
+(defclass Tuple1 [[java.lang.Object _0]])
+(defclass Tuple2 [[java.lang.Object _0] [java.lang.Object _1]])
+
(def const "IDENTITY")
(def sample (#Tag "value"))
@@ -25,5 +29,5 @@
(def (main args)
(if true
- (_. (_.. System out) (println (constant "TRUE" "YOLO")))
+ (_. (_.. System out) (println ["TRUE" "YOLO"]))
(_. (_.. System out) (println "FALSE"))))