aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-03-08 12:44:42 -0400
committerEduardo Julian2015-03-08 12:44:42 -0400
commit57f89f16e95749e4ee4ad98a4e3d7a7908fb9a2f (patch)
treef132d6aa08184c2772e335fabae82167e3a68c3a
parent33f318849c0702b254eccf79f6ef9b7015e4537b (diff)
- The implementation of monadic macros is finally finished.
-rw-r--r--source/lux.lux134
-rw-r--r--src/lux.clj1
-rw-r--r--src/lux/analyser/lux.clj10
-rw-r--r--src/lux/compiler/lux.clj2
-rw-r--r--src/lux/macro.clj19
5 files changed, 85 insertions, 81 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 8aefa309a..24b5cb837 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -5,48 +5,48 @@
## Base functions & macros
(def' let'
(lambda' _ tokens
- (lambda' _ state
- (case' tokens
- (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
- [(#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
- #Nil])
- state])
- )))
+ (lambda' _ state
+ (case' tokens
+ (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
+ (#Ok [state
+ (#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
+ #Nil])]))
+ )))
(declare-macro let')
(def' lambda
(lambda' _ tokens
- (lambda' _ state
- (let' output (case' tokens
- (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])
- (#Form (#Cons [(#Ident "lambda'")
- (#Cons [(#Ident "")
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (#Form (#Cons [(#Ident "lux;lambda")
- (#Cons [(#Tuple args')
- (#Cons [body #Nil])])])))
- #Nil])])])]))
-
- (#Cons [(#Ident self) (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])])
- (#Form (#Cons [(#Ident "lambda'")
- (#Cons [(#Ident self)
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (#Form (#Cons [(#Ident "lux;lambda")
- (#Cons [(#Tuple args')
- (#Cons [body #Nil])])])))
- #Nil])])])])))
- [(#Cons [output #Nil]) state])
- )))
+ (lambda' _ state
+ (let' output (case' tokens
+ (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])
+ (#Form (#Cons [(#Ident "lambda'")
+ (#Cons [(#Ident "")
+ (#Cons [arg
+ (#Cons [(case' args'
+ #Nil
+ body
+
+ _
+ (#Form (#Cons [(#Ident "lux;lambda")
+ (#Cons [(#Tuple args')
+ (#Cons [body #Nil])])])))
+ #Nil])])])]))
+
+ (#Cons [(#Ident self) (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])])
+ (#Form (#Cons [(#Ident "lambda'")
+ (#Cons [(#Ident self)
+ (#Cons [arg
+ (#Cons [(case' args'
+ #Nil
+ body
+
+ _
+ (#Form (#Cons [(#Ident "lux;lambda")
+ (#Cons [(#Tuple args')
+ (#Cons [body #Nil])])])))
+ #Nil])])])])))
+ (#Ok [state (#Cons [output #Nil])]))
+ )))
(declare-macro lambda)
(def' def
@@ -64,7 +64,7 @@
(#Cons [(#Tuple args)
(#Cons [body #Nil])])])]))
#Nil])])])))
- [(#Cons [output #Nil]) state])))
+ (#Ok [state (#Cons [output #Nil])]))))
(declare-macro def)
(def (defmacro tokens state)
@@ -80,11 +80,11 @@
(#Cons [body
#Nil])])]))])
(let' declaration (#Form (#Cons [(#Ident "declare-macro") (#Cons [(#Ident fn-name) #Nil])]))
- [(#Cons [fn-def (#Cons [declaration #Nil])]) state])))
+ (#Ok [state (#Cons [fn-def (#Cons [declaration #Nil])])]))))
(declare-macro defmacro)
(defmacro (comment tokens state)
- [#Nil state])
+ (#Ok [state #Nil]))
(def (int+ x y)
(jvm-iadd x y))
@@ -121,9 +121,8 @@
(#Cons [(#Tuple (#Cons [head (#Cons [tail #Nil])]))
#Nil])])))
(#Tag "Nil")
- xs'
- )
- [(#Cons [output #Nil]) state])))
+ xs')
+ (#Ok [state (#Cons [output #Nil])]))))
(defmacro (list+ xs state)
(case' (reverse xs)
@@ -135,7 +134,7 @@
(#Form (list (#Tag "Cons") (#Tuple (list head tail)))))
last
init')
- [(#Cons [output #Nil]) state])))
+ (#Ok [state (#Cons [output #Nil])]))))
(def (as-pairs xs)
(case' xs
@@ -145,16 +144,16 @@
_
#Nil))
-## (defmacro (let tokens state)
-## (case' tokens
-## (#Cons [(#Tuple bindings) (#Cons [body #Nil])])
-## (let' output (fold (lambda [body binding]
-## (case' binding
-## [label value]
-## (#Form (list (#Ident "lux;let'") label value body))))
-## body
-## (reverse (as-pairs bindings)))
-## [(list output) state])))
+(defmacro (let tokens state)
+ (case' tokens
+ (#Cons [(#Tuple bindings) (#Cons [body #Nil])])
+ (let' output (fold (lambda [body binding]
+ (case' binding
+ [label value]
+ (#Form (list (#Ident "lux;let'") label value body))))
+ body
+ (reverse (as-pairs bindings)))
+ (#Ok [state (list output)]))))
(def (++ xs ys)
(case' xs
@@ -216,16 +215,16 @@
))
(defmacro (` tokens state)
- [(list (untemplate-list (map untemplate tokens)))
- state])
+ (#Ok [state
+ (list (untemplate-list (map untemplate tokens)))]))
(defmacro (if tokens state)
(case' tokens
(#Cons [test (#Cons [then (#Cons [else #Nil])])])
- [(` (case' (~ test)
- true (~ then)
- false (~ else)))
- state]))
+ (#Ok [state
+ (` (case' (~ test)
+ true (~ then)
+ false (~ else)))])))
(def (filter p xs)
(case' xs
@@ -239,13 +238,20 @@
(def (return val)
(lambda [state]
- [state val]))
+ (#Ok [state val])))
+
+(def (fail msg)
+ (lambda [_]
+ (#Error msg)))
(def (bind f v)
(lambda [state]
(case' (v state)
- [state' x]
- ((f x) state'))))
+ (#Ok [state' x])
+ (f x state')
+
+ (#Error msg)
+ (#Error msg))))
#(
diff --git a/src/lux.clj b/src/lux.clj
index ce843d0cd..888618de6 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -3,7 +3,6 @@
:reload-all))
(comment
- ;; TODO: Make macros monadic.
;; TODO: Finish type system.
;; TODO: Re-implement compiler in language.
;; TODO: Adding metadata to global vars.
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 570048dcd..75b6f375a 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -60,13 +60,9 @@
[::&&/global ?module ?name]
(exec [macro? (&&def/macro? ?module ?name)]
(if macro?
- (let [macro-class (&host/location (list ?module ?name))
- [macro-expansion state*] (&macro/expand loader macro-class ?args)
- ;; _ (prn 'macro-expansion)
- ;; _ (doseq [ast macro-expansion]
- ;; (prn '=> ast))
- ]
- (mapcat-m analyse macro-expansion))
+ (let [macro-class (&host/location (list ?module ?name))]
+ (exec [macro-expansion (&macro/expand loader macro-class ?args)]
+ (mapcat-m analyse macro-expansion)))
(exec [=args (mapcat-m analyse ?args)]
(return (list [::&&/Expression [::&&/call =fn =args] &type/+dont-care-type+])))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index f85d2f7a5..7e9e55b23 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -87,7 +87,7 @@
(return nil)))
(defn compile-captured [compile *type* ?scope ?captured-id ?source]
- (prn 'compile-captured ?scope ?captured-id)
+ ;; (prn 'compile-captured ?scope ?captured-id)
(exec [*writer* &/get-writer
:let [_ (doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
diff --git a/src/lux/macro.clj b/src/lux/macro.clj
index 071f95691..9f42d6402 100644
--- a/src/lux/macro.clj
+++ b/src/lux/macro.clj
@@ -1,6 +1,7 @@
(ns lux.macro
(:require [clojure.core.match :refer [match]]
- [lux.parser :as &parser]))
+ (lux [base :as & :refer [fail* return*]]
+ [parser :as &parser])))
;; [Utils]
(defn ^:private ->lux+ [->lux loader xs]
@@ -63,10 +64,12 @@
;; [Resources]
(defn expand [loader macro-class tokens]
- (let [output (-> (.loadClass loader macro-class)
- (.getField "_datum")
- (.get nil)
- (.apply (->lux+ ->lux loader tokens))
- (.apply nil))]
- [(->clojure+ ->clojure (aget output 0))
- (aget output 1)]))
+ (fn [state]
+ (let [output (-> (.loadClass loader macro-class)
+ (.getField "_datum")
+ (.get nil)
+ (.apply (->lux+ ->lux loader tokens))
+ (.apply state))]
+ (case (aget output 0)
+ "Ok" (return* (aget output 1 0) (->clojure+ ->clojure (aget output 1 1)))
+ "Error" (fail* (aget output 1))))))