From 6e72c1363efae036bf511cbc53aa9a10c1c93eb9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 26 Apr 2015 18:36:50 -0400 Subject: - lux/analyser/def has been renamed to lux/analyser/module. - Renamed a few defs in lux.lux. - No more type-test shortcut inside lux/analyser/lux. - Defs are now being classified as either (#ValueD ) or (#MacroD ). --- source/lux.lux | 427 ++++++++++++++++++++++---------------------- src/lux/analyser/def.clj | 65 ------- src/lux/analyser/lux.clj | 163 +++++++++-------- src/lux/analyser/module.clj | 76 ++++++++ src/lux/compiler.clj | 8 +- src/lux/compiler/lux.clj | 196 ++++++++++---------- src/lux/lexer.clj | 6 +- 7 files changed, 488 insertions(+), 453 deletions(-) delete mode 100644 src/lux/analyser/def.clj create mode 100644 src/lux/analyser/module.clj 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 [ ] - (defn [module name] - (fn [state] - (return* state - (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ ) (&/|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 (¯o/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 [ ] (let [+class+ (&host/->class )] (defn [compile *type* value] (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW +class+) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn ( value)) - (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "" ))]] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW +class+) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn ( value)) + (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "" ))]] (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 "" "()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 "" "()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)))) -- cgit v1.2.3