aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-01-16 03:43:55 -0400
committerEduardo Julian2015-01-16 03:43:55 -0400
commitd1e7c4dd03a72a93dbca15cbc1b0ac29ab49efbc (patch)
tree46ac79134b26c46e97d2cec2e797f6a54961bced
parentb0b17a0270fdad3e890cf00bab399fd8dac80fa9 (diff)
Fixed a bug in the ' macro.
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj26
-rw-r--r--src/lux/compiler.clj57
-rw-r--r--src/lux/util.clj4
-rw-r--r--test2.lux144
4 files changed, 142 insertions, 89 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 6b823b3ee..1aa2d587b 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -477,39 +477,39 @@
;; (prn '->token x)
(match x
[::&parser/bool ?bool]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Bool"))
(-> .-_1 (set! ?bool)))
[::&parser/int ?int]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Int"))
(-> .-_1 (set! ?int)))
[::&parser/real ?real]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Real"))
(-> .-_1 (set! ?real)))
[::&parser/char ?elem]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Char"))
(-> .-_1 (set! ?elem)))
[::&parser/text ?text]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Text"))
(-> .-_1 (set! ?text)))
[::&parser/tag ?tag]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Tag"))
(-> .-_1 (set! ?tag)))
[::&parser/ident ?ident]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Ident"))
(-> .-_1 (set! ?ident)))
[::&parser/tuple ?elems]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Tuple"))
(-> .-_1 (set! (->tokens ?elems))))
[::&parser/form ?elems]
- (doto (.newInstance (.loadClass loader "test2.Variant1"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant1"))
(-> .-tag (set! "Form"))
(-> .-_1 (set! (->tokens ?elems))))
))
@@ -517,11 +517,11 @@
(defn ->tokens [xs]
(reduce (fn [tail x]
;; (prn 'tail (.-tag tail) 'x x)
- (doto (.newInstance (.loadClass loader "test2.Variant2"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant2"))
(-> .-tag (set! "Cons"))
(-> .-_1 (set! (->token x)))
(-> .-_2 (set! tail))))
- (doto (.newInstance (.loadClass loader "test2.Variant0"))
+ (doto (.newInstance (.loadClass @loader "test2.Variant0"))
(-> .-tag (set! "Nil")))
(reverse xs)))
@@ -557,12 +557,12 @@
:let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]]
(if (and macro? (not scoped?))
(let [macro-class (str ?module "$" (normalize-ident ?name))
- transformed (-> (.loadClass loader macro-class)
+ transformed (-> (.loadClass @loader macro-class)
.newInstance
(.apply (->tokens ?args))
->clojure-token)
_ (prn 'analyse-call/transformed transformed)]
- (-> (.loadClass loader macro-class)
+ (-> (.loadClass @loader macro-class)
.newInstance
(.apply (->tokens ?args))
->clojure-token
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index aea9ea1e2..31b440b88 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -8,7 +8,7 @@
repeat-m try-m try-all-m map-m reduce-m
apply-m within
normalize-ident
- loader]]
+ loader reset-loader!]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -36,7 +36,7 @@
;; (println "Defining..." name "@" file-name ;; (alength bytecode)
;; )
;; (prn 'loader loader)
- (.loadClass loader name)
+ (.loadClass @loader name)
;; (println "SUCCESFUL LOAD!")
;; (.defineClass loader name bytecode 0 (alength bytecode))
))
@@ -281,24 +281,26 @@
nil)
)))
-(defcompiler ^:private compile-if
- [::&analyser/if ?test ?then ?else]
- (let [else-label (new Label)
- end-label (new Label)]
- ;; (println "PRE")
- (compile-form (assoc *state* :form ?test))
- (doto *writer*
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z")
- (.visitJumpInsn Opcodes/IFEQ else-label))
- ;; (prn 'compile-if/?then (:form ?then))
- (compile-form (assoc *state* :form ?then))
- ;; (.visitInsn *writer* Opcodes/POP)
- (doto *writer*
- (.visitJumpInsn Opcodes/GOTO end-label)
- (.visitLabel else-label))
- (compile-form (assoc *state* :form ?else))
- ;; (.visitInsn *writer* Opcodes/POP)
- (.visitLabel *writer* end-label)))
+(let [+bool-class+ (->class "java.lang.Boolean")]
+ (defcompiler ^:private compile-if
+ [::&analyser/if ?test ?then ?else]
+ (let [else-label (new Label)
+ end-label (new Label)]
+ ;; (println "PRE")
+ (compile-form (assoc *state* :form ?test))
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +bool-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +bool-class+ "booleanValue" "()Z")
+ (.visitJumpInsn Opcodes/IFEQ else-label))
+ ;; (prn 'compile-if/?then (:form ?then))
+ (compile-form (assoc *state* :form ?then))
+ ;; (.visitInsn *writer* Opcodes/POP)
+ (doto *writer*
+ (.visitJumpInsn Opcodes/GOTO end-label)
+ (.visitLabel else-label))
+ (compile-form (assoc *state* :form ?else))
+ ;; (.visitInsn *writer* Opcodes/POP)
+ (.visitLabel *writer* end-label))))
(defcompiler ^:private compile-do
[::&analyser/do ?exprs]
@@ -330,6 +332,11 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO default-label)))
+ [::default [::&analyser/local _ ?idx] $body]
+ (doto writer
+ (.visitVarInsn Opcodes/ASTORE ?idx)
+ (.visitJumpInsn Opcodes/GOTO (get mappings $body)))
+
[::store [::&analyser/local _ ?idx] $body]
(doto writer
(.visitVarInsn Opcodes/ASTORE ?idx)
@@ -543,10 +550,13 @@
(.visitVarInsn Opcodes/ASTORE ?idx)
(.visitJumpInsn Opcodes/GOTO (get mappings* ?body)))
(doto *writer*
- (.visitInsn Opcodes/POP)
+ ;; (.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)
- (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
+ (.visitInsn Opcodes/DUP_X1)
+ (.visitInsn Opcodes/SWAP)
+ (.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)
@@ -1006,6 +1016,7 @@
;; [Interface]
(defn compile [class-name inputs]
;; (prn 'inputs inputs)
+ (reset-loader!)
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(->class class-name) nil "java/lang/Object" nil))
diff --git a/src/lux/util.clj b/src/lux/util.clj
index 890b73880..5496e8699 100644
--- a/src/lux/util.clj
+++ b/src/lux/util.clj
@@ -160,4 +160,6 @@
(defn normalize-ident [ident]
(reduce str "" (map normalize-char ident)))
-(defonce loader (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.))
+(defonce loader (atom nil))
+(defn reset-loader! []
+ (reset! loader (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.)))
diff --git a/test2.lux b/test2.lux
index af17b4c7a..d24c9d10b 100644
--- a/test2.lux
+++ b/test2.lux
@@ -75,30 +75,21 @@
(jvm/invokevirtual java.io.PrintStream "println" [Object]
(jvm/getstatic System out) [x]))
-(def (++ xs ys)
+(defmacro (list xs)
(case xs
#Nil
- ys
+ (#Tag "Nil")
(#Cons x xs*)
- (#Cons x (++ xs* ys))))
+ (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
-(def (template elems)
- (case elems
+(def (++ xs ys)
+ (case xs
#Nil
- elems
-
- (#Cons head tail)
- (case head
- (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil)))
- (#Cons unquoted (template tail))
-
- (#Form (#Cons (#Ident "~@") (#Cons spliced #Nil)))
- (#Cons (#Ident "++") (#Cons spliced (template tail)))
+ ys
- _
- (#Cons head (template tail))
- )))
+ (#Cons x xs*)
+ (#Cons x (++ xs* ys))))
(def (map f xs)
(case xs
@@ -108,42 +99,51 @@
(#Cons x xs*)
(#Cons (f x) (map f xs*))))
-(def (convert-list f xs)
- (case xs
+(def (untemplate-list untemplate tokens)
+ (case tokens
#Nil
(#Tag "Nil")
- (#Cons x xs*)
- (#Form (#Cons (#Tag "Cons") (#Cons (f x) (#Cons (convert-list f xs*) #Nil))))))
+ (#Cons token tokens')
+ (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens')))))
-(def (convert token)
+(def (untemplate token)
(case token
- (#Tag tag)
- (#Form (#Cons (#Tag "Tag") (#Cons (#Text tag) #Nil)))
+ (#Bool elem)
+ (#Form (list (#Tag "Bool") (#Bool elem)))
+
+ (#Int elem)
+ (#Form (list (#Tag "Int") (#Int elem)))
+
+ (#Real elem)
+ (#Form (list (#Tag "Real") (#Real elem)))
+
+ (#Char elem)
+ (#Form (list (#Tag "Char") (#Char elem)))
+
+ (#Text elem)
+ (#Form (list (#Tag "Text") (#Text elem)))
+
+ (#Tag elem)
+ (#Form (list (#Tag "Tag") (#Text elem)))
- (#Text text)
- (#Form (#Cons (#Tag "Text") (#Cons (#Text text) #Nil)))
+ (#Ident elem)
+ (#Form (list (#Tag "Ident") (#Text elem)))
- (#Ident ident)
- (#Form (#Cons (#Tag "Ident") (#Cons (#Text ident) #Nil)))
+ (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil)))
+ unquoted
(#Tuple elems)
- (#Form (#Cons (#Tag "Tuple") (#Cons (convert-list convert elems) #Nil)))
+ (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems)))
(#Form elems)
- (#Form (#Cons (#Tag "Form") (#Cons (convert-list convert elems) #Nil)))
+ (#Form (list (#Tag "Form") (untemplate-list untemplate elems)))
))
(defmacro (' form)
(case form
- (#Cons form* #Nil)
- (case form*
- (#Form elems)
- (convert (#Form (template elems)))
-
- _
- (convert form)
- )))
+ (#Cons token #Nil)
+ (untemplate token)))
## Utils
(def (fail* message)
@@ -170,12 +170,6 @@
_
inputs))))
-## Ideally, this is what I want...
-## (exec [yolo lol
-## #let [foo (bar 1 2 3)]
-## #when true]
-## (meme yolo foo))
-
(def (+ x y)
(jvm/i+ x y))
@@ -208,13 +202,10 @@
_
#Nil))
-(defmacro (list xs)
- (case xs
- #Nil
- (#Tag "Nil")
-
- (#Cons x xs*)
- (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
+## Ideally, this is what I want...
+## (exec [yolo lol
+## #let [foo (bar 1 2 3)]]
+## (meme yolo foo))
(defmacro (exec tokens)
(case tokens
@@ -229,6 +220,55 @@
(as-pairs steps))
(#Text "Oh no!"))))
+(def (try-m monad)
+ (lambda [state]
+ (case (monad state)
+ (#Ok [?state ?datum])
+ (return* ?state (#Just ?datum))
+
+ (#Failure _)
+ (return* state #Nothing))))
+
+(def (repeat-m monad)
+ (lambda [state]
+ (case (monad state)
+ (#Ok [?state ?head])
+ (case ((repeat-m monad) ?state)
+ (#Ok [?state* ?tail])
+ (return* ?state* (#Cons ?head ?tail)))
+
+ (#Failure ?message)
+ (return* state #Nil))))
+
+(def (try-all-m monads)
+ (lambda [state]
+ (case monads
+ #Nil
+ (fail* "No alternative worked!")
+ (#Cons monad monads')
+ (let output (monad state)
+ (case output
+ (#Ok _)
+ output
+
+ (#Failure _)
+ (case monads'
+ #Nil
+ output
+ (#Cons _ _)
+ ((try-all-m monads') state))
+ ))
+ )))
+
+(def (map-m f inputs)
+ (case inputs
+ #Nil
+ (return #Nil)
+ (#Cons input inputs')
+ (exec [output (f input)
+ outputs (map-m f inputs')]
+ (return (#Cons output outputs)))))
+
(def (cons tail head)
(#Cons head tail))
@@ -257,7 +297,7 @@
## Program
(def (main args)
(case (' ((~ "Oh yeah...")))
- (#Form (#Cons (#Text text) #Nil))
+ (#Form (#Cons text #Nil))
(do (println text)
(println (+ 10 20))
(println (inc 10))