From 1a7aa7e3ed6fae612d2b22eacc5805bd786efdd9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 21 Jun 2017 23:33:01 -0400 Subject: - Renamed "App" to "Apply" and swapped the order of the arguments to it. - Also did argument swapping for lux/type;application. --- stdlib/source/lux.lux | 224 ++++++++++++++++++++++++++------------------------ 1 file changed, 117 insertions(+), 107 deletions(-) (limited to 'stdlib/source/lux.lux') 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 [=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 [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 - [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 @@ ( left right) ( (beta-reduce env left) (beta-reduce env right))) ([#;Function] - [#;App]) + [#;Apply]) (^template [] ( 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])) -- cgit v1.2.3