diff options
author | Eduardo Julian | 2018-04-15 02:24:27 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-04-15 02:24:27 -0400 |
commit | 6eb9cf17f161522d4eddf6783284952f8a84f099 (patch) | |
tree | 9158749544826d8d0940117ca5884fdd2f90c327 /new-luxc/source/luxc/lang/translation/r/case.jvm.lux | |
parent | 0bba53ceb52502510e0f6ba4c53a951933532a61 (diff) |
- Fixes for R back-end.
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/r/case.jvm.lux | 29 |
1 files changed, 18 insertions, 11 deletions
diff --git a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux b/new-luxc/source/luxc/lang/translation/r/case.jvm.lux index 67de862e8..6ceae3842 100644 --- a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/case.jvm.lux @@ -25,9 +25,10 @@ [valueO (translate valueS) bodyO (translate bodyS) #let [$register (referenceT.variable register)]] - (wrap ($_ r.then - (r.set! $register valueO) - bodyO)))) + (wrap (r.block + ($_ r.then + (r.set! $register valueO) + bodyO))))) (def: #export (translate-record-get translate valueS pathP) (-> (-> Synthesis (Meta Expression)) Synthesis (List [Nat Bool]) @@ -73,7 +74,7 @@ (def: cursor-top Expression - (top (@@ $cursor))) + (|> (@@ $cursor) (r.nth (top (@@ $cursor))))) (def: pop-cursor! Expression @@ -115,13 +116,18 @@ [_ (<tag> value)] (meta/wrap (r.when (r.not (r.= (|> value <format>) cursor-top)) fail-pm!))) - ([#.Nat (<| runtimeT.int (:! Int))] - [#.Int runtimeT.int] - [#.Deg (<| runtimeT.int (:! Int))] - [#.Bool r.bool] + ([#.Bool r.bool] [#.Frac r.float] [#.Text r.string]) + (^template [<tag> <format>] + [_ (<tag> value)] + (meta/wrap (r.when (r.not (runtimeT.int//= (|> value <format>) cursor-top)) + fail-pm!))) + ([#.Nat (<| runtimeT.int (:! Int))] + [#.Int runtimeT.int] + [#.Deg (<| runtimeT.int (:! Int))]) + (^template [<pm> <getter>] (^code (<pm> (~ [_ (#.Nat idx)]))) (meta/wrap (push-cursor! (<getter> cursor-top (r.int (:! Int idx)))))) @@ -183,6 +189,7 @@ (do macro.Monad<Meta> [valueO (translate valueS) pattern-matching! (translate-pattern-matching translate pathP)] - (wrap ($_ r.then - (initialize-pattern-matching! valueO) - pattern-matching!)))) + (wrap (r.block + ($_ r.then + (initialize-pattern-matching! valueO) + pattern-matching!))))) |