diff options
| -rw-r--r-- | src/lux.clj | 5 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 90 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 202 | ||||
| -rw-r--r-- | src/lux/lexer.clj | 11 | ||||
| -rw-r--r-- | src/lux/parser.clj | 29 | ||||
| -rw-r--r-- | src/lux/util.clj | 4 | ||||
| -rw-r--r-- | test2.lux | 74 |
7 files changed, 232 insertions, 183 deletions
diff --git a/src/lux.clj b/src/lux.clj index 82fcb3a57..3c466e86f 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -17,14 +17,13 @@ ;; TODO: Adding metadata to global vars. ;; TODO: Add records. ;; TODO: throw, try, catch, finally - ;; TODO: Tuple8 and Tuple8X (for arbitrary-size tuples). ;; TODO: Add extra arities (apply2, apply3, ..., apply16) ;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly. ;; TODO: Add "new". Allow setting fields. ;; TODO: Don't take into account newlines in strings unless they come from \n to allow better coding. ;; TODO: monitor enter & monitor exit. - ;; TODO: - ;; TODO: + ;; TODO: Reinplement "if" as a macro on top of case. + ;; TODO: Eliminate the reliance of variants upon tuples for storage. ;; TODO: (let [source-code (slurp "test2.lux") diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index f70dab914..e21431cef 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -193,7 +193,7 @@ short-name =class}) nil]]))) -(defn ^:private require-module [name alias] +(defn ^:private use-module [name alias] (fn [state] [::&util/ok [(assoc-in state [:deps alias] name) nil]])) @@ -408,61 +408,47 @@ (defn ->token [x] ;; (prn '->token x) - (let [variant (.newInstance (.loadClass loader "test2.Variant"))] - (match x - [::&parser/text ?text] - (doto variant - (-> .-tag (set! "Text")) - (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1")) - (-> .-_0 (set! ?text)))))) - [::&parser/ident ?ident] - (doto variant - (-> .-tag (set! "Ident")) - (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1")) - (-> .-_0 (set! ?ident)))))) - [::&parser/fn-call ?fn ?args] - (doto variant - (-> .-tag (set! "Form")) - (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1")) - (-> .-_0 (set! (->tokens (cons ?fn ?args)))))) - )) - ))) + (match x + [::&parser/text ?text] + (doto (.newInstance (.loadClass loader "test2.Variant1")) + (-> .-tag (set! "Text")) + (-> .-_1 (set! ?text))) + [::&parser/ident ?ident] + (doto (.newInstance (.loadClass loader "test2.Variant1")) + (-> .-tag (set! "Ident")) + (-> .-_1 (set! ?ident))) + [::&parser/fn-call ?fn ?args] + (doto (.newInstance (.loadClass loader "test2.Variant1")) + (-> .-tag (set! "Form")) + (-> .-_1 (set! (->tokens (cons ?fn ?args))))) + )) (defn ->tokens [xs] - (let [variant (.loadClass loader "test2.Variant") - tuple2 (.loadClass loader "test2.Tuple2")] - (reduce (fn [tail x] - ;; (prn 'tail (.-tag tail) 'x x) - (doto (.newInstance variant) - (-> .-tag (set! "Cons")) - (-> .-value (set! (doto (.newInstance tuple2) - (-> .-_0 (set! (->token x))) - (-> .-_1 (set! tail)) - ;; (-> prn) - ))) - ;; (-> prn) - )) - (doto (.newInstance variant) - (-> .-tag (set! "Nil")) - (-> .-value (set! (.newInstance (.loadClass loader "test2.Tuple0"))))) - (reverse xs)))) + (reduce (fn [tail x] + ;; (prn 'tail (.-tag tail) 'x x) + (doto (.newInstance (.loadClass loader "test2.Variant2")) + (-> .-tag (set! "Cons")) + (-> .-_1 (set! (->token x))) + (-> .-_2 (set! tail)))) + (doto (.newInstance (.loadClass loader "test2.Variant0")) + (-> .-tag (set! "Nil"))) + (reverse xs))) (defn ->clojure-token [x] ;; (prn '->clojure-token x (.-tag x)) (case (.-tag x) - "Text" [::&parser/text (-> x .-value .-_0 (doto (-> string? assert)))] - "Ident" [::&parser/ident (-> x .-value .-_0 (doto (-> string? assert)))] - "Form" (let [[?fn & ?args] (-> x .-value .-_0 tokens->clojure)] + "Text" [::&parser/text (-> x .-_1 (doto (-> string? assert)))] + "Ident" [::&parser/ident (-> x .-_1 (doto (-> string? assert)))] + "Form" (let [[?fn & ?args] (-> x .-_1 tokens->clojure)] [::&parser/fn-call ?fn ?args]) - "Quote" [::&parser/quote (-> x .-value .-_0 ->clojure-token)])) + "Quote" [::&parser/quote (-> x .-_1 ->clojure-token)])) (defn tokens->clojure [xs] ;; (prn 'tokens->clojure xs (.-tag xs)) (case (.-tag xs) "Nil" '() - "Cons" (let [tuple2 (.-value xs)] - (cons (->clojure-token (.-_0 tuple2)) - (tokens->clojure (.-_1 tuple2)))) + "Cons" (cons (->clojure-token (.-_1 xs)) + (tokens->clojure (.-_2 xs))) )) (defanalyser analyse-fn-call @@ -674,13 +660,13 @@ (return (annotated [::let idx ?label =value =body] (:type =body))))) (defanalyser analyse-defclass - [::&parser/defclass ?name ?fields] + [::&parser/defclass ?name ?super-class ?fields] (let [=members {:fields (into {} (for [[class field] ?fields] [field {:access ::public :type class}]))} =class [::class ?name =members]] (exec [name module-name] - (return (annotated [::defclass [name ?name] =members] ::&type/nothing))))) + (return (annotated [::defclass [name ?name] ?super-class =members] ::&type/nothing))))) (defanalyser analyse-definterface [::&parser/definterface ?name ?members] @@ -765,14 +751,14 @@ (exec [_ (import-class ?class (last (string/split ?class #"\.")))] (return (annotated [::import ?class] ::&type/nothing)))) -(defanalyser analyse-require - [::&parser/require ?file ?alias] - (let [;; _ (prn `[require ~?file ~?alias]) +(defanalyser analyse-use + [::&parser/use ?file ?alias] + (let [;; _ (prn `[use ~?file ~?alias]) module-name (re-find #"[^/]+$" ?file) ;; _ (prn 'module-name module-name) ] - (exec [_ (require-module module-name ?alias)] - (return (annotated [::require ?file ?alias] ::&type/nothing))))) + (exec [_ (use-module module-name ?alias)] + (return (annotated [::use ?file ?alias] ::&type/nothing))))) (defanalyser analyse-quote [::&parser/quote ?quoted] @@ -799,7 +785,7 @@ analyse-def analyse-defmacro analyse-import - analyse-require + analyse-use analyse-quote])) ;; [Interface] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 84b3bc18c..d603df4df 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -61,11 +61,6 @@ [::&parser/ident ?label] ?label)) -(defn ^:private unwrap-tagged [ident] - (match ident - [::&parser/tagged ?tag ?data] - [?tag ?data])) - (defn ^:private ->class [class] (string/replace class #"\." "/")) @@ -147,7 +142,7 @@ (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;"))))) + (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str "_" (inc idx)) "Ljava/lang/Object;"))))) (defcompiler ^:private compile-local [::&analyser/local ?env ?idx] @@ -284,10 +279,10 @@ (let [+tag-sig+ (->type-signature "java.lang.String") variant-class* (->class +variant-class+) oclass (->class "java.lang.Object") - +tuple-field-sig+ (->type-signature "java.lang.Object") + +variant-field-sig+ (->type-signature "java.lang.Object") equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")] - (defn compile-decision-tree [writer mappings cleanup-level next-label default-label decision-tree] - ;; (prn 'compile-decision-tree cleanup-level decision-tree) + (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)] @@ -297,18 +292,16 @@ (.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 next-label) + (.visitInsn Opcodes/POP) + (.visitJumpInsn Opcodes/GOTO (get mappings $body)) (.visitLabel $else) - (-> (doto (.visitInsn Opcodes/POP)) - (->> (dotimes [_ (inc cleanup-level)]))) + (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO default-label))) - + [::store [::&analyser/local _ ?idx] $body] (doto writer (.visitVarInsn Opcodes/ASTORE ?idx) - (-> (.visitJumpInsn Opcodes/GOTO (get mappings $body)) - (->> (when (nil? next-label))))) + (.visitJumpInsn Opcodes/GOTO (get mappings $body))) [::test-adt ?branches ?cases] (doto writer @@ -322,41 +315,37 @@ (.visitJumpInsn Opcodes/IFEQ tag-else-label) ;; variant, tag (.visitInsn Opcodes/POP) ;; variant (do (let [arity (-> ?subcases first (nth 2) count) - tuple-class (str "test2/Tuple" arity) - ;; _ (prn ?tag arity tuple-class) + variant-class** (str variant-class* arity) + ;; _ (prn ?tag arity variant-class**) ] - (when (> arity 0) - (doto writer - (.visitInsn Opcodes/DUP) ;; variant, variant - (.visitFieldInsn Opcodes/GETFIELD variant-class* "value" +tuple-field-sig+) ;; variant, object - (.visitTypeInsn Opcodes/CHECKCAST tuple-class) ;; variant, tuple - )) + (.visitTypeInsn writer Opcodes/CHECKCAST variant-class**) ;; variantN (doseq [subcase ?subcases - :let [else-label (new Label)]] + :let [next-subcase (new Label)]] (match subcase [::subcase $body ?subseq] - (do (when (not (empty? ?subseq)) - (doseq [[?subpart ?subidx] (map vector ?subseq (range (count ?subseq))) - :let [next-label (new Label)]] - (doto writer - (.visitInsn Opcodes/DUP) ;; variant, tuple, tuple - (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?subidx) +tuple-field-sig+) ;; variant, tuple, object - (compile-decision-tree mappings cleanup-level next-label else-label ?subpart) ;; variant, tuple - (.visitLabel next-label)))) + (do (doseq [[?subpart ?subidx] (map vector ?subseq (range (count ?subseq))) + :let [sub-next-elem (new Label)]] + (doto writer + (.visitInsn Opcodes/DUP) ;; variant, variant + (.visitFieldInsn Opcodes/GETFIELD variant-class** (str "_" (inc ?subidx)) +variant-field-sig+) ;; variant, object + (compile-decision-tree (assoc mappings $body sub-next-elem) next-subcase ?subpart) ;; variant + (.visitLabel sub-next-elem))) (doto writer - (-> (doto (.visitInsn Opcodes/POP)) - (->> (dotimes [_ (+ cleanup-level (if (> arity 0) 2 1))]))) ;; - (.visitJumpInsn Opcodes/GOTO (or next-label (get mappings $body))) - (.visitLabel else-label))) + (.visitInsn Opcodes/POP) + (.visitJumpInsn Opcodes/GOTO (get mappings $body)) + (.visitLabel next-subcase))) )) )) + (.visitInsn Opcodes/POP) ;; -> + (.visitJumpInsn Opcodes/GOTO default-label) ;; variant, tag -> (.visitLabel tag-else-label)) (->> (doseq [[?tag ?subcases] ?cases ;; :let [_ (.print System/out (prn-str 'COMPILE-PATTERN ?tag ?subcases))] :let [tag-else-label (new Label)]]))) - (-> (doto (.visitInsn Opcodes/POP)) - (->> (dotimes [_ (+ cleanup-level 2)]))) + ;; variant, tag -> + (.visitInsn Opcodes/POP) ;; variant -> + (.visitInsn Opcodes/POP) ;; -> (.visitJumpInsn Opcodes/GOTO default-label))) )) @@ -386,27 +375,45 @@ ::&analyser/adt* (do ;; (prn '(:default head) (:default head)) ;; (assert (nil? (:default head))) - (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head) - ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))] - :let [?parts (:parts ?struct) - num-parts (count ?parts) - ?supports (:branches ?struct) - subcases (for [?body (set/intersection branches ?supports) - subseq (sequence-parts #{?body} ?parts) - ;; :let [_ (when (= "Symbol" ?tag) - ;; (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))] - :when (= num-parts (count subseq))] - [::subcase ?body subseq])] - :when (not (empty? subcases))] - [?tag subcases]))] - (if (empty? patterns) - '() - (list [[::test-adt branches patterns] - branches]))) - (if-let [[_ ?local ?body] (:default head)] - (for [?body (set/intersection branches #{?body})] - [[::store ?local ?body] #{?body}]) - '()))) + ;; (let [patterns (into {} (for [[?tag ?struct] (:patterns head) + ;; ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))] + ;; :let [?parts (:parts ?struct) + ;; num-parts (count ?parts) + ;; ?supports (:branches ?struct) + ;; subcases (for [?body (set/intersection branches ?supports) + ;; subseq (sequence-parts #{?body} ?parts) + ;; ;; :let [_ (when (= "Symbol" ?tag) + ;; ;; (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))] + ;; :when (= num-parts (count subseq))] + ;; [::subcase ?body subseq])] + ;; :when (not (empty? subcases))] + ;; [?tag subcases]))] + ;; (if (empty? patterns) + ;; '() + ;; (list [[::test-adt branches patterns] + ;; branches]))) + (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head) + ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))] + :let [?parts (:parts ?struct) + num-parts (count ?parts) + ?supports (:branches ?struct) + subcases (for [?body (set/intersection branches ?supports) + subseq (sequence-parts #{?body} ?parts) + ;; :let [_ (when (= "Symbol" ?tag) + ;; (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))] + :when (= num-parts (count subseq))] + [::subcase ?body subseq])] + :when (not (empty? subcases))] + [?tag subcases]))] + (if (empty? patterns) + '() + (list [[::test-adt branches patterns] + branches]))) + (if-let [[_ ?local ?body] (:default head)] + (for [?body (set/intersection branches #{?body})] + [[::default ?local ?body] #{?body}]) + '())) + ) )] (for [[step branches*] expanded tail* (sequence-parts branches* tail) @@ -435,29 +442,48 @@ (dotimes [idx ?max-registers] (.visitLocalVariable *writer* (str "__" (swap! !case-vars inc) "__") (->java-sig ::&type/any) nil start-label end-label (+ ?base-idx (inc idx)))) (compile-form (assoc *state* :form ?variant)) - (.visitLabel *writer* start-label) + (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLabel start-label)) (let [default-label (new Label) - default-code (:default ?decision-tree)] + ;; default-code (:default ?decision-tree) + ] ;; (prn 'sequence-parts ;; (sequence-parts (:branches ?decision-tree) (list ?decision-tree))) - (doseq [decision-tree (map first (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))] - (compile-decision-tree *writer* mappings* 0 nil default-label decision-tree)) + (doseq [decision-tree (let [pieces (map first (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))] + (if (:default ?decision-tree) + (butlast pieces) + pieces))] + (compile-decision-tree *writer* mappings* default-label decision-tree)) (.visitLabel *writer* default-label) - (when (not default-code) - ;; (do (prn 'default-code default-code) - ;; (assert false) - ;; ;; (.visitInsn Opcodes/POP) ;; ... - ;; (compile-form (assoc *state* :form default-code)) - ;; (.visitJumpInsn *writer* Opcodes/GOTO end-label)) + (if-let [[_ [_ _ ?idx] ?body] (:default ?decision-tree)] + (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitVarInsn Opcodes/ASTORE ?idx) + (.visitJumpInsn Opcodes/GOTO (get mappings* ?body))) (doto *writer* - ;; (.visitInsn Opcodes/POP) + (.visitInsn Opcodes/POP) (.visitTypeInsn Opcodes/NEW ex-class) (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V") - (.visitInsn Opcodes/ATHROW)))) + (.visitInsn Opcodes/ATHROW))) + ;; (if default-code + ;; ;; (do (prn 'default-code default-code) + ;; ;; (assert false) + ;; ;; ;; (.visitInsn Opcodes/POP) ;; ... + ;; ;; (compile-form (assoc *state* :form default-code)) + ;; ;; (.visitJumpInsn *writer* Opcodes/GOTO end-label)) + ;; (doto *writer* + ;; (.visitInsn Opcodes/POP) + ;; (.visitTypeInsn Opcodes/NEW ex-class) + ;; (.visitInsn Opcodes/DUP) + ;; (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V") + ;; (.visitInsn Opcodes/ATHROW))) + ) ;; (compile-decision-tree *state* *writer* mappings* 1 nil (:branches ?decision-tree) ?decision-tree) (doseq [[?label ?body] (map second entries)] (.visitLabel *writer* ?label) + (.visitInsn *writer* Opcodes/POP) (compile-form (assoc *state* :form ?body)) (.visitJumpInsn *writer* Opcodes/GOTO end-label)) (.visitLabel *writer* end-label) @@ -751,18 +777,19 @@ )) (defcompiler ^:private compile-defclass - [::&analyser/defclass [?package ?name] ?members] + [::&analyser/defclass [?package ?name] ?super-class ?members] (let [parent-dir (->package ?package) + super-class* (->class ?super-class) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (str parent-dir "/" ?name) nil "java/lang/Object" nil))] + (str parent-dir "/" ?name) nil super-class* nil))] (doseq [[field props] (:fields ?members)] (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature (:type props)) nil nil) (.visitEnd))) (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" "()V" nil nil) (.visitCode) (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V") + (.visitMethodInsn Opcodes/INVOKESPECIAL super-class* "<init>" "()V") (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd)) @@ -789,7 +816,7 @@ (defcompiler ^:private compile-variant [::&analyser/variant ?tag ?members] - (let [variant-class* (->class +variant-class+)] + (let [variant-class* (str (->class +variant-class+) (count ?members))] ;; (prn 'compile-variant ?tag ?value) (doto *writer* (.visitTypeInsn Opcodes/NEW variant-class*) @@ -798,27 +825,18 @@ (.visitInsn Opcodes/DUP) (.visitLdcInsn ?tag) (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" (->type-signature "java.lang.String")) - (.visitInsn Opcodes/DUP)) - (let [tuple-class (str "test2/Tuple" (count ?members))] - (doto *writer* - (.visitTypeInsn Opcodes/NEW tuple-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL tuple-class "<init>" "()V")) - (doseq [[?tfield ?member] (mapv vector (range (count ?members)) ?members)] - (doto *writer* - (.visitInsn Opcodes/DUP) - (do (compile-form (assoc *state* :form ?member))) - (.visitFieldInsn Opcodes/PUTFIELD tuple-class (str "_" ?tfield) "Ljava/lang/Object;")))) - (doto *writer* - (.visitFieldInsn Opcodes/PUTFIELD variant-class* "value" "Ljava/lang/Object;")) + (-> (doto (.visitInsn Opcodes/DUP) + (do (compile-form (assoc *state* :form ?member))) + (.visitFieldInsn Opcodes/PUTFIELD variant-class* (str "_" (inc ?tfield)) "Ljava/lang/Object;")) + (->> (doseq [[?tfield ?member] (mapv vector (range (count ?members)) ?members)])))) )) (defcompiler compile-import [::&analyser/import ?class] nil) -(defcompiler compile-require - [::&analyser/require ?file ?alias] +(defcompiler compile-use + [::&analyser/use ?file ?alias] (let [module-name (re-find #"[^/]+$" ?file) ;; _ (prn 'module-name module-name) source-code (slurp (str module-name ".lux")) @@ -881,7 +899,7 @@ compile-defclass compile-definterface compile-import - compile-require + compile-use compile-quote]] (defn ^:private compile-form [state] ;; (prn 'compile-form/state state) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index e058bf75f..c0ced6baf 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -49,11 +49,11 @@ (return (str prefix unescaped postfix))) (lex-regex #"(?s)^([^\"\\]*)")])) +(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?]*)") + ;; [Lexers] (def ^:private lex-white-space (lex-regex #"^(\s+)")) -(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?]*)") - (do-template [<name> <tag> <regex>] (def <name> (exec [token (lex-regex <regex>)] @@ -111,6 +111,10 @@ ] (return [::comment comment]))) +(def ^:private lex-comment + (try-all-m [lex-single-line-comment + lex-multi-line-comment])) + (def ^:private lex-tag (exec [_ (lex-str "#") token (lex-regex +ident-re+)] @@ -128,8 +132,7 @@ lex-list lex-tuple lex-record - lex-single-line-comment - lex-multi-line-comment]) + lex-comment]) _ (try-m lex-white-space)] (return form))) diff --git a/src/lux/parser.clj b/src/lux/parser.clj index 3079e22a7..a383e78a5 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -77,18 +77,6 @@ =body (apply-m parse-form (list ?body))] (return [::defmacro =name =body]))) -(defparser ^:private parse-defdata - [::&lexer/list ([[::&lexer/ident "defdata"] ?type & ?cases] :seq)] - (exec [=type (apply-m parse-form (list ?type)) - =cases (map-m (fn [arg] - (match arg - [::&lexer/list ([[::&lexer/tag ?tag] ?data] :seq)] - (exec [=data (apply-m parse-form (list ?data))] - (return [::tagged ?tag =data])) - )) - ?cases)] - (return [::defdata =type =cases]))) - (defparser ^:private parse-if [::&lexer/list ([[::&lexer/ident "if"] ?test ?then ?else] :seq)] (exec [=test (apply-m parse-form (list ?test)) @@ -123,20 +111,22 @@ [::&lexer/list ([[::&lexer/ident "import"] [::&lexer/ident ?class]] :seq)] (return [::import ?class])) -(defparser ^:private parse-require - [::&lexer/list ([[::&lexer/ident "require"] [::&lexer/text ?file] [::&lexer/ident "as"] [::&lexer/ident ?alias]] :seq)] - (return [::require ?file ?alias])) +(defparser ^:private parse-use + [::&lexer/list ([[::&lexer/ident "use"] [::&lexer/text ?file] [::&lexer/ident "as"] [::&lexer/ident ?alias]] :seq)] + (return [::use ?file ?alias])) (defparser ^:private parse-defclass - [::&lexer/list ([[::&lexer/ident "defclass"] [::&lexer/ident ?name] [::&lexer/tuple ?fields]] :seq)] + [::&lexer/list ([[::&lexer/ident "jvm/defclass"] [::&lexer/ident ?name] + [::&lexer/ident ?super-class] + [::&lexer/tuple ?fields]] :seq)] (let [fields (for [field ?fields] (match field [::&lexer/tuple ([[::&lexer/ident ?class] [::&lexer/ident ?field]] :seq)] [?class ?field]))] - (return [::defclass ?name fields]))) + (return [::defclass ?name ?super-class fields]))) (defparser ^:private parse-definterface - [::&lexer/list ([[::&lexer/ident "definterface"] [::&lexer/ident ?name] & ?members] :seq)] + [::&lexer/list ([[::&lexer/ident "jvm/definterface"] [::&lexer/ident ?name] & ?members] :seq)] (let [members (for [field ?members] (match field [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?member] [::&lexer/list ([[::&lexer/ident "->"] [::&lexer/tuple ?inputs] ?output] :seq)]] :seq)] @@ -202,7 +192,6 @@ parse-lambda parse-def parse-defmacro - parse-defdata parse-if parse-do parse-case @@ -215,7 +204,7 @@ parse-defclass parse-definterface parse-import - parse-require + parse-use parse-fn-call])) ;; [Interface] diff --git a/src/lux/util.clj b/src/lux/util.clj index 83fdc16aa..890b73880 100644 --- a/src/lux/util.clj +++ b/src/lux/util.clj @@ -35,10 +35,6 @@ (reduce (fn [inner [label computation]] (case label :let `(let ~computation ~inner) - ;; :when (assert false "Can't use :when") - :when `(if ~computation - ~inner - zero) ;; else `(bind ~computation (fn [~label] ~inner)))) return @@ -1,14 +1,72 @@ (import java.lang.System) -## (require "./another" as another) +## (use "./another" as another) -(definterface Function +(jvm/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]]) - -(defclass Variant [[java.lang.String tag] [java.lang.Object value]]) +(jvm/defclass Tuple0 java.lang.Object + []) +(jvm/defclass Tuple1 java.lang.Object + [[java.lang.Object _1]]) +(jvm/defclass Tuple2 java.lang.Object + [[java.lang.Object _1] [java.lang.Object _2]]) +(jvm/defclass Tuple3 java.lang.Object + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3]]) +(jvm/defclass Tuple4 java.lang.Object + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4]]) +(jvm/defclass Tuple5 java.lang.Object + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5]]) +(jvm/defclass Tuple6 java.lang.Object + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6]]) +(jvm/defclass Tuple7 java.lang.Object + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7]]) +(jvm/defclass Tuple8 java.lang.Object + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7] [java.lang.Object _8]]) + +(jvm/defclass Variant java.lang.Object + [[java.lang.String tag]]) +(jvm/defclass Variant0 test2.Variant + []) +(jvm/defclass Variant1 test2.Variant + [[java.lang.Object _1]]) +(jvm/defclass Variant2 test2.Variant + [[java.lang.Object _1] [java.lang.Object _2]]) +(jvm/defclass Variant3 test2.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3]]) +(jvm/defclass Variant4 test2.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4]]) +(jvm/defclass Variant5 test2.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5]]) +(jvm/defclass Variant6 test2.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6]]) +(jvm/defclass Variant7 test2.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7]]) +(jvm/defclass Variant8 test2.Variant + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7] [java.lang.Object _8]]) (def (++ xs ys) (case xs @@ -120,7 +178,7 @@ ## Program (def (main args) - (case (' ((~ "Doing a slight makeover."))) + (case (' ((~ "Oh yeah..."))) (#Form (#Cons (#Text text) #Nil)) (:: (:: System out) (println text)) )) |