Skip to content

Commit

Permalink
Fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
@sgraf812
sgraf812 committed Jun 23, 2024
1 parent 468a2bd commit d5bbb82
Show file tree
Hide file tree
Showing 2 changed files with 46 additions and 22 deletions.
41 changes: 29 additions & 12 deletions packages/backend-lalr/data/HappyTemplate.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,16 +82,16 @@ happyDoAction i tk st =
{-# INLINE happyNextAction #-}
happyNextAction i st = case happyIndexActionTable i st of
Just (Happy_GHC_Exts.I# act) -> act
Nothing -> indexOffAddr happyDefActions st
Nothing -> happyIndexOffAddr happyDefActions st

{-# INLINE happyIndexActionTable #-}
happyIndexActionTable i st
| GTE(off, 0#), EQ(indexOffAddr happyCheck off, i)
= Prelude.Just (Happy_GHC_Exts.I# (indexOffAddr happyTable off))
| GTE(off, 0#), EQ(happyIndexOffAddr happyCheck off, i)
= Prelude.Just (Happy_GHC_Exts.I# (happyIndexOffAddr happyTable off))
| otherwise
= Prelude.Nothing
where
off = PLUS(indexOffAddr happyActOffsets st, i)
off = PLUS(happyIndexOffAddr happyActOffsets st, i)

data HappyAction
= HappyFail
Expand All @@ -107,19 +107,36 @@ happyDecodeAction action | LT(action, 0#) = HappyReduce NEGATE(PLUS(action, 1
| otherwise = HappyShift MINUS(action, 1#)

{-# INLINE happyIndexGotoTable #-}
happyIndexGotoTable nt st = indexOffAddr happyTable off
happyIndexGotoTable nt st = happyIndexOffAddr happyTable off
where
off = PLUS(indexOffAddr happyGotoOffsets st, nt)
off = PLUS(happyIndexOffAddr happyGotoOffsets st, nt)


indexOffAddr (HappyA# arr) off =
Happy_GHC_Exts.int32ToInt# (Happy_GHC_Exts.indexInt32OffAddr# arr off)
{-# INLINE happyIndexOffAddr #-}
happyIndexOffAddr :: HappyAddr -> Happy_Int -> Happy_Int
happyIndexOffAddr (HappyA# arr) off =
#ifdef WORDS_BIGENDIAN
Happy_GHC_Exts.narrow32Int# i
where
i = Happy_GHC_Exts.word2Int# ((b3 `Happy_GHC_Exts.uncheckedShiftL#` 24#) `Happy_GHC_Exts.or#`
(b2 `Happy_GHC_Exts.uncheckedShiftL#` 16#) `Happy_GHC_Exts.or#`
(b1 `Happy_GHC_Exts.uncheckedShiftL#` 8#) `Happy_GHC_Exts.or#` b0)
b3 = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr PLUS(off', 3#)))
b2 = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr PLUS(off', 2#)))
b1 = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr PLUS(off', 1#)))
b0 = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))
off' = TIMES(off, 4#)
#else
#if __GLASGOW_HASKELL__ >= 901
Happy_GHC_Exts.int32ToInt#
#endif
(Happy_GHC_Exts.indexInt32OffAddr# arr off)
#endif

{-# INLINE happyLt #-}
happyLt x y = LT(x,y)

readArrayBit arr bit =
Bits.testBit (Happy_GHC_Exts.I# (indexOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 5#))) (bit `Prelude.mod` 32)
Bits.testBit (Happy_GHC_Exts.I# (happyIndexOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 5#))) (bit `Prelude.mod` 32)
where unbox_int (Happy_GHC_Exts.I# x) = x

data HappyAddr = HappyA# Happy_GHC_Exts.Addr#
Expand Down Expand Up @@ -187,9 +204,9 @@ happyMonad2Reduce k nt fn j tk st sts stk =
case happyDrop k (HappyCons st sts) of
sts1@(HappyCons st1 _) ->
let drop_stk = happyDropStk k stk
off = happyAdjustOffset (indexOffAddr happyGotoOffsets st1)
off = happyAdjustOffset (happyIndexOffAddr happyGotoOffsets st1)
off_i = PLUS(off, nt)
new_state = indexOffAddr happyTable off_i
new_state = happyIndexOffAddr happyTable off_i
in
happyThen1 (fn stk tk)
(\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
Expand Down
27 changes: 17 additions & 10 deletions packages/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -488,8 +488,8 @@ machinery to discard states in the parser...
> . str "happyExpListPerState st =\n"
> . str " token_strs_expected\n"
> . str " where token_strs = " . str (show $ elems token_names') . str "\n"
> . str " bit_start = st Prelude.* " . str (show nr_tokens) . str "\n"
> . str " bit_end = (st Prelude.+ 1) Prelude.* " . str (show nr_tokens) . str "\n"
> . str " bit_start = st Prelude.* " . str (show nr_tokens) . str "\n"
> . str " bit_end = (st Prelude.+ 1) Prelude.* " . str (show nr_tokens) . str "\n"
> . str " read_bit = readArrayBit happyExpList\n"
> . str " bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1]\n"
> . str " bits_indexed = Prelude.zip bits [0.."
Expand Down Expand Up @@ -542,7 +542,7 @@ action array indexed by (terminal * last_state) + state
> produceExpListArray
> = str "happyExpList :: HappyAddr\n"
> . str "happyExpList = HappyA# \"" --"
> . hexChars explist
> . hexCharsForBits explist
> . str "\"#\n\n" --"

> n_terminals = length terms
Expand Down Expand Up @@ -1015,7 +1015,7 @@ See notes under "Action Tables" above for some subtleties in this function.
> act_offs <- newArray (0, n_actions) 0
> goto_offs <- newArray (0, n_actions) 0
> off_arr <- newArray (-max_token, mAX_TABLE_SIZE) 0
> exp_array <- newArray (0, (n_actions * n_token_names + 15) `div` 16) 0
> exp_array <- newArray (0, (n_actions * n_token_names + 31) `div` 32) 0 -- 32 bits per entry
>
> (min_off,max_off) <- genTables' table check act_offs goto_offs off_arr exp_array entries
> explist max_token n_token_names
Expand Down Expand Up @@ -1063,8 +1063,8 @@ See notes under "Action Tables" above for some subtleties in this function.
> forM_ explist $ \(state, tokens) ->
> forM_ tokens $ \token -> do
> let bit_nr = state * n_token_names + token
> let word_nr = bit_nr `div` 16
> let word_offset = bit_nr `mod` 16
> let word_nr = bit_nr `div` 32
> let word_offset = bit_nr `mod` 32
> x <- readArray exp_array word_nr
> writeArray exp_array word_nr (setBit x word_offset)
>
Expand Down Expand Up @@ -1218,12 +1218,19 @@ slot is free or not.
> brack' s = char '(' . s . char ')'

-----------------------------------------------------------------------------
-- Convert an integer to a 16-bit number encoded in \xNN\xNN format suitable
-- for placing in a string.
-- Convert an integer to a 32-bit number encoded in little-endian
-- \xNN\xNN\xNN\xNN format suitable for placing in a string.

> hexChars :: [Int] -> String -> String
> hexChars is s = foldr (hexChar . toInt32) s is

The following function is used for generating happyExpList, which is an array of
bits encoded as [Int] for legacy reasons; we don't want to check for overflow
here.

> hexCharsForBits :: [Int] -> String -> String
> hexCharsForBits is s = foldr (hexChar . fromIntegral) s is

The following definition of @hexChar@ is endian-ness preserving.
Should endianness differ between the architecture running happy and the one
running the compiled parser, the order of [0,1,2,3] must be reversed.
Expand All @@ -1232,10 +1239,10 @@ running the compiled parser, the order of [0,1,2,3] must be reversed.
> hexChar i s = foldr (toHex . byte i) s [0,1,2,3]

> byte :: Int32 -> Int -> Word8
> byte n i = fromIntegral (0xFF .&. unsafeShiftR n (i*8))
> byte n i = fromIntegral (0xFF .&. shiftR n (i*8))

> toHex :: Word8 -> String -> String
> toHex i s = '\\':'x':hexDig (0xF .&. unsafeShiftR i 4):hexDig (0xF .&. i):s
> toHex i s = '\\':'x':hexDig (0xF .&. shiftR i 4):hexDig (0xF .&. i):s

> hexDig :: Word8 -> Char
> hexDig i | i <= 9 = chr (fromIntegral i + ord '0')
Expand Down

0 comments on commit d5bbb82

Please sign in to comment.