diff options
| -rw-r--r-- | source/lux.lux | 603 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 9 | ||||
| -rw-r--r-- | src/lux/analyser/case.clj | 5 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 42 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 4 | ||||
| -rw-r--r-- | src/lux/base.clj | 64 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 2 |
7 files changed, 453 insertions, 276 deletions
diff --git a/source/lux.lux b/source/lux.lux index dee780e98..8816589e7 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1,36 +1,26 @@ ## First things first, must define functions (jvm-interface Function - (: apply (-> [java.lang.Object] java.lang.Object))) - -## (jvm-interface Function -## [apply ([java.lang.Object] java.lang.Object)]) - -## (jvm-class Function -## (modifiers public abstract) -## (fields) -## (abstract-methods -## [apply1 ([java.lang.Object] java.lang.Object)]) -## (virtual-methods -## [apply2 ((this [arg1 java.lang.Object] [arg2 java.lang.Object]) -## java.lang.Object -## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] -## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] -## this [arg1]) [arg2]))] -## [apply3 ((this [arg1 java.lang.Object] [arg2 java.lang.Object] [arg3 java.lang.Object]) -## java.lang.Object -## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] -## (jvm-invokevirtual lux.Function "apply2" [java.lang.Object java.lang.Object] -## this [arg1 arg2]) [arg3]))])) - + (:' (-> [java.lang.Object] java.lang.Object) + apply)) ## Basic types (def' Any #AnyT) (def' Nothing #NothingT) + (def' Bool (#DataT "java.lang.Boolean")) +(export' Bool) + (def' Int (#DataT "java.lang.Long")) +(export' Int) + (def' Real (#DataT "java.lang.Double")) +(export' Real) + (def' Char (#DataT "java.lang.Character")) +(export' Char) + (def' Text (#DataT "java.lang.String")) +(export' Text) ## (deftype (List a) ## (| #Nil @@ -42,6 +32,7 @@ (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")]) #Nil])]))] #Nil])]))])) +(export' List) ## (deftype #rec Type ## (| #AnyT @@ -74,22 +65,24 @@ (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] #Nil])])])])])])])])])])]))]) #NothingT])))) +(export' Type) ## (deftype (Maybe a) ## (| #None ## (#Some a))) (def' Maybe - (: Type + (:' Type (#AllT [#Nil "Maybe" "a" (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] (#Cons [["lux;Some" (#BoundT "a")] #Nil])]))]))) +(export' Maybe) ## (deftype (Bindings k v) ## (& #counter Int ## #mappings (List (, k v)))) (def' Bindings - (: Type + (:' Type (#AllT [#Nil "Bindings" "k" (#AllT [#Nil "" "v" (#RecordT (#Cons [["lux;counter" Int] @@ -105,7 +98,7 @@ ## #locals (Bindings k v) ## #closure (Bindings k v))) (def' Env - (: Type + (:' Type (#AllT [#Nil "Env" "k" (#AllT [#Nil "" "v" (#RecordT (#Cons [["lux;name" Text] @@ -119,27 +112,29 @@ ## (deftype Cursor ## (, Text Int Int)) (def' Cursor - (: Type + (:' Type (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))) ## (deftype (Meta m v) ## (| (#Meta (, m v)))) (def' Meta - (: Type + (:' Type (#AllT [#Nil "Meta" "m" (#AllT [#Nil "" "v" (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") (#Cons [(#BoundT "v") #Nil])]))] #Nil]))])]))) +(export' Meta) ## (def' Reader ## (List (Meta Cursor Text))) (def' Reader - (: Type + (:' Type (#AppT [List (#AppT [(#AppT [Meta Cursor]) Text])]))) +(export' Reader) ## (deftype CompilerState ## (& #source (Maybe Reader) @@ -152,7 +147,7 @@ ## #loader (^ java.net.URLClassLoader) ## #eval-ctor Int)) (def' CompilerState - (: Type + (:' Type (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] (#Cons [["lux;modules" (#AppT [List Any])] (#Cons [["lux;module-aliases" (#AppT [List Any])] @@ -163,6 +158,7 @@ (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] (#Cons [["lux;eval-ctor" Int] #Nil])])])])])])])])])))) +(export' CompilerState) ## (deftype (Syntax' w) ## (| (#Bool Bool) @@ -176,7 +172,7 @@ ## (#Tuple (List (w (Syntax' w)))) ## (#Record (List (, Text (w (Syntax' w))))))) (def' Syntax' - (: Type + (:' Type (case' (#AppT [(#BoundT "w") (#AppT [(#BoundT "Syntax'") (#BoundT "w")])]) @@ -200,31 +196,34 @@ ])])])])])])])])]) )]) ))))) +(export' Syntax') ## (deftype Syntax ## (Meta Cursor (Syntax' (Meta Cursor)))) (def' Syntax - (: Type + (:' Type (case' (#AppT [Meta Cursor]) w (#AppT [w (#AppT [Syntax' w])])))) +(export' Syntax) ## (deftype (Either l r) ## (| (#Left l) ## (#Right r))) (def' Either - (: Type + (:' Type (#AllT [#Nil "_" "l" (#AllT [#Nil "" "r" (#VariantT (#Cons [["lux;Left" (#BoundT "l")] (#Cons [["lux;Right" (#BoundT "r")] #Nil])]))])]))) +(export' Either) ## (deftype Macro ## (-> (List Syntax) CompilerState ## (Either Text [CompilerState (List Syntax)]))) (def' Macro - (: Type + (:' Type (case' (#AppT [List Syntax]) SyntaxList (#LambdaT [SyntaxList @@ -233,13 +232,14 @@ (#TupleT (#Cons [CompilerState (#Cons [SyntaxList #Nil])]))])])])))) +(export' Macro) ## Base functions & macros ## (def (_meta data) ## (-> (Syntax' (Meta Cursor)) Syntax) ## (#Meta [["" -1 -1] data])) (def' _meta - (: (#LambdaT [(#AppT [Syntax' + (:' (#LambdaT [(#AppT [Syntax' (#AppT [Meta Cursor])]) Syntax]) (lambda' _ data @@ -250,7 +250,7 @@ ## (Either Text (, CompilerState SyntaxList))) ## ...) (def' return' - (: (case' (#AppT [List Syntax]) + (:' (case' (#AppT [List Syntax]) SyntaxList (#LambdaT [SyntaxList (#LambdaT [CompilerState @@ -267,7 +267,7 @@ ## (Either Text (, CompilerState SyntaxList))) ## ...) (def' fail' - (: (case' (#AppT [List Syntax]) + (:' (case' (#AppT [List Syntax]) SyntaxList (#LambdaT [Text (#LambdaT [CompilerState @@ -280,7 +280,7 @@ (#Left msg))))) ## (def' let' -## (: Macro +## (:' Macro ## (lambda' _ tokens ## (case' tokens ## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) @@ -291,7 +291,7 @@ ## _ ## (#Left "Wrong syntax for let'"))))) (def' let' - (: Macro + (:' Macro (lambda' _ tokens (case' tokens (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) @@ -304,7 +304,7 @@ (declare-macro' let') (def' lambda - (: Macro + (:' Macro (lambda' _ tokens (case' tokens (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) @@ -340,54 +340,56 @@ _ (fail' "Wrong syntax for lambda"))))) (declare-macro' lambda) +(export' lambda) (def' def - (: Macro - (lambda [tokens] - (case' tokens - (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) - #Nil])) - - (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) - (#Cons [body #Nil])]) - (return' (#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' (#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' (#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") - )))) + (:' Macro + (lambda [tokens] + (case' tokens + (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) + #Nil])) + + (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) + (#Cons [body #Nil])]) + (return' (#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' (#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' (#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") + )))) (declare-macro' def) +(export' def) (def (defmacro tokens) Macro @@ -409,6 +411,7 @@ (defmacro (comment tokens) (return' #Nil)) +(export' comment) (defmacro (->' tokens) (case' tokens @@ -430,7 +433,7 @@ _ (fail' "Wrong syntax for ->'"))) -(def (int+ x y) +(def (int:+ x y) (->' Int Int Int) (jvm-ladd x y)) @@ -489,8 +492,9 @@ (def (id x) (All' [a] (->' (B' a) (B' a))) x) +(export' id) -(def (fold' f init xs) +(def (fold f init xs) (All' [a b] (->' (->' (B' a) (B' b) (B' a)) (B' a) @@ -501,11 +505,11 @@ init (#Cons [x xs']) - (fold' f (f init x) xs'))) + (fold f (f init x) xs'))) (def (reverse' list) (->' ($' List Syntax) ($' List Syntax)) - (fold' (: (->' ($' List Syntax) Syntax + (fold (:' (->' ($' List Syntax) Syntax ($' List Syntax)) (lambda [tail head] (#Cons [head tail]))) @@ -513,7 +517,7 @@ list)) (defmacro (list xs) - (return' (#Cons [(fold' (: (->' Syntax Syntax Syntax) + (return' (#Cons [(fold (:' (->' Syntax Syntax Syntax) (lambda [tail head] (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"])) (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])]))) @@ -521,11 +525,12 @@ (_meta (#Tag ["lux" "Nil"])) (reverse' xs)) #Nil]))) +(export' list) (defmacro (list& xs) (case' (reverse' xs) (#Cons [last init]) - (return' (list (fold' (: (->' Syntax Syntax Syntax) + (return' (list (fold (:' (->' Syntax Syntax Syntax) (lambda [tail head] (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) (_meta (#Tuple (list head tail)))))))) @@ -534,6 +539,7 @@ _ (fail' "Wrong syntax for list&"))) +(export' list&) (def (as-pairs' xs) (All' [a] @@ -548,14 +554,14 @@ (defmacro (let tokens) (case' tokens (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) - (return' (list (fold' (: (->' Syntax (#TupleT (list Syntax Syntax)) + (return' (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)) + (fold (:' (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax)) ($' List (#TupleT (list Syntax Syntax)))) (lambda [tail head] (#Cons [head tail]))) @@ -564,8 +570,9 @@ _ (fail' "Wrong syntax for let"))) +(export' let) -(def (map' f xs) +(def (map f xs) (All' [a b] (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b)))) (case' xs @@ -573,7 +580,7 @@ #Nil (#Cons [x xs']) - (#Cons [(f x) (map' f xs')]))) + (#Cons [(f x) (map f xs')]))) (def (wrap-meta content) (->' ($' Syntax' ($' Meta Cursor)) Syntax) @@ -616,16 +623,16 @@ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) (#Meta [_ (#Tuple elems)]) - (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map' untemplate elems))))) + (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map untemplate elems))))) (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [(#Meta [_ unquoted]) #Nil])]))]) (_meta unquoted) (#Meta [_ (#Form elems)]) - (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map' untemplate elems))))) + (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map untemplate elems))))) (#Meta [_ (#Record fields)]) - (wrap-meta (#Record (map' (: (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax))) + (wrap-meta (#Record (map (:' (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax))) (lambda [kv] (let [[k v] kv] [k (untemplate v)]))) @@ -639,6 +646,7 @@ _ (fail' "Wrong syntax for `"))) +(export' `) (defmacro (if tokens) (case' tokens @@ -649,6 +657,257 @@ _ (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' ,) + +## (defmacro (^ tokens) +## (case' tokens +## (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil]) +## (return' (list (` (#DataT (~ (_meta (#Text class-name))))))) + +## _ +## (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) + +## _ +## (fail' "Wrong syntax for ^"))) +## (export' ->) + +## (defmacro (| members) +## (let [members' (map (:' (->' Syntax Syntax) +## (lambda [m] +## (case' m +## (#Meta [_ (#Tag [module name])]) +## (` [(~ ($ text-++ module ";" name)) (#Tuple (list))]) + +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## (` [(~ ($ text-++ module ";" name)) (~ value)])))) +## members)] +## (return' (list (` (#VariantT (~ (untemplate-list members)))))))) +## (export' |) + +## (defmacro (& members) +## (let [members' (map (:' (->' Syntax Syntax) +## (lambda [m] +## (case' m +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## (` [(~ ($ text-++ module ";" name)) (~ value)])))) +## members)] +## (return' (list (` (#RecordT (~ (untemplate-list members)))))))) +## (export' &) + +## (def (text:= x y) +## (-> Text Text Bool) +## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] +## x [y])) + +## (def (replace-ident ident value syntax) +## (-> (, Text Text) Syntax Syntax Syntax) +## (let [[module name] ident] +## (case' syntax +## (#Meta [_ (#Symbol [?module ?name])]) +## (if (and (text:= module ?module) +## (text:= name ?name)) +## value +## syntax) + +## (#Meta [_ (#Form members)]) +## (_meta (#Form (map (replace-ident ident value) members))) + +## (#Meta [_ (#Tuple members)]) +## (_meta (#Tuple (map (replace-ident ident value) members))) + +## (#Meta [_ (#Record members)]) +## (_meta (#Record (map (lambda [kv] +## (case' kv +## [k v] +## [k (replace-ident ident value v)])) +## members))) + +## _ +## syntax))) + +## (defmacro (All tokens) +## (let [[name args body] (case' tokens +## (#Cons [(#Meta [_ (#Symbol ["" name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) +## [name args body] + +## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) +## ["" args body]) +## rolled (fold (:' (-> Syntax Syntax Syntax) +## (lambda [body arg] +## (case' arg +## (#Meta [_ (#Symbol [arg-module arg-name])]) +## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] +## (` (#BoundT (~ (#Text ($ text:++ arg-module ";" arg-name))))) +## body))))))) +## body +## 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)) +## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) +## body))))))))) +## (export' All) + +## (defsig (Eq a) +## (: (-> a a Bool) +## =)) + +## (defstruct Text:Eq (Eq Text) +## (def = text=)) + +## (defstruct Ident:Eq (Eq Ident) +## (def (= x y) +## (let [[m1 n1] x +## [m2 n2] y] +## (and (text:= m1 m2) +## (text:= n1 n2))))) + +## (deftype (Dict k v) +## (: (-> k v (Dict k v) (Dict k v)) +## put) +## (: (-> k (Dict k v) (Maybe v)) +## get) +## (: (-> k (Dict k v) (Dict k v)) +## remove)) + +## (deftype (PList k v) +## (| (#PList (, (Eq k) (List (, k v)))))) + +## (def (some f xs) +## (All [a b] +## (-> (-> a (Maybe b)) (List a) (Maybe b))) +## (case' xs +## #Nil +## #None + +## (#Cons [x xs']) +## (if-let [y (f x)] +## (#Some y) +## (some f xs')) +## )) + +## (defstruct PList:Dict (Dict PList) +## (def (get k plist) +## (let [(#PList [{#= =} kvs]) plist] +## (some (:' (-> (, )) +## (lambda [kv] +## (let [[k' v'] kv] +## (when (= k k') +## v')))) +## kvs)))) + +## (deftype CompilerState +## (& #source (Maybe Reader) +## #modules (List Any) +## #module-aliases (List Any) +## #global-env (Maybe (Env Text Any)) +## #local-envs (List (Env Text Any)) +## #types (Bindings Int Type) +## #writer (^ org.objectweb.asm.ClassWriter) +## #loader (^ java.net.URLClassLoader) +## #eval-ctor Int)) +## (deftype CompilerState +## (& (#source (Maybe Reader)) +## (#modules (PList Text Any)) +## (#module-aliases (PList Text Text)) +## (#envs (List (Env Text Any))) +## (#types (Bindings Int Type)) +## (#host (& (#writer (^ org.objectweb.asm.ClassWriter)) +## (#loader (^ java.net.URLClassLoader)) +## (#eval-ctor Int))))) +## (def (find-macro ident) +## (lambda [state] +## (let [[module name] ident] +## (case' state +## {#source source #modules modules #module-aliases module-aliases +## #global-env global-env #local-envs local-envs #types types +## #writer writer #loader loader #eval-ctor eval-ctor} +## (when-let [bindings (get module modules) +## bound (get name bindings)] +## (case' bound +## (#Macro macro) +## (#Some macro) + +## _ +## #None)))))) + +## (def (walk-type type) +## (-> Syntax ($' Lux Syntax)) +## (case' type +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol sym)]) args]))]) +## (do' [macro' (find-macro sym)] +## (case' macro' +## (#Some macro) +## (do' [expansion (macro args)] +## (case' expansion +## (#Cons [expansion' #Nil]) +## (walk-type expansion') + +## _ +## (fail' "Macro can't expand to more than 1 output."))) + +## #None +## (do' [args' (map% walk-type args)] +## (return (fold (:' (-> Syntax Syntax Syntax) +## (lambda [f a] +## (` (#AppT [(~ f) (~ a)])))) +## sym +## args'))))) + +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) args]))]) +## ... + +## (#Meta [_ (#Symbol _)]) +## (return' type) + +## _ +## (fail' "Wrong syntax for walk-type"))) + +## (defmacro (->type tokens) +## (case' tokens +## (#Cons [type #Nil]) +## (do' [type' (walk-type type)] +## (return' (list type'))) + +## _ +## (fail' "Wrong syntax for ->type"))) + +## (defmacro (: tokens) +## (case' tokens +## (#Cons [type (#Cons [value #Nil])]) +## (return' (list (` (:' (->type (~ type)) (~ value))))) + +## _ +## (fail' "Wrong syntax for :"))) + +## (defmacro (:! tokens) +## (case' tokens +## (#Cons [type (#Cons [value #Nil])]) +## (return' (list (` (:!' (->type (~ type)) (~ value))))) + +## _ +## (fail' "Wrong syntax for :!"))) + + ## (def (print x) ## (-> (^ java.lang.Object) []) @@ -705,17 +964,18 @@ ## (#Cons [x (filter p xs')]) ## (filter p xs')))) -## (deftype (LuxStateM a) -## (-> CompilerState (Either Text [CompilerState a]))) +## (deftype (Lux a) +## (-> CompilerState (Either Text (, CompilerState a)))) ## (def (return val) ## (All [a] -## (-> a (LuxStateM a))) +## (-> a (Lux a))) ## (lambda [state] ## (#Right [state val]))) ## (def (fail msg) -## (-> Text (LuxStateM Nothing)) +## (All [a] +## (-> Text (Lux a))) ## (lambda [_] ## (#Left msg))) @@ -909,6 +1169,34 @@ ## ## [every? and] ## ## [any? or]) +## (deftype Ordering +## (| #< #> #=)) + +## (defsig (Ord a) +## (: (-> a a Ordering) +## compare)) + +## (defsig (Enum a) +## (: (Ord a) +## order) + +## (: (-> a a) +## succ) + +## (: (-> a a) +## pred)) + +## (def (range enum from to) +## (All [a] +## (-> (Enum a) a a (List a))) +## (using [enum order] +## (case' (compare from to) +## #< +## (list& from (range enum (succ from) to)) + +## _ +## #Nil))) + ## (def (range from to) ## (-> Int Int (List Int)) ## (if (int< from to) @@ -931,19 +1219,6 @@ ## _ ## #Nil)) -## (def (get key map) -## (All [a b] -## (-> a (List (, a b)) (Maybe b))) -## (case' map -## #Nil -## #None - -## (#Cons [[k v] map']) -## (if (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## k [key]) -## (#Some v) -## (get key map')))) - ## (def (get-ident x) ## (-> Syntax Text) ## (case' x @@ -1195,100 +1470,12 @@ ## ## (return (flat-map (lambda [pattern] (list pattern body)) ## ## patterns)))) -## (defmacro (^ tokens) -## (case' tokens -## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil]) -## (return (list (` (#DataT (~ (_meta (#Text class-name))))))) -## )) - -## (defmacro (, members) -## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "TupleT"])) (untemplate-list members))))))) - -## (defmacro (| members) -## (let [members' (map (lambda [m] -## (case' m -## (#Meta [_ (#Tag [module name])]) -## [($ text-++ module ";" name) (` (#Tuple (list)))] - -## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## members)] -## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "VariantT"])) (untemplate-list members)))))))) - -## (defmacro (& members) -## (let [members' (map (lambda [m] -## (case' m -## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## members)] -## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "RecordT"])) (untemplate-list members)))))))) - -## (defmacro (-> tokens) -## (case' (reverse tokens) -## (#Cons [f-return f-args]) -## (fold (lambda [f-return f-arg] -## (` (#LambdaT [(~ f-arg) (~ f-return)]))) -## f-return -## f-args))) - -## (def (text= x y) -## (-> Text Text Bool) -## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## x [y])) - -## (def (replace-ident ident value syntax) -## (-> (, Text Text) Syntax Syntax Syntax) -## (let [[module name] ident] -## (case' syntax -## (#Meta [_ (#Symbol [?module ?name])]) -## (if (and (text= module ?module) -## (text= name ?name)) -## value -## syntax) - -## (#Meta [_ (#Form members)]) -## (_meta (#Form (map (replace-ident ident value) members))) - -## (#Meta [_ (#Tuple members)]) -## (_meta (#Tuple (map (replace-ident ident value) members))) - -## (#Meta [_ (#Record members)]) -## (_meta (#Record (map (lambda [kv] -## (case' kv -## [k v] -## [k (replace-ident ident value v)])) -## members))) - -## _ -## syntax))) - -## (defmacro (All tokens) -## (let [[name args body] (case' tokens -## (#Cons [(#Meta [_ (#Symbol [_ name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) -## [name args body] - -## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) -## ["" args body]) -## rolled (fold (lambda [body arg] -## (case' arg -## (#Meta [_ (#Symbol [arg-module arg-name])]) -## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] -## (` (#BoundT (~ (#Text arg-name)))) -## body)))))) -## body -## 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)) -## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) -## body))))))))) - ## (def (macro-expand syntax) ## (-> Syntax (LuxStateM (List Syntax))) ## (case' syntax ## (#Form (#Cons [(#Symbol macro-name) args])) ## (do [macro (get-macro macro-name)] -## ((:! macro Macro) args)))) +## ((:'! macro Macro) args)))) ## (defmacro (case tokens) ## (case' tokens @@ -1354,12 +1541,12 @@ ## (` (#Record (~ (untemplate-list ...)))) ## args)] ## (return (list (` (def (~ name) -## (: (~ def-body) (~ signature)))))))) +## (:' (~ def-body) (~ signature)))))))) ## (defsig (Monad m) -## (: (All [a] (-> a (m a))) +## (:' (All [a] (-> a (m a))) ## return) -## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) +## (:' (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) ## (defstruct ListMonad (Monad List) @@ -1369,7 +1556,7 @@ ## (def bind (. concat map))) ## (defsig (Eq a) -## (: = (-> a a Bool))) +## (:' = (-> a a Bool))) ## (defstruct (List_Eq A_Eq) ## (All [a] (-> (Eq a) (Eq (List a)))) @@ -1438,6 +1625,6 @@ ## (defsyntax #export (deftype [[name args] %usage] body) ## (return (list (` (def (~ name) -## (: Type +## (:' Type ## (type (All [(~@ args)] ## (~ body))))))))) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 9097168e2..f4c7cce86 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -101,18 +101,23 @@ ["lux;Nil" _]]]]]]]]] (&&lux/analyse-import analyse ?path) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":'"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-check analyse eval! exo-type ?type ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!'"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-coerce analyse eval! ?type ?value) + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "export'"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?ident]]] + ["lux;Nil" _]]]]]]]]] + (&&lux/analyse-export analyse ?ident) + ;; Host special forms ;; Integer arithmetic [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index e1f5c4c84..0c459f0de 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -205,8 +205,9 @@ (defn ^:private check-totality [value-type struct] ;; (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type)) (matchv ::M/objects [struct] - [["BoolTotal" [?total _]]] - (return ?total) + [["BoolTotal" [?total ?values]]] + (return (or ?total + (= #{true false} (set (&/->seq ?values))))) [["IntTotal" [?total _]]] (return ?total) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 299471ee8..7b27a2a92 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -167,27 +167,27 @@ (defn analyse-jvm-interface [analyse ?name ?members] ;; (prn 'analyse-jvm-interface ?name ?members) (|do [=members (&/map% (fn [member] - ;; (prn 'analyse-jvm-interface (&/show-ast member)) - (matchv ::M/objects [member] - [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ":"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?member-name]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?inputs]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?output]]]] - ["lux;Nil" _]]]]]]]]]] - ["lux;Nil" _]]]]]]]]]]] - (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output) - (|do [inputs* (&/map% extract-ident ?inputs)] - (return [?member-name [inputs* ?output]]))) - - [_] - (fail "[Analyser Error] Invalid method signature!"))) - ?members) - :let [;; _ (prn '=members =members) - =methods (into {} (for [[method [inputs output]] (&/->seq =members)] - [method {:access :public - :type [inputs output]}]))] - $module &/get-module-name] + ;; (prn 'analyse-jvm-interface (&/show-ast member)) + (matchv ::M/objects [member] + [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":'"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?inputs]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?output]]]] + ["lux;Nil" _]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?member-name]]]] + ["lux;Nil" _]]]]]]]]]]] + (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output) + (|do [inputs* (&/map% extract-ident ?inputs)] + (return [?member-name [inputs* ?output]]))) + + [_] + (fail "[Analyser Error] Invalid method signature!"))) + ?members) + :let [;; _ (prn '=members =members) + =methods (into {} (for [[method [inputs output]] (&/->seq =members)] + [method {:access :public + :type [inputs output]}]))] + $module &/get-module-name] (return (&/|list (&/V "Statement" (&/V "jvm-interface" (&/T $module ?name =methods))))))) (defn analyse-jvm-try [analyse ?body [?catches ?finally]] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 68d612db6..b22b1932a 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -297,7 +297,9 @@ (fail "Can't declare macros from foreign modules.")))) (defn analyse-import [analyse exo-type ?path] - (assert false) + (return (&/|list))) + +(defn analyse-export [analyse ?ident] (return (&/|list))) (defn analyse-check [analyse eval! exo-type ?type ?value] diff --git a/src/lux/base.clj b/src/lux/base.clj index 6771c9290..e989b681e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -3,6 +3,12 @@ [clojure.core.match :as M :refer [matchv]] clojure.core.match.array)) +;; [Fields] +(def $WRITER "lux;writer") +(def $LOADER "lux;loader") +(def $EVAL-CTOR "lux;eval-ctor") +(def $HOST "lux;host") + ;; [Exports] (def +name-separator+ ";") @@ -16,6 +22,7 @@ (to-array kvs)) (defn get$ [slot record] + ;; (prn 'get$ slot) (let [size (alength record)] (loop [idx 0] (if (< idx size) @@ -514,7 +521,7 @@ (def loader (fn [state] - (return* state (get$ "lux;loader" state)))) + (return* state (->> state (get$ $HOST) (get$ $LOADER))))) (def +init-bindings+ (R "lux;counter" 0 @@ -526,6 +533,11 @@ "lux;locals" +init-bindings+ "lux;closure" +init-bindings+)) +(defn host [_] + (R $WRITER (V "lux;None" nil) + $LOADER (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) + $EVAL-CTOR 0)) + (defn init-state [_] (R "lux;source" (V "lux;None" nil) "lux;modules" (|table) @@ -533,9 +545,7 @@ "lux;global-env" (V "lux;None" nil) "lux;local-envs" (|list) "lux;types" +init-bindings+ - "lux;writer" (V "lux;None" nil) - "lux;loader" (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) - "lux;eval-ctor" 0)) + $HOST (host nil))) (defn from-some [some] (matchv ::M/objects [some] @@ -545,43 +555,14 @@ [_] (assert false))) -(defn show-state [state] - (let [source (get$ "lux;source" state) - modules (get$ "lux;modules" state) - global-env (get$ "lux;global-env" state) - local-envs (get$ "lux;local-envs" state) - types (get$ "lux;types" state) - writer (get$ "lux;writer" state) - loader (get$ "lux;loader" state) - eval-ctor (get$ "lux;eval-ctor" state)] - (str "{" - (->> (for [slot ["lux;source", "lux;modules", "lux;global-env", "lux;local-envs", "lux;types", "lux;writer", "lux;loader", "lux;eval-ctor"] - :let [value (get$ slot state)]] - (str "#" slot " " (case slot - "lux;source" "???" - "lux;modules" "???" - "lux;global-env" (->> value from-some (get$ "lux;locals") (get$ "lux;mappings") show-table) - "lux;local-envs" (str "(" - (->> value - (|map #(->> % (get$ "lux;locals") (get$ "lux;mappings") show-table)) - (|interpose " ") - (fold str "")) - ")") - "lux;types" "???" - "lux;writer" "???" - "lux;loader" "???" - "lux;eval-ctor" value))) - (interpose " ") - (reduce str "")) - "}"))) - (def get-eval-ctor (fn [state] - (return* (update$ "lux;eval-ctor" inc state) (get$ "lux;eval-ctor" state)))) + (return* (update$ $HOST #(update$ $EVAL-CTOR inc %) state) + (get$ $EVAL-CTOR (get$ $HOST state))))) (def get-writer (fn [state] - (let [writer* (get$ "lux;writer" state)] + (let [writer* (->> state (get$ $HOST) (get$ $WRITER))] ;; (prn 'get-writer (class writer*)) ;; (prn 'get-writer (aget writer* 0)) (matchv ::M/objects [writer*] @@ -643,9 +624,9 @@ (defn with-closure [body] (|do [closure-info (try-all% (|list (|do [top get-top-local-env] - (return (T true (->> top (get$ "lux;inner-closures") str)))) - (|do [global get-current-module-env] - (return (T false (->> global (get$ "lux;inner-closures") str))))))] + (return (T true (->> top (get$ "lux;inner-closures") str)))) + (|do [global get-current-module-env] + (return (T false (->> global (get$ "lux;inner-closures") str))))))] (matchv ::M/objects [closure-info] [[local? closure-name]] (fn [state] @@ -671,10 +652,11 @@ (defn with-writer [writer body] (fn [state] - (let [output (body (set$ "lux;writer" (V "lux;Some" writer) state))] + (let [output (body (update$ $HOST #(set$ $WRITER (V "lux;Some" writer) %) state))] (matchv ::M/objects [output] [["lux;Right" [?state ?value]]] - (return* (set$ "lux;writer" (get$ "lux;writer" state) ?state) ?value) + (return* (update$ $HOST #(set$ $WRITER (->> state (get$ $HOST) (get$ $WRITER)) %) ?state) + ?value) [_] output)))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 9576fc1a2..410b11abf 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -374,7 +374,7 @@ (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state (&/set$ "lux;source" (&/V "lux;Some" (&reader/from (str "source/" name ".lux")))) (&/set$ "lux;global-env" (&/V "lux;Some" (&/env name))) - (&/set$ "lux;writer" (&/V "lux;Some" =class)) + (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) (&/update$ "lux;modules" #(&/|put name &a-def/init-module %))))] [["lux;Right" [?state _]]] (do (.visitEnd =class) |