aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux427
-rw-r--r--src/lux/analyser/def.clj65
-rw-r--r--src/lux/analyser/lux.clj163
-rw-r--r--src/lux/analyser/module.clj76
-rw-r--r--src/lux/compiler.clj8
-rw-r--r--src/lux/compiler/lux.clj196
-rw-r--r--src/lux/lexer.clj6
7 files changed, 488 insertions, 453 deletions
diff --git a/source/lux.lux b/source/lux.lux
index c5a532a2a..36e678886 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -245,12 +245,12 @@
(lambda' _ data
(#Meta [["" -1 -1] data]))))
-## (def (return' x)
+## (def (return x)
## (All [a]
## (-> a CompilerState
## (Either Text (, CompilerState a))))
## ...)
-(def' return'
+(def' return
(:' (#AllT [#None "" "a"
(#LambdaT [(#BoundT "a")
(#LambdaT [CompilerState
@@ -262,12 +262,12 @@
(lambda' _ state
(#Right [state val])))))
-## (def (fail' msg)
+## (def (fail msg)
## (All [a]
## (-> Text CompilerState
## (Either Text (, CompilerState a))))
## ...)
-(def' fail'
+(def' fail
(:' (#AllT [#None "" "a"
(#LambdaT [Text
(#LambdaT [CompilerState
@@ -284,7 +284,7 @@
## (lambda' _ tokens
## (case' tokens
## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
-## (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
+## (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])))
## #Nil]))
@@ -295,52 +295,52 @@
(lambda' _ tokens
(case' tokens
(#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
- (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
+ (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])))
+ #Nil])))
_
- (fail' "Wrong syntax for let'")))))
+ (fail "Wrong syntax for let'")))))
(def' lambda
(:' Macro
(lambda' _ tokens
(case' tokens
(#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
- (#Cons [(_meta (#Symbol ["" ""]))
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
- (#Cons [(_meta (#Tuple args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
+ (#Cons [(_meta (#Symbol ["" ""]))
+ (#Cons [arg
+ (#Cons [(case' args'
+ #Nil
+ body
+
+ _
+ (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
+ (#Cons [(_meta (#Tuple args'))
+ (#Cons [body #Nil])])]))))
+ #Nil])])])])))
+ #Nil])))
(#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
- (#Cons [(_meta (#Symbol self))
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
- (#Cons [(_meta (#Tuple args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
+ (#Cons [(_meta (#Symbol self))
+ (#Cons [arg
+ (#Cons [(case' args'
+ #Nil
+ body
+
+ _
+ (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
+ (#Cons [(_meta (#Tuple args'))
+ (#Cons [body #Nil])])]))))
+ #Nil])])])])))
+ #Nil])))
_
- (fail' "Wrong syntax for lambda")))))
+ (fail "Wrong syntax for lambda")))))
(export' lambda)
(def' def
@@ -348,50 +348,50 @@
(lambda [tokens]
(case' tokens
(#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens])))
+ #Nil])))
(#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))])
(#Cons [body #Nil])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
- (#Cons [(_meta (#Symbol name))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
- (#Cons [(_meta (#Symbol name))
- (#Cons [(_meta (#Tuple args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
+ (#Cons [(_meta (#Symbol name))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
+ (#Cons [(_meta (#Symbol name))
+ (#Cons [(_meta (#Tuple args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])))
(#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type (#Cons [body #Nil])])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
- (#Cons [(_meta (#Symbol name))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- #Nil])])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
+ (#Cons [(_meta (#Symbol name))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])))
+ #Nil])))
(#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))])
(#Cons [type (#Cons [body #Nil])])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
- (#Cons [(_meta (#Symbol name))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
- (#Cons [type
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
- (#Cons [(_meta (#Symbol name))
- (#Cons [(_meta (#Tuple args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
+ (#Cons [(_meta (#Symbol name))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
+ (#Cons [type
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
+ (#Cons [(_meta (#Symbol name))
+ (#Cons [(_meta (#Tuple args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])])])))
+ #Nil])))
_
- (fail' "Wrong syntax for def")
+ (fail "Wrong syntax for def")
))))
(export' def)
@@ -400,107 +400,99 @@
(case' tokens
(#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol fn-name)]) args]))])
(#Cons [body #Nil])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"]))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args])))
- (#Cons [(_meta (#Symbol ["lux" "Macro"]))
- (#Cons [body
- #Nil])])
- ])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"]))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args])))
+ (#Cons [(_meta (#Symbol ["lux" "Macro"]))
+ (#Cons [body
+ #Nil])])
+ ])])))
+ #Nil])))
_
- (fail' "Wrong syntax for defmacro")))
+ (fail "Wrong syntax for defmacro")))
(defmacro (comment tokens)
- (return' (:' SyntaxList #Nil)))
+ (return (:' SyntaxList #Nil)))
(export' comment)
(defmacro (->' tokens)
(case' tokens
(#Cons [input (#Cons [output #Nil])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
- (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])])))
- #Nil])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
+ (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])])))
+ #Nil])])))
+ #Nil])))
(#Cons [input (#Cons [output others])])
- (return' (:' SyntaxList(#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
- (#Cons [(_meta (#Tuple (#Cons [input
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"]))
- (#Cons [output others])])))
- #Nil])])))
- #Nil])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
+ (#Cons [(_meta (#Tuple (#Cons [input
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"]))
+ (#Cons [output others])])))
+ #Nil])])))
+ #Nil])])))
+ #Nil])))
_
- (fail' "Wrong syntax for ->'")))
-
-(def (int:+ x y)
- (->' Int Int Int)
- (jvm-ladd x y))
+ (fail "Wrong syntax for ->'")))
(defmacro (All' tokens)
(case' tokens
(#Cons [(#Meta [_ (#Tuple #Nil)])
(#Cons [body #Nil])])
- (return' (:' SyntaxList
- (#Cons [body
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [body
+ #Nil])))
(#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))])
(#Cons [body #Nil])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"]))
- (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"]))
- (#Cons [(_meta (#Text ""))
- (#Cons [(_meta (#Text arg-name))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"]))
- (#Cons [(_meta (#Tuple other-args))
- (#Cons [body
- #Nil])])])))
- #Nil])])])])))
- #Nil])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"]))
+ (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"]))
+ (#Cons [(_meta (#Text ""))
+ (#Cons [(_meta (#Text arg-name))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"]))
+ (#Cons [(_meta (#Tuple other-args))
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])])))
+ #Nil])])))
+ #Nil])))
_
- (fail' "Wrong syntax for All'")))
+ (fail "Wrong syntax for All'")))
(defmacro (B' tokens)
(case' tokens
(#Cons [(#Meta [_ (#Symbol ["" bound-name])])
#Nil])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"]))
- (#Cons [(_meta (#Text bound-name))
- #Nil])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"]))
+ (#Cons [(_meta (#Text bound-name))
+ #Nil])])))
+ #Nil])))
_
- (fail' "Wrong syntax for B'")))
+ (fail "Wrong syntax for B'")))
(defmacro ($' tokens)
(case' tokens
(#Cons [x #Nil])
- (return' tokens)
+ (return tokens)
(#Cons [x (#Cons [y xs])])
- (return' (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"]))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"]))
- (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])])))
- #Nil])])))
- xs])])))
- #Nil])))
+ (return (:' SyntaxList
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"]))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"]))
+ (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])])))
+ #Nil])])))
+ xs])])))
+ #Nil])))
_
- (fail' "Wrong syntax for $'")))
-
-(def (id x)
- (All' [a] (->' (B' a) (B' a)))
- x)
-(export' id)
+ (fail "Wrong syntax for $'")))
(def (fold f init xs)
(All' [a b]
@@ -515,7 +507,7 @@
(#Cons [x xs'])
(fold f (f init x) xs')))
-(def (reverse' list)
+(def (reverse list)
(All' [a]
(->' ($' List (B' a)) ($' List (B' a))))
(fold (:' (All' [a]
@@ -526,38 +518,38 @@
list))
(defmacro (list xs)
- (return' (:' SyntaxList
- (#Cons [(fold (:' (->' Syntax Syntax Syntax)
- (lambda [tail head]
- (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"]))
- (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])])))
- #Nil])])))))
- (_meta (#Tag ["lux" "Nil"]))
- (reverse' xs))
- #Nil]))))
+ (return (:' SyntaxList
+ (#Cons [(fold (:' (->' Syntax Syntax Syntax)
+ (lambda [tail head]
+ (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"]))
+ (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])])))
+ #Nil])])))))
+ (_meta (#Tag ["lux" "Nil"]))
+ (reverse xs))
+ #Nil]))))
(export' list)
(defmacro (list& xs)
- (case' (reverse' xs)
+ (case' (reverse xs)
(#Cons [last init])
- (return' (:' SyntaxList
- (list (fold (:' (->' Syntax Syntax Syntax)
- (lambda [tail head]
- (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
- (_meta (#Tuple (list head tail))))))))
- last
- init))))
+ (return (:' SyntaxList
+ (list (fold (:' (->' Syntax Syntax Syntax)
+ (lambda [tail head]
+ (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
+ (_meta (#Tuple (list head tail))))))))
+ last
+ init))))
_
- (fail' "Wrong syntax for list&")))
+ (fail "Wrong syntax for list&")))
(export' list&)
-(def (as-pairs' xs)
+(def (as-pairs xs)
(All' [a]
(->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
(case' xs
(#Cons [x (#Cons [y xs'])])
- (list& [x y] (as-pairs' xs'))
+ (list& [x y] (as-pairs xs'))
_
#Nil))
@@ -565,23 +557,23 @@
(defmacro (let tokens)
(case' tokens
(#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])
- (return' (:' SyntaxList
- (list (fold (:' (->' Syntax (#TupleT (list Syntax Syntax))
- Syntax)
- (lambda [body binding]
- (case' binding
- [label value]
- (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))))
- body
- (fold (:' (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax))
- ($' List (#TupleT (list Syntax Syntax))))
- (lambda [tail head]
- (#Cons [head tail])))
- #Nil
- (as-pairs' bindings))))))
+ (return (:' SyntaxList
+ (list (fold (:' (->' Syntax (#TupleT (list Syntax Syntax))
+ Syntax)
+ (lambda [body binding]
+ (case' binding
+ [label value]
+ (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))))
+ body
+ (fold (:' (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax))
+ ($' List (#TupleT (list Syntax Syntax))))
+ (lambda [tail head]
+ (#Cons [head tail])))
+ #Nil
+ (as-pairs bindings))))))
_
- (fail' "Wrong syntax for let")))
+ (fail "Wrong syntax for let")))
(export' let)
(def (map f xs)
@@ -654,54 +646,57 @@
(defmacro (` tokens)
(case' tokens
(#Cons [template #Nil])
- (return' (:' SyntaxList
- (list (untemplate template))))
+ (return (:' SyntaxList
+ (list (untemplate template))))
_
- (fail' "Wrong syntax for `")))
+ (fail "Wrong syntax for `")))
(export' `)
(defmacro (if tokens)
(case' tokens
(#Cons [test (#Cons [then (#Cons [else #Nil])])])
- (return' (:' SyntaxList
- (list (` (case' (~ test)
- true (~ then)
- false (~ else))))))
+ (return (:' SyntaxList
+ (list (` (case' (~ test)
+ true (~ then)
+ false (~ else))))))
_
- (fail' "Wrong syntax for if")))
+ (fail "Wrong syntax for if")))
(export' if)
-## (defmacro (, tokens)
-## (let [elems (fold (:' (->' Syntax Syntax Syntax)
-## (lambda [tail head]
-## (` (#Cons [(~ head) (~ tail)]))))
-## (` #Nil)
-## (reverse' tokens))]
-## (return' (list (` (#TupleT (~ elems)))))))
-## (export' ,)
+## (def (id x)
+## (All [a] (-> a a))
+## x)
+## (export' id)
## (defmacro (^ tokens)
## (case' tokens
## (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil])
-## (return' (list (` (#DataT (~ (_meta (#Text class-name)))))))
+## (return (:' SyntaxList
+## (list (` (#DataT (~ (_meta (#Text class-name))))))))
## _
-## (fail' "Wrong syntax for ^")))
+## (fail "Wrong syntax for ^")))
## (export' ^)
-## (defmacro (-> tokens)
-## (case' (reverse' tokens)
-## (#Cons [f-return f-args])
-## (fold (:' (->' Syntax Syntax Syntax)
-## (lambda [f-return f-arg]
-## (` (#LambdaT [(~ f-arg) (~ f-return)]))))
-## f-return
-## f-args)
+## (defmacro (, tokens)
+## (return (:' SyntaxList
+## (list (` (#TupleT (list (~@ tokens))))))))
+## (export' ,)
+## (defmacro (-> tokens)
+## (case' (reverse tokens)
+## (#Cons [output inputs])
+## (return (:' SyntaxList
+## (list (fold (:' (->' Syntax Syntax Syntax)
+## (lambda [o i]
+## (` (#;LambdaT [(~ i) (~ o)]))))
+## output
+## inputs))))
+
## _
-## (fail' "Wrong syntax for ^")))
+## (fail "Wrong syntax for ->")))
## (export' ->)
## (defmacro (| members)
@@ -714,7 +709,7 @@
## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))])
## (` [(~ ($ text-++ module ";" name)) (~ value)]))))
## members)]
-## (return' (list (` (#VariantT (~ (untemplate-list members))))))))
+## (return (list (` (#VariantT (~ (untemplate-list members))))))))
## (export' |)
## (defmacro (& members)
@@ -724,7 +719,7 @@
## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))])
## (` [(~ ($ text-++ module ";" name)) (~ value)]))))
## members)]
-## (return' (list (` (#RecordT (~ (untemplate-list members))))))))
+## (return (list (` (#RecordT (~ (untemplate-list members))))))))
## (export' &)
## (def (text:= x y)
@@ -732,6 +727,10 @@
## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object]
## x [y]))
+## (def #export (int:+ x y)
+## (-> Int Int Int)
+## (jvm-ladd x y))
+
## (def (replace-ident ident value syntax)
## (-> (, Text Text) Syntax Syntax Syntax)
## (let [[module name] ident]
@@ -776,7 +775,7 @@
## args)]
## (case' rolled
## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "AllT"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))])
-## (return' (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name))
+## (return (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name))
## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name))))
## body)))))))))
## (export' All)
@@ -876,7 +875,7 @@
## (walk-type expansion')
## _
-## (fail' "Macro can't expand to more than 1 output.")))
+## (fail "Macro can't expand to more than 1 output.")))
## #None
## (do' [args' (map% walk-type args)]
@@ -890,35 +889,35 @@
## ...
## (#Meta [_ (#Symbol _)])
-## (return' type)
+## (return type)
## _
-## (fail' "Wrong syntax for walk-type")))
+## (fail "Wrong syntax for walk-type")))
## (defmacro (->type tokens)
## (case' tokens
## (#Cons [type #Nil])
## (do' [type' (walk-type type)]
-## (return' (list type')))
+## (return (list type')))
## _
-## (fail' "Wrong syntax for ->type")))
+## (fail "Wrong syntax for ->type")))
## (defmacro (: tokens)
## (case' tokens
## (#Cons [type (#Cons [value #Nil])])
-## (return' (list (` (:' (->type (~ type)) (~ value)))))
+## (return (list (` (:' (->type (~ type)) (~ value)))))
## _
-## (fail' "Wrong syntax for :")))
+## (fail "Wrong syntax for :")))
## (defmacro (:! tokens)
## (case' tokens
## (#Cons [type (#Cons [value #Nil])])
-## (return' (list (` (:!' (->type (~ type)) (~ value)))))
+## (return (list (` (:!' (->type (~ type)) (~ value)))))
## _
-## (fail' "Wrong syntax for :!")))
+## (fail "Wrong syntax for :!")))
@@ -1621,17 +1620,17 @@
## #None
## (do' [flat-map% (map% walk-syntax args)]
-## (return' (list (fold (lambda [fun arg]
+## (return (list (fold (lambda [fun arg]
## (` (#AppT [(~ fun) (~ arg)])))
## op
## args))))))
## _
## (do' [flat-map% (map% walk-syntax args)]
-## (return' (list (_meta (#Form (list op args')))))))
+## (return (list (_meta (#Form (list op args')))))))
## _
-## (return' (list type))))
+## (return (list type))))
## (defsyntax #export (type type-syntax)
## (walk-syntax type-syntax))
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj
deleted file mode 100644
index c44a7ea36..000000000
--- a/src/lux/analyser/def.clj
+++ /dev/null
@@ -1,65 +0,0 @@
-(ns lux.analyser.def
- (:require (clojure [template :refer [do-template]])
- [clojure.core.match :as M :refer [matchv]]
- clojure.core.match.array
- (lux [base :as & :refer [|do return return* fail]])
- [lux.analyser.base :as &&]))
-
-(def $DEFS 0)
-(def $MACROS 1)
-
-;; [Exports]
-(def init-module
- (&/R ;; "lux;defs"
- (&/|table)
- ;; "lux;macros"
- (&/|table)))
-
-(do-template [<name> <category>]
- (defn <name> [module name]
- (fn [state]
- (return* state
- (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ <category>) (&/|contains? name)))))
-
- defined? $DEFS
- macro? $MACROS
- )
-
-(defn declare-macro [module name]
- (fn [state]
- (return* (&/update$ &/$MODULES (fn [ms] (&/|update module (fn [m] (&/update$ $MACROS #(&/|put name true %) m)) ms)) state)
- nil)))
-
-(defn define [module name type]
- (fn [state]
- (let [full-name (str module &/+name-separator+ name)
- bound (&/V "Expression" (&/T (&/V "global" (&/T module name)) type))]
- (matchv ::M/objects [(&/get$ &/$ENVS state)]
- [["lux;Cons" [?env ["lux;Nil" _]]]]
- (return* (->> state
- (&/update$ &/$MODULES (fn [ms]
- (&/|update module (fn [m]
- (&/update$ $DEFS #(&/|put full-name type %)
- m))
- ms)))
- (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
- (&/update$ &/$MAPPINGS (fn [mappings]
- (&/|put (str "" &/+name-separator+ name) bound mappings))
- locals))
- ?env))))
- nil)
-
- [_]
- (fail "[Analyser Error] Can't create a new global definition outside of a global environment."))
- )))
-
-(defn module-exists? [name]
- (fn [state]
- (return* state
- (->> state (&/get$ &/$MODULES) (&/|contains? name)))))
-
-(defn unalias-module [name]
- (fn [state]
- (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))]
- (return* state real-name)
- (fail "Unknown alias."))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 1761ec1a2..e2d56c3e0 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -11,7 +11,7 @@
[lambda :as &&lambda]
[case :as &&case]
[env :as &&env]
- [def :as &&def])))
+ [module :as &&module])))
(defn ^:private analyse-1+ [analyse ?token]
(&type/with-var
@@ -95,48 +95,60 @@
&/|keys &/->seq (interpose " ") (reduce str ""))
"}}"))
-(defn ^:private type-test [exo-type binding]
- (|do [btype (&&/expr-type binding)
- o?? (&type/is-Type? exo-type)]
- (if o??
- (|do [i?? (&type/is-Type? btype)]
- (if i??
- (do ;; (println "FOUND TWO TYPES!")
- (return (&/|list binding)))
- (fail "[Type Error] Types don't match.")))
- (|do [_ (&type/check exo-type btype)]
- (return (&/|list binding))))))
-
(defn analyse-symbol [analyse exo-type ident]
(|do [module-name &/get-module-name]
(fn [state]
(|let [[?module ?name] ident
+ ;; _ (prn 'analyse-symbol ?module ?name)
local-ident (str ?module ";" ?name)
- global-ident (str (if (= "" ?module) module-name ?module) ";" ?name)
stack (&/get$ &/$ENVS state)
no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)
(->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not))
[inner outer] (&/|split-with no-binding? stack)]
(matchv ::M/objects [outer]
[["lux;Nil" _]]
- (if-let [module-env (->> state
- (&/get$ &/$MODULES)
- (&/|get (if (= "" ?module) module-name ?module)))]
- (if-let [def-type (do ;; (->> module-env (&/get$ &&def/$DEFS) &/|keys &/->seq (prn 'module-env global-ident))
- (->> module-env (&/get$ &&def/$DEFS) (&/|get global-ident)))]
- (do ;; (prn 'GOT_DEF-TYPE global-ident)
- (return* state (&/|list (&/V "Expression" (&/T (&/V "global" (&/T (if (= "" ?module) module-name ?module) ?name))
- def-type)))))
- (fail* (str "[Analyser Error] Unknown module: " (if (= "" ?module) module-name ?module))))
- (fail* (str "[Analyser Error] Unrecognized identifier: " local-ident)))
+ (&/run-state (|do [$def (&&module/find-def (if (= "" ?module) module-name ?module)
+ ?name)
+ ;; :let [_ (println "Found def:" (if (= "" ?module) module-name ?module)
+ ;; ?name)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" ?type]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro))
+ ;; :let [_ (println "Got endo-type:" endo-type)]
+ _ (&type/check exo-type endo-type)
+ ;; :let [_ (println "Type-checked:" exo-type endo-type)]
+ ]
+ (return (&/|list (&/V "Expression" (&/T (&/V "global" (&/T (if (= "" ?module) module-name ?module)
+ ?name))
+ endo-type)))))
+ state)
[["lux;Cons" [?genv ["lux;Nil" _]]]]
(if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
- (&/run-state (type-test exo-type global)
- ;; (|do [btype (&&/expr-type global)
- ;; _ (&type/check exo-type btype)]
- ;; (return (&/|list global)))
- state)
+ (do ;; (prn 'GOT_GLOBAL local-ident)
+ (matchv ::M/objects [global]
+ [["Expression" [["global" [?module* ?name*]] _]]]
+ (&/run-state (|do [$def (&&module/find-def ?module* ?name*)
+ ;; :let [_ (println "Found def:" ?module* ?name*)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" ?type]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro))
+ ;; :let [_ (println "Got endo-type:" endo-type)]
+ _ (&type/check exo-type endo-type)
+ ;; :let [_ (println "Type-checked:" exo-type endo-type)]
+ ]
+ (return (&/|list (&/V "Expression" (&/T (&/V "global" (&/T ?module* ?name*))
+ endo-type)))))
+ state)
+
+ [_]
+ (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")))
(fail* ""))
[["lux;Cons" [top-outer _]]]
@@ -152,10 +164,9 @@
(->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
(&/|list))
(&/zip2 (&/|reverse inner) scopes))]
- (&/run-state (type-test exo-type =local)
- ;; (|do [btype (&&/expr-type =local)
- ;; _ (&type/check exo-type btype)]
- ;; (return (&/|list =local)))
+ (&/run-state (|do [btype (&&/expr-type =local)
+ _ (&type/check exo-type btype)]
+ (return (&/|list =local)))
(&/set$ &/$ENVS (&/|++ inner* outer) state)))
)))
))
@@ -175,31 +186,31 @@
[["lux;Cons" [?arg ?args*]]]
(do ;; (prn 'analyse-apply*/=fn (&type/show-type ?fun-type))
- (matchv ::M/objects [?fun-type]
- [["lux;AllT" _]]
- (&type/with-var
- (fn [$var]
- (|do [type* (&type/apply-type ?fun-type $var)
- output (analyse-apply* analyse exo-type (&/V "Expression" (&/T ?fun-expr type*)) ?args)]
- (matchv ::M/objects [output]
- [["lux;Cons" [["Expression" [?expr* ?type*]] ["lux;Nil" _]]]]
- (|do [type** (&type/clean $var ?type*)]
- (return (&/|list (&/V "Expression" (&/T ?expr* type**)))))
-
- [_]
- (assert false (prn-str 'analyse-apply*/output (aget output 0)))))))
-
- [["lux;LambdaT" [?input-t ?output-t]]]
- ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
- ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
- ;; ?output-t)))))
- (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
- (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
- ?output-t))
- ?args*))
-
- [_]
- (fail "[Analyser Error] Can't apply a non-function.")))
+ (matchv ::M/objects [?fun-type]
+ [["lux;AllT" _]]
+ (&type/with-var
+ (fn [$var]
+ (|do [type* (&type/apply-type ?fun-type $var)
+ output (analyse-apply* analyse exo-type (&/V "Expression" (&/T ?fun-expr type*)) ?args)]
+ (matchv ::M/objects [output]
+ [["lux;Cons" [["Expression" [?expr* ?type*]] ["lux;Nil" _]]]]
+ (|do [type** (&type/clean $var ?type*)]
+ (return (&/|list (&/V "Expression" (&/T ?expr* type**)))))
+
+ [_]
+ (assert false (prn-str 'analyse-apply*/output (aget output 0)))))))
+
+ [["lux;LambdaT" [?input-t ?output-t]]]
+ ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
+ ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
+ ;; ?output-t)))))
+ (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
+ (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
+ ?output-t))
+ ?args*))
+
+ [_]
+ (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type)))))
)))
(defn analyse-apply [analyse exo-type =fn ?args]
@@ -210,16 +221,18 @@
(do ;; (prn 'analyse-apply2 (aget =fn-form 0))
(matchv ::M/objects [=fn-form]
[["global" [?module ?name]]]
- (|do [macro? (&&def/macro? ?module ?name)]
- (if macro?
- (let [macro-class (&host/location (&/|list ?module ?name))]
- (|do [macro-expansion (&macro/expand loader macro-class ?args)
- ;; :let [_ (when (and (= "lux" ?module)
- ;; (= "`" ?name))
- ;; (prn 'macro-expansion (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))]
- ;; :let [_ (prn 'EXPANDING (&type/show-type exo-type))]
- output (&/flat-map% (partial analyse exo-type) macro-expansion)]
- (return output)))
+ (|do [$def (&&module/find-def ?module ?name)]
+ (matchv ::M/objects [$def]
+ [["lux;MacroD" _macro]]
+ (matchv ::M/objects [_macro]
+ [["lux;Some" macro]]
+ (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))]
+ (&/flat-map% (partial analyse exo-type) macro-expansion))
+
+ [["lux;None" _]]
+ (fail (str "[Analyser Error] Macro has yet to be compiled: " (str ?module ";" ?name))))
+
+ [_]
(analyse-apply* analyse exo-type =fn ?args)))
[_]
@@ -281,7 +294,7 @@
(defn analyse-def [analyse ?name ?value]
(prn 'analyse-def/CODE ?name (&/show-ast ?value))
(|do [module-name &/get-module-name
- ? (&&def/defined? module-name ?name)]
+ ? (&&module/defined? module-name ?name)]
(if ?
(fail (str "[Analyser Error] Can't redefine " ?name))
(|do [;; :let [_ (prn 'analyse-def/_0)]
@@ -291,14 +304,14 @@
=value-type (&&/expr-type =value)
;; :let [_ (prn 'analyse-def/_2)]
:let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type))
- _ (println)]
- _ (&&def/define module-name ?name =value-type)
- _ (if (&type/type= &type/Macro =value-type)
- (&&def/declare-macro module-name ?name)
- (return nil))
+ _ (println)
+ def-data (if (&type/type= &type/Macro =value-type)
+ (&/V "lux;MacroD" (&/V "lux;None" nil))
+ (&/V "lux;ValueD" =value-type))]
+ _ (&&module/define module-name ?name def-data)
;; :let [_ (prn 'analyse-def/_3)]
]
- (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value)))))))))
+ (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value def-data)))))))))
(defn analyse-import [analyse exo-type ?path]
(return (&/|list)))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
new file mode 100644
index 000000000..944e98580
--- /dev/null
+++ b/src/lux/analyser/module.clj
@@ -0,0 +1,76 @@
+(ns lux.analyser.module
+ (:require [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [|do return return* fail fail*]]
+ [type :as &type])
+ [lux.analyser.base :as &&]))
+
+;; [Exports]
+(def init-module
+ (&/|table))
+
+(defn define [module name def-data]
+ (fn [state]
+ (matchv ::M/objects [(&/get$ &/$ENVS state)]
+ [["lux;Cons" [?env ["lux;Nil" _]]]]
+ (return* (->> state
+ (&/update$ &/$MODULES (fn [ms]
+ (&/|update module #(&/|put name def-data %)
+ ms)))
+ (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
+ (&/update$ &/$MAPPINGS (fn [mappings]
+ (&/|put (str "" &/+name-separator+ name)
+ (&/V "Expression" (&/T (&/V "global" (&/T module name)) &type/$Void))
+ mappings))
+ locals))
+ ?env))))
+ nil)
+
+ [_]
+ (fail "[Analyser Error] Can't create a new global definition outside of a global environment."))))
+
+(defn exists? [name]
+ (fn [state]
+ (return* state
+ (->> state (&/get$ &/$MODULES) (&/|contains? name)))))
+
+(defn dealias [name]
+ (fn [state]
+ (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))]
+ (return* state real-name)
+ (fail (str "Unknown alias: " name)))))
+
+(defn find-def [module name]
+ (fn [state]
+ (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [$def (&/|get name $module)]
+ (return* state $def)
+ (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
+ (fail* (str "[Analyser Error] Module doesn't exist: " module)))))
+
+(defn defined? [module name]
+ (&/try-all% (&/|list (|do [_ (find-def module name)]
+ (return true))
+ (return false))))
+
+(defn install-macro [module name macro]
+ (fn [state]
+ (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [$def (&/|get name $module)]
+ (matchv ::M/objects [$def]
+ [["lux;MacroD" ["lux;None" _]]]
+ (return* (&/update$ &/$MODULES
+ (fn [$modules]
+ (&/|put module (&/|put name (&/V "lux;MacroD" (&/V "lux;Some" macro)) $module)
+ $modules))
+ state)
+ nil)
+
+ [["lux;MacroD" ["lux;Some" _]]]
+ (fail* (str "[Analyser Error] Can't re-install a macro: " (str module &/+name-separator+ name)))
+
+ [_]
+ (fail* (str "[Analyser Error] Can't install a non-macro: " (str module &/+name-separator+ name))))
+ (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
+ (fail* (str "[Analyser Error] Module doesn't exist: " module)))
+ ))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 7bd31779a..59e3d9c36 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -14,7 +14,7 @@
[optimizer :as &optimizer]
[host :as &host])
[lux.analyser.base :as &a]
- [lux.analyser.def :as &a-def]
+ [lux.analyser.module :as &a-module]
(lux.compiler [base :as &&]
[lux :as &&lux]
[host :as &&host]
@@ -315,8 +315,8 @@
[["Statement" ?form]]
(do ;; (prn 'compile-statement (aget syntax 0) (aget ?form 0))
(matchv ::M/objects [?form]
- [["def" [?name ?body]]]
- (&&lux/compile-def compile-expression ?name ?body)
+ [["def" [?name ?body ?def-data]]]
+ (&&lux/compile-def compile-expression ?name ?body ?def-data)
[["jvm-interface" [?package ?name ?methods]]]
(&&host/compile-jvm-interface compile-expression ?package ?name ?methods)
@@ -375,7 +375,7 @@
(&/set$ &/$SOURCE (&/V "lux;Some" (&reader/from (str "source/" name ".lux"))))
(&/set$ &/$ENVS (&/|list (&/env name)))
(&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
- (&/update$ &/$MODULES #(&/|put name &a-def/init-module %))))]
+ (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))]
[["lux;Right" [?state _]]]
(do (.visitEnd =class)
;; (prn 'compile-module 'DONE name)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 2417a0459..f9a56e74e 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -10,7 +10,8 @@
[parser :as &parser]
[analyser :as &analyser]
[host :as &host])
- [lux.analyser.base :as &a]
+ (lux.analyser [base :as &a]
+ [module :as &a-module])
(lux.compiler [base :as &&]
[lambda :as &&lambda])
;; :reload
@@ -25,18 +26,18 @@
+sig+ (&host/->type-signature "java.lang.Boolean")]
(defn compile-bool [compile *type* ?value]
(|do [*writer* &/get-writer
- :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]]
(return nil))))
(do-template [<name> <class> <sig> <caster>]
(let [+class+ (&host/->class <class>)]
(defn <name> [compile *type* value]
(|do [*writer* &/get-writer
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/NEW +class+)
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (<caster> value))
- (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "<init>" <sig>))]]
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW +class+)
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (<caster> value))
+ (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "<init>" <sig>))]]
(return nil))))
compile-int "java.lang.Long" "(J)V" long
@@ -46,121 +47,132 @@
(defn compile-text [compile *type* ?value]
(|do [*writer* &/get-writer
- :let [_ (.visitLdcInsn *writer* ?value)]]
+ :let [_ (.visitLdcInsn *writer* ?value)]]
(return nil)))
(defn compile-tuple [compile *type* ?elems]
(|do [*writer* &/get-writer
- :let [num-elems (&/|length ?elems)
- _ (doto *writer*
- (.visitLdcInsn (int num-elems))
- (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (&/map% (fn [idx+elem]
- (|let [[idx elem] idx+elem]
- (|do [:let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx)))]
- ret (compile elem)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret))))
- (&/zip2 (&/|range num-elems) ?elems))]
+ :let [num-elems (&/|length ?elems)
+ _ (doto *writer*
+ (.visitLdcInsn (int num-elems))
+ (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
+ _ (&/map% (fn [idx+elem]
+ (|let [[idx elem] idx+elem]
+ (|do [:let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx)))]
+ ret (compile elem)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret))))
+ (&/zip2 (&/|range num-elems) ?elems))]
(return nil)))
(defn compile-record [compile *type* ?elems]
(|do [*writer* &/get-writer
- :let [num-elems (&/|length ?elems)
- _ (doto *writer*
- (.visitLdcInsn (int (* 2 num-elems)))
- (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (&/map% (fn [idx+kv]
- (|let [[idx [k v]] idx+kv]
- (|do [:let [idx* (* 2 idx)
- _ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx*))
- (.visitLdcInsn k)
- (.visitInsn Opcodes/AASTORE))]
- :let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int (inc idx*))))]
- ret (compile v)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret))))
- (&/zip2 (&/|range num-elems) ?elems))]
+ :let [num-elems (&/|length ?elems)
+ _ (doto *writer*
+ (.visitLdcInsn (int (* 2 num-elems)))
+ (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
+ _ (&/map% (fn [idx+kv]
+ (|let [[idx [k v]] idx+kv]
+ (|do [:let [idx* (* 2 idx)
+ _ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx*))
+ (.visitLdcInsn k)
+ (.visitInsn Opcodes/AASTORE))]
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int (inc idx*))))]
+ ret (compile v)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret))))
+ (&/zip2 (&/|range num-elems) ?elems))]
(return nil)))
(defn compile-variant [compile *type* ?tag ?value]
(|do [*writer* &/get-writer
- :let [_ (doto *writer*
- (.visitLdcInsn (int 2))
- (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object"))
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 0))
- (.visitLdcInsn ?tag)
- (.visitInsn Opcodes/AASTORE)
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 1)))]
- _ (compile ?value)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ :let [_ (doto *writer*
+ (.visitLdcInsn (int 2))
+ (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object"))
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int 0))
+ (.visitLdcInsn ?tag)
+ (.visitInsn Opcodes/AASTORE)
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int 1)))]
+ _ (compile ?value)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return nil)))
(defn compile-local [compile *type* ?idx]
(|do [*writer* &/get-writer
- :let [_ (.visitVarInsn *writer* Opcodes/ALOAD (int ?idx))]]
+ :let [_ (.visitVarInsn *writer* Opcodes/ALOAD (int ?idx))]]
(return nil)))
(defn compile-captured [compile *type* ?scope ?captured-id ?source]
;; (prn 'compile-captured ?scope ?captured-id)
(|do [*writer* &/get-writer
- :let [_ (doto *writer*
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD
- (&host/location ?scope)
- (str &&/closure-prefix ?captured-id)
- "Ljava/lang/Object;"))]]
+ :let [_ (doto *writer*
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitFieldInsn Opcodes/GETFIELD
+ (&host/location ?scope)
+ (str &&/closure-prefix ?captured-id)
+ "Ljava/lang/Object;"))]]
(return nil)))
(defn compile-global [compile *type* ?owner-class ?name]
(|do [*writer* &/get-writer
- :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
(return nil)))
(defn compile-apply [compile *type* ?fn ?arg]
(|do [*writer* &/get-writer
- _ (compile ?fn)
- _ (compile ?arg)
- :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]]
+ _ (compile ?fn)
+ _ (compile ?arg)
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]]
(return nil)))
-(defn compile-def [compile ?name ?body]
+(defn compile-def [compile ?name ?body ?def-data]
(|do [*writer* &/get-writer
- module-name &/get-module-name
- :let [outer-class (&host/->class module-name)
- datum-sig (&host/->type-signature "java.lang.Object")
- current-class (&host/location (&/|list outer-class ?name))
- _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
- current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil)
- (doto (.visitEnd))))]
- ;; :let [_ (prn 'compile-def/pre-body)]
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
- (|do [**writer** &/get-writer
- :let [_ (.visitCode **writer**)]
- ;; :let [_ (prn 'compile-def/pre-body2)]
- _ (compile ?body)
- ;; :let [_ (prn 'compile-def/post-body2)]
- :let [_ (doto **writer**
- (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))
- ;; :let [_ (prn 'compile-def/post-body)]
- :let [_ (.visitEnd *writer*)]
- ;; :let [_ (prn 'compile-def/_1 ?name current-class)]
- _ (&&/save-class! current-class (.toByteArray =class))
- ;; :let [_ (prn 'compile-def/_2 ?name)]
- ]
+ module-name &/get-module-name
+ :let [outer-class (&host/->class module-name)
+ datum-sig (&host/->type-signature "java.lang.Object")
+ current-class (&host/location (&/|list outer-class ?name))
+ _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
+ current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil)
+ (doto (.visitEnd))))]
+ ;; :let [_ (prn 'compile-def/pre-body)]
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+ (|do [**writer** &/get-writer
+ :let [_ (.visitCode **writer**)]
+ ;; :let [_ (prn 'compile-def/pre-body2)]
+ _ (compile ?body)
+ ;; :let [_ (prn 'compile-def/post-body2)]
+ :let [_ (doto **writer**
+ (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))
+ ;; :let [_ (prn 'compile-def/post-body)]
+ :let [_ (.visitEnd *writer*)]
+ ;; :let [_ (prn 'compile-def/_1 ?name current-class)]
+ _ (&&/save-class! current-class (.toByteArray =class))
+ ;; :let [_ (prn 'compile-def/_2 ?name)]
+ loader &/loader
+ :let [full-macro-name (&host/location (&/|list module-name ?name))]
+ _ (if-let [macro (matchv ::M/objects [?def-data]
+ [["lux;MacroD" ["lux;None" _]]]
+ (-> (.loadClass loader full-macro-name)
+ (.getField "_datum")
+ (.get nil))
+
+ [_]
+ nil)]
+ (&a-module/install-macro module-name ?name macro)
+ (return nil))]
(return nil)))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index cae2fdcaf..ca63576ef 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -2,7 +2,7 @@
(:require [clojure.template :refer [do-template]]
(lux [base :as & :refer [|do return* return fail fail*]]
[reader :as &reader])
- [lux.analyser.def :as &def]))
+ [lux.analyser.module :as &module]))
;; [Utils]
(defn ^:private escape-char [escaped]
@@ -85,9 +85,9 @@
(|do [[_ [meta token]] (&reader/read-regex +ident-re+)]
(&/try-all% (&/|list (|do [_ (&reader/read-text ";")
[_ [_ local-token]] (&reader/read-regex +ident-re+)]
- (&/try-all% (&/|list (|do [unaliased (&def/unalias-module token)]
+ (&/try-all% (&/|list (|do [unaliased (&module/dealias token)]
(return (&/V "lux;Meta" (&/T meta (&/T unaliased local-token)))))
- (|do [? (&def/module-exists? token)]
+ (|do [? (&module/exists? token)]
(if ?
(return (&/V "lux;Meta" (&/T meta (&/T token local-token))))
(fail (str "[Lexer Error] Unknown module: " token))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 10:02:08 +0000