{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NumericUnderscores #-} {-# OPTIONS_GHC -Wno-overflowed-literals #-} {-| Module : Parsley.Internal.Backend.Machine.PosOps Description : Collection of platform dependent position operations License : BSD-3-Clause Maintainer : Jamie Willis Stability : experimental This module contains the implementations of updates on positions: these depend on the number of bits in a word, or if the @full-width-positions@ flag was set on the @parsley-core@ library. @since 1.8.0.0 -} module Parsley.Internal.Backend.Machine.PosOps ( initPos, tabWidth, extractLine, extractCol, liftPos, updatePos, updatePosQ, updatePosNewlineOnly, updatePosNewlineOnlyQ, shiftLineAndSetCol, shiftCol, shiftAlignAndShiftCol, shiftLineAndSetColQ, shiftColQ, shiftAlignAndShiftColQ, toNextTab ) where #include "MachDeps.h" #if WORD_SIZE_IN_BITS < 64 #define FULL_WIDTH_POSITIONS #endif import Data.Bits ( (.&.), (.|.) #ifndef FULL_WIDTH_POSITIONS , unsafeShiftL #endif ) import Parsley.Internal.Backend.Machine.Types.Base (Pos) import Parsley.Internal.Common (Code) import GHC.Exts (Int(..), Word(W#)) import GHC.Prim ( plusWord#, and#, or#, word2Int# #ifdef FULL_WIDTH_POSITIONS , minusWord# #else , uncheckedShiftRL# #endif ) {-| Advances a column to the next tab column. @since 2.1.0.0 -} toNextTab :: Word -> Word toNextTab x = (x + tabWidth - 1) .&. negate tabWidth .|. 1 {-| Given a dynamic character and a static position, produces a new dynamic position. @since 2.1.0.0 -} updatePos :: Code Char -> Word -> Word -> Code Pos updatePos c line col = [||updatePos# $$(liftPos line col) $$c||] {-| Given a dynamic character and a static position, produces a new dynamic position. For this variant, newlines are the only character than can affect the update. @since 2.1.0.0 -} updatePosNewlineOnly :: Code Char -> Word -> Code Pos updatePosNewlineOnly c line = [||updatePos0ColNewlineOnly# $$(liftPos line 0) $$c||] {-| Given a dynamic character and a dynamic position, returns the representation of the updated position. @since 2.1.0.0 -} updatePosQ :: Code Char -> Code Pos -> Code Pos updatePosQ c pos = [||updatePos# $$pos $$c||] {-| Given a dynamic character and a dynamic position, returns the representation of the updated position. For this variant, newlines are the only character than can affect the update. @since 2.1.0.0 -} updatePosNewlineOnlyQ :: Code Char -> Code Pos -> Code Pos updatePosNewlineOnlyQ c pos = [||updatePosNewlineOnly# $$pos $$c||] {-| Shift a static postion's column by a given amount @since 2.1.0.0 -} shiftCol :: Word -- ^ The amount to shift the column by -> Word -- ^ The line -> Word -- ^ The column -> (Word, Word) shiftCol n line col = (line, col + n) {-| Shift a static line by a given amount and then set the column @since 2.1.0.0 -} shiftLineAndSetCol :: Word -- ^ The amount to shift the line by -> Word -- ^ The new column -> Word -- ^ The line -> (Word, Word) shiftLineAndSetCol n col line = (line + n, col) {-| Shift a static position by first adjusting the column, then aligning to a tab, then shifting further @since 2.1.0.0 -} shiftAlignAndShiftCol :: Word -- ^ Amount to shift column by before the tab shift -> Word -- ^ Amount to shift column by after the tab shift -> Word -- ^ The line -> Word -- ^ The new column -> (Word, Word) shiftAlignAndShiftCol firstBy thenBy line col = (line, toNextTab (col + firstBy) + thenBy) {-| The initial position used by the parser. This is some representation of (1, 1). @since 1.8.0.0 -} initPos :: (Word, Word) initPos = (1, 1) {-| The size of a tab. @since 2.1.0.0 -} tabWidth :: Num a => a tabWidth = 4 {-# INLINEABLE updatePos# #-} updatePos# :: Pos -> Char -> Pos {-# INLINE updatePosNewlineOnly# #-} updatePosNewlineOnly# :: Pos -> Char -> Pos {-# INLINEABLE updatePos0ColNewlineOnly# #-} updatePos0ColNewlineOnly# :: Pos -> Char -> Pos {-| Shift a dynamic postion's column by a given amount @since 2.1.0.0 -} shiftColQ :: Word -- ^ The amount to shift the column by -> Code Pos -> Code Pos {-| Shift a dynamic line by a given amount and then set the column @since 2.1.0.0 -} shiftLineAndSetColQ :: Word -- ^ The amount to shift the line by -> Word -- ^ The new column -> Code Pos -> Code Pos {-| Shift a dynamic position by first adjusting the column, then aligning to a tab, then shifting further @since 2.1.0.0 -} shiftAlignAndShiftColQ :: Word -- ^ Amount to shift column by before the tab shift -> Word -- ^ Amount to shift column by after the tab shift -> Code Pos -> Code Pos {-| Given the opaque representation of a position, extracts the line number out of it. @since 1.8.0.0 -} extractLine :: Code Pos -> Code Int {-| Given the opaque representation of a position, extracts the column number out of it. @since 1.8.0.0 -} extractCol :: Code Pos -> Code Int {-| Converts a static position into a dynamic one. @since 2.1.0.0 -} liftPos :: Word -> Word -> Code Pos #ifndef FULL_WIDTH_POSITIONS -- This is referred to directly in generated code, leave optimised primitives updatePos# pos '\n' = (pos `and#` 0xffffffff_00000000##) `plusWord#` 0x00000001_00000001## updatePos# pos '\t' = ((pos `plusWord#` 0x00000000_00000003##) `and#` 0xffffffff_fffffffc##) `or#` 0x00000000_00000001## updatePos# pos _ = pos `plusWord#` 0x00000000_00000001## -- This is referred to directly in generated code, leave optimised primitives updatePosNewlineOnly# pos = updatePos0ColNewlineOnly# (pos `and#` 0xffffffff_00000000##) -- This is referred to directly in generated code, leave optimised primitives updatePos0ColNewlineOnly# pos0Col '\n' = pos0Col `plusWord#` 0x00000001_00000000## updatePos0ColNewlineOnly# pos0Col _ = pos0Col shiftLineAndSetColQ n col qpos = [|| ($$qpos `and#` 0xffffffff_00000000##) `plusWord#` $$(liftPos n col) ||] shiftColQ (W# n) qpos = [|| $$qpos `plusWord#` n ||] shiftAlignAndShiftColQ firstBy thenBy qpos = let !(W# pre) = firstBy + 3 -- offset first, then add 3 to overshoot !(W# mask) = -4 -- constant fold this into raw literal !(W# post) = thenBy + 1 -- add the offset of tab boundary from power of two, then remaining positions in if thenBy == 0 then [|| (($$qpos `plusWord#` pre) `and#` mask) `or#` 0x00000000_00000001## ||] -- because tab widths are multiples of two else [|| (($$qpos `plusWord#` pre) `and#` mask) `plusWord#` post ||] extractLine qpos = [||I# (word2Int# ($$qpos `uncheckedShiftRL#` 32#))||] extractCol qpos = [||I# (word2Int# ($$qpos `and#` 0x00000000_ffffffff##))||] liftPos line col = let !(W# p) = (line `unsafeShiftL` 32) .|. col in [||p||] #else -- This is referred to directly in generated code, leave optimised primitives updatePos# (# line, _ #) '\n' = (# line `plusWord#` 1##, 1## #) updatePos# (# line, col #) '\t' = (# line, ((col `plusWord#` 3##) `and#` (0## `minusWord#` 4##)) `or#` 1## #) -- nearest tab boundary `c + (4 - (c - 1) % 4)` updatePos# (# line, col #) _ = (# line, col `plusWord#` 1## #) -- This is referred to directly in generated code, leave optimised primitives updatePosNewlineOnly# = updatePos0ColNewlineOnly# -- This is referred to directly in generated code, leave optimised primitives updatePos0ColNewlineOnly# (# line, _ #) '\n' = (# line `plusWord#` 1##, 0## #) updatePos0ColNewlineOnly# pos _ = pos shiftLineAndSetColQ (W# n) (W# col) qpos = [|| case $$qpos of (# line, _ #) -> (# line `plusWord#` n, col #) ||] shiftColQ (W# n) qpos = [|| case $$qpos of (# line, col #) -> (# line, col `plusWord#` n #) ||] shiftAlignAndShiftColQ firstBy thenBy qpos = let !(W# pre) = firstBy + 3 -- offset first, then add 3 to overshoot !(W# mask) = -4 -- constant fold this into raw literal !(W# post) = thenBy + 1 -- add the offset of tab boundary from power of two, then remaining positions in [|| case $$qpos of (# line, col #) -> (# line, $$(if thenBy == 0 then [|| ((col `plusWord#` pre) `and#` mask) `or#` 1## ||] -- because tab widths are multiples of two else [|| ((col `plusWord#` pre) `and#` mask) `plusWord#` post ||]) #) ||] extractLine qpos = [|| case $$qpos of (# line, _ #) -> I# (word2Int# line) ||] extractCol qpos = [|| case $$qpos of (# _, col #) -> I# (word2Int# col) ||] liftPos (W# line) (W# col) = [||(# line, col #)||] #endif