diff options
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 53 | ||||
| -rw-r--r-- | src/lux/compiler/type.clj | 18 | ||||
| -rw-r--r-- | src/lux/type.clj | 49 |
3 files changed, 48 insertions, 72 deletions
diff --git a/source/lux.lux b/source/lux.lux index 7acb5222a..815f95c69 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -45,7 +45,7 @@ ## (#Cons a (List a)))) (_lux_def List (9 ["lux" "List"] - (7 (1 (0)) "lux;List" "a" + (7 (0) "lux;List" "a" (1 (1 ## "lux;Nil" (2 (0)) (1 ## "lux;Cons" @@ -61,7 +61,7 @@ ## (1 a))) (_lux_def Maybe (9 ["lux" "Maybe"] - (7 (1 (0)) "lux;Maybe" "a" + (7 (0) "lux;Maybe" "a" (1 (1 ## "lux;None" (2 (0)) (1 ## "lux;Some" @@ -77,7 +77,7 @@ ## (#LambdaT Type Type) ## (#BoundT Text) ## (#VarT Int) -## (#AllT (Maybe (List (, Text Type))) Text Text Type) +## (#AllT (List (, Text Type)) Text Text Type) ## (#AppT Type Type) ## (#NamedT Ident Type) ## )) @@ -89,7 +89,7 @@ TypeEnv (_lux_case (8 List Type) TypeList - (8 (7 (1 (0)) "Type" "_" + (8 (7 (0) "Type" "_" (1 (1 ## "lux;DataT" Text (1 ## "lux;VariantT" @@ -105,7 +105,7 @@ (1 ## "lux;ExT" Int (1 ## "lux;AllT" - (2 (1 (8 Maybe TypeEnv) (1 Text (1 Text (1 Type (0)))))) + (2 (1 TypeEnv (1 Text (1 Text (1 Type (0)))))) (1 ## "lux;AppT" (2 (1 Type (1 Type (0)))) (1 ## "lux;NamedT" @@ -120,7 +120,7 @@ ## #mappings (List (, k v)))) (_lux_def Bindings (#NamedT ["lux" "Bindings"] - (#AllT [(#Some #Nil) "lux;Bindings" "k" + (#AllT [#Nil "lux;Bindings" "k" (#AllT [#None "" "v" (#TupleT (#Cons ## "lux;counter" Int @@ -140,7 +140,7 @@ ## #closure (Bindings k v))) (_lux_def Env (#NamedT ["lux" "Env"] - (#AllT (#Some #Nil) "lux;Env" "k" + (#AllT #Nil "lux;Env" "k" (#AllT #None "" "v" (#TupleT (#Cons ## "lux;name" Text @@ -167,7 +167,7 @@ ## (| (#Meta m v))) (_lux_def Meta (#NamedT ["lux" "Meta"] - (#AllT (#Some #Nil) "lux;Meta" "m" + (#AllT #Nil "lux;Meta" "m" (#AllT #None "" "v" (#VariantT (#Cons ## "lux;Meta" (#TupleT (#Cons (#BoundT "m") @@ -196,7 +196,7 @@ AST (_lux_case (#AppT [List AST]) ASTList - (#AllT (#Some #Nil) "lux;AST'" "w" + (#AllT #Nil "lux;AST'" "w" (#VariantT (#Cons ## "lux;BoolS" Bool (#Cons ## "lux;IntS" @@ -239,7 +239,7 @@ ## (#Right r))) (_lux_def Either (#NamedT ["lux" "Either"] - (#AllT (#Some #Nil) "lux;Either" "l" + (#AllT #Nil "lux;Either" "l" (#AllT #None "" "r" (#VariantT (#Cons ## "lux;Left" (#BoundT "l") @@ -252,7 +252,7 @@ ## (deftype (StateE s a) ## (-> s (Either Text (, s a)))) (_lux_def StateE - (#AllT [(#Some #Nil) "lux;StateE" "s" + (#AllT [#Nil "lux;StateE" "s" (#AllT [#None "" "a" (#LambdaT [(#BoundT "s") (#AppT [(#AppT [Either Text]) @@ -291,7 +291,7 @@ ## (#AliasD Ident))) (_lux_def DefData' (#NamedT ["lux" "DefData'"] - (#AllT [(#Some #Nil) "lux;DefData'" "" + (#AllT [#Nil "lux;DefData'" "" (#VariantT (#Cons [## "lux;ValueD" (#TupleT (#Cons [Type (#Cons [Unit @@ -328,7 +328,7 @@ ## )) (_lux_def Module (#NamedT ["lux" "Module"] - (#AllT [(#Some #Nil) "lux;Module" "Compiler" + (#AllT [#Nil "lux;Module" "Compiler" (#TupleT (#Cons [## "lux;module-aliases" (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))]) (#Cons [## "lux;defs" @@ -372,7 +372,7 @@ ## )) (_lux_def Compiler (#NamedT ["lux" "Compiler"] - (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" "" + (#AppT [(#AllT [#Nil "lux;Compiler" "" (#TupleT (#Cons [## "lux;source" Source (#Cons [## "lux;cursor" @@ -431,7 +431,7 @@ ## (Either Text (, Compiler a)))) ## ...) (_lux_def return - (_lux_: (#AllT (#Some #Nil) "" "a" + (_lux_: (#AllT #Nil "" "a" (#LambdaT (#BoundT "a") (#LambdaT Compiler (#AppT (#AppT Either Text) @@ -448,7 +448,7 @@ ## (Either Text (, Compiler a)))) ## ...) (_lux_def fail - (_lux_: (#AllT (#Some #Nil) "" "a" + (_lux_: (#AllT #Nil "" "a" (#LambdaT Text (#LambdaT Compiler (#AppT (#AppT Either Text) @@ -2192,10 +2192,10 @@ (#AllT ?local-env ?local-name ?local-arg ?local-def) (case ?local-env - #None - (#AllT (#Some env) ?local-name ?local-arg ?local-def) + #Nil + (#AllT env ?local-name ?local-arg ?local-def) - (#Some _) + _ type) (#LambdaT ?input ?output) @@ -2220,9 +2220,7 @@ (-> Type Type (Maybe Type)) (case type-fn (#AllT env name arg body) - (#Some (beta-reduce (|> (case env - (#Some env) env - _ (list)) + (#Some (beta-reduce (|> env (put name type-fn) (put arg param)) body)) @@ -3151,13 +3149,10 @@ (` (#;ExT (~ (int$ id)))) (#AllT env name arg type) - (let [env' (: AST - (case env - #None (` #None) - (#Some _env) (` (#Some (~ (untemplate-list (map (: (-> (, Text Type) AST) - (lambda [[label type]] - (tuple$ (list (text$ label) (type->syntax type))))) - _env)))))))] + (let [env' (untemplate-list (map (: (-> (, Text Type) AST) + (lambda [[label type]] + (tuple$ (list (text$ label) (type->syntax type))))) + env))] (` (#;AllT (~ env') (~ (text$ name)) (~ (text$ arg)) (~ (type->syntax type))))) (#AppT fun arg) diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj index 4b43673cc..54a7c5e0c 100644 --- a/src/lux/compiler/type.clj +++ b/src/lux/compiler/type.clj @@ -60,18 +60,12 @@ (&/$AllT ?env ?name ?arg ?body) (variant$ &/$AllT - (tuple$ (&/|list (|case ?env - (&/$None) - (variant$ &/$None (tuple$ (&/|list))) - - (&/$Some ??env) - (variant$ &/$Some - (&/fold (fn [tail head] - (|let [[hlabel htype] head] - (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) - tail))) - $Nil - (&/|reverse ??env)))) + (tuple$ (&/|list (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) + tail))) + $Nil + (&/|reverse ?env)) (text$ ?name) (text$ ?arg) (->analysis ?body)))) diff --git a/src/lux/type.clj b/src/lux/type.clj index f65fdbf12..bcef74475 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -23,8 +23,7 @@ _ false)) -(def ^:private empty-env (&/V &/$Some (&/V &/$Nil nil))) -(def ^:private no-env (&/V &/$None nil)) +(def ^:private empty-env (&/V &/$Nil nil)) (defn Data$ [name] (&/V &/$DataT name)) (defn Bound$ [name] @@ -106,7 +105,7 @@ ;; ExT Int ;; AllT - (Tuple$ (&/|list (App$ Maybe TypeEnv) Text Text Type)) + (Tuple$ (&/|list TypeEnv Text Text Type)) ;; AppT TypePair ;; NamedT @@ -117,7 +116,7 @@ (def Bindings (Named$ (&/T "lux" "Bindings") (All$ empty-env "lux;Bindings" "k" - (All$ no-env "" "v" + (All$ empty-env "" "v" (Tuple$ (&/|list ;; "lux;counter" Int @@ -131,7 +130,7 @@ (let [bindings (App$ (App$ Bindings (Bound$ "k")) (Bound$ "v"))] (All$ empty-env "lux;Env" "k" - (All$ no-env "" "v" + (All$ empty-env "" "v" (Tuple$ (&/|list ;; "lux;name" @@ -151,7 +150,7 @@ (def Meta (Named$ (&/T "lux" "Meta") (All$ empty-env "lux;Meta" "m" - (All$ no-env "" "v" + (All$ empty-env "" "v" (Variant$ (&/|list ;; &/$Meta (Tuple$ (&/|list (Bound$ "m") @@ -197,7 +196,7 @@ (def Either (Named$ (&/T "lux" "Either") (All$ empty-env "lux;Either" "l" - (All$ no-env "" "r" + (All$ empty-env "" "r" (Variant$ (&/|list ;; &/$Left (Bound$ "l") @@ -206,7 +205,7 @@ (def StateE (All$ empty-env "lux;StateE" "s" - (All$ no-env "" "a" + (All$ empty-env "" "a" (Lambda$ (Bound$ "s") (App$ (App$ Either Text) (Tuple$ (&/|list (Bound$ "s") @@ -441,16 +440,10 @@ (return (Variant$ =members))) (&/$AllT ?env ?name ?arg ?body) - (|do [=env (|case ?env - (&/$None) - (return ?env) - - (&/$Some ?env*) - (|do [clean-env (&/map% (fn [[k v]] - (|do [=v (clean* ?tid v)] - (return (&/T k =v)))) - ?env*)] - (return (&/V &/$Some clean-env)))) + (|do [=env (&/map% (fn [[k v]] + (|do [=v (clean* ?tid v)] + (return (&/T k =v)))) + ?env) body* (clean* ?tid ?body)] (return (All$ =env ?name ?arg body*))) @@ -634,10 +627,10 @@ (&/$AllT ?local-env ?local-name ?local-arg ?local-def) (|case ?local-env - (&/$None) - (All$ (&/V &/$Some env) ?local-name ?local-arg ?local-def) + (&/$Nil) + (All$ env ?local-name ?local-arg ?local-def) - (&/$Some _) + _ type) (&/$LambdaT ?input ?output) @@ -655,16 +648,10 @@ (defn apply-type [type-fn param] (|case type-fn (&/$AllT local-env local-name local-arg local-def) - (let [local-env* (|case local-env - (&/$None) - (&/|table) - - (&/$Some local-env*) - local-env*)] - (return (beta-reduce (->> local-env* - (&/|put local-name type-fn) - (&/|put local-arg param)) - local-def))) + (return (beta-reduce (->> local-env + (&/|put local-name type-fn) + (&/|put local-arg param)) + local-def)) (&/$AppT F A) (|do [type-fn* (apply-type F A)] |