{-# LANGUAGE NoImplicitPrelude #-}

{-
    BNF Converter: C Main file
    Copyright (C) 2004  Author:  Michael Pellauer
    Copyright (C) 2020  Andreas Abel
-}
module BNFC.Backend.C (makeC, bufferC, bufferH) where

import Prelude hiding ((<>))

import Data.Foldable (toList)
import qualified Data.Map as Map

import BNFC.Utils
import BNFC.CF
import BNFC.Options
import BNFC.Backend.Base
import BNFC.Backend.C.CFtoCAbs
import BNFC.Backend.C.CFtoFlexC
import BNFC.Backend.C.CFtoBisonC
import BNFC.Backend.C.CFtoCSkel
import BNFC.Backend.C.CFtoCPrinter
import BNFC.PrettyPrint

import qualified BNFC.Backend.Common.Makefile as Makefile

makeC :: SharedOptions -> CF -> MkFiles ()
makeC :: SharedOptions -> CF -> MkFiles ()
makeC SharedOptions
opts CF
cf = do
    let (String
hfile, String
cfile) = RecordPositions -> String -> CF -> (String, String)
cf2CAbs (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) String
prefix CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Absyn.h" String
hfile
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Absyn.c" String
cfile
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Buffer.h" String
bufferH
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Buffer.c" (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String
bufferC String
"Buffer.h"
    let (String
flex, SymMap
env) = String -> CF -> (String, SymMap)
cf2flex String
prefix CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".l") String
flex
    let bison :: String
bison = RecordPositions -> String -> CF -> SymMap -> String
cf2Bison (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) String
prefix CF
cf SymMap
env
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".y") String
bison
    let header :: String
header = RecordPositions -> CF -> [String] -> String
mkHeaderFile (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) CF
cf (SymMap -> [String]
forall k a. Map k a -> [a]
Map.elems SymMap
env)
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Parser.h" String
header
    let (String
skelH, String
skelC) = CF -> (String, String)
cf2CSkel CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Skeleton.h" String
skelH
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Skeleton.c" String
skelC
    let (String
prinH, String
prinC) = CF -> (String, String)
cf2CPrinter CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Printer.h" String
prinH
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Printer.c" String
prinC
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Test.c" (CF -> String
ctest CF
cf)
    SharedOptions -> (String -> Doc) -> MkFiles ()
Makefile.mkMakefile SharedOptions
opts (String -> String -> String -> Doc
makefile String
name String
prefix)
  where
    name :: String
    name :: String
name = SharedOptions -> String
lang SharedOptions
opts
    -- The prefix is a string used by flex and bison
    -- that is prepended to generated function names.
    -- It should be a valid C identifier.
    prefix :: String
    prefix :: String
prefix = String -> String
snakeCase_ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"


