aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to 'source')
-rw-r--r--source/lux.lux603
1 files changed, 395 insertions, 208 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)))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 02:38:07 +0000