aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux856
-rw-r--r--src/lux/analyser.clj6
-rw-r--r--src/lux/analyser/base.clj12
-rw-r--r--src/lux/analyser/case.clj4
-rw-r--r--src/lux/analyser/host.clj11
-rw-r--r--src/lux/analyser/lambda.clj10
-rw-r--r--src/lux/analyser/lux.clj42
-rw-r--r--src/lux/compiler/case.clj2
-rw-r--r--src/lux/compiler/lambda.clj62
9 files changed, 499 insertions, 506 deletions
diff --git a/source/lux.lux b/source/lux.lux
index b03de7473..dee780e98 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -79,25 +79,25 @@
## (| #None
## (#Some a)))
(def' Maybe
- (check' Type
- (#AllT [#Nil "Maybe" "a"
- (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
- (#Cons [["lux;Some" (#BoundT "a")]
- #Nil])]))])))
+ (: Type
+ (#AllT [#Nil "Maybe" "a"
+ (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
+ (#Cons [["lux;Some" (#BoundT "a")]
+ #Nil])]))])))
## (deftype (Bindings k v)
## (& #counter Int
## #mappings (List (, k v))))
(def' Bindings
- (check' Type
- (#AllT [#Nil "Bindings" "k"
- (#AllT [#Nil "" "v"
- (#RecordT (#Cons [["lux;counter" Int]
- (#Cons [["lux;mappings" (#AppT [List
- (#TupleT (#Cons [(#BoundT "k")
- (#Cons [(#BoundT "v")
- #Nil])]))])]
- #Nil])]))])])))
+ (: Type
+ (#AllT [#Nil "Bindings" "k"
+ (#AllT [#Nil "" "v"
+ (#RecordT (#Cons [["lux;counter" Int]
+ (#Cons [["lux;mappings" (#AppT [List
+ (#TupleT (#Cons [(#BoundT "k")
+ (#Cons [(#BoundT "v")
+ #Nil])]))])]
+ #Nil])]))])])))
## (deftype (Env k v)
## (& #name Text
@@ -105,41 +105,41 @@
## #locals (Bindings k v)
## #closure (Bindings k v)))
(def' Env
- (check' Type
- (#AllT [#Nil "Env" "k"
- (#AllT [#Nil "" "v"
- (#RecordT (#Cons [["lux;name" Text]
- (#Cons [["lux;inner-closures" Int]
- (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")])
- (#BoundT "v")])]
- (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")])
- (#BoundT "v")])]
- #Nil])])])]))])])))
+ (: Type
+ (#AllT [#Nil "Env" "k"
+ (#AllT [#Nil "" "v"
+ (#RecordT (#Cons [["lux;name" Text]
+ (#Cons [["lux;inner-closures" Int]
+ (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")])
+ (#BoundT "v")])]
+ (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")])
+ (#BoundT "v")])]
+ #Nil])])])]))])])))
## (deftype Cursor
## (, Text Int Int))
(def' Cursor
- (check' Type
- (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))))
+ (: Type
+ (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))))
## (deftype (Meta m v)
## (| (#Meta (, m v))))
(def' Meta
- (check' Type
- (#AllT [#Nil "Meta" "m"
- (#AllT [#Nil "" "v"
- (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
- (#Cons [(#BoundT "v")
- #Nil])]))]
- #Nil]))])])))
+ (: Type
+ (#AllT [#Nil "Meta" "m"
+ (#AllT [#Nil "" "v"
+ (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
+ (#Cons [(#BoundT "v")
+ #Nil])]))]
+ #Nil]))])])))
## (def' Reader
## (List (Meta Cursor Text)))
(def' Reader
- (check' Type
- (#AppT [List
- (#AppT [(#AppT [Meta Cursor])
- Text])])))
+ (: Type
+ (#AppT [List
+ (#AppT [(#AppT [Meta Cursor])
+ Text])])))
## (deftype CompilerState
## (& #source (Maybe Reader)
@@ -152,36 +152,18 @@
## #loader (^ java.net.URLClassLoader)
## #eval-ctor Int))
(def' CompilerState
- (check' Type
- (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])]
- (#Cons [["lux;modules" (#AppT [List Any])]
- (#Cons [["lux;module-aliases" (#AppT [List Any])]
- (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])]
- (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])]
- (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
- (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
- (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
- (#Cons [["lux;eval-ctor" Int]
- #Nil])])])])])])])])]))))
-
-## (deftype (Syntax' f)
-## (f (| (#Bool Bool)
-## (#Int Int)
-## (#Real Real)
-## (#Char Char)
-## (#Text Text)
-## (#Form (List (Syntax' f)))
-## (#Tuple (List (Syntax' f)))
-## (#Record (List (, Text (Syntax' f)))))))
-## (deftype #rec Syntax
-## (Meta Cursor (| (#Bool Bool)
-## (#Int Int)
-## (#Real Real)
-## (#Char Char)
-## (#Text Text)
-## (#Form (List Syntax))
-## (#Tuple (List Syntax))
-## (#Record (List (, Text Syntax))))))
+ (: Type
+ (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])]
+ (#Cons [["lux;modules" (#AppT [List Any])]
+ (#Cons [["lux;module-aliases" (#AppT [List Any])]
+ (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])]
+ (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])]
+ (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
+ (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
+ (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
+ (#Cons [["lux;eval-ctor" Int]
+ #Nil])])])])])])])])]))))
+
## (deftype (Syntax' w)
## (| (#Bool Bool)
## (#Int Int)
@@ -194,246 +176,217 @@
## (#Tuple (List (w (Syntax' w))))
## (#Record (List (, Text (w (Syntax' w)))))))
(def' Syntax'
- (check' Type
- (case' (#AppT [(#BoundT "w")
- (#AppT [(#BoundT "Syntax'")
- (#BoundT "w")])])
- Syntax'
- (case' (#AppT [List Syntax'])
- Syntax'List
- (case' (#TupleT (#Cons [Text (#Cons [Text #Nil])]))
- Ident
- (#AllT [#Nil "Syntax'" "w"
- (#VariantT (#Cons [["lux;Bool" Bool]
- (#Cons [["lux;Int" Int]
- (#Cons [["lux;Real" Real]
- (#Cons [["lux;Char" Char]
- (#Cons [["lux;Text" Text]
- (#Cons [["lux;Symbol" Ident]
- (#Cons [["lux;Tag" Ident]
- (#Cons [["lux;Form" Syntax'List]
- (#Cons [["lux;Tuple" Syntax'List]
- (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax' #Nil])]))])]
- #Nil])
- ])])])])])])])])])
- )])
- )))))
+ (: Type
+ (case' (#AppT [(#BoundT "w")
+ (#AppT [(#BoundT "Syntax'")
+ (#BoundT "w")])])
+ Syntax'
+ (case' (#AppT [List Syntax'])
+ Syntax'List
+ (case' (#TupleT (#Cons [Text (#Cons [Text #Nil])]))
+ Ident
+ (#AllT [#Nil "Syntax'" "w"
+ (#VariantT (#Cons [["lux;Bool" Bool]
+ (#Cons [["lux;Int" Int]
+ (#Cons [["lux;Real" Real]
+ (#Cons [["lux;Char" Char]
+ (#Cons [["lux;Text" Text]
+ (#Cons [["lux;Symbol" Ident]
+ (#Cons [["lux;Tag" Ident]
+ (#Cons [["lux;Form" Syntax'List]
+ (#Cons [["lux;Tuple" Syntax'List]
+ (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax' #Nil])]))])]
+ #Nil])
+ ])])])])])])])])])
+ )])
+ )))))
## (deftype Syntax
## (Meta Cursor (Syntax' (Meta Cursor))))
(def' Syntax
- (check' Type
- (case' (#AppT [Meta Cursor])
- w
- (#AppT [w (#AppT [Syntax' w])]))))
-
-## (def' Syntax
-## (check' Type
-## (case' (#AppT [(#BoundT "Syntax") (#BoundT "")])
-## Syntax
-## (case' (#AppT [List Syntax])
-## SyntaxList
-## (#AppT [(#AllT [#Nil "Syntax" ""
-## (#AppT [(#AppT [Meta Cursor])
-## (#VariantT (#Cons [["lux;Bool" Bool]
-## (#Cons [["lux;Int" Int]
-## (#Cons [["lux;Real" Real]
-## (#Cons [["lux;Char" Char]
-## (#Cons [["lux;Text" Text]
-## (#Cons [["lux;Form" SyntaxList]
-## (#Cons [["lux;Tuple" SyntaxList]
-## (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax #Nil])]))])]
-## #Nil])])])])])])])]))])])
-## #NothingT])))))
+ (: Type
+ (case' (#AppT [Meta Cursor])
+ w
+ (#AppT [w (#AppT [Syntax' w])]))))
## (deftype (Either l r)
## (| (#Left l)
## (#Right r)))
(def' Either
- (check' Type
- (#AllT [#Nil "_" "l"
- (#AllT [#Nil "" "r"
- (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
- (#Cons [["lux;Right" (#BoundT "r")]
- #Nil])]))])])))
-
-## (deftype MacroOutput
-## (Either Text [CompilerState (List Syntax)]))
-## (def' MacroOutput
-## (check' Type
-## (case' (#AppT [List Syntax])
-## SyntaxList
-## (#AppT [(#AppT [Either Text])
-## (#TupleT (#Cons [CompilerState
-## (#Cons [SyntaxList #Nil])]))]))))
+ (: Type
+ (#AllT [#Nil "_" "l"
+ (#AllT [#Nil "" "r"
+ (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
+ (#Cons [["lux;Right" (#BoundT "r")]
+ #Nil])]))])])))
## (deftype Macro
## (-> (List Syntax) CompilerState
## (Either Text [CompilerState (List Syntax)])))
(def' Macro
- (check' Type
- (case' (#AppT [List Syntax])
- SyntaxList
- (#LambdaT [SyntaxList
- (#LambdaT [CompilerState
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
- (#Cons [SyntaxList
- #Nil])]))])])]))))
+ (: Type
+ (case' (#AppT [List Syntax])
+ SyntaxList
+ (#LambdaT [SyntaxList
+ (#LambdaT [CompilerState
+ (#AppT [(#AppT [Either Text])
+ (#TupleT (#Cons [CompilerState
+ (#Cons [SyntaxList
+ #Nil])]))])])]))))
## Base functions & macros
## (def (_meta data)
## (-> (Syntax' (Meta Cursor)) Syntax)
## (#Meta [["" -1 -1] data]))
(def' _meta
- (check' (#LambdaT [(#AppT [Syntax'
- (#AppT [Meta Cursor])])
- Syntax])
- (lambda' _ data
- (#Meta [["" -1 -1] data]))))
+ (: (#LambdaT [(#AppT [Syntax'
+ (#AppT [Meta Cursor])])
+ Syntax])
+ (lambda' _ data
+ (#Meta [["" -1 -1] data]))))
## (def (return' x)
## (-> SyntaxList CompilerState
## (Either Text (, CompilerState SyntaxList)))
## ...)
(def' return'
- (check' (case' (#AppT [List Syntax])
- SyntaxList
- (#LambdaT [SyntaxList
- (#LambdaT [CompilerState
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
- (#Cons [SyntaxList
- #Nil])]))])])]))
- (lambda' _ val
- (lambda' _ state
- (#Right [state val])))))
+ (: (case' (#AppT [List Syntax])
+ SyntaxList
+ (#LambdaT [SyntaxList
+ (#LambdaT [CompilerState
+ (#AppT [(#AppT [Either Text])
+ (#TupleT (#Cons [CompilerState
+ (#Cons [SyntaxList
+ #Nil])]))])])]))
+ (lambda' _ val
+ (lambda' _ state
+ (#Right [state val])))))
## (def (fail' msg)
## (-> Text CompilerState
## (Either Text (, CompilerState SyntaxList)))
## ...)
(def' fail'
- (check' (case' (#AppT [List Syntax])
- SyntaxList
- (#LambdaT [Text
- (#LambdaT [CompilerState
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
- (#Cons [SyntaxList
- #Nil])]))])])]))
- (lambda' _ msg
- (lambda' _ state
- (#Left msg)))))
+ (: (case' (#AppT [List Syntax])
+ SyntaxList
+ (#LambdaT [Text
+ (#LambdaT [CompilerState
+ (#AppT [(#AppT [Either Text])
+ (#TupleT (#Cons [CompilerState
+ (#Cons [SyntaxList
+ #Nil])]))])])]))
+ (lambda' _ msg
+ (lambda' _ state
+ (#Left msg)))))
## (def' let'
-## (check' Macro
+## (: Macro
## (lambda' _ tokens
## (case' tokens
## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
## (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])))
## #Nil]))
-
+
## _
## (#Left "Wrong syntax for let'")))))
(def' let'
- (check' Macro
- (lambda' _ tokens
- (case' tokens
- (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
- (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
- (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])))
- #Nil]))
-
- _
- (fail' "Wrong syntax for let'")))))
+ (: Macro
+ (lambda' _ tokens
+ (case' tokens
+ (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
+ (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
+ (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])))
+ #Nil]))
+
+ _
+ (fail' "Wrong syntax for let'")))))
(declare-macro' let')
(def' lambda
- (check' Macro
- (lambda' _ tokens
- (case' tokens
- (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])
- (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
- (#Cons [(_meta (#Symbol ["" ""]))
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
- (#Cons [(_meta (#Tuple args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #Nil]))
-
- (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])])
- (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
- (#Cons [(_meta (#Symbol self))
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
- (#Cons [(_meta (#Tuple args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #Nil]))
-
- _
- (fail' "Wrong syntax for lambda")))))
+ (: Macro
+ (lambda' _ tokens
+ (case' tokens
+ (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])
+ (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
+ (#Cons [(_meta (#Symbol ["" ""]))
+ (#Cons [arg
+ (#Cons [(case' args'
+ #Nil
+ body
+
+ _
+ (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
+ (#Cons [(_meta (#Tuple args'))
+ (#Cons [body #Nil])])]))))
+ #Nil])])])])))
+ #Nil]))
+
+ (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])])
+ (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
+ (#Cons [(_meta (#Symbol self))
+ (#Cons [arg
+ (#Cons [(case' args'
+ #Nil
+ body
+
+ _
+ (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"]))
+ (#Cons [(_meta (#Tuple args'))
+ (#Cons [body #Nil])])]))))
+ #Nil])])])])))
+ #Nil]))
+
+ _
+ (fail' "Wrong syntax for lambda")))))
(declare-macro' lambda)
(def' def
- (check' 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 ["" "check'"]))
- (#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 ["" "check'"]))
- (#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)
(def (defmacro tokens)
@@ -552,19 +505,19 @@
(def (reverse' list)
(->' ($' List Syntax) ($' List Syntax))
- (fold' (check' (->' ($' List Syntax) Syntax
- ($' List Syntax))
- (lambda [tail head]
- (#Cons [head tail])))
+ (fold' (: (->' ($' List Syntax) Syntax
+ ($' List Syntax))
+ (lambda [tail head]
+ (#Cons [head tail])))
#Nil
list))
(defmacro (list xs)
- (return' (#Cons [(fold' (check' (->' Syntax Syntax Syntax)
- (lambda [tail head]
- (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"]))
- (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])])))
- #Nil])])))))
+ (return' (#Cons [(fold' (: (->' Syntax Syntax Syntax)
+ (lambda [tail head]
+ (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"]))
+ (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])])))
+ #Nil])])))))
(_meta (#Tag ["lux" "Nil"]))
(reverse' xs))
#Nil])))
@@ -572,36 +525,130 @@
(defmacro (list& xs)
(case' (reverse' xs)
(#Cons [last init])
- (return' (list (fold' (check' (->' Syntax Syntax Syntax)
- (lambda [tail head]
- (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
- (_meta (#Tuple (list head tail))))))))
+ (return' (list (fold' (: (->' Syntax Syntax Syntax)
+ (lambda [tail head]
+ (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
+ (_meta (#Tuple (list head tail))))))))
last
init)))
_
(fail' "Wrong syntax for list&")))
-## (def (as-pairs xs)
-## (All [a]
-## (-> (List a) (List [a a])))
-## (case' xs
-## (#Cons [x (#Cons [y xs'])])
-## (#Cons [[x y] (as-pairs xs')])
+(def (as-pairs' xs)
+ (All' [a]
+ (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
+ (case' xs
+ (#Cons [x (#Cons [y xs'])])
+ (list& [x y] (as-pairs' xs'))
-## _
-## #Nil))
+ _
+ #Nil))
-## (defmacro (let tokens state)
-## (case' tokens
-## (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])
-## (let' output (fold (lambda [body binding]
-## (case' binding
-## [label value]
-## (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body)))))
-## body
-## (reverse (as-pairs bindings)))
-## (#Right [state (list output)]))))
+(defmacro (let tokens)
+ (case' tokens
+ (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])
+ (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))
+ ($' List (#TupleT (list Syntax Syntax))))
+ (lambda [tail head]
+ (#Cons [head tail])))
+ #Nil
+ (as-pairs' bindings)))))
+
+ _
+ (fail' "Wrong syntax for let")))
+
+(def (map' f xs)
+ (All' [a b]
+ (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
+ (case' xs
+ #Nil
+ #Nil
+
+ (#Cons [x xs'])
+ (#Cons [(f x) (map' f xs')])))
+
+(def (wrap-meta content)
+ (->' ($' Syntax' ($' Meta Cursor)) Syntax)
+ (_meta (#Form (list (_meta (#Tag ["lux" "Meta"]))
+ (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Text "")) (_meta (#Int -1)) (_meta (#Int -1)))))
+ (_meta content))))))))
+
+(def (untemplate-list tokens)
+ (->' ($' List Syntax) Syntax)
+ (case' tokens
+ #Nil
+ (_meta (#Tag ["lux" "Nil"]))
+
+ (#Cons [token tokens'])
+ (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
+ (_meta (#Tuple (list token (untemplate-list tokens')))))))))
+
+(def (untemplate token)
+ (->' Syntax Syntax)
+ (case' token
+ (#Meta [_ (#Bool value)])
+ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value)))))
+
+ (#Meta [_ (#Int value)])
+ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value)))))
+
+ (#Meta [_ (#Real value)])
+ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value)))))
+
+ (#Meta [_ (#Char value)])
+ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value)))))
+
+ (#Meta [_ (#Text value)])
+ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value)))))
+
+ (#Meta [_ (#Tag [module name])])
+ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name))))))))
+
+ (#Meta [_ (#Symbol [module name])])
+ (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)))))
+
+ (#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)))))
+
+ (#Meta [_ (#Record fields)])
+ (wrap-meta (#Record (map' (: (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax)))
+ (lambda [kv]
+ (let [[k v] kv]
+ [k (untemplate v)])))
+ fields)))
+ ))
+
+(defmacro (` tokens)
+ (case' tokens
+ (#Cons [template #Nil])
+ (return' (list (untemplate template)))
+
+ _
+ (fail' "Wrong syntax for `")))
+
+(defmacro (if tokens)
+ (case' tokens
+ (#Cons [test (#Cons [then (#Cons [else #Nil])])])
+ (return' (list (` (case' (~ test)
+ true (~ then)
+ false (~ else)))))
+
+ _
+ (fail' "Wrong syntax for if")))
## (def (print x)
## (-> (^ java.lang.Object) [])
@@ -641,85 +688,11 @@
## (-> (List (List a)) (List a)))
## (fold ++ #Nil))
-## (def (map f xs)
-## (All [a b]
-## (-> (-> a b) (List a) (List b)))
-## (case' xs
-## #Nil
-## #Nil
-
-## (#Cons [x xs'])
-## (#Cons [(f x) (map f xs')])))
-
## (def flat-map
## (All [a b]
## (-> (-> a (List b)) (List a) (List b)))
## (. concat map))
-## (def (wrap-meta content)
-## ...
-## (_meta (#Form (list (_meta (#Tag ["lux" "Meta"]))
-## (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text "")))))
-## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1)))))
-## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1))))))))
-## (_meta content))))))))
-
-## (def (untemplate-list tokens)
-## (-> (List Syntax) Syntax)
-## (case' tokens
-## #Nil
-## (_meta (#Tag ["lux" "Nil"]))
-
-## (#Cons [token tokens'])
-## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
-## (_meta (#Tuple (list token (untemplate-list tokens')))))))))
-
-## (def (untemplate token)
-## ...
-## (case' token
-## (#Meta [_ (#Bool value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value)))))
-
-## (#Meta [_ (#Int value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value)))))
-
-## (#Meta [_ (#Real value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value)))))
-
-## (#Meta [_ (#Char value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value)))))
-
-## (#Meta [_ (#Text value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value)))))
-
-## (#Meta [_ (#Tag [module name])])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name))))))))
-
-## (#Meta [_ (#Symbol [module name])])
-## (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)))))
-
-## (#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)))))
-## ))
-
-(defmacro (` tokens)
- (case' tokens
- (#Cons [template #Nil])
- (return' (list (untemplate template)))))
-
-(defmacro (if tokens)
- (case' tokens
- (#Cons [test (#Cons [then (#Cons [else #Nil])])])
- (return' (list (` (case' (~ test)
- true (~ then)
- false (~ else)))))))
-
## (def (filter p xs)
## (All [a]
## (-> (-> a Bool) (List a) (List a)))
@@ -927,14 +900,14 @@
## #Nil true
## _ false))
-## ## ## ## (do-template [<name> <op>]
-## ## ## ## (def (<name> p xs)
-## ## ## ## (case xs
-## ## ## ## #Nil true
-## ## ## ## (#Cons [x xs']) (<op> (p x) (<name> p xs'))))
+## ## (do-template [<name> <op>]
+## ## (def (<name> p xs)
+## ## (case xs
+## ## #Nil true
+## ## (#Cons [x xs']) (<op> (p x) (<name> p xs'))))
-## ## ## ## [every? and]
-## ## ## ## [any? or])
+## ## [every? and]
+## ## [any? or])
## (def (range from to)
## (-> Int Int (List Int))
@@ -1022,11 +995,11 @@
## (map (. apply (zip2 bindings-list)))
## return))))
-## ## ## ## (do-template [<name> <offset>]
-## ## ## ## (def <name> (int+ <offset>))
+## ## (do-template [<name> <offset>]
+## ## (def <name> (int+ <offset>))
-## ## ## ## [inc 1]
-## ## ## ## [dec -1])
+## ## [inc 1]
+## ## [dec -1])
## (def (int= x y)
## (-> Int Int Bool)
@@ -1222,8 +1195,6 @@
## ## (return (flat-map (lambda [pattern] (list pattern body))
## ## patterns))))
-## ## (def null jvm-null)
-
## (defmacro (^ tokens)
## (case' tokens
## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil])
@@ -1312,60 +1283,12 @@
## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name))))
## body)))))))))
-## (defmacro (Exists tokens)
-## (case' tokens
-## (#Cons [args (#Cons [body #Nil])])
-## (return (list (` (All (~ args) (~ body)))))))
-
-## (def Any #AnyT)
-## (def Nothing #NothingT)
-## (def Bool (^ java.lang.Boolean))
-## (def Int (^ java.lang.Long))
-## (def Real (^ java.lang.Double))
-## (def Char (^ java.lang.Character))
-## (def Text (^ java.lang.String))
-
-## (deftype (List a)
-## (| #Nil
-## (#Cons (, a (List a)))))
-
-## (deftype #rec Type
-## (| #AnyT
-## #NothingT
-## (#DataT Text)
-## (#TupleT (List Type))
-## (#VariantT (List (, Text Type)))
-## (#RecordT (List (, Text Type)))
-## (#LambdaT (, Type Type))
-## (#BoundT Text)
-## (#VarT Int)
-## (#AllT (, (List (, Text Type)) Text Text Type))
-## (#AppT (, Type Type))))
-
-## (deftype (Either l r)
-## (| (#Left l)
-## (#Right r)))
-
-## (deftype #rec Syntax
-## (| (#Bool Bool)
-## (#Int Int)
-## (#Real Real)
-## (#Char Char)
-## (#Text Text)
-## (#Form (List Syntax))
-## (#Tuple (List Syntax))
-## (#Record (List (, Text Syntax)))))
-
-## (deftype Macro
-## (-> (List Syntax) CompilerState
-## (Either Text (, CompilerState (List Syntax)))))
-
## (def (macro-expand syntax)
## (-> Syntax (LuxStateM (List Syntax)))
## (case' syntax
## (#Form (#Cons [(#Symbol macro-name) args]))
## (do [macro (get-macro macro-name)]
-## ((coerce macro Macro) args))))
+## ((:! macro Macro) args))))
## (defmacro (case tokens)
## (case' tokens
@@ -1434,8 +1357,10 @@
## (: (~ def-body) (~ signature))))))))
## (defsig (Monad m)
-## (: return (All [a] (-> a (m a))))
-## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b)))))
+## (: (All [a] (-> a (m a)))
+## return)
+## (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
+## bind))
## (defstruct ListMonad (Monad List)
## (def (return x)
@@ -1456,20 +1381,63 @@
## (= x y)))
## (zip2 xs ys)))))
-## ## ## (def (with tokens)
-## ## ## ...)
-
-## ## ## TODO: Full pattern-matching
-## ## ## TODO: Type-related macros
-## ## ## TODO: (Im|Ex)ports-related macros
-## ## ## TODO: Macro-related macros
-
-## ## ## (import "lux")
-## ## ## (module-alias "lux" "l")
-## ## ## (def-alias "lux;map" "map")
-
-## ## ## (def (require tokens)
-## ## ## (case tokens
-## ## ## ...))
-
-## ## ## (require lux #as l #refer [map])
+## ## (def (with tokens)
+## ## ...)
+
+## ## (import "lux")
+## ## (module-alias "lux" "l")
+## ## (def-alias "lux;map" "map")
+
+## ## (def (require tokens)
+## ## (case tokens
+## ## ...))
+
+## ## (require lux #as l #refer [map])
+
+## (defsyntax #export (All [name (%? %name)] [args %args] body)
+## (let [name' (case name
+## #None ""
+## (#Some name) name)
+## arg-replacements (map (lambda [arg]
+## [(#Symbol ["" arg]) (` (#Bound (~ arg)))])
+## args)
+## args' (map (lambda [arg]
+## (#Symbol ["" arg]))
+## args)
+## body' (replace-syntax arg-replacements body)]
+## (return (list (` (#AllT [#Nil (~ name') (#Tuple (list (~@ args')))
+## (~ body')]))))))
+
+## (def (walk-syntax type)
+## (case type
+## (#Meta [_ (#Form (\list& op args))])
+## (case op
+## (#Meta [_ (#Symbol ident)])
+## (do' [macro?? (find-macro ident)]
+## (case macro??
+## (#Some macro)
+## (do' [expansion (macro args)]
+## (flat-map% walk-syntax expansion))
+
+## #None
+## (do' [flat-map% (map% walk-syntax args)]
+## (return' (list (fold (lambda [fun arg]
+## (` (#AppT [(~ fun) (~ arg)])))
+## op
+## args))))))
+
+## _
+## (do' [flat-map% (map% walk-syntax args)]
+## (return' (list (_meta (#Form (list op args')))))))
+
+## _
+## (return' (list type))))
+
+## (defsyntax #export (type type-syntax)
+## (walk-syntax type-syntax))
+
+## (defsyntax #export (deftype [[name args] %usage] body)
+## (return (list (` (def (~ name)
+## (: Type
+## (type (All [(~@ args)]
+## (~ body)))))))))
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 181d76b5b..9097168e2 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -101,13 +101,13 @@
["lux;Nil" _]]]]]]]]]
(&&lux/analyse-import analyse ?path)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "check'"]]]]
+ [["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" ["" "coerce'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!"]]]]
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
@@ -435,7 +435,7 @@
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]]
(fn [state]
- ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn))
+ ;; (prn 'analyse-ast '(&/show-ast ?fn) (&/show-ast ?fn))
(matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval!) % ?fn)) state)]
[["lux;Right" [state* =fn]]]
((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*)
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 4b23f9460..1653a4fa1 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -26,18 +26,6 @@
[_]
(fail "[Analyser Error] Can't expand to other than 1 element.")))))
-(defn analyse-2 [analyse exo-type1 el1 exo-type2 el2]
- (|do [output1 (analyse exo-type1 el1)
- output2 (analyse exo-type2 el2)]
- (do ;; (prn 'analyse-2 (aget output 0))
- (matchv ::M/objects [output1 output2]
- [["lux;Cons" [x ["lux;Nil" _]]]
- ["lux;Cons" [y ["lux;Nil" _]]]]
- (return (&/T x y))
-
- [_ _]
- (fail "[Analyser Error] Can't expand to other than 2 elements.")))))
-
(defn resolved-ident [ident]
(|let [[?module ?name] ident]
(|do [module* (if (= "" ?module)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index a9424b50d..e1f5c4c84 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -203,7 +203,7 @@
))))
(defn ^:private check-totality [value-type struct]
- (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type))
+ ;; (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type))
(matchv ::M/objects [struct]
[["BoolTotal" [?total _]]]
(return ?total)
@@ -279,7 +279,7 @@
(analyse-branch analyse exo-type value-type pattern body patterns)))
(&/|list)
branches)
- :let [_ (prn 'PRE_MERGE_TOTALS)]
+ ;; :let [_ (prn 'PRE_MERGE_TOTALS)]
struct (&/fold% merge-total (&/V "DefaultTotal" false) patterns)
? (check-totality value-type struct)]
(if ?
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index b282f806e..299471ee8 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -23,7 +23,8 @@
(let [input-type (&/V "lux;DataT" <input-class>)
output-type (&/V "lux;DataT" <output-class>)]
(defn <name> [analyse ?x ?y]
- (|do [[=x =y] (&&/analyse-2 analyse input-type ?x input-type ?y)]
+ (|do [=x (&&/analyse-1 analyse input-type ?x)
+ =y (&&/analyse-1 analyse input-type ?y)]
(return (&/|list (&/V "Expression" (&/T (&/V <output-tag> (&/T =x =y)) output-type)))))))
analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer"
@@ -136,11 +137,9 @@
(&/V "lux;Nil" nil)))))))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
- (|do [=array+=elem (&&/analyse-2 analyse ?array ?elem)
- :let [[=array =elem] (matchv ::M/objects [=array+=elem]
- [[=array =elem]]
- [=array =elem])]
- =array-type (&&/expr-type =array)]
+ (|do [=array (&&/analyse-1 analyse &type/Nothing ?array)
+ =elem (&&/analyse-1 analyse &type/Nothing ?elem)
+ =array-type (&&/expr-type =array)]
(return (&/|list (&/V "Expression" (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type))))))
(defn analyse-jvm-aaload [analyse ?array ?idx]
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index 553c4ea9b..da9d6b044 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -21,11 +21,11 @@
(return (&/T scope-name =captured =return)))))))))
(defn close-over [scope ident register frame]
- (prn 'close-over
- (&host/location scope)
- (&host/location (&/|list ident))
- register
- (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")))
+ ;; (prn 'close-over
+ ;; (&host/location scope)
+ ;; (&host/location (&/|list ident))
+ ;; register
+ ;; (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")))
(matchv ::M/objects [register]
[["Expression" [_ register-type]]]
(|let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index f1c7a6035..68d612db6 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -16,7 +16,7 @@
(defn ^:private analyse-1+ [analyse ?token]
(&type/with-var
(fn [$var]
- (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token))
+ ;; (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token))
(|do [=expr (&&/analyse-1 analyse $var ?token)]
(matchv ::M/objects [=expr]
[["Expression" [?item ?type]]]
@@ -125,7 +125,7 @@
;; _ (&type/check exo-type btype)]
;; (return (&/|list global)))
state)
- (do (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))"))
+ (do ;; (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))"))
(fail* (str "[Analyser Error] Unrecognized identifier: " local-ident))))
[["lux;Cons" [top-outer _]]]
@@ -150,7 +150,8 @@
))
(defn ^:private analyse-apply* [analyse exo-type =fn ?args]
- (prn 'analyse-apply*/exo-type (&type/show-type exo-type))
+ ;; (prn 'analyse-apply* (&/->seq (&/|map &/show-ast ?args)))
+ ;; (prn 'analyse-apply*/exo-type (&type/show-type exo-type))
(matchv ::M/objects [=fn]
[["Statement" _]]
(fail "[Analyser Error] Can't apply a statement!")
@@ -162,7 +163,7 @@
(return (&/|list =fn)))
[["lux;Cons" [?arg ?args*]]]
- (do (prn 'analyse-apply*/=fn (&type/show-type ?fun-type))
+ (do ;; (prn 'analyse-apply*/=fn (&type/show-type ?fun-type))
(matchv ::M/objects [?fun-type]
[["lux;AllT" _]]
(&type/with-var
@@ -175,13 +176,16 @@
(return (&/|list (&/V "Expression" (&/T ?expr* type**)))))
[_]
- (do (prn 'analyse-apply*/output (aget output 0))
- (assert false))))))
+ (assert false (prn-str 'analyse-apply*/output (aget output 0)))))))
[["lux;LambdaT" [?input-t ?output-t]]]
+ ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
+ ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
+ ;; ?output-t)))))
(|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
- (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
- ?output-t)))))
+ (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
+ ?output-t))
+ ?args*))
[_]
(fail "[Analyser Error] Can't apply a non-function.")))
@@ -199,7 +203,10 @@
(if macro?
(let [macro-class (&host/location (&/|list ?module ?name))]
(|do [macro-expansion (&macro/expand loader macro-class ?args)
- :let [_ (prn 'EXPANDING (&type/show-type exo-type))]
+ ;; :let [_ (when (and (= "lux" ?module)
+ ;; (= "`" ?name))
+ ;; (prn 'macro-expansion (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))]
+ ;; :let [_ (prn 'EXPANDING (&type/show-type exo-type))]
output (&/flat-map% (partial analyse exo-type) macro-expansion)]
(return output)))
(analyse-apply* analyse exo-type =fn ?args)))
@@ -212,15 +219,16 @@
))
(defn analyse-case [analyse exo-type ?value ?branches]
- (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value))
+ ;; (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value))
(|do [:let [num-branches (&/|length ?branches)]
_ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.")
_ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.")
=value (analyse-1+ analyse ?value)
=value-type (&&/expr-type =value)
- :let [_ (prn 'analyse-case/GOT_VALUE (&type/show-type =value-type))]
+ ;; :let [_ (prn 'analyse-case/GOT_VALUE (&type/show-type =value-type))]
=match (&&case/analyse-branches analyse exo-type =value-type (&/|as-pairs ?branches))
- :let [_ (prn 'analyse-case/GOT_MATCH)]]
+ ;; :let [_ (prn 'analyse-case/GOT_MATCH)]
+ ]
(return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value =match))
exo-type))))))
@@ -237,7 +245,7 @@
(fail (str "[Analyser Error] Functions require function types: " (&type/show-type exo-type)))))
(defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
- (prn 'analyse-lambda**/&& (aget exo-type 0))
+ ;; (prn 'analyse-lambda**/&& (aget exo-type 0))
(matchv ::M/objects [exo-type]
[["lux;AllT" _]]
(&type/with-var
@@ -270,7 +278,8 @@
;; :let [_ (prn 'analyse-def/_1)]
=value-type (&&/expr-type =value)
;; :let [_ (prn 'analyse-def/_2)]
- :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type))]
+ :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type))
+ _ (println)]
_ (&&def/define module-name ?name =value-type)
;; :let [_ (prn 'analyse-def/_3)]
]
@@ -278,9 +287,10 @@
(defn analyse-declare-macro [ident]
(|do [current-module &/get-module-name
- :let [_ (prn 'analyse-declare-macro/current-module current-module)]
+ ;; :let [_ (prn 'analyse-declare-macro/current-module current-module)]
[?module ?name] (&&/resolved-ident* ident)
- :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])]]
+ ;; :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])]
+ ]
(if (= ?module current-module)
(|do [_ (&&def/declare-macro ?module ?name)]
(return (&/|list)))
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 8f737af20..d6a259476 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -142,7 +142,7 @@
(doseq [?body+?match (&/->seq patterns)
:let [;; _ (prn 'compile-pattern-matching/pattern pattern)
;; _ (prn '?body+?match (alength ?body+?match) (aget ?body+?match 0))
- _ (prn '?body+?match (aget ?body+?match 0))
+ ;; _ (prn '?body+?match (aget ?body+?match 0))
$else (new Label)]])))
(.visitInsn Opcodes/POP)
(.visitTypeInsn Opcodes/NEW ex-class)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 332f9804b..3c3774e7e 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -40,7 +40,8 @@
(.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
(.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)
- _ (prn 'add-lambda-<init> class-name ?captured-id)])
+ ;; _ (prn 'add-lambda-<init> class-name ?captured-id)
+ ])
(matchv ::M/objects [?name+?captured]
[[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]])
(doseq [?name+?captured (&/->seq env)])))
@@ -78,23 +79,50 @@
(return ret))))
(defn ^:private instance-closure [compile lambda-class closed-over init-signature]
- ;; (prn 'instance-closure lambda-class closed-over init-signature)
+ ;; (prn 'instance-closure lambda-class (&/|length closed-over) init-signature)
(|do [*writer* &/get-writer
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/NEW lambda-class)
- (.visitInsn Opcodes/DUP))]
- _ (->> closed-over
- &/->seq
- (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
- [["Expression" [["captured" [_ ?cid1 _]] _]]
- ["Expression" [["captured" [_ ?cid2 _]] _]]]
- (< ?cid1 ?cid2)))
- &/->list
- (&/map% (fn [?name+?captured]
- (matchv ::M/objects [?name+?captured]
- [[?name ["Expression" [["captured" [_ _ ?source]] _]]]]
- (compile ?source)))))
- :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW lambda-class)
+ (.visitInsn Opcodes/DUP))
+ ;; _ (prn 'closed-over/pre
+ ;; (&/->seq (&/|map #(matchv ::M/objects [(&/|second %1)]
+ ;; [["Expression" [["captured" [_ ?cid _]] _]]]
+ ;; ?cid)
+ ;; closed-over)))
+ ;; _ (prn 'closed-over/post
+ ;; (->> closed-over
+ ;; &/->seq
+ ;; (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
+ ;; [["Expression" [["captured" [_ ?cid1 _]] _]]
+ ;; ["Expression" [["captured" [_ ?cid2 _]] _]]]
+ ;; (< ?cid1 ?cid2)))
+ ;; &/->list
+ ;; (&/|map #(matchv ::M/objects [(&/|second %1)]
+ ;; [["Expression" [["captured" [_ ?cid _]] _]]]
+ ;; ?cid))
+ ;; &/->seq))
+ ]
+ _ (->> closed-over
+ &/->seq
+ (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
+ [["Expression" [["captured" [_ ?cid1 _]] _]]
+ ["Expression" [["captured" [_ ?cid2 _]] _]]]
+ (< ?cid1 ?cid2)))
+ &/->list
+ (&/map% (fn [?name+?captured]
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ _ ?source]] _]]]]
+ (do ;; (prn '?source (aget ?source 1 0 0)
+ ;; (cond (= "captured" (aget ?source 1 0 0))
+ ;; ["captured" (aget ?source 1 0 1 1)]
+
+ ;; (= "local" (aget ?source 1 0 0))
+ ;; ["local" (aget ?source 1 0 1)]
+
+ ;; :else
+ ;; '???))
+ (compile ?source))))))
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
(return nil)))
;; [Exports]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 20:37:21 +0000