diff options
author | Eduardo Julian | 2017-11-14 02:00:14 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-14 02:00:14 -0400 |
commit | 72603f38074a67f9ab1e53df1b5fb5da3836162d (patch) | |
tree | a6cb2b675d41ff97fa7b26f1b15123cc54d60362 /new-luxc/source/luxc/lang/translation/loop.jvm.lux | |
parent | 4a43c41d139dfed45a8ed9b2308cf97fd6f3a59a (diff) |
- Implemented loop translation.
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/loop.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/loop.jvm.lux | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/loop.jvm.lux new file mode 100644 index 000000000..d9216f1a7 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/loop.jvm.lux @@ -0,0 +1,62 @@ +(;module: + lux + (lux (control [monad #+ do]) + (data [text] + text/format + (coll [list "list/" Functor<List> Monoid<List>])) + [meta]) + (luxc ["&" base] + [";L" host] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) + (lang ["la" analysis] + ["ls" synthesis] + (translation [";T" common] + [";T" runtime] + [";T" reference]) + [";L" variable #+ Variable]))) + +(def: #export (translate-recur translate argsS) + (-> (-> ls;Synthesis (Meta $;Inst)) + (List ls;Synthesis) + (Meta $;Inst)) + (do meta;Monad<Meta> + [[@begin offset] hostL;anchor + argsI (monad;map @ (function [[register argS]] + (let [register' (n.+ offset register)] + (: (Meta $;Inst) + (case argS + (^multi (^code ((~ [_ (#;Int var)]))) + (i.= (variableL;local register') + var)) + (wrap id) + + _ + (do @ + [argI (translate argS)] + (wrap (|>. argI + ($i;ASTORE register')))))))) + (list;zip2 (list;n.range +0 (n.dec (list;size argsS))) + argsS))] + (wrap (|>. ($i;fuse argsI) + ($i;GOTO @begin))))) + +(def: #export (translate-loop translate offset initsS+ bodyS) + (-> (-> ls;Synthesis (Meta $;Inst)) + Nat (List ls;Synthesis) ls;Synthesis + (Meta $;Inst)) + (do meta;Monad<Meta> + [@begin $i;make-label + initsI+ (monad;map @ translate initsS+) + bodyI (hostL;with-anchor [@begin offset] + (translate bodyS)) + #let [initializationI (|> (list;enumerate initsI+) + (list/map (function [[register initI]] + (|>. initI + ($i;ASTORE (|> register n.inc (n.+ offset)))))) + $i;fuse)]] + (wrap (|>. initializationI + ($i;label @begin) + bodyI)))) |