Merge pull request #133 from EpitechPromo2027/jabolol/static-strings

fix: correct memory location for `strings`

lib/Ast/Parser/Literal.hs

@@ -2,6 +2,7 @@ module Ast.Parser.Literal where
 
 import qualified Ast.Parser.Utils as PU
 import qualified Ast.Types as AT
+import qualified Data.Char as C
 import qualified Text.Megaparsec as M
 import qualified Text.Megaparsec.Char as MC
 import qualified Text.Megaparsec.Char.Lexer as ML
@@ -54,9 +55,53 @@ parseChar = AT.LChar <$> M.between (MC.char '\'') (MC.char '\'') M.anySingle
 parseArray :: PU.Parser AT.Literal
 parseArray =
   M.choice
-    [ AT.LArray . map AT.LChar <$> M.between (MC.char '\"') (MC.char '\"') (M.many (M.noneOf ['"'])),
-      AT.LArray <$> M.between (PU.symbol "[") (PU.symbol "]") (M.sepBy parseLiteral PU.sc)
+    [ parseStringArray,
+      parseLiteralArray
     ]
+  where
+    parseStringArray =
+      AT.LArray . map AT.LChar
+        <$> M.between (MC.char '\"') (MC.char '\"') (M.many parseStringChar)
+
+    parseLiteralArray =
+      AT.LArray
+        <$> M.between (PU.symbol "[") (PU.symbol "]") (M.sepBy parseLiteral PU.sc)
+
+    parseStringChar =
+      M.choice
+        [ parseEscapeSequence,
+          M.noneOf ['"', '\\']
+        ]
+
+    parseEscapeSequence =
+      MC.char '\\'
+        >> M.choice
+          [ '\a' <$ MC.char 'a',
+            '\b' <$ MC.char 'b',
+            '\f' <$ MC.char 'f',
+            '\n' <$ MC.char 'n',
+            '\r' <$ MC.char 'r',
+            '\t' <$ MC.char 't',
+            '\v' <$ MC.char 'v',
+            '\\' <$ MC.char '\\',
+            '\"' <$ MC.char '"',
+            '\'' <$ MC.char '\'',
+            '\0' <$ MC.char '0',
+            parseHexEscape,
+            parseOctalEscape
+          ]
+
+    parseHexEscape = do
+      _ <- MC.char 'x'
+      digits <- M.count 2 hexDigit
+      return $ C.chr $ read ("0x" ++ digits)
+
+    parseOctalEscape = do
+      digits <- M.count 3 octalDigit
+      return $ C.chr $ read ("0o" ++ digits)
+
+    hexDigit = M.oneOf $ ['0' .. '9'] ++ ['a' .. 'f'] ++ ['A' .. 'F']
+    octalDigit = M.oneOf ['0' .. '7']
 
 -- | Parses a `null` literal.
 -- Returns a `Literal` of type `LNull`.

lib/Codegen/Codegen.hs

@@ -18,11 +18,15 @@ import qualified Control.Monad.State as S
 import qualified Data.List as L
 import qualified Data.Maybe as M
 import qualified LLVM.AST as AST
+import qualified LLVM.AST.AddrSpace as AS
 import qualified LLVM.AST.Constant as C
 import qualified LLVM.AST.Float as FF
+import qualified LLVM.AST.Global as G
 import qualified LLVM.AST.IntegerPredicate as IP
+import qualified LLVM.AST.Linkage as LK
 import qualified LLVM.AST.Type as T
 import qualified LLVM.AST.Typed as TD
+import qualified LLVM.AST.Visibility as V
 import qualified LLVM.IRBuilder.Constant as IC
 import qualified LLVM.IRBuilder.Instruction as I
 import qualified LLVM.IRBuilder.Module as M
@@ -183,31 +187,73 @@ instance ExprGen AT.Expr where
     AT.Assignment {} -> generateAssignment expr
 
 -- | Generate LLVM code for constants.
-generateConstant :: (MonadCodegen m) => AT.Literal -> m C.Constant
-generateConstant lit = case lit of
+generateConstant :: (MonadCodegen m) => AT.Literal -> AT.SrcLoc -> m C.Constant
+generateConstant lit loc = case lit of
   AT.LInt n -> return $ C.Int 32 (fromIntegral n)
   AT.LChar c -> return $ C.Int 8 (fromIntegral $ fromEnum c)
   AT.LBool b -> return $ C.Int 1 (if b then 1 else 0)
   AT.LNull -> return $ C.Null T.i8
   AT.LFloat f -> pure $ C.Float (FF.Single (realToFrac f))
   AT.LArray elems -> do
-    constants <- mapM generateConstant elems
-    return $ C.Array (TD.typeOf $ head constants) constants
+    let (headElem, _) = M.fromJust $ L.uncons elems
+    case headElem of
+      AT.LChar _ -> do
+        strPtr <- createGlobalString [c | AT.LChar c <- elems]
+        case strPtr of
+          AST.ConstantOperand c -> return c
+          _ -> E.throwError $ CodegenError loc $ UnsupportedLiteral lit
+      _ -> do
+        constants <- mapM (`generateConstant` loc) elems
+        return $ C.Array (TD.typeOf $ head constants) constants
   AT.LStruct fields -> do
     -- We do not need the names of the fields
     -- as we only use them when accessing the fields of the struct
     let (_, values) = unzip fields
-    constants <- mapM generateConstant values
+    constants <- mapM (`generateConstant` loc) values
     return $ C.Struct Nothing False constants
 
 -- | Generate LLVM code for literals.
 generateLiteral :: (MonadCodegen m) => AT.Expr -> m AST.Operand
-generateLiteral (AT.Lit _ lit) = do
-  constant <- generateConstant lit
+generateLiteral (AT.Lit loc lit) = do
+  constant <- generateConstant lit loc
   pure $ AST.ConstantOperand constant
 generateLiteral expr =
   E.throwError $ CodegenError (U.getLoc expr) $ UnsupportedDefinition expr
 
+-- | Generate LLVM code for global variables.
+createGlobalString :: (MonadCodegen m) => String -> m AST.Operand
+createGlobalString str = do
+  let strConst =
+        C.Array
+          (T.IntegerType 8)
+          (map (C.Int 8 . fromIntegral . fromEnum) (str ++ "\0"))
+  let strType = T.ArrayType (fromIntegral $ length str + 1) (T.IntegerType 8)
+  name <- IRM.fresh
+  let global =
+        AST.GlobalVariable
+          { G.name = name,
+            G.linkage = LK.Private,
+            G.visibility = V.Default,
+            G.dllStorageClass = Nothing,
+            G.threadLocalMode = Nothing,
+            G.unnamedAddr = Just AST.GlobalAddr,
+            G.isConstant = True,
+            G.type' = strType,
+            G.addrSpace = AS.AddrSpace 0,
+            G.initializer = Just strConst,
+            G.section = Nothing,
+            G.comdat = Nothing,
+            G.alignment = 1,
+            G.metadata = []
+          }
+  M.emitDefn $ AST.GlobalDefinition global
+  return $
+    AST.ConstantOperand $
+      C.GetElementPtr
+        True
+        (C.GlobalReference (T.ptr strType) name)
+        [C.Int 64 0, C.Int 64 0]
+
 -- | Generate LLVM code for binary operations.
 generateBinaryOp :: (MonadCodegen m) => AT.Expr -> m AST.Operand
 generateBinaryOp (AT.Op loc op e1 e2) = do