aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux603
-rw-r--r--src/lux/analyser.clj9
-rw-r--r--src/lux/analyser/case.clj5
-rw-r--r--src/lux/analyser/host.clj42
-rw-r--r--src/lux/analyser/lux.clj4
-rw-r--r--src/lux/base.clj64
-rw-r--r--src/lux/compiler.clj2
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 07:56:40 +0000