aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux.lux')
-rw-r--r--stdlib/source/lux.lux224
1 files changed, 117 insertions, 107 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 54ac52b70..1a8d07922 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -95,7 +95,7 @@
(+2)
## "lux;Cons"
(+4 (+6 +1)
- (+11 (+6 +0) (+6 +1))))))
+ (+11 (+6 +1) (+6 +0))))))
(+1 [["lux" "type?"] (+0 true)]
(+1 [["lux" "export?"] (+0 true)]
(+1 [["lux" "tags"] (+8 (+1 (+6 "Nil") (+1 (+6 "Cons") (+0))))]
@@ -132,18 +132,19 @@
## (#Ex Nat)
## (#UnivQ (List Type) Type)
## (#ExQ (List Type) Type)
-## (#App Type Type)
+## (#Apply Type Type)
## (#Named Ident Type)
## )
(_lux_def Type
(+12 ["lux" "Type"]
- (_lux_case (+11 (+6 +0) (+6 +1))
+ (_lux_case (+11 (+6 +1) (+6 +0))
Type
- (_lux_case (+11 List Type)
+ (_lux_case (+11 Type List)
TypeList
(_lux_case (+4 Type Type)
TypePair
- (+11 (+9 #Nil
+ (+11 Void
+ (+9 #Nil
(+3 ## "lux;Host"
(+4 Text TypeList)
(+3 ## "lux;Void"
@@ -169,8 +170,7 @@
(+3 ## "lux;App"
TypePair
## "lux;Named"
- (+4 Ident Type))))))))))))))
- Void)))))
+ (+4 Ident Type)))))))))))))))))))
(#Cons [["lux" "type?"] (+0 true)]
(#Cons [["lux" "export?"] (+0 true)]
(#Cons [["lux" "tags"] (+8 (#Cons (+6 "Host")
@@ -184,7 +184,7 @@
(#Cons (+6 "Ex")
(#Cons (+6 "UnivQ")
(#Cons (+6 "ExQ")
- (#Cons (+6 "App")
+ (#Cons (+6 "Apply")
(#Cons (+6 "Named")
#Nil))))))))))))))]
(#Cons [["lux" "doc"] (+6 "This type represents the data-structures that are used to specify types themselves.")]
@@ -228,31 +228,31 @@
## (#DictA (List [Text Ann-Value])))
(_lux_def Ann-Value
(#Named ["lux" "Ann-Value"]
- (_lux_case (#App (#Bound +0) (#Bound +1))
+ (_lux_case (#Apply (#Bound +1) (#Bound +0))
Ann-Value
- (#App (#UnivQ #Nil
- (#Sum ## #BoolA
- Bool
- (#Sum ## #NatA
- Nat
- (#Sum ## #IntA
- Int
- (#Sum ## #DegA
- Deg
- (#Sum ## #RealA
- Real
- (#Sum ## #CharA
- Char
- (#Sum ## #TextA
- Text
- (#Sum ## #IdentA
- Ident
- (#Sum ## #ListA
- (#App List Ann-Value)
- ## #DictA
- (#App List (#Product Text Ann-Value)))))))))))
- )
- Void)
+ (#Apply Void
+ (#UnivQ #Nil
+ (#Sum ## #BoolA
+ Bool
+ (#Sum ## #NatA
+ Nat
+ (#Sum ## #IntA
+ Int
+ (#Sum ## #DegA
+ Deg
+ (#Sum ## #RealA
+ Real
+ (#Sum ## #CharA
+ Char
+ (#Sum ## #TextA
+ Text
+ (#Sum ## #IdentA
+ Ident
+ (#Sum ## #ListA
+ (#Apply Ann-Value List)
+ ## #DictA
+ (#Apply (#Product Text Ann-Value) List))))))))))
+ ))
))
(#Cons [["lux" "type?"] (+0 true)]
(#Cons [["lux" "export?"] (+0 true)]
@@ -275,7 +275,7 @@
## (List [Ident Ann-Value]))
(_lux_def Anns
(#Named ["lux" "Anns"]
- (#App List (#Product Ident Ann-Value)))
+ (#Apply (#Product Ident Ann-Value) List))
(#Cons [["lux" "type?"] (#BoolA true)]
(#Cons [["lux" "export?"] (#BoolA true)]
(#Cons [["lux" "doc"] (#TextA "A set of annotations associated with a definition.")]
@@ -312,9 +312,9 @@
(#Product ## "lux;counter"
Nat
## "lux;mappings"
- (#App List
- (#Product (#Bound +3)
- (#Bound +1)))))))
+ (#Apply (#Product (#Bound +3)
+ (#Bound +1))
+ List)))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "counter")
(#Cons (#TextA "mappings")
#Nil)))]
@@ -373,13 +373,13 @@
(_lux_def Scope
(#Named ["lux" "Scope"]
(#Product ## name
- (#App List Text)
+ (#Apply Text List)
(#Product ## inner
Nat
(#Product ## locals
- (#App (#App Bindings Text) (#Product Type Nat))
+ (#Apply (#Product Type Nat) (#Apply Text Bindings))
## captured
- (#App (#App Bindings Text) (#Product Type Ref))))))
+ (#Apply (#Product Type Ref) (#Apply Text Bindings))))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "name")
(#Cons (#TextA "inner")
(#Cons (#TextA "locals")
@@ -402,11 +402,11 @@
## (#Record (List [(w (Code' w)) (w (Code' w))])))
(_lux_def Code'
(#Named ["lux" "Code'"]
- (_lux_case (#App (#Bound +1)
- (#App (#Bound +0)
- (#Bound +1)))
+ (_lux_case (#Apply (#Apply (#Bound +1)
+ (#Bound +0))
+ (#Bound +1))
Code
- (_lux_case (#App [List Code])
+ (_lux_case (#Apply Code List)
Code-List
(#UnivQ #Nil
(#Sum ## "lux;Bool"
@@ -432,7 +432,7 @@
(#Sum ## "lux;Tuple"
Code-List
## "lux;Record"
- (#App List (#Product Code Code))
+ (#Apply (#Product Code Code) List)
)))))))))))
))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Bool")
@@ -455,14 +455,14 @@
## (Meta Cursor (Code' (Meta Cursor))))
(_lux_def Code
(#Named ["lux" "Code"]
- (_lux_case (#App Meta Cursor)
+ (_lux_case (#Apply Cursor Meta)
w
- (#App w (#App Code' w))))
+ (#Apply (#Apply w Code') w)))
(#Cons [["lux" "doc"] (#TextA "The type of Code nodes for Lux syntax.")]
default-def-meta-exported))
(_lux_def Code-List
- (#App List Code)
+ (#Apply Code List)
default-def-meta-unexported)
## (type: (Either l r)
@@ -524,25 +524,24 @@
(#Product ## "lux;module-hash"
Nat
(#Product ## "lux;module-aliases"
- (#App List (#Product Text Text))
+ (#Apply (#Product Text Text) List)
(#Product ## "lux;defs"
- (#App List (#Product Text
- Def))
+ (#Apply (#Product Text Def) List)
(#Product ## "lux;imports"
- (#App List Text)
+ (#Apply Text List)
(#Product ## "lux;tags"
- (#App List
- (#Product Text
- (#Product Nat
- (#Product (#App List Ident)
- (#Product Bool
- Type)))))
+ (#Apply (#Product Text
+ (#Product Nat
+ (#Product (#Apply Ident List)
+ (#Product Bool
+ Type))))
+ List)
(#Product ## "lux;types"
- (#App List
- (#Product Text
- (#Product (#App List Ident)
- (#Product Bool
- Type))))
+ (#Apply (#Product Text
+ (#Product (#Apply Ident List)
+ (#Product Bool
+ Type)))
+ List)
(#Product ## "lux;module-anns"
Anns
Module-State))
@@ -570,9 +569,8 @@
(#Product ## var-counter
Nat
## var-bindings
- (#App List
- (#Product Nat
- (#App Maybe Type))))))
+ (#Apply (#Product Nat (#Apply Type Maybe))
+ List))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "ex-counter")
(#Cons (#TextA "var-counter")
(#Cons (#TextA "var-bindings")
@@ -633,18 +631,17 @@
(#Product ## "lux;cursor"
Cursor
(#Product ## "lux;modules"
- (#App List (#Product Text
- Module))
+ (#Apply (#Product Text Module) List)
(#Product ## "lux;scopes"
- (#App List Scope)
+ (#Apply Scope List)
(#Product ## "lux;type-context"
Type-Context
(#Product ## "lux;expected"
- (#App Maybe Type)
+ (#Apply Type Maybe)
(#Product ## "lux;seed"
Nat
(#Product ## scope-type-vars
- (#App List Nat)
+ (#Apply Nat List)
## "lux;host"
Void))))))))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "info")
@@ -671,8 +668,8 @@
(#Named ["lux" "Lux"]
(#UnivQ #Nil
(#Function Compiler
- (#App (#App Either Text)
- (#Product Compiler (#Bound +1))))))
+ (#Apply (#Product Compiler (#Bound +1))
+ (#Apply Text Either)))))
(#Cons [["lux" "doc"] (#TextA "Computations that can have access to the state of the compiler.
These computations may fail, or modify the state of the compiler.")]
@@ -683,7 +680,7 @@
## (-> (List Code) (Lux (List Code))))
(_lux_def Macro
(#Named ["lux" "Macro"]
- (#Function Code-List (#App Lux Code-List)))
+ (#Function Code-List (#Apply Code-List Lux)))
(#Cons [["lux" "doc"] (#TextA "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")]
default-def-meta-exported))
@@ -694,8 +691,8 @@
#Nil))
(_lux_def _meta
- (_lux_: (#Function (#App Code'
- (#App Meta Cursor))
+ (_lux_: (#Function (#Apply (#Apply Cursor Meta)
+ Code')
Code)
(_lux_function _ data
[dummy-cursor data]))
@@ -705,9 +702,9 @@
(_lux_: (#UnivQ #Nil
(#Function (#Bound +1)
(#Function Compiler
- (#App (#App Either Text)
- (#Product Compiler
- (#Bound +1))))))
+ (#Apply (#Product Compiler
+ (#Bound +1))
+ (#Apply Text Either)))))
(_lux_function _ val
(_lux_function _ state
(#Right state val))))
@@ -717,9 +714,9 @@
(_lux_: (#UnivQ #Nil
(#Function Text
(#Function Compiler
- (#App (#App Either Text)
- (#Product Compiler
- (#Bound +1))))))
+ (#Apply (#Product Compiler
+ (#Bound +1))
+ (#Apply Text Either)))))
(_lux_function _ msg
(_lux_function _ state
(#Left msg))))
@@ -771,17 +768,17 @@
#Nil)
(_lux_def form$
- (_lux_: (#Function (#App List Code) Code)
+ (_lux_: (#Function (#Apply Code List) Code)
(_lux_function _ tokens (_meta (#Form tokens))))
#Nil)
(_lux_def tuple$
- (_lux_: (#Function (#App List Code) Code)
+ (_lux_: (#Function (#Apply Code List) Code)
(_lux_function _ tokens (_meta (#Tuple tokens))))
#Nil)
(_lux_def record$
- (_lux_: (#Function (#App List (#Product Code Code)) Code)
+ (_lux_: (#Function (#Apply (#Product Code Code) List) Code)
(_lux_function _ tokens (_meta (#Record tokens))))
#Nil)
@@ -1004,8 +1001,8 @@
(#Cons x (#Cons y xs))
(return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"])
- (#Cons (form$ (#Cons (tag$ ["lux" "App"])
- (#Cons x (#Cons y #Nil))))
+ (#Cons (form$ (#Cons (tag$ ["lux" "Apply"])
+ (#Cons y (#Cons x #Nil))))
xs)))
#Nil))
@@ -1118,8 +1115,8 @@
#Nil
## (-> (List Code) (-> (List Text) (Lux (List Code))) (Lux (List Code)))
(#Function ($' List Code)
- (#Function (#Function ($' List Text) (#App Lux ($' List Code)))
- (#App Lux ($' List Code))
+ (#Function (#Function ($' List Text) (#Apply ($' List Code) Lux))
+ (#Apply ($' List Code) Lux)
))
(_lux_case args
#Nil
@@ -1763,7 +1760,7 @@
(do Monad<Lux>
[=elem (untemplate elem)]
(wrap (form$ (list (symbol$ ["" "_lux_:"])
- (form$ (list (tag$ ["lux" "App"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "Code"])))))
+ (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"])))))
(form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"]))))))))))))
elems))]
(wrap (wrap-meta (form$ (list tag
@@ -2495,7 +2492,7 @@
[_ (#Form (#Cons type-fn args))]
(fold (_lux_: (-> Code Code Code)
- (function' [arg type-fn] (` (#;App (~ type-fn) (~ arg)))))
+ (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn)))))
(walk-type type-fn)
(map walk-type args))
@@ -2632,9 +2629,9 @@
[Int (List Self)])")])
(_lux_case tokens
(#Cons [_ (#Symbol "" name)] (#Cons body #Nil))
- (let' [body' (replace-syntax (list [name (` (#App (~ (make-bound +0)) (~ (make-bound +1))))])
+ (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))])
(update-bounds body))]
- (return (list (` (#App (#UnivQ #Nil (~ body')) Void)))))
+ (return (list (` (#Apply Void (#UnivQ #Nil (~ body')))))))
_
(fail "Wrong syntax for Rec")))
@@ -3382,8 +3379,8 @@
(#Product left right)
(#Product (beta-reduce env left) (beta-reduce env right))
- (#App ?type-fn ?type-arg)
- (#App (beta-reduce env ?type-fn) (beta-reduce env ?type-arg))
+ (#Apply arg func)
+ (#Apply (beta-reduce env arg) (beta-reduce env func))
(#UnivQ ?local-env ?local-def)
(case ?local-env
@@ -3428,7 +3425,7 @@
(#ExQ env body)
(#Some (beta-reduce (list& type-fn param env) body))
- (#App F A)
+ (#Apply A F)
(do Monad<Maybe>
[type-fn* (apply-type F A)]
(apply-type type-fn* param))
@@ -3452,18 +3449,27 @@
[flatten-variant #;Sum]
[flatten-tuple #;Product]
[flatten-lambda #;Function]
- [flatten-app #;App]
)
+(def: (flatten-app type)
+ (-> Type [Type (List Type)])
+ (case type
+ (#;Apply head func')
+ (let [[func tail] (flatten-app func')]
+ [func (#;Cons head tail)])
+
+ _
+ [type (list)]))
+
(def: (resolve-struct-type type)
(-> Type (Maybe (List Type)))
(case type
(#Product _)
(#Some (flatten-tuple type))
- (#App fun arg)
+ (#Apply arg func)
(do Monad<Maybe>
- [output (apply-type fun arg)]
+ [output (apply-type func arg)]
(resolve-struct-type output))
(#UnivQ _ body)
@@ -3516,8 +3522,8 @@
(def: (resolve-type-tags type)
(-> Type (Lux (Maybe [(List Ident) (List Type)])))
(case type
- (#App fun arg)
- (resolve-type-tags fun)
+ (#Apply arg func)
+ (resolve-type-tags func)
(#UnivQ env body)
(resolve-type-tags body)
@@ -3668,7 +3674,7 @@
(struct (~@ defs)))))))
#;None
- (fail "Struct must have a name other than \"_\"!"))
+ (fail "Cannot infer name, so struct must have a name other than \"_\"!"))
#None
(fail "Wrong syntax for struct:"))))
@@ -4265,8 +4271,12 @@
(#ExQ env body)
($_ Text/append "(Ex " (Type/show body) ")")
- (#App _)
- ($_ Text/append "(" (|> (flatten-app type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")")
+ (#Apply _)
+ (let [[func args] (flatten-app type)]
+ ($_ Text/append
+ "(" (Type/show func) " "
+ (|> args (map Type/show) (interpose " ") reverse (fold Text/append ""))
+ ")"))
(#Named [prefix name] _)
($_ Text/append prefix ";" name)
@@ -4858,7 +4868,7 @@
(<tag> left right)
(<tag> (beta-reduce env left) (beta-reduce env right)))
([#;Function]
- [#;App])
+ [#;Apply])
(^template [<tag>]
(<tag> old-env def)
@@ -5151,8 +5161,8 @@
(let [env' (untemplate-list (map type-to-ast env))]
(` (#ExQ (~ env') (~ (type-to-ast type)))))
- (#App fun arg)
- (` (#App (~ (type-to-ast fun)) (~ (type-to-ast arg))))
+ (#Apply arg fun)
+ (` (#Apply (~ (type-to-ast arg)) (~ (type-to-ast fun))))
(#Named [module name] type)
(` (#Named [(~ (text$ module)) (~ (text$ name))] (~ (type-to-ast type))))
@@ -5486,7 +5496,7 @@
expected get-expected-type
g!temp (gensym "temp")]
(let [output (list g!temp
- (` (;_lux_case (;_lux_: (#;App Maybe (~ (type-to-ast expected)))
+ (` (;_lux_case (;_lux_: (#;Apply (~ (type-to-ast expected)) Maybe)
(case (~ g!temp)
(~@ (multi-level-case$ g!temp [mlc body]))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-24 09:48:30 +0000