From 57f89f16e95749e4ee4ad98a4e3d7a7908fb9a2f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 8 Mar 2015 12:44:42 -0400 Subject: - The implementation of monadic macros is finally finished. --- source/lux.lux | 134 +++++++++++++++++++++++++---------------------- src/lux.clj | 1 - src/lux/analyser/lux.clj | 10 ++-- src/lux/compiler/lux.clj | 2 +- src/lux/macro.clj | 19 ++++--- 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*] (¯o/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 (¯o/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)))))) -- cgit v1.2.3