aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj26
-rw-r--r--src/lux/compiler.clj82
2 files changed, 86 insertions, 22 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index b192a2e31..07d3fb3b7 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -609,6 +609,17 @@
(let [fold-branch (fn [struct entry]
(let [struct* (clojure.core.match/match (nth entry 0)
+ [::pm-char ?token]
+ (clojure.core.match/match (:type struct)
+ ::char-tests (update-in struct [:patterns ?token] (fn [bodies]
+ (if bodies
+ (conj bodies (nth entry 1))
+ #{(nth entry 1)})))
+ nil (-> struct
+ (assoc :type ::char-tests)
+ (assoc-in [:patterns ?token] #{(nth entry 1)}))
+ _ (assert false "Can't do match."))
+
[::pm-text ?text]
(clojure.core.match/match (:type struct)
::text-tests (update-in struct [:patterns ?text] (fn [bodies]
@@ -676,6 +687,7 @@
;; (.print System/out (prn-str 'branches* branches*))
;; (.print System/out (prn-str '(:type branches*) (:type branches*)))
(clojure.core.match/match (:type branches*)
+ ::char-tests branches*
::text-tests branches*
::tuple (do (assert (<= (count (:defaults branches*)) 1))
{:type ::tuple*
@@ -710,6 +722,9 @@
:branches (:branches branches*)})))
get-vars (fn get-vars [pattern]
(clojure.core.match/match pattern
+ [::&parser/char ?token]
+ '()
+
[::&parser/text ?text]
'()
@@ -730,6 +745,9 @@
))
->instructions (fn ->instructions [locals pattern]
(clojure.core.match/match pattern
+ [::&parser/char ?token]
+ [::pm-char ?token]
+
[::&parser/text ?text]
[::pm-text ?text]
@@ -801,6 +819,14 @@
[registers mappings tree] (exec [=branches (map-m (fn [[?pattern ?body]]
;; (prn '?branch ?branch)
(match ?pattern
+ [::&parser/char ?token]
+ (exec [=body (analyse-form* ?body)]
+ (return [::case-branch [::&parser/char ?token] =body]))
+
+ [::&parser/text ?token]
+ (exec [=body (analyse-form* ?body)]
+ (return [::case-branch [::&parser/text ?token] =body]))
+
[::&parser/ident ?name]
(exec [=body (with-locals {?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])}
(analyse-form* ?body))]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 5b257eaed..ae8c75aa0 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -318,17 +318,38 @@
(defn compile-decision-tree [writer mappings default-label decision-tree]
;; (prn 'compile-decision-tree decision-tree)
(match decision-tree
- [::test-text ?text $body]
- (let [$else (new Label)]
+ [::test-char ?pairs]
+ (do (doseq [[?token $body] ?pairs
+ :let [$else (new Label)]]
+ (doto writer
+ ;; object
+ (.visitInsn Opcodes/DUP) ;; object, object
+ (.visitTypeInsn Opcodes/NEW (->class "java.lang.Character"))
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn ?token) ;; object, object, text
+ (.visitMethodInsn Opcodes/INVOKESPECIAL (->class "java.lang.Character") "<init>" "(C)V")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig) ;; object, B
+ (.visitJumpInsn Opcodes/IFEQ $else) ;; object
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO (get mappings $body))
+ (.visitLabel $else)))
(doto writer
- ;; object
- (.visitInsn Opcodes/DUP) ;; object, object
- (.visitLdcInsn ?text) ;; object, object, text
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig) ;; object, B
- (.visitJumpInsn Opcodes/IFEQ $else) ;; object
(.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO (get mappings $body))
- (.visitLabel $else)
+ (.visitJumpInsn Opcodes/GOTO default-label)))
+
+ [::test-text ?pairs]
+ (do (doseq [[?text $body] ?pairs
+ :let [$else (new Label)]]
+ (doto writer
+ ;; object
+ (.visitInsn Opcodes/DUP) ;; object, object
+ (.visitLdcInsn ?text) ;; object, object, text
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig) ;; object, B
+ (.visitJumpInsn Opcodes/IFEQ $else) ;; object
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO (get mappings $body))
+ (.visitLabel $else)))
+ (doto writer
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO default-label)))
@@ -427,12 +448,24 @@
]
[[::store ?local ?body] #{?body}])
+ ::&analyser/char-tests
+ (concat (list [[::test-char (for [[?token ?supports] (:patterns head)
+ ?body (set/intersection branches ?supports)
+ ;; :when (set/subset? branches ?supports)
+ ]
+ [?token ?body])]
+ branches])
+ (for [[_ ?local ?body] (:defaults head)
+ :when (contains? branches ?body)]
+ [[::store ?local ?body] #{?body}]))
+
::&analyser/text-tests
- (concat (for [[?text ?supports] (:patterns head)
- ?body (set/intersection branches ?supports)
- ;; :when (set/subset? branches ?supports)
- ]
- [[::test-text ?text ?body] #{?body}])
+ (concat (list [[::test-text (for [[?token ?supports] (:patterns head)
+ ?body (set/intersection branches ?supports)
+ ;; :when (set/subset? branches ?supports)
+ ]
+ [?token ?body])]
+ branches])
(for [[_ ?local ?body] (:defaults head)
:when (contains? branches ?body)]
[[::store ?local ?body] #{?body}]))
@@ -519,6 +552,7 @@
[::&analyser/case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree]
(do ;; (prn 'compile-case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree)
;; (assert false)
+ ;; (prn 'compile-case ?decision-tree)
(let [start-label (new Label)
end-label (new Label)
;; default-label (new Label)
@@ -539,24 +573,28 @@
;; (prn 'sequence-parts
;; (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))
(doseq [decision-tree (let [pieces (map first (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))]
- (if (:default ?decision-tree)
+ (if (or (:default ?decision-tree)
+ (not (empty? (:defaults ?decision-tree))))
(butlast pieces)
pieces))]
(compile-decision-tree *writer* mappings* default-label decision-tree))
(.visitLabel *writer* default-label)
- (if-let [[_ [_ _ ?idx] ?body] (:default ?decision-tree)]
+ (if-let [[_ [_ _ ?idx] ?body] (or (:default ?decision-tree)
+ (first (:defaults ?decision-tree)))]
(doto *writer*
(.visitInsn Opcodes/DUP)
(.visitVarInsn Opcodes/ASTORE ?idx)
(.visitJumpInsn Opcodes/GOTO (get mappings* ?body)))
(doto *writer*
- ;; (.visitInsn Opcodes/POP)
- (.visitTypeInsn Opcodes/CHECKCAST (->class +variant-class+))
- (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "tag" (->type-signature "java.lang.String"))
+ (.visitInsn Opcodes/POP)
+ ;; (.visitTypeInsn Opcodes/CHECKCAST (->class +variant-class+))
+ ;; (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "tag" (->type-signature "java.lang.String"))
(.visitTypeInsn Opcodes/NEW ex-class)
- (.visitInsn Opcodes/DUP_X1)
- (.visitInsn Opcodes/SWAP)
- (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" (str "(" (->type-signature "java.lang.String") ")" "V"))
+ (.visitInsn Opcodes/DUP)
+ ;; (.visitInsn Opcodes/DUP_X1)
+ ;; (.visitInsn Opcodes/SWAP)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
+ ;; (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" (str "(" (->type-signature "java.lang.String") ")" "V"))
(.visitInsn Opcodes/ATHROW)))
;; (if default-code
;; ;; (do (prn 'default-code default-code)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 08:45:49 +0000