[Git][ghc/ghc][wip/T23490] Kill off gen_bytearray_addr_access_ops.py

Matthew Craven (@clyring) gitlab at gitlab.haskell.org
Sun Jul 23 14:16:42 UTC 2023



Matthew Craven pushed to branch wip/T23490 at Glasgow Haskell Compiler / GHC


Commits:
0ed8a76d by Matthew Craven at 2023-07-23T10:16:05-04:00
Kill off gen_bytearray_addr_access_ops.py

Fixes #23490. The relevant primop descriptions are now
generated directly by genprimopcode.

- - - - -


8 changed files:

- − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py
- compiler/GHC/Builtin/primops.txt.pp
- hadrian/src/Rules/Generate.hs
- + utils/genprimopcode/AccessOps.hs
- utils/genprimopcode/Lexer.x
- utils/genprimopcode/Parser.y
- utils/genprimopcode/ParserM.hs
- utils/genprimopcode/genprimopcode.cabal


Changes:

=====================================
compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py deleted
=====================================
@@ -1,201 +0,0 @@
-#!/usr/bin/env python
-# -*- coding: utf-8 -*-
-
-# This script generates the primop descriptions for many similar ByteArray#
-# and Addr# access operations.  Its output is #include-d into primops.txt.pp.
-
-from typing import Optional, NamedTuple
-import textwrap
-import argparse
-
-arg_parser = argparse.ArgumentParser()
-arg_parser.add_argument('addr_or_bytearray',
-                        choices = ["addr-access-ops", "bytearray-access-ops"],
-                        )
-arg_parser.add_argument('output_file',
-                        type=argparse.FileType('w'),
-                        metavar='FILE',
-                        )
-args = arg_parser.parse_args()
-write = args.output_file.write
-
-
-
-write('''
--- Do not edit.
--- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py.
--- (The build system should take care of this for you.)
-
-''')
-
-class ElementType(NamedTuple):
-    name: str
-    rep_ty: str
-    desc: str
-    width: Optional[int]
-
-MACH_WORD = None
-
-element_types = [
-    # (name, representation type, human description, width)
-    #
-    # width in bytes.
-    # width == None denotes machine word
-
-    ElementType("Char",      "Char#",        "8-bit character",                       1),
-    ElementType("WideChar",  "Char#",        "32-bit character",                      4),
-    ElementType("Int",       "Int#",         "word-sized integer",                    MACH_WORD),
-    ElementType("Word",      "Word#",        "word-sized unsigned integer",           MACH_WORD),
-    ElementType("Addr",      "Addr#",        "machine address",                       MACH_WORD),
-    ElementType("Float",     "Float#",       "single-precision floating-point value", 4),
-    ElementType("Double",    "Double#",      "double-precision floating-point value", 8),
-    ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value",                    MACH_WORD),
-]
-
-for n in [8,16,32,64]:
-    element_types += [
-        ElementType(f"Int{n}",  f"Int{n}#",
-                    f"{n}-bit signed integer",   n // 8),
-        ElementType(f"Word{n}", f"Word{n}#",
-                    f"{n}-bit unsigned integer", n // 8)
-    ]
-
-def pretty_offset(n: Optional[int]) -> str:
-    if n == MACH_WORD:
-        return 'machine words'
-    elif n == 1:
-        return 'bytes'
-    else:
-        return f'{n}-byte words'
-
-def get_align_warn(n: ElementType) -> str:
-    if n.width == 1:
-        return ''
-    return '''
-        On some platforms, the access may fail
-        for an insufficiently aligned @Addr#@.
-    '''
-
-def print_block(template: str, **kwargs) -> None:
-    write(textwrap.dedent(template.format(**kwargs)).lstrip())
-    write('\n')
-
-def header(s: str):
-    write('\n')
-    print_block('''
-        ------------------------------------
-        -- {s}
-        ------------------------------------
-    ''', s=s)
-
-if args.addr_or_bytearray == "bytearray-access-ops":
-    header("ByteArray# operations")
-
-    header('aligned index operations')
-    for t in element_types:
-        offset = pretty_offset(t.width)
-        print_block('''
-        primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp
-           ByteArray# -> Int# -> {rep_ty}
-           {{Read a {desc}; offset in {offset}.}}
-           with can_fail = True
-        ''', offset = offset, **t._asdict())
-
-    header('unaligned index operations')
-    for t in element_types:
-        if t.name in ['Int8', 'Word8']: continue
-        print_block('''
-        primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp
-           ByteArray# -> Int# -> {rep_ty}
-           {{Read a {desc}; offset in bytes.}}
-           with can_fail = True
-        ''', **t._asdict())
-
-    header('aligned read operations')
-    for t in element_types:
-        offset = pretty_offset(t.width)
-        print_block('''
-        primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp
-           MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #)
-           {{Read a {desc}; offset in {offset}.}}
-           with has_side_effects = True
-                can_fail = True
-        ''', offset = offset, **t._asdict())
-
-    header('unaligned read operations')
-    for t in element_types:
-        if t.name in ['Int8', 'Word8']: continue
-        print_block('''
-        primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp
-           MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #)
-           {{Read a {desc}; offset in bytes.}}
-           with has_side_effects = True
-                can_fail = True
-        ''', **t._asdict())
-
-    header('aligned write operations')
-    for t in element_types:
-        offset = pretty_offset(t.width)
-        print_block('''
-        primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp
-           MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s
-           {{Write a {desc}; offset in {offset}.}}
-           with has_side_effects = True
-                can_fail = True
-        ''', offset = offset, **t._asdict())
-
-    header('unaligned write operations')
-    for t in element_types:
-        if t.name in ['Int8', 'Word8']: continue
-        print_block('''
-        primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp
-           MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s
-           {{Write a {desc}; offset in bytes.}}
-           with has_side_effects = True
-                can_fail = True
-        ''', **t._asdict())
-
-
-else: # addr_or_bytearray == "addr-access-ops":
-    header("Addr# access operations")
-
-    header('aligned index operations')
-    for t in element_types:
-        offset = pretty_offset(t.width)
-        align_warn = get_align_warn(t)
-        print_block('''
-        primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp
-           Addr# -> Int# -> {rep_ty}
-           {{ Read a {desc}; offset in {offset}.
-              {align_warn}
-           }}
-           with can_fail = True
-        ''', offset = offset, align_warn = align_warn, **t._asdict())
-
-    header('aligned read operations')
-    for t in element_types:
-        offset = pretty_offset(t.width)
-        align_warn = get_align_warn(t)
-        print_block('''
-        primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp
-           Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #)
-           {{ Read a {desc}; offset in {offset}.
-              {align_warn}
-           }}
-           with has_side_effects = True
-                can_fail = True
-        ''', offset = offset, align_warn = align_warn, **t._asdict())
-
-    header('aligned write operations')
-    for t in element_types:
-        offset = pretty_offset(t.width)
-        align_warn = get_align_warn(t)
-        print_block('''
-        primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp
-           Addr# -> Int# -> {rep_ty} -> State# s -> State# s
-           {{ Write a {desc}; offset in {offset}.
-              {align_warn}
-           }}
-           with has_side_effects = True
-                can_fail = True
-        ''', offset = offset, align_warn = align_warn, **t._asdict())


=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1956,7 +1956,11 @@ primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
 
    @since 0.5.0.0}
 
-#include "bytearray-access-ops.txt.pp"
+
+bytearray_access_ops
+-- This generates a whole bunch of primops;
+-- see utils/genprimopcode/AccessOps.hs
+
 
 primop  CompareByteArraysOp "compareByteArrays#" GenPrimOp
    ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
@@ -2259,7 +2263,11 @@ primop   AddrNeOp  "neAddr#"   Compare   Addr# -> Addr# -> Int#
 primop   AddrLtOp  "ltAddr#"   Compare   Addr# -> Addr# -> Int#
 primop   AddrLeOp  "leAddr#"   Compare   Addr# -> Addr# -> Int#
 
-#include "addr-access-ops.txt.pp"
+
+addr_access_ops
+-- This generates a whole bunch of primops;
+-- see utils/genprimopcode/AccessOps.hs
+
 
 primop  InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp
    Addr# -> Addr# -> State# s -> (# State# s, Addr# #)


=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -32,17 +32,6 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp"
 primopsTxt :: Stage -> FilePath
 primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt"
 
-accessOpsSource :: FilePath
-accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py"
-
-byteArrayAccessOpsTxt :: Stage -> FilePath
-byteArrayAccessOpsTxt stage
-  = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp"
-
-addrAccessOpsTxt :: Stage -> FilePath
-addrAccessOpsTxt stage
-  = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp"
-
 isGeneratedCmmFile :: FilePath -> Bool
 isGeneratedCmmFile file = takeBaseName file == "AutoApply"
 
@@ -153,21 +142,8 @@ generatePackageCode context@(Context stage pkg _ _) = do
             root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs
 
     when (pkg == compiler) $ do
-        let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage
-        let addr_ops_txt = root -/- addrAccessOpsTxt stage
-        ba_ops_txt %> \file -> do
-            need [accessOpsSource]
-            runBuilder Python
-              [accessOpsSource, "bytearray-access-ops", file]
-              [] []
-        addr_ops_txt %> \file -> do
-            need [accessOpsSource]
-            runBuilder Python
-              [accessOpsSource, "addr-access-ops", file]
-              [] []
         root -/- primopsTxt stage %> \file -> do
-            need $ [primopsSource, ba_ops_txt, addr_ops_txt]
-            -- ba_ops_txt and addr_ops_txt get #include-d
+            need $ [primopsSource]
             build $ target context HsCpp [primopsSource] [file]
 
     when (pkg == rts) $ do


=====================================
utils/genprimopcode/AccessOps.hs
=====================================
@@ -0,0 +1,250 @@
+module AccessOps (byteArrayAccessOps, addrAccessOps) where
+
+import Syntax
+
+data ElementType = MkElementType
+  { elt_name :: String
+  , elt_rep_ty :: Ty
+  , elt_desc :: String
+  , elt_width :: Maybe Int
+  }
+
+machWord :: Maybe Int
+machWord = Nothing
+
+strToTy :: String -> Ty
+strToTy s = TyApp (TyCon s) []
+
+elementTypes :: [ElementType]
+elementTypes =
+  [ MkElementType "Char"      (strToTy "Char#"  ) "an 8-bit character"             (Just 1)
+  , MkElementType "WideChar"  (strToTy "Char#"  ) "a 32-bit character"             (Just 4)
+  , MkElementType "Int"       (strToTy "Int#"   ) "a word-sized integer"           machWord
+  , MkElementType "Word"      (strToTy "Word#"  ) "a word-sized unsigned integer"  machWord
+  , MkElementType "Addr"      (strToTy "Addr#"  ) "a machine address"              machWord
+  , MkElementType "Float"     (strToTy "Float#" ) "a single-precision floating-point value"  (Just 4)
+  , MkElementType "Double"    (strToTy "Double#") "a double-precision floating-point value"  (Just 8)
+  , MkElementType "StablePtr" (TyApp (TyCon "StablePtr#") [TyVar "a"])
+                  "a 'StablePtr#' value"  machWord
+  ] ++ do
+  n <- [8, 16, 32, 64]
+  let mkDesc suff = (if n == 8 then "an " else "a ") ++ shows n suff
+  [ MkElementType
+      { elt_name = "Int" ++ show n
+      , elt_rep_ty = strToTy $ "Int" ++ shows n "#"
+      , elt_desc = mkDesc "-bit signed integer"
+      , elt_width = Just (n `quot` 8)
+      },
+    MkElementType
+      { elt_name = "Word" ++ show n
+      , elt_rep_ty = strToTy $ "Word" ++ shows n "#"
+      , elt_desc = mkDesc "-bit unsigned integer"
+      , elt_width = Just (n `quot` 8)
+      }
+    ]
+
+unalignedElementTypes :: [ElementType]
+unalignedElementTypes
+  = filter (\e -> elt_name e `notElem` ["Int8", "Word8"]) elementTypes
+--unalignedElementTypes = filter (\e -> elt_width e /= Just 1) elementTypes
+
+prettyOffset :: ElementType -> String
+prettyOffset e = case elt_width e of
+  Nothing -> "machine words"
+  Just 1  -> "bytes"
+  Just n  -> shows n "-byte words"
+
+getAlignWarn :: ElementType -> String
+getAlignWarn e = case elt_width e of
+  Just 1 -> ""
+  _ -> "On some platforms, the access may fail\n"
+       ++ "for an insufficiently aligned @Addr#@."
+
+mutableByteArrayS :: Ty
+mutableByteArrayS = TyApp (TyCon "MutableByteArray#") [TyVar "s"]
+
+stateS :: Ty
+stateS = TyApp (TyCon "State#") [TyVar "s"]
+
+readResTy :: ElementType -> Ty
+readResTy e = TyF stateS (TyUTup [stateS, elt_rep_ty e])
+
+writeResTy :: ElementType -> Ty
+writeResTy e = TyF (elt_rep_ty e) (TyF stateS stateS)
+
+
+
+mkIndexByteArrayOp :: ElementType -> Entry
+mkIndexByteArrayOp e = PrimOpSpec
+  { cons = "IndexByteArrayOp_" ++ elt_name e
+  , name = "index" ++ elt_name e ++ "Array#"
+  , ty = TyF (strToTy "ByteArray#")
+       $ TyF (strToTy "Int#")
+             (elt_rep_ty e)
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "."
+  , opts = [OptionTrue "can_fail"]
+  }
+
+mkUnalignedIndexByteArrayOp :: ElementType -> Entry
+mkUnalignedIndexByteArrayOp e = PrimOpSpec
+  { cons = "IndexByteArrayOp_Word8As" ++ elt_name e
+  , name = "indexWord8ArrayAs" ++ elt_name e ++ "#"
+  , ty = TyF (strToTy "ByteArray#")
+       $ TyF (strToTy "Int#")
+             (elt_rep_ty e)
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+  , opts = [OptionTrue "can_fail"]
+  }
+
+mkReadByteArrayOp :: ElementType -> Entry
+mkReadByteArrayOp e = PrimOpSpec
+  { cons = "ReadByteArrayOp_" ++ elt_name e
+  , name = "read" ++ elt_name e ++ "Array#"
+  , ty = TyF mutableByteArrayS
+       $ TyF (strToTy "Int#")
+       $ readResTy e
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "."
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+
+mkUnalignedReadByteArrayOp :: ElementType -> Entry
+mkUnalignedReadByteArrayOp e = PrimOpSpec
+  { cons = "ReadByteArrayOp_Word8As" ++ elt_name e
+  , name = "readWord8ArrayAs" ++ elt_name e ++ "#"
+  , ty = TyF mutableByteArrayS
+       $ TyF (strToTy "Int#")
+       $ readResTy e
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+
+mkWriteByteArrayOp :: ElementType -> Entry
+mkWriteByteArrayOp e = PrimOpSpec
+  { cons = "WriteByteArrayOp_" ++ elt_name e
+  , name = "write" ++ elt_name e ++ "Array#"
+  , ty = TyF mutableByteArrayS
+       $ TyF (strToTy "Int#")
+       $ writeResTy e
+  , cat = GenPrimOp
+  , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "."
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+
+mkUnalignedWriteByteArrayOp :: ElementType -> Entry
+mkUnalignedWriteByteArrayOp e = PrimOpSpec
+  { cons = "WriteByteArrayOp_Word8As" ++ elt_name e
+  , name = "writeWord8ArrayAs" ++ elt_name e ++ "#"
+  , ty = TyF mutableByteArrayS
+       $ TyF (strToTy "Int#")
+       $ writeResTy e
+  , cat = GenPrimOp
+  , desc = "Write " ++ elt_desc e ++ "; offset in bytes."
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+
+
+byteArrayAccessOps :: [Entry]
+byteArrayAccessOps
+  =  map mkIndexByteArrayOp elementTypes
+  ++ map mkUnalignedIndexByteArrayOp unalignedElementTypes
+  ++ map mkReadByteArrayOp elementTypes
+  ++ map mkUnalignedReadByteArrayOp unalignedElementTypes
+  ++ map mkWriteByteArrayOp elementTypes
+  ++ map mkUnalignedWriteByteArrayOp unalignedElementTypes
+
+
+
+mkIndexOffAddrOp :: ElementType -> Entry
+mkIndexOffAddrOp e = PrimOpSpec
+  { cons = "IndexOffAddrOp_" ++ elt_name e
+  , name = "index" ++ elt_name e ++ "OffAddr#"
+  , ty = TyF (strToTy "Addr#")
+       $ TyF (strToTy "Int#")
+             (elt_rep_ty e)
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n"
+           ++ getAlignWarn e
+  , opts = [OptionTrue "can_fail"]
+  }
+
+{-
+mkUnalignedIndexOffAddrOp :: ElementType -> Entry
+mkUnalignedIndexOffAddrOp e = PrimOpSpec
+  { cons = "IndexOffAddrOp_Word8As" ++ elt_name e
+  , name = "indexWord8OffAddrAs" ++ elt_name e ++ "#"
+  , ty = TyF (strToTy "Addr#")
+       $ TyF (strToTy "Int#")
+             (elt_rep_ty e)
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+  , opts = [OptionTrue "can_fail"]
+  }
+-}
+
+mkReadOffAddrOp :: ElementType -> Entry
+mkReadOffAddrOp e = PrimOpSpec
+  { cons = "ReadOffAddrOp_" ++ elt_name e
+  , name = "read" ++ elt_name e ++ "OffAddr#"
+  , ty = TyF (strToTy "Addr#")
+       $ TyF (strToTy "Int#")
+       $ readResTy e
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n"
+           ++ getAlignWarn e
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+
+{-
+mkUnalignedReadOffAddrOp :: ElementType -> Entry
+mkUnalignedReadOffAddrOp e = PrimOpSpec
+  { cons = "ReadOffAddrOp_Word8As" ++ elt_name e
+  , name = "readWord8OffAddrAs" ++ elt_name e ++ "#"
+  , ty = TyF (strToTy "Addr#")
+       $ TyF (strToTy "Int#")
+       $ readResTy e
+  , cat = GenPrimOp
+  , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+-}
+
+mkWriteOffAddrOp :: ElementType -> Entry
+mkWriteOffAddrOp e = PrimOpSpec
+  { cons = "WriteOffAddrOp_" ++ elt_name e
+  , name = "write" ++ elt_name e ++ "OffAddr#"
+  , ty = TyF (strToTy "Addr#")
+       $ TyF (strToTy "Int#")
+       $ writeResTy e
+  , cat = GenPrimOp
+  , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n"
+           ++ getAlignWarn e
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+
+{-
+mkUnalignedWriteOffAddrOp :: ElementType -> Entry
+mkUnalignedWriteOffAddrOp e = PrimOpSpec
+  { cons = "WriteOffAddrOp_Word8As" ++ elt_name e
+  , name = "writeWord8OffAddrAs" ++ elt_name e ++ "#"
+  , ty = TyF (strToTy "Addr#")
+       $ TyF (strToTy "Int#")
+       $ writeResTy e
+  , cat = GenPrimOp
+  , desc = "Write " ++ elt_desc e ++ "; offset in bytes."
+  , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"]
+  }
+-}
+
+
+addrAccessOps :: [Entry]
+addrAccessOps
+  =  map mkIndexOffAddrOp elementTypes
+--  ++ map mkUnalignedIndexOffAddrOp unalignedElementTypes
+  ++ map mkReadOffAddrOp elementTypes
+--  ++ map mkUnalignedReadOffAddrOp unalignedElementTypes
+  ++ map mkWriteOffAddrOp elementTypes
+--  ++ map mkUnalignedWriteOffAddrOp unalignedElementTypes


=====================================
utils/genprimopcode/Lexer.x
=====================================
@@ -52,6 +52,8 @@ words :-
     <0>         "infixr"            { mkT TInfixR }
     <0>         "Nothing"           { mkT TNothing }
     <0>         "vector"            { mkT TVector }
+    <0>         "bytearray_access_ops" { mkT TByteArrayAccessOps }
+    <0>         "addr_access_ops"   { mkT TAddrAccessOps }
     <0>         "thats_all_folks"   { mkT TThatsAllFolks }
     <0>         "SCALAR"            { mkT TSCALAR }
     <0>         "VECTOR"            { mkT TVECTOR }


=====================================
utils/genprimopcode/Parser.y
=====================================
@@ -5,6 +5,8 @@ import Lexer (lex_tok)
 import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos,
                 happyError)
 import Syntax
+
+import AccessOps
 }
 
 %name      parsex
@@ -47,6 +49,8 @@ import Syntax
     SCALAR          { TSCALAR }
     VECTOR          { TVECTOR }
     VECTUPLE        { TVECTUPLE }
+    bytearray_access_ops { TByteArrayAccessOps }
+    addr_access_ops { TAddrAccessOps }
     thats_all_folks { TThatsAllFolks }
     lowerName       { TLowerName $$ }
     upperName       { TUpperName $$ }
@@ -83,8 +87,13 @@ pInfix : infix  integer { Just $ Fixity NoSourceText $2 InfixN }
 
 pEntries :: { [Entry] }
 pEntries : pEntry pEntries { $1 : $2 }
+         | pAccessOps pEntries { $1 ++ $2 }
          | {- empty -}   { [] }
 
+pAccessOps :: { [Entry] }
+pAccessOps : bytearray_access_ops { byteArrayAccessOps }
+           | addr_access_ops { addrAccessOps }
+
 pEntry :: { Entry }
 pEntry : pPrimOpSpec   { $1 }
        | pPrimTypeSpec { $1 }
@@ -148,7 +157,7 @@ pVectors : pVector ',' pVectors { [$1] ++ $3 }
 
 pVector :: { (String, String, Int) }
 pVector : '<' upperName ',' upperName ',' integer '>' { ($2, $4, $6) }
- 
+
 pType :: { Ty }
 pType : paT '->' pType { TyF $1 $3 }
       | paT '=>' pType { TyC $1 $3 }


=====================================
utils/genprimopcode/ParserM.hs
=====================================
@@ -98,6 +98,8 @@ data Token = TEOF
            | TFalse
            | TCompare
            | TGenPrimOp
+           | TByteArrayAccessOps
+           | TAddrAccessOps
            | TThatsAllFolks
            | TLowerName String
            | TUpperName String


=====================================
utils/genprimopcode/genprimopcode.cabal
=====================================
@@ -28,6 +28,7 @@ Executable genprimopcode
                    Parser
                    ParserM
                    Syntax
+                   AccessOps
     Build-Depends: base       >= 4   && < 5,
                    array
     if flag(build-tool-depends)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ed8a76ddb1ce196d39c6d2c903a5353dec55a9d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ed8a76ddb1ce196d39c6d2c903a5353dec55a9d
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230723/ea596978/attachment-0001.html>


More information about the ghc-commits mailing list