makefile :: String -> String -> String -> Doc
makefile :: String -> String -> String -> Doc
makefile String
name String
prefix String
basename = [Doc] -> Doc
vcat
    [ Doc
"CC = gcc -g"
    , Doc
"CCFLAGS = --ansi -W -Wall -Wno-unused-parameter -Wno-unused-function -Wno-unneeded-internal-declaration ${CC_OPTS}"
    -- The @#define _POSIX_C_SOURCE 200809L@ is now placed locally in
    -- the generated lexer.
    -- , "CCFLAGS = --ansi -W -Wall -Wno-unused-parameter -Wno-unused-function -Wno-unneeded-internal-declaration -D_POSIX_C_SOURCE=200809L ${CC_OPTS}"
    -- , "# Setting _POSIX_C_SOURCE to 200809L activates strdup in string.h."
    -- , "# strdup was not in the ISO C standard before 6/2019 (C2x), yet in POSIX 1003.1."
    -- , "# See https://en.cppreference.com/w/c/experimental/dynamic/strdup"
    , Doc
""
    , Doc
"FLEX = flex"
    , Doc
"FLEX_OPTS = -P" Doc -> Doc -> Doc
<> String -> Doc
text String
prefix
    , Doc
""
    , Doc
"BISON = bison"
    , Doc
"BISON_OPTS = -t -p" Doc -> Doc -> Doc
<> String -> Doc
text String
prefix
    , Doc
""
    , Doc
"OBJS = Absyn.o Buffer.o Lexer.o Parser.o Printer.o"
    , Doc
""
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
".PHONY" [String
"clean", String
"distclean"]
      []
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"all" [String
testName]
      []
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"clean" []
      -- peteg: don't nuke what we generated - move that to the "vclean" target.
      [ String
"rm -f *.o " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
testName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
        [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e | String
e <- [String
".aux", String
".log", String
".pdf",String
".dvi", String
".ps", String
""]] ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"distclean" [String
"clean"]
      [ String
"rm -f " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
        [ String
"Absyn.h", String
"Absyn.c"
        , String
"Buffer.h", String
"Buffer.c"
        , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".l", String
"Lexer.c"
        , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".y", String
"Parser.h", String
"Parser.c"
        , String
"Printer.c", String
"Printer.h"
        , String
"Skeleton.c", String
"Skeleton.h"
        , String
"Test.c"
        , String
basename, String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".tex"
        ]
      ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
testName [String
"${OBJS}", String
"Test.o"]
      [ String
"@echo \"Linking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
testName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...\""
      , String
"${CC} ${OBJS} Test.o -o " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
testName ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Absyn.o" [ String
"Absyn.c", String
"Absyn.h"]
      [ String
"${CC} ${CCFLAGS} -c Absyn.c" ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Buffer.o" [ String
"Buffer.c", String
"Buffer.h"]
      [ String
"${CC} ${CCFLAGS} -c Buffer.c" ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Lexer.c" [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".l" ]
      [ String
"${FLEX} ${FLEX_OPTS} -oLexer.c " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".l" ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Parser.c" [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".y" ]
      [ String
"${BISON} ${BISON_OPTS} " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".y -o Parser.c" ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Lexer.o" [ String
"Lexer.c", String
"Parser.h" ]
      [ String
"${CC} ${CCFLAGS} -c Lexer.c " ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Parser.o" [String
"Parser.c", String
"Absyn.h" ]
      [ String
"${CC} ${CCFLAGS} -c Parser.c" ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Printer.o" [ String
"Printer.c", String
"Printer.h", String
"Absyn.h" ]
      [ String
"${CC} ${CCFLAGS} -c Printer.c" ]
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"Test.o" [ String
"Test.c", String
"Parser.h", String
"Printer.h", String
"Absyn.h" ]
      [ String
"${CC} ${CCFLAGS} -c Test.c" ]
    ]
  where testName :: String
testName = String
"Test" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name

-- | Generate a test program that parses stdin and prints the AST and it's
-- linearization
ctest :: CF -> String
ctest :: CF -> String
ctest CF
cf =
  [String] -> String
unlines
   [
    String
"/*** Compiler Front-End Test automatically generated by the BNF Converter ***/",
    String
"/*                                                                          */",
    String
"/* This test will parse a file, print the abstract syntax tree, and then    */",
    String
"/* pretty-print the result.                                                 */",
    String
"/*                                                                          */",
    String
"/****************************************************************************/",
    String
"",
    String
"#include <stdio.h>",
    String
"#include <stdlib.h>",
    String
"#include <string.h>",
    String
"",
    String
"#include \"Parser.h\"",
    String
"#include \"Printer.h\"",
    String
"#include \"Absyn.h\"",
    String
"",
    String
"void usage(void) {",
    String
"  printf(\"usage: Call with one of the following argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"combinations:\\n\");",
    String
"  printf(\"\\t--help\\t\\tDisplay this help message.\\n\");",
    String
"  printf(\"\\t(no arguments)\\tParse stdin verbosely.\\n\");",
    String
"  printf(\"\\t(files)\\t\\tParse content of files verbosely.\\n\");",
    String
"  printf(\"\\t-s (files)\\tSilent mode. Parse content of files " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"silently.\\n\");",
    String
"}",
    String
"",
    String
"int main(int argc, char ** argv)",
    String
"{",
    String
"  FILE *input;",
    String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" parse_tree;",
    String
"  int quiet = 0;",
    String
"  char *filename = NULL;",
    String
"",
    String
"  if (argc > 1) {",
    String
"    if (strcmp(argv[1], \"-s\") == 0) {",
    String
"      quiet = 1;",
    String
"      if (argc > 2) {",
    String
"        filename = argv[2];",
    String
"      } else {",
    String
"        input = stdin;",
    String
"      }",
    String
"    } else {",
    String
"      filename = argv[1];",
    String
"    }",
    String
"  }",
    String
"",
    String
"  if (filename) {",
    String
"    input = fopen(filename, \"r\");",
    String
"    if (!input) {",
    String
"      usage();",
    String
"      exit(1);",
    String
"    }",
    String
"  }",
    String
"  else input = stdin;",
    String
"  /* The default entry point is used. For other options see Parser.h */",
    String
"  parse_tree = p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
def String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(input);",
    String
"  if (parse_tree)",
    String
"  {",
    String
"    printf(\"\\nParse Successful!\\n\");",
    String
"    if (!quiet) {",
    String
"      printf(\"\\n[Abstract Syntax]\\n\");",
    String
"      printf(\"%s\\n\\n\", show" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(parse_tree));",
    String
"      printf(\"[Linearized Tree]\\n\");",
    String
"      printf(\"%s\\n\\n\", print" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(parse_tree));",
    String
"    }",
    String
"    return 0;",
    String
"  }",
    String
"  return 1;",
    String
"}",
    String
""
   ]
  where
  cat :: Cat
  cat :: Cat
cat = CF -> Cat
firstEntry CF
cf
  def :: String
  def :: String
def = Cat -> String
identCat Cat
cat
  dat :: String
  dat :: String
dat = Cat -> String
identCat (Cat -> String) -> (Cat -> Cat) -> Cat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> Cat
normCat (Cat -> String) -> Cat -> String
forall a b. (a -> b) -> a -> b
$ Cat
cat

mkHeaderFile :: RecordPositions -> CF -> [String] -> String
mkHeaderFile :: RecordPositions -> CF -> [String] -> String
mkHeaderFile RecordPositions
_ CF
cf [String]
env = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ String
"#ifndef PARSER_HEADER_FILE"
    , String
"#define PARSER_HEADER_FILE"
    , String
""
    , String
"#include \"Absyn.h\""
    , String
""
    , String
"typedef union"
    , String
"{"
    ]
  , (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
unionBuiltinTokens
  , (Cat -> [String]) -> [Cat] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> [String]
mkPointer ([Cat] -> [String]) -> [Cat] -> [String]
forall a b. (a -> b) -> a -> b
$ CF -> [Cat]
forall f. CFG f -> [Cat]
allParserCatsNorm CF
cf
  , [ String
"} YYSTYPE;"
    , String
""
      -- https://www.gnu.org/software/bison/manual/html_node/Location-Type.html#Location-Type
    , String
"typedef struct YYLTYPE"
    , String
"{"
    , String
"  int first_line;"
    , String
"  int first_column;"
    , String
"  int last_line;"
    , String
"  int last_column;"
    , String
"} YYLTYPE;"
    , String
""
    , String
"#define _ERROR_ 258"
    , Int -> [String] -> String
forall t. (Show t, Num t) => t -> [String] -> String
mkDefines (Int
259::Int) [String]
env
    , String
""
    , String
"extern YYLTYPE yylloc;"
    , String
"extern YYSTYPE yylval;"
    , String
""
    ]
  , (Cat -> [String]) -> [Cat] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> [String]
mkFunc ([Cat] -> [String]) -> [Cat] -> [String]
forall a b. (a -> b) -> a -> b
$ NonEmpty Cat -> [Cat]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Cat -> [Cat]) -> NonEmpty Cat -> [Cat]
forall a b. (a -> b) -> a -> b
$ CF -> NonEmpty Cat
forall f. CFG f -> NonEmpty Cat
allEntryPoints CF
cf
  , [ String
""
    , String
"#endif"
    ]
  ]
  where
  mkDefines :: t -> [String] -> String
