diff options
-rw-r--r-- | luxc/src/lux/analyser/jvm.clj | 7 | ||||
-rw-r--r-- | luxc/src/lux/base.clj | 10 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm.clj | 2 | ||||
-rw-r--r-- | stdlib/source/lux.lux | 39 |
4 files changed, 31 insertions, 27 deletions
diff --git a/luxc/src/lux/analyser/jvm.clj b/luxc/src/lux/analyser/jvm.clj index 24d2b2017..5ea64d41a 100644 --- a/luxc/src/lux/analyser/jvm.clj +++ b/luxc/src/lux/analyser/jvm.clj @@ -25,7 +25,6 @@ (fn [state] (|let [exceptions (&/|map #(Class/forName % true class-loader) exceptions*) catching (->> state - (&/get$ &/$host) (&/get$ &/$catching) (&/|map #(Class/forName % true class-loader)))] (if-let [missing-ex (&/fold (fn [prev ^Class now] @@ -53,14 +52,14 @@ (defn ^:private with-catches [catches body] "(All [a] (-> (List Text) (Lux a) (Lux a)))" (fn [state] - (let [old-catches (->> state (&/get$ &/$host) (&/get$ &/$catching)) - state* (->> state (&/update$ &/$host #(&/update$ &/$catching (partial &/|++ catches) %)))] + (let [old-catches (&/get$ &/$catching state) + state* (&/update$ &/$catching (partial &/|++ catches) state)] (|case (&/run-state body state*) (&/$Left msg) (&/$Left msg) (&/$Right state** output) - (&/$Right (&/T [(->> state** (&/update$ &/$host #(&/set$ &/$catching old-catches %))) + (&/$Right (&/T [(&/set$ &/$catching old-catches state**) output])))) )) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 5e8c8c0d0..6ab09166e 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -117,7 +117,6 @@ ["writer" "loader" "classes" - "catching" "type-env" "dummy-mappings" ]) @@ -143,6 +142,7 @@ "expected" "seed" "scope-type-vars" + "catching" "host"]) ;; Compiler @@ -716,10 +716,10 @@ (defn with-no-catches [body] "(All [a] (-> (Lux a) (Lux a)))" (fn [state] - (let [old-catching (->> state (get$ $host) (get$ $catching))] - (|case (body (update$ $host #(set$ $catching $Nil %) state)) + (let [old-catching (->> state (get$ $catching))] + (|case (body (set$ $catching $Nil state)) ($Right state* output) - (return* (update$ $host #(set$ $catching old-catching %) state*) output) + (return* (set$ $catching old-catching state*) output) ($Left msg) (fail* msg))))) @@ -750,6 +750,8 @@ 0 ;; scope-type-vars $Nil + ;; catching + $Nil ;; "lux;host" host-data] )) diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj index bb333df57..809c03022 100644 --- a/luxc/src/lux/compiler/jvm.clj +++ b/luxc/src/lux/compiler/jvm.clj @@ -232,8 +232,6 @@ (memory-class-loader store) ;; "lux;classes" store - ;; "lux;catching" - &/$Nil ;; "lux;module-states" (&/|table) ;; lux;type-env diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 19a7b4716..cd16ce35f 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -603,6 +603,7 @@ ## #expected (Maybe Type) ## #seed Nat ## #scope-type-vars (List Nat) +## #catching (List Text) ## #host Void}) (_lux_def Compiler (#NamedT ["lux" "Compiler"] @@ -623,10 +624,13 @@ (#AppT Maybe Type) (#ProdT ## "lux;seed" Nat - (#ProdT ## "lux;scope-type-vars" + (#ProdT ## scope-type-vars (#AppT List Nat) ## "lux;host" - Void)))))))))) + (#ProdT ## catching + (#AppT List Text) + ## "lux;host" + Void))))))))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "info") (#Cons (#TextA "source") (#Cons (#TextA "cursor") @@ -636,8 +640,9 @@ (#Cons (#TextA "expected") (#Cons (#TextA "seed") (#Cons (#TextA "scope-type-vars") - (#Cons (#TextA "host") - #Nil)))))))))))] + (#Cons (#TextA "catching") + (#Cons (#TextA "host") + #Nil))))))))))))] (#Cons [["lux" "doc"] (#TextA "Represents the state of the Lux compiler during a run. It is provided to macros during their invocation, so they can access compiler data. @@ -1714,7 +1719,7 @@ {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] + #scope-type-vars scope-type-vars #catching _} state] (_lux_case (get module modules) (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _}) (_lux_case (get name defs) @@ -1873,7 +1878,7 @@ {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} + #scope-type-vars scope-type-vars #catching _} (_lux_case (reverse scopes) (#Cons {#name (#;Cons module-name #Nil) #inner-closures _ #locals _ #closure _} _) (#Right [state module-name]) @@ -2273,7 +2278,7 @@ #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} + #scope-type-vars scope-type-vars #catching _} (#Right state (find-macro' modules current-module module name))))))) (def:''' (macro? ident) @@ -2528,12 +2533,12 @@ #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} + #scope-type-vars scope-type-vars #catching catching} (#Right {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed (n.+ +1 seed) #expected expected #cursor cursor - #scope-type-vars scope-type-vars} + #scope-type-vars scope-type-vars #catching catching} (symbol$ ["" ($_ Text/append "__gensym__" prefix (->Text seed))])))) (macro:' #export (Rec tokens) @@ -3375,7 +3380,7 @@ (let [{#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] + #scope-type-vars scope-type-vars #catching _} state] (case (get name modules) (#Some module) (#Right state module) @@ -3438,7 +3443,7 @@ (let [{#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] + #scope-type-vars scope-type-vars #catching _} state] (case expected (#Some type) (#Right state type) @@ -3961,7 +3966,7 @@ {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} + #scope-type-vars scope-type-vars #catching _} modules)] (case (get module modules) (#Some =module) @@ -4016,7 +4021,7 @@ {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} + #scope-type-vars scope-type-vars #catching _} (find (: (-> Scope (Maybe Type)) (lambda [env] (case env @@ -4036,7 +4041,7 @@ {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] + #scope-type-vars scope-type-vars #catching _} state] (case (get v-prefix modules) #None #None @@ -4055,7 +4060,7 @@ {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] + #scope-type-vars scope-type-vars #catching _} state] (case (get v-prefix modules) #None (#Left (Text/append "Unknown definition: " (Ident/encode name))) @@ -5409,7 +5414,7 @@ {#info info #source source #modules modules #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} + #scope-type-vars scope-type-vars #catching _} (#Right state scope-type-vars) )) @@ -5518,7 +5523,7 @@ (let [{#;info info #;source source #;modules modules #;scopes scopes #;type-vars types #;host host #;seed seed #;expected expected #;cursor cursor - #;scope-type-vars scope-type-vars} state] + #;scope-type-vars scope-type-vars #catching _} state] (#;Right [state cursor])))) (macro: #export (with-cursor tokens) |