diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-05-12 03:28:51 +0200 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-05-12 03:28:51 +0200 |
commit | 0aba5a79ab0475540ef2ddf93a0bf4473418103f (patch) | |
tree | 111cf6116102fc19bcb2522b84766d56268524ea /src | |
parent | 3b66a4fdfbd74e9dc77b05536062129018fb0ade (diff) |
refactoring
Diffstat (limited to 'src')
-rw-r--r-- | src/LambdaCube/Compiler/DeBruijn.hs | 10 |
1 files changed, 7 insertions, 3 deletions
diff --git a/src/LambdaCube/Compiler/DeBruijn.hs b/src/LambdaCube/Compiler/DeBruijn.hs index 7d3e2679..cc8ad32a 100644 --- a/src/LambdaCube/Compiler/DeBruijn.hs +++ b/src/LambdaCube/Compiler/DeBruijn.hs | |||
@@ -76,7 +76,11 @@ freeVar :: Int -> FreeVars | |||
76 | freeVar i = FreeVars $ 1 `shiftL` i | 76 | freeVar i = FreeVars $ 1 `shiftL` i |
77 | 77 | ||
78 | delVar :: Int -> FreeVars -> FreeVars | 78 | delVar :: Int -> FreeVars -> FreeVars |
79 | delVar l (FreeVars i) = FreeVars $ (i `shiftR` (l+1) `shiftL` l) .|. (i .&. ((1 `shiftL` l)-1)) | 79 | delVar 0 (FreeVars i) = FreeVars $ i `shiftR` 1 |
80 | delVar 1 (FreeVars i) = FreeVars $ if testBit i 0 then (i `shiftR` 1) `setBit` 0 else (i `shiftR` 1) `clearBit` 0 | ||
81 | delVar l (FreeVars i) = FreeVars $ case i `shiftR` (l+1) of | ||
82 | 0 -> i `clearBit` l | ||
83 | x -> (x `shiftL` l) .|. (i .&. ((1 `shiftL` l)-1)) | ||
80 | 84 | ||
81 | shiftFreeVars :: Int -> FreeVars -> FreeVars | 85 | shiftFreeVars :: Int -> FreeVars -> FreeVars |
82 | shiftFreeVars i (FreeVars x) = FreeVars $ x `shift` i | 86 | shiftFreeVars i (FreeVars x) = FreeVars $ x `shift` i |
@@ -93,8 +97,8 @@ isClosed (FreeVars x) = x == 0 | |||
93 | lowerFreeVars = shiftFreeVars (-1) | 97 | lowerFreeVars = shiftFreeVars (-1) |
94 | 98 | ||
95 | rearrangeFreeVars g l (FreeVars i) = FreeVars $ case g of | 99 | rearrangeFreeVars g l (FreeVars i) = FreeVars $ case g of |
96 | RFUp n -> (i `shiftR` l `shiftL` (n+l)) .|. (i .&. ((1 `shiftL` l)-1)) | 100 | RFUp n -> ((i `shiftR` l) `shiftL` (n+l)) .|. (i .&. ((1 `shiftL` l)-1)) |
97 | RFMove n -> (f $ i `shiftR` l `shiftL` (l+1)) .|. (i .&. ((1 `shiftL` l)-1)) | 101 | RFMove n -> (f $ (i `shiftR` l) `shiftL` (l+1)) .|. (i .&. ((1 `shiftL` l)-1)) |
98 | where | 102 | where |
99 | f x = if testBit x (n+l+1) then x `clearBit` (n+l+1) `setBit` l else x | 103 | f x = if testBit x (n+l+1) then x `clearBit` (n+l+1) `setBit` l else x |
100 | _ -> error $ "rearrangeFreeVars: " ++ show g | 104 | _ -> error $ "rearrangeFreeVars: " ++ show g |