aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux43
-rw-r--r--source/lux/data/list.lux3
-rw-r--r--source/lux/meta/ast.lux4
-rw-r--r--source/lux/meta/type.lux24
4 files changed, 45 insertions, 29 deletions
diff --git a/source/lux.lux b/source/lux.lux
index f5cc8d3d1..39cbb7765 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -9,23 +9,23 @@
## Basic types
(_lux_def Bool (10 ["lux" "Bool"]
- (0 "java.lang.Boolean")))
+ (0 "java.lang.Boolean" (0))))
(_lux_export Bool)
(_lux_def Int (10 ["lux" "Int"]
- (0 "java.lang.Long")))
+ (0 "java.lang.Long" (0))))
(_lux_export Int)
(_lux_def Real (10 ["lux" "Real"]
- (0 "java.lang.Double")))
+ (0 "java.lang.Double" (0))))
(_lux_export Real)
(_lux_def Char (10 ["lux" "Char"]
- (0 "java.lang.Character")))
+ (0 "java.lang.Character" (0))))
(_lux_export Char)
(_lux_def Text (10 ["lux" "Text"]
- (0 "java.lang.String")))
+ (0 "java.lang.String" (0))))
(_lux_export Text)
(_lux_def Unit (10 ["lux" "Unit"]
@@ -71,7 +71,7 @@
(_lux_declare-tags [#None #Some] Maybe)
## (deftype #rec Type
-## (| (#DataT Text)
+## (| (#DataT (, Text (List Type)))
## (#VariantT (List Type))
## (#TupleT (List Type))
## (#LambdaT Type Type)
@@ -90,7 +90,7 @@
TypeList
(9 (7 (0)
(1 (1 ## "lux;DataT"
- Text
+ (2 (1 Text (1 TypeList (0))))
(1 ## "lux;VariantT"
TypeList
(1 ## "lux;TupleT"
@@ -279,11 +279,11 @@
(_lux_def Host
(#NamedT ["lux" "Host"]
(#TupleT (#Cons [## "lux;writer"
- (#DataT "org.objectweb.asm.ClassWriter")
+ (#DataT "org.objectweb.asm.ClassWriter" #Nil)
(#Cons [## "lux;loader"
- (#DataT "java.lang.ClassLoader")
+ (#DataT "java.lang.ClassLoader" #Nil)
(#Cons [## "lux;classes"
- (#DataT "clojure.lang.Atom")
+ (#DataT "clojure.lang.Atom" #Nil)
#Nil])])]))))
(_lux_declare-tags [#writer #loader #classes] Host)
@@ -912,14 +912,6 @@
_
(fail "Wrong syntax for @list&")))
-(defmacro' #export (^ tokens)
- (_lux_case tokens
- (#Cons [_ (#SymbolS "" class-name)] #Nil)
- (return (@list (form$ (@list (tag$ ["lux" "DataT"]) (text$ class-name)))))
-
- _
- (fail "Wrong syntax for ^")))
-
(defmacro' #export (, tokens)
(return (@list (form$ (@list (tag$ ["lux" "TupleT"])
(foldL (lambda'' [tail head] (form$ (@list (tag$ ["lux" "Cons"]) head tail)))
@@ -1352,6 +1344,17 @@
(wrap (wrap-meta (form$ (@list (tag$ ["lux" "RecordS"]) (untemplate-list =fields))))))
))
+(defmacro' #export (^ tokens)
+ (_lux_case tokens
+ (#Cons [_ (#SymbolS "" class-name)] #Nil)
+ (return (@list (form$ (@list (tag$ ["lux" "DataT"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
+
+ (#Cons [_ (#SymbolS "" class-name)] params)
+ (return (@list (form$ (@list (tag$ ["lux" "DataT"]) (text$ class-name) (untemplate-list params)))))
+
+ _
+ (fail "Wrong syntax for ^")))
+
(def'' (get-module-name state)
($' Lux Text)
(_lux_case state
@@ -3192,8 +3195,8 @@
(def (type->ast type)
(-> Type AST)
(case type
- (#DataT name)
- (` (#DataT (~ (text$ name))))
+ (#DataT name params)
+ (` (#DataT (~ (text$ name)) (~ (untemplate-list (map type->ast params)))))
(#;VariantT cases)
(` (#VariantT (~ (untemplate-list (map type->ast cases)))))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 54f8fed4c..e538007bf 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -333,3 +333,6 @@
_
(#;Left "Wrong syntax for zip")))
+
+(def #export zip2 (zip 2))
+(def #export zip3 (zip 3))
diff --git a/source/lux/meta/ast.lux b/source/lux/meta/ast.lux
index 398acf6cc..6d9271847 100644
--- a/source/lux/meta/ast.lux
+++ b/source/lux/meta/ast.lux
@@ -99,7 +99,7 @@
(foldL (lambda [old [x' y']]
(and old (= x' y')))
true
- ((zip 2) xs' ys')))])
+ (zip2 xs' ys')))])
[[#;FormS] [#;TupleS]]
[[_ (#;RecordS xs')] [_ (#;RecordS ys')]]
@@ -107,7 +107,7 @@
(foldL (lambda [old [[xl' xr'] [yl' yr']]]
(and old (= xl' yl') (= xr' yr')))
true
- ((zip 2) xs' ys')))
+ (zip2 xs' ys')))
_
false)))
diff --git a/source/lux/meta/type.lux b/source/lux/meta/type.lux
index 4147e37d4..a1c34b1ac 100644
--- a/source/lux/meta/type.lux
+++ b/source/lux/meta/type.lux
@@ -10,7 +10,7 @@
(data (text #open ("text:" Text/Monoid Text/Eq))
(number/int #open ("int:" Int/Eq Int/Show))
maybe
- (list #refer #all #open ("list:" List/Monad)))
+ (list #refer #all #open ("list:" List/Monad List/Fold)))
))
(open List/Fold)
@@ -19,8 +19,13 @@
(defstruct #export Type/Show (Show Type)
(def (show type)
(case type
- (#;DataT name)
- ($ text:++ "(^ " name ")")
+ (#;DataT name params)
+ (case params
+ #;Nil
+ ($ text:++ "(^ " name ")")
+
+ _
+ ($ text:++ "(^ " name " " (|> params (list:map show) (interpose " ") (list:foldL text:++ "")) ")"))
(#;TupleT members)
(case members
@@ -66,8 +71,13 @@
(defstruct #export Type/Eq (Eq Type)
(def (= x y)
(case [x y]
- [(#;DataT xname) (#;DataT yname)]
- (text:= xname yname)
+ [(#;DataT xname xparams) (#;DataT yname yparams)]
+ (and (text:= xname yname)
+ (int:= (size xparams) (size yparams))
+ (foldL (lambda [prev [x y]]
+ (and prev (= x y)))
+ true
+ (zip2 xparams yparams)))
(\or [(#;VarT xid) (#;VarT yid)]
[(#;ExT xid) (#;ExT yid)]
@@ -90,7 +100,7 @@
(foldL (lambda [prev [x y]]
(and prev (= x y)))
true
- ((zip 2) xmembers ymembers)))
+ (zip2 xmembers ymembers)))
(\or [(#;UnivQ xenv xbody) (#;UnivQ yenv ybody)]
[(#;ExQ xenv xbody) (#;ExQ yenv ybody)])
@@ -98,7 +108,7 @@
(foldL (lambda [prev [x y]]
(and prev (= x y)))
(= xbody ybody)
- ((zip 2) xenv yenv)))
+ (zip2 xenv yenv)))
_
false
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:04:10 +0000