module Language.TRM.Programs (
succBB'
, plusBB'
, clear
, move
, copy
, compare
, succBB
, addBB
) where
import Language.TRM.Base
import Control.Applicative
import Control.Monad
import Prelude hiding (compare)
succBB' :: Word
succBB' = "1##### 1111111111 111### 1111111111### 11# 1##### 111111### 111### 11## 1111#### 11# 111111#### 1111### 11## 1111111111 111#### 11# 11##### 111111### 111### 1## 1111#### 1# 111111####"
plusBB' :: Word
plusBB' = "1##### 111### 111111### 111111111### 11##### 1111111111 11111111111 11111111111 111### 1111111111 11111111111 11111### 1111111111 11111111111 111111### 11##### 1111111111 11111111111 11### 1111111111 11111111111 1111111### 1111111111 11111111111### 11##### 1111111111 11111111111### 1111111111 11111111### 1111111111 111111111### 1##### 111### 111111### 111111111### 11##### 1111111111 1### 1111111111 111111### 111111111### 11##### 1111111111 111### 1111111111### 1111111111 1### 11##### 111### 11111111### 1### 111# 1111111111 11111111111 11111111111 1#### 111## 1111111111 11111111111 11111111111 111#### 111# 1111111111 11111111111#### 111## 1111111111 11111111111 11#### 1### 111##### 111111### 111### 1## 1111#### 1# 111111####"
compare' :: Word
compare' = "1##### 111111### 111111111### 11##### 1111111111 1### 1111111111### 111111#### 11##### 1111111111 11111### 111111### 11111### 11##### 111### 1111111111 111#### 1### 1##### 111### 11#### 111#### 11##### 1111### 11#### 111#### 1#"
clear :: Register
-> LComp ()
clear r =
do_ $ \continue break ->
cond r break continue continue
move :: Register
-> Register
-> LComp ()
move src dest =
do_ $ \continue break ->
cond src
break
(snocOne dest >> continue)
(snocHash dest >> continue)
copy :: Register
-> Register
-> Register
-> LComp ()
copy src dest tmp = do
do_ $ \continue break ->
cond src
break
(do snocOne dest ; snocOne tmp ; continue)
(do snocHash dest ; snocHash tmp ; continue)
move tmp src
compare :: Register -> Register -> LComp ()
compare r1 r2 = do
[true, false, clear1, clear2] <- replicateM 4 freshLabel
top <- freshLabelHere
do_ $ \continue _ ->
cond r1
(cond r2 (goto true) (goto clear2) (goto clear2))
(cond r2 (goto clear1) continue (goto clear1))
(cond r2 (goto clear1) (goto clear1) continue )
label clear1
clear r1
label clear2
clear r2
goto false
label true
snocOne r1
label false
succBB :: Register
-> Register
-> LComp ()
succBB r tmp = do
do_ $ \continue break ->
cond r
(do snocOne tmp ; break)
(do snocHash tmp ; continue)
(do snocOne tmp ; move r tmp ; break)
move tmp r
addBB :: Register -> Register -> [Register] -> LComp ()
addBB r1 r2 [r3, r4, r5, r6, r7] = do
recCase <- freshLabel
snocHash r3 >> move r1 r4
do_ $ \continue break -> do
copy r2 r5 r6
copy r3 r6 r7
compare r5 r6
cond r5 (goto recCase) break (goto recCase)
label recCase
succBB r4 r5
succBB r3 r5
continue
clear r1 >> clear r2 >> clear r3
move r4 r1