mkDefines t
n [] = t -> String
forall a. (Show a, Num a) => a -> String
mkString t
n
  mkDefines t
n (String
s:[String]
ss) = (String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
+++ (t -> String
forall a. Show a => a -> String
show t
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ (t -> [String] -> String
mkDefines (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) [String]
ss)
  mkString :: a -> String
mkString a
n =  if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf (String -> Cat
TokenCat String
catString)
   then (String
"#define _STRING_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Show a, Num a) => a -> String
mkChar (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. (Show a, Num a) => a -> String
mkChar a
n
  mkChar :: a -> String
mkChar a
n =  if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf (String -> Cat
TokenCat String
catChar)
   then (String
"#define _CHAR_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Show a, Num a) => a -> String
mkInteger (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. (Show a, Num a) => a -> String
mkInteger a
n
  mkInteger :: a -> String
mkInteger a
n =  if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf (String -> Cat
TokenCat String
catInteger)
   then (String
"#define _INTEGER_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Show a, Num a) => a -> String
mkDouble (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. (Show a, Num a) => a -> String
mkDouble a
n
  mkDouble :: a -> String
mkDouble a
n =  if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf (String -> Cat
TokenCat String
catDouble)
   then (String
"#define _DOUBLE_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
mkIdent(a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. Show a => a -> String
mkIdent a
n
  mkIdent :: a -> String
mkIdent a
n =  if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf (String -> Cat
TokenCat String
catIdent)
   then (String
"#define _IDENT_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
   else String
""
  -- Andreas, 2019-04-29, issue #210: generate parsers also for coercions
  mkFunc :: Cat -> [String]
mkFunc Cat
c =
    [ Cat -> String
identCat (Cat -> Cat
normCat Cat
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(FILE *inp);"
    , Cat -> String
identCat (Cat -> Cat
normCat Cat
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ps" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const char *str);"
    ]


-- | A tiny buffer library for string buffers in the lexer.

bufferH :: String
bufferH :: String
bufferH = [String] -> String
unlines
  [ String
"/* This utility file was automatically generated by BNFC. */"
  , String
""
  , String
"/* A dynamically allocated character buffer that grows as it is appended. */"
  , String
""
  , String
"#ifndef BUFFER_HEADER"
  , String
"#define BUFFER_HEADER"
  , String
""
  , String
"typedef struct buffer {"
  , String
"  char* chars;           /* Pointer to start of the buffer.        */"
  , String
"  unsigned int size;     /* Buffer size (>= 1).                    */"
  , String
"  unsigned int current;  /* Next free character position (< size). */"
  , String
"} * Buffer;"
  , String
""
  , String
"/* External interface. */"
  , String
"/************************************************************************/"
  , String
""
  , String
"/* Create a new buffer of the given size. */"
  , String
"Buffer newBuffer (const unsigned int size);"
  , String
""
  , String
"/* Deallocate the buffer. */"
  , String
"void freeBuffer (Buffer buffer);"
  , String
""
  , String
"/* Deallocate the buffer, but return its content as string. */"
  , String
"char* releaseBuffer (Buffer buffer);"
  , String
""
  , String
"/* Clear contents of buffer. */"
  , String
"void resetBuffer (Buffer buffer);"
  , String
""
  , String
"/* Append string at the end of the buffer. */"
  , String
"void bufferAppendString (Buffer buffer, const char *s);"
  , String
""
  , String
"/* Append single character at the end of the buffer. */"
  , String
"void bufferAppendChar (Buffer buffer, const char c);"
  , String
""
  , String
"/* Give read-only access to the buffer content. */"
  , String
"const char* bufferContent (Buffer buffer);"
  , String
""
  , String
"#endif"
  ]

-- | A tiny buffer library for string buffers in the lexer.

bufferC :: String -> String
bufferC :: String -> String
bufferC String
bufferH = [String] -> String
unlines
  [ String
"/* This utility file was automatically generated by BNFC. */"
  , String
""
  , String
"/* A dynamically allocated character buffer that grows as it is appended. */"
  , String
""
  , String
"#include <assert.h>  /* assert */"
  , String
"#include <stdlib.h>  /* free, malloc */"
  , String
"#include <stdio.h>   /* fprintf */"
  , String
"#include <string.h>  /* size_t, strncpy */"
  , String
"#include \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bufferH String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
  , String
""
  , String
"/* Internal functions. */"
  , String
"/************************************************************************/"
  , String
""
  , String
"/* Make sure the buffer can hold `n` more characters. */"
  , String
"static void bufferAllocateChars (Buffer buffer, const unsigned int n);"
  , String
""
  , String
"/* Increase the buffer size to the new `buffer->size`. */"
  , String
"static void resizeBuffer(Buffer buffer);"
  , String
""
  , String
"/* External interface. */"
  , String
"/************************************************************************/"
  , String
""
  , String
"/* Create a new buffer of the given size. */"
  , String
""
  , String
"Buffer newBuffer (const unsigned int size) {"
  , String
""
  , String
"  /* The buffer cannot be of size 0. */"
  , String
"  assert (size >= 1);"
  , String
""
  , String
"  /* Allocate and initialize a new Buffer structure. */"
  , String
"  Buffer buffer    = (Buffer) malloc(sizeof(struct buffer));"
  , String
"  buffer->size     = size;"
  , String
"  buffer->current  = 0;"
  , String
"  buffer->chars    = NULL;"
  , String
"  resizeBuffer(buffer);"
  , String
"  buffer->chars[0] = 0;"
  , String
"  return buffer;"
  , String
"}"
  , String
""
  , String
"/* Deallocate the buffer and its content. */"
  , String
""
  , String
"void freeBuffer (Buffer buffer) {"
  , String
"  free(buffer->chars);"
  , String
"  free(buffer);"
  , String
"}"
  , String
""
  , String
"/* Deallocate the buffer, but return its content as string. */"
  , String
""
  , String
"char* releaseBuffer (Buffer buffer) {"
  , String
"  char* content = (char*) realloc (buffer->chars, buffer->current + 1);"
  , String
"  free(buffer);"
  , String
"  return content;"
  , String
"}"
  , String
""
  , String
"/* Clear contents of buffer. */"
  , String
""
  , String
"void resetBuffer (Buffer buffer) {"
  , String
"  buffer->current = 0;"
  , String
"  buffer->chars[buffer->current] = 0;"
  , String
"}"
  , String
""
  , String
"/* Append string at the end of the buffer. */"
  , String
""
  , String
"void bufferAppendString (Buffer buffer, const char *s)"
  , String
"{"
  , String
"  /* Nothing to do if s is the empty string. */"
  , String
"  size_t len = strlen(s);"
  , String
"  if (len) {"
  , String
""
  , String
"    /* Make sure the buffer can hold all of s. */"
  , String
"    bufferAllocateChars(buffer, len);"
  , String
""
  , String
"    /* Append s at the end of the buffer. */"
  , String
"    strncpy(buffer->chars + buffer->current, s, len);"
  , String
""
  , String
"    /* Terminate with 0. */"
  , String
"    buffer->current += len;"
  , String
"    buffer->chars[buffer->current] = 0;"
  , String
"  }"
  , String
"}"
  , String
""
  , String
"/* Append single character at the end of the buffer. */"
  , String
""
  , String
"void bufferAppendChar (Buffer buffer, const char c)"
  , String
"{"
  , String
"  /* Make sure the buffer can hold one more character and append it. */"
  , String
"  bufferAllocateChars(buffer, 1);"
  , String
"  buffer->chars[buffer->current] = c;"
  , String
""
  , String
"  /* Terminate with 0. */"
  , String
"  buffer->current++;"
  , String
"  buffer->chars[buffer->current] = 0;"
  , String
"}"
  , String
""
  , String
"/* Give read-only access to the buffer content."
  , String
"   Does not survive the destruction of the buffer object. */"
  , String
""
  , String
"const char* bufferContent (Buffer buffer) {"
  , String
"  return buffer->chars;"
  , String
"}"
  , String
""
  , String
"/* Internal functions. */"
  , String
"/************************************************************************/"
  , String
""
  , String
"/* Make sure the buffer can hold `n` more characters. */"
  , String
""
  , String
"static void bufferAllocateChars (Buffer buffer, const unsigned int n) {"
  , String
"  /* 1 extra char for terminating 0. */"
  , String
"  unsigned int requiredSize = buffer->current + 1 + n;"
  , String
"  if (buffer->size < requiredSize)"
  , String
"  {"
  , String
"    do buffer->size *= 2; /* Double the buffer size */"
  , String
"      while (buffer->size < requiredSize);"
  , String
"    resizeBuffer(buffer);"
  , String
"  }"
  , String
"}"
  , String
""
  , String
"/* Increase the buffer size to the new `size`. */"
  , String
""
  , String
"static void resizeBuffer(Buffer buffer)"
  , String
"{"
  , String
"  /* The new size needs to be strictly greater than the currently"
  , String
"   * used part, otherwise writing to position buffer->current will"
  , String
"   * be out of bounds."
  , String
"   */"
  , String
"  assert(buffer->size > buffer->current);"
  , String
""
  , String
"  /* Resize (or, the first time allocate) the buffer. */"
  , String
"  buffer->chars = (char*) realloc(buffer->chars, buffer->size);"
  , String
""
  , String
"  /* Crash if out-of-memory. */"
  , String
"  if (! buffer->chars)"
  , String
"  {"
  , String
"    fprintf(stderr, \"Buffer.c: Error: Out of memory while attempting to grow buffer!\\n\");"
  , String
"    exit(1);  /* This seems to be the right exit code for out-of-memory. 137 is only when the OS kills us. */"
  , String
"  }"
  , String
"}"
  ]