{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

{-
    BNF Converter: C Main file
    Copyright (C) 2004  Author:  Michael Pellauer
    Copyright (C) 2020  Andreas Abel
-}
module BNFC.Backend.C (makeC, bufferC, bufferH, comment, testfileHeader) 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 ([Char]
hfile, [Char]
cfile) = RecordPositions -> [Char] -> CF -> ([Char], [Char])
cf2CAbs (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) [Char]
prefix CF
cf
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Absyn.h" [Char]
hfile
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Absyn.c" [Char]
cfile
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Buffer.h" [Char]
bufferH
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Buffer.c" forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
bufferC [Char]
"Buffer.h"
    let ([Char]
flex, SymMap
env) = ParserMode -> CF -> ([Char], SymMap)
cf2flex ParserMode
parserMode CF
cf
    forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile ([Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".l") [Char] -> [Char]
commentWithEmacsModeHint [Char]
flex
    forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile ([Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".y") [Char] -> [Char]
commentWithEmacsModeHint forall a b. (a -> b) -> a -> b
$
      RecordPositions -> ParserMode -> CF -> SymMap -> [Char]
cf2Bison (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) ParserMode
parserMode CF
cf SymMap
env
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Parser.h" forall a b. (a -> b) -> a -> b
$ RecordPositions -> CF -> [[Char]] -> [Char]
mkHeaderFile (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) CF
cf (forall k a. Map k a -> [a]
Map.elems SymMap
env)
    let ([Char]
skelH, [Char]
skelC) = CF -> ([Char], [Char])
cf2CSkel CF
cf
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Skeleton.h" [Char]
skelH
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Skeleton.c" [Char]
skelC
    let ([Char]
prinH, [Char]
prinC) = CF -> ([Char], [Char])
cf2CPrinter CF
cf
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Printer.h" [Char]
prinH
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Printer.c" [Char]
prinC
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCFile [Char]
"Test.c" (CF -> [Char]
ctest CF
cf)
    SharedOptions -> ([Char] -> Doc) -> MkFiles ()
Makefile.mkMakefile SharedOptions
opts forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char] -> Doc
makefile [Char]
name [Char]
prefix
  where
    name :: String
    name :: [Char]
name = SharedOptions -> [Char]
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 :: [Char]
prefix = [Char] -> [Char]
snakeCase_ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
"_"
    parserMode :: ParserMode
    parserMode :: ParserMode
parserMode = Bool -> [Char] -> ParserMode
CParser Bool
False [Char]
prefix
    mkCFile :: [Char] -> c -> MkFiles ()
mkCFile [Char]
x = forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile [Char]
x [Char] -> [Char]
comment


makefile :: String -> String -> String -> Doc
makefile :: [Char] -> [Char] -> [Char] -> Doc
makefile [Char]
name [Char]
prefix [Char]
basename = [Doc] -> Doc
vcat
    [ Doc
"CC = gcc -g"
    , Doc
"CCFLAGS = --ansi -W -Wall -Wsign-conversion -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
<> [Char] -> Doc
text [Char]
prefix
    , Doc
""
    , Doc
"BISON = bison"
    , Doc
"BISON_OPTS = -t -p" Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
prefix
    , Doc
""
    , Doc
"OBJS = Absyn.o Buffer.o Lexer.o Parser.o Printer.o"
    , Doc
""
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
".PHONY" [[Char]
"clean", [Char]
"distclean"]
      []
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"all" [[Char]
testName]
      []
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"clean" []
      -- peteg: don't nuke what we generated - move that to the "vclean" target.
      [ [Char]
"rm -f *.o " forall a. [a] -> [a] -> [a]
++ [Char]
testName forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords
        [ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
e | [Char]
e <- [[Char]
".aux", [Char]
".log", [Char]
".pdf",[Char]
".dvi", [Char]
".ps", [Char]
""]] ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"distclean" [[Char]
"clean"]
      [ [Char]
"rm -f " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords
        [ [Char]
"Absyn.h", [Char]
"Absyn.c"
        , [Char]
"Bison.h"
        , [Char]
"Buffer.h", [Char]
"Buffer.c"
        , [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".l", [Char]
"Lexer.c"
        , [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".y", [Char]
"Parser.h", [Char]
"Parser.c"
        , [Char]
"Printer.c", [Char]
"Printer.h"
        , [Char]
"Skeleton.c", [Char]
"Skeleton.h"
        , [Char]
"Test.c"
        , [Char]
basename, [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".tex"
        ]
      ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
testName [[Char]
"${OBJS}", [Char]
"Test.o"]
      [ [Char]
"@echo \"Linking " forall a. [a] -> [a] -> [a]
++ [Char]
testName forall a. [a] -> [a] -> [a]
++ [Char]
"...\""
      , [Char]
"${CC} ${OBJS} Test.o -o " forall a. [a] -> [a] -> [a]
++ [Char]
testName ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Absyn.o" [ [Char]
"Absyn.c", [Char]
"Absyn.h"]
      [ [Char]
"${CC} ${CCFLAGS} -c Absyn.c" ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Buffer.o" [ [Char]
"Buffer.c", [Char]
"Buffer.h"]
      [ [Char]
"${CC} ${CCFLAGS} -c Buffer.c" ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Lexer.c" [ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".l" ]
      [ [Char]
"${FLEX} ${FLEX_OPTS} -oLexer.c " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".l" ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Parser.c Bison.h" [ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".y" ]
      [ [Char]
"${BISON} ${BISON_OPTS} " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".y -o Parser.c" ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Lexer.o" [ [Char]
"CCFLAGS+=-Wno-sign-conversion" ]
        []
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Lexer.o" [ [Char]
"Lexer.c", [Char]
"Bison.h" ]
      [ [Char]
"${CC} ${CCFLAGS} -c Lexer.c " ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Parser.o" [[Char]
"Parser.c", [Char]
"Absyn.h", [Char]
"Bison.h" ]
      [ [Char]
"${CC} ${CCFLAGS} -c Parser.c" ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Printer.o" [ [Char]
"Printer.c", [Char]
"Printer.h", [Char]
"Absyn.h" ]
      [ [Char]
"${CC} ${CCFLAGS} -c Printer.c" ]
    , [Char] -> [[Char]] -> [[Char]] -> Doc
Makefile.mkRule [Char]
"Test.o" [ [Char]
"Test.c", [Char]
"Parser.h", [Char]
"Printer.h", [Char]
"Absyn.h" ]
      [ [Char]
"${CC} ${CCFLAGS} -c Test.c" ]
    ]
  where testName :: [Char]
testName = [Char]
"Test" forall a. [a] -> [a] -> [a]
++ [Char]
name

-- | Put string into a block comment.
comment :: String -> String
comment :: [Char] -> [Char]
comment [Char]
x = [[Char]] -> [Char]
unwords [[Char]
"/*", [Char]
x, [Char]
"*/"]

-- | C line comment including mode hint for emacs.
commentWithEmacsModeHint :: String -> String
commentWithEmacsModeHint :: [Char] -> [Char]
commentWithEmacsModeHint = [Char] -> [Char]
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"-*- c -*- " forall a. [a] -> [a] -> [a]
++)

-- | A heading comment for the generated parser test.
testfileHeader :: [String]
testfileHeader :: [[Char]]
testfileHeader =
  [ [Char]
"/************************* Compiler Front-End Test *************************/"
  , [Char]
"/*                                                                         */"
  , [Char]
"/*  This test will parse a file, print the abstract syntax tree, and then  */"
  , [Char]
"/*  pretty-print the result.                                               */"
  , [Char]
"/*                                                                         */"
  , [Char]
"/***************************************************************************/"
  ]

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

mkHeaderFile :: RecordPositions -> CF -> [String] -> String
mkHeaderFile :: RecordPositions -> CF -> [[Char]] -> [Char]
mkHeaderFile RecordPositions
_ CF
cf [[Char]]
_env = [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ [Char]
"#ifndef PARSER_HEADER_FILE"
    , [Char]
"#define PARSER_HEADER_FILE"
    , [Char]
""
    , [Char]
"#include <stdio.h>"
    , [Char]
"#include \"Absyn.h\""
    , [Char]
""
    ]
  -- Andreas, 2021-03-24
  -- Removed stuff that is now generated in Bison.h using the %defines pragma in the .y file.
  , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> [[Char]]
mkFunc forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall f. CFG f -> List1 Cat
allEntryPoints CF
cf
  , [ [Char]
""
    , [Char]
"#endif"
    ]
  ]
  where
  -- Andreas, 2019-04-29, issue #210: generate parsers also for coercions
  mkFunc :: Cat -> [[Char]]
mkFunc Cat
c =
    [ Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
c) forall a. [a] -> [a] -> [a]
++ [Char]
"  p" forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat Cat
c forall a. [a] -> [a] -> [a]
++ [Char]
"(FILE *inp);"
    , Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
c) forall a. [a] -> [a] -> [a]
++ [Char]
" ps" forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat Cat
c forall a. [a] -> [a] -> [a]
++ [Char]
"(const char *str);"
    ]


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

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

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

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