content: \documentclass{article}
  \usepackage[english]{babel}
  \usepackage{listings}
  \usepackage{fullpage}
  \usepackage{color}
  
  %include polycode.fmt
  
  %if false
    Error: DSL for error definition
     
    Copyright (c) 2009, 2011 ETH Zurich.
    All rights reserved.
    
    This file is distributed under the terms in the attached LICENSE file.
    If you do not find this file, copies can be found by writing to:
    ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
  %endif
  
  \title{Filet-O-Fish Tutorial:\\
         The Fugu Error Definition Language}
  \author{\Large{Pierre-Evariste \sc{Dagand}}}
  \date{}
  
  \begin{document}
  
  \lstset{basicstyle=\ttfamily,
          columns=fullflexible,
          language=C}
  
  \maketitle
  
  
  
  \textcolor{red}{Warning: the comments below are out-of-sync with some
  aspects of the code. Some will claim that this is a clear proof that
  literate programming is useless. Others will note that in non-literate
  code, I would not have written this disclaimer and the code would be a
  complete mess. Anyway, feel free to improve the literate story: we
  have variable-size blocks, error codes are not generated randomly
  anymore, we use a threshold to differentiate success to failure
  cases.}
  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \section*{Introduction}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  
  
  %% <- Present the goal of the tutorial
  
  In this tutorial, we aim at illustrating the usage of Filet-O-Fish
  (FoF). Therefore, we will implement a small Domain-Specific Language
  (DSL), using FoF in the back-end. However, we will also cover a
  broader topic: how to design a new DSL taking advantage of FoF
  particularities. In particular, this DSL will be an Error Definition
  Language (EDL) called Fugu. Its functionalities are described in
  Section~\ref{sec:edl}.
  
  %%    -> Step-by-step, real life design
  
  Hence, we will adopt a step-by-step approach. While covering the
  various phases of development, we will try to devise a more
  ``principled'' approach, which could serve for future development.
  
  %%    -> From C code to high-level language
  
  One of our partis pris is that such work should start from mature C
  code. FoF is meant as a safe meta-language, allowing the DSL designer
  to, first, abstract over C and, then, manipulate these high-level
  constructions in a powerful environment, such as Haskell or a theorem
  prover.
  
  %%    -> With a focus on the back-end 
  
  For the sake of brevity, we will focus our presentation on the DSL
  back-end. Hence, we will not write a parser for Fugu: the syntax of
  this small language will be \emph{embedded} in Haskell, by the means
  of some \emph{combinators}. We will take care of avoiding any
  confusion between all those languages.
  
  %% <- Outline
  %%    -> Follow real development
  %%    <- Intents of the Error Definition language
  %%    <- Presentation of the C sample
  %%    <- Designing the Syntax
  %%    <- Backend
  
  This tutorial is organized as follow. In a first Section, we specify
  our requirements concerning Fugu. In a second Section, we consider
  define a small class of errors and describe how we would like to
  compile them down. From there, we carry a step-by-step implementation
  of Fugu in Section~\ref{sec:backend}.
  
  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \section{An Error Definition System}
  \label{sec:edl}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  
  %% <- Replacing errno
  %%      <- Overloaded meaning (several causes, one code)
  
  The need for an Error Definition System arises from the deficiencies of
  the traditional scheme, namely the \texttt{errno.h}, or similar,
  file. In this file, developers typically aggregate the error codes of
  all errors that could potentially occur in the system. In order to
  scale, they quickly ``overload'' the meaning of these error codes:
  instead of defining distinct error codes, they use a single code which
  has multiple causes. For example, the {\sc Einval} error of FreeBSD
  signals that ``some invalid argument was supplied: for example,
  specifying an undefined signal to a signal function or a kill system
  call''. In parallel, they also abuse the return values of
  functions. For instance, a function returning a {\sc Null} pointer is
  typically signalling an error. However, this does not provide much
  information to the developer facing such case.
  
  %%      <- Artificially limited namespace
  
  Although this might have been historically relevant, there is no
  incentive, today, to limit the error code space to 255. Using 16 bits
  would allow us to define 65535 error codes. In such a huge space, we
  would be freed from the burden of overloading error codes and
  functions return values: when it is relevant, the developer should be
  able to define new error codes. Hence, he could handle errors more
  precisely, in the code as well as during the debugging process.
  
  %%      <- Flat namespace
  
  However, by imposing a flat name-space, the \texttt{errno.h} approach
  reduces the benefit of defining more precise error codes. When an
  error occurs, the developer is not able to relate it to a subsystem:
  it is simply defined as one error among thousands of others. In a
  sense, the error is more precise but still lacks some context. Being
  able to give a context to an error would be a step forward, notably
  during debugging.
  
  %%      <- Absence of error-tracking
  
  Finally, it is often the case that an error in one function must be
  reported to several functions in the call-stack. Whereas the depth of
  the call-stack is generally low, it is extremely inconvenient to
  define case-specific error codes at each level (the number of cases
  growing exponentially with the depth). Hence, we generally give up
  accuracy and report a global, overloaded error code.
  
  %% <- Design goals
  %%      <- One class of errors per "component"
  
  For these reasons, we provide the developer with the power of
  defining classes of errors per ``component''. The notion of
  \emph{component} is purposely kept fuzzy: it is up to the developer
  to define its components, on a case-by-case basis. For example, it
  could be a single function or a class of related functions.
  
  %%      <- Call-trace
  
  By using a 16 bits space, we are able get rid of the artificial
  limitation of the state-space. But we can also take advantage of this
  sub-word quantity in our 64 bits machines. Indeed, in one machine
  word, we are able to handle 4 error codes. Hence, we can build the
  call-trace by \emph{pushing} an error code in the previous one, and so
  on along the call-path.
  
  %%      <- Automated, human-readable error reporting
  
  By relying on a tool to generate C code for us, we can also get rid of
  a lot of boilerplate code. For example, when defining an error code,
  we label it with a descriptive message as well as a short
  acronym. Then, given an error, we should be able to report it to the
  user, in a meaningful way.
  
  %%      <- Sensibility to wild writes
  
  Finally, in the event of wild write -- such as a buffer overflow -- on
  the error code variable, we would like the error code to become
  meaningless, instead of signaling an unrelated error. Therefore, we
  should use random numbers to identify errors. Hence, the common
  consequences of a wild write, such as overwriting with 0 or with a
  character, could be detected more easily.
  
  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \section{C Sample Code}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  %% <- Why starting with a C sample
  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \subsection{Starting from C}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  %%     <- Ability for anyone (non-FoF user) to discuss 
  %%        and modify the model
  %%         <- Importance of user's feed-back
  
  First of all, we would like to stress the importance of starting from
  a mature C code. The first and foremost reason is the ability to
  \emph{discuss} this draft with the final users of the DSL: whereas not
  everyone is familiar with Haskell and FoF, C is the \emph{lingua
  franca} for everyone. Thanks to this support, users are given the
  power to influence the design of the DSL, without having to handle its
  machinery. Moreover, this C file is an inexpensive support for testing
  and debugging: we can quickly modify its behavior without dealing
  with the compilation machinery.
  
  %%     <- FoF should not be meant as a programming language per se
  %%         <- Give a meaning
  
  Although disturbing at first, FoF should \emph{not} be meant as a
  programming language. First and foremost, FoF gives a meaning, the
  semantics, to your DSL language. The fact that it can be compiled to C
  comes as a bonus.
  
  %%     <- C code serves as a weak specification of the intention
  %%         <- Informal alternative semantics
  
  Finally, a ``good'' DSL should be defined by an alternative semantics,
  which would allow the DSL designer to check the correctness of the
  compiler. Having a C sample of a particular instance can play this
  role, for this test-case. Although it does not help in obtaining
  formal guarantees, it is a first step toward a seemingly correct
  compiler.
  
  
  %% <- The Errors
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \subsection{Our Test-Case}
  \label{sec:example}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  In the following, we will define the error codes for two components:
  ``system'' and ``pci''. The ``\verb!system_err!'' class of errors will
  contain the following cases of success:
  \begin{description}
          \item[\verb!SYS_OK!] No error
          \item[\verb!SYS_ILIA!] Mafioso Pasta (private ETH joke, on SOSP lunches)
  \end{description}
  
  And the following cases of error:
  \begin{description}
          \item[\verb!SYS_FAIL!] Failed
          \item[\verb!SYS_TEM!] Kernel Hacker
          \item[\verb!SYS_IPHUS!] Analphabet Greek
  \end{description}
  
  The ``\verb!pci_err!'' class of errors is more serious, with the
  following cases of success:
  \begin{description}
          \item[\verb!PCI_OK!] No PCI error
          \item[\verb!PCI_GET_CAP!] That is my cap
  \end{description}
  
  And this case of error:
  \begin{description}
          \item[\verb!PCI_CAP_NOK!] Lost my cap
  \end{description}
  
  In the next Section, we review the C code \emph{we would like to
  generate} from this or a similar description. Bear in mind that this
  code is the result of a long and contradictory discussion with the
  final users.
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \subsection{The C Sample}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  %% <- Includes
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Includes}
  %%%%%%%%%%%%%%%%%%%%
  
  
  First of all, we will need, more or less, the following includes:
  
  \begin{lstlisting}
   #include <stdlib.h>
   #include <stdio.h>
   #include <assert.h>
   #include <stdbool.h>
   #include <stdint.h>
   #include <stdarg.h>
  \end{lstlisting}
  
  
  
  %% <- Typedef
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Type Definitions}
  %%%%%%%%%%%%%%%%%%%%
  
  We define an error value as 64 bits machine word. This encompass both
  the current error code and, potentially, 3 others stacked error codes.
  
  \begin{lstlisting}
  typedef uint64_t errval_t;
  \end{lstlisting}
  
  %% <- Enumeration
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Error codes}
  %%%%%%%%%%%%%%%%%%%%
  
  We define the error codes in an enumeration. Each code is identified
  by a random number between 0 and 65535. The success codes are
  identified by an odd number whereas failure codes are identified by an
  even number. This will come handy when we define a global
  \verb!err_is_ok! and \verb!err_is_fail! functions.
  
  \begin{lstlisting}
  enum err_code {
      SYS_OK = 11,
      SYS_FAIL = 84,
      SYS_ILIA = 93,
      SYS_TEM = 2,
      SYS_IPHUS = 34,
      PCI_OK = 41,
      PCI_CAP_NOK = 28,
      PCI_GET_CAP = 16
  };
  \end{lstlisting}
  
  
  %% <- Labels
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Labels}
  %%%%%%%%%%%%%%%%%%%%
  
  Then, we statically define the previous error descriptions, acronyms,
  and domains. This way, we will be able to provide a descriptive
  notification to the user in case of error.
  
  \begin{lstlisting}
  static char *err_domains[] = {
      "System_err", "Pci_err", "Undefined"
  };
  static char *err_codes[] = {
      "SYS_OK", "SYS_FAIL", "SYS_ILIA",
      "SYS_TEM", "SYS_IPHUS", "PCI_OK",
      "PCI_CAP_NOK", "PCI_GET_CAP",
      "UNDEFINED"
  };
  static char *err_msgs[] = {
      "No error", "Failed",
      "Mafioso Pasta",
      "Kernel Hacker",
      "Analphabet Greek",
      "No PCI error",
      "Lost my cap",
      "That is my cap",
      "Undefined error",
  };
  \end{lstlisting}
  
  
  %% <- Pop and push Error number
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Getting and Stacking Errors}
  %%%%%%%%%%%%%%%%%%%%
  
  Given an \verb!errval_t!, we will need to extract the latest error
  code. This is done by accessing the lowest 16 bits.
  
  \begin{lstlisting}
  static inline enum err_code err_no(errval_t err){
      return (err & ((1 << 16) - 1));
  }
  \end{lstlisting}
  
  Similarly, we can stack up an error code in an existing error value:
  we simply have to shift-left the stack and write the current error
  code in the lowest 16 bits.
  
  \begin{lstlisting}
  static inline errval_t err_push(errval_t err, enum err_code code){
      return (err << 16) || code;
  }
  \end{lstlisting}
  
  
  
  %% <- Testing for success or failure
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Success and Failure}
  %%%%%%%%%%%%%%%%%%%%
  
  We will frequently need to test an error code for failure or
  success. Hence, we provide two function which are both efficient and
  apply to any error code.
  
  \begin{lstlisting}
  static inline bool err_is_ok(errval_t err){
      return err_no(err) % 2;
  }
  static inline bool err_is_fail(errval_t err){
      return 1 - (err_no(err) % 2);
  }
  \end{lstlisting}
  
  
  %% <- Error-specific tests
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Error-specific Tests}
  %%%%%%%%%%%%%%%%%%%%
  
  Then, we might need to test some error codes against a specific
  error. This is simply achieved by the following functions.
  
  \begin{lstlisting}
  static inline bool err_is_sys_fail(errval_t e){
      return err_no(e) == SYS_FAIL;
  }
  ...
  static inline bool err_is_pci_ok(errval_t e){
      return err_no(e) == SYS_OK;
  }
  ...
  \end{lstlisting}
  
  
  %% <- Asserting success or failure
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Asserting Success and Failure}
  %%%%%%%%%%%%%%%%%%%%
  
  Similarly, during the debugging phase, we might need to assert the
  correctness or incorrectness of a result. Hence, the following
  assertions.
  
  \begin{lstlisting}
  static inline void err_assert_ok(errval_t err){
      assert(err_is_ok(err));
  }
  static inline void err_assert_fail(errval_t err){
      assert(err_is_fail(err));
  }
  \end{lstlisting}
  
  
  %% <- Printers on errors
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Printing Errors}
  %%%%%%%%%%%%%%%%%%%%
  
  
  
  \begin{lstlisting}
  static inline char *err_getstring(errval_t err) {
  
      switch (err_no(err)) {
      case SYS_OK: {
          return err_msgs[0]; 
          break;
      }
      ...
      case PCI_OK: {
          return err_msgs[5]; 
          break;
      }
      ...
      default: {
          return err_msgs[8];
          break;
      }
      }
      return NULL;
  }
  
  static inline char *err_getcode(errval_t err ) {
  
      switch (err_no(err)) {
      case SYS_OK: {
          return err_codes[0]; 
          break;
      }
      ...
      case PCI_OK: {
          return err_codes[5]; 
          break;
      }
      ...
      default: {
          return err_codes[8];
          break;
      }
      }
      return NULL;
  }
  
  static inline char *err_getdomain(errval_t err ) {
  
      switch (err_no(err)) {
      case SYS_OK: {
          return err_domains[0]; 
          break;
      }
      ...
      case PCI_OK: {
          return err_domains[1]; 
          break;
      }
      ...
      default: {
          return err_domains[2];
          break;
      }
      }
      return NULL;
  }
  \end{lstlisting}
  
  
  %% <- Printing the call trace
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Printing the Call-trace}
  %%%%%%%%%%%%%%%%%%%%
  
  Finally, mostly during debugging, we would like to inspect the
  call-trace leading to an error. This is achieved by the following
  code. First, it verifies that the stack contains an error. Then, it
  \emph{pop}s error codes from it and prints their domain, description,
  and acronym.
  
  \begin{lstlisting}
  static inline void err_print_calltrace(errval_t err){
      
      if (err_is_fail(err)){
          
          enum err_code x;
          while( (x = err_no(err)) != 0 ){
              printf("Failure: (%12s) %20s [%s]\n",
                     err_getdomain(x),
                     err_getstring(x),
                     err_getcode(x));
              err = err >> 16;
          }       
      }
  }
  \end{lstlisting}
  
  
  This concludes our draft implementation of an error management
  system. Now, we are aware of our needs, what the user needs to specify
  and what constructs should we abstract away. Let us start implementing
  Fugu, now.
  
  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \section{Fugu: the Error Definition Language}
  \label{sec:backend}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  
  %if false
  
  > module FuguBackend where
  
  > import System.IO
  > import System.Random
  > import Data.Char
  > import Data.Maybe
  > import Data.List
  > import Data.Monoid
  > import qualified Data.Bits as B
  
  > import Debug.Trace
  
  > import Semantics
  > import Constructs
  > import PureExpressions
  > import Expressions
  
  > import Constructs.Conditionals
  > import Constructs.References
  > import Constructs.Functions
  > import Constructs.Structures
  > import Constructs.Arrays
  > import Constructs.Enumerations
  > import Constructs.Typedef
  > import Constructs.Strings
  
  > import Libc.Assert
  > import Libc.Printf
  
  > import Compile
  
  %endif
  
  In the following Sections, we describe the implementation of Fugu. As
  usual with me, you are reading a literate code: the Haskell compiler
  processes this very same file. Therefore, you are reading the real
  Fugu's code. In Section \ref{sec:syntax}, we define Fugu's AST and a
  set of combinators, to be able to embed Fugu's language into
  Haskell. In Section \ref{sec:fof_backend}, we implement the back-end
  using Filet-O-Fish.
  
  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \subsection{Fugu Embedded Syntax}
  \label{sec:syntax}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  
  
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{The Abstract-Syntax Tree}
  %%%%%%%%%%%%%%%%%%%%
  
  First, we define the Abstract-Syntax Tree (AST). An error definition
  file is a list of error classes:
  
  > type Errors = [ ErrorClass ]
  
  Where an error class is identified by a string, its name, and a list
  of error definitions:
  
  > data ErrorClass = ErrorClass String [ ErrorField ]
  
  An error definition is composed by a description and a short
  acronym. We also specify an error status, either a failure case or a
  success case.
  
  > data ErrorField = ErrorField ErrorStatus String String
  >
  > data ErrorStatus = Failure
  >                  | Success
  >                  | DefaultSuccess
  >                  deriving Eq
  
  
  
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Enbedding Fugu in Haskell}
  %%%%%%%%%%%%%%%%%%%%
  
  Instead of designing a parser, possibly using Parsec, we chose to
  embed the Fugu language inside Haskell. This means that we are going
  to define some Haskell functions, operating on the AST. By combining
  these functions, we will be able to build a complete AST that can be
  processed by Fugu's back-end.
  
  First of all, we can build an |ErrorField| out of the error acronym
  and description, using one of these two combinators:
  
  > success, failure :: String -> String -> ErrorField
  > success acronym description = ErrorField Success acronym description
  > failure acronym description = ErrorField Failure acronym description
  
  Given a list of such fields and a global name for them, we can then
  build an |ErrorClass|:
  
  > errors :: String -> [ ErrorField ] -> ErrorClass
  > errors className errors = ErrorClass className errors
  
  And, finally, given a list of such classes, we get a valid error
  definition ``file'':
  
  > define :: [ErrorClass] -> Errors
  > define errors = errors
  
  
  
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Our Example in Fugu}
  %%%%%%%%%%%%%%%%%%%%
  
  
  If we translate our informal description of Section~\ref{sec:example},
  this leads to the following code:
  
  > testE = define [
  >          errors "system_err" [
  >                      success "SYS_ERR_OK" "No error",
  >                      failure "SYS_ERR_FAIL" "Failed",
  >                      success "SYS_ERR_ILIA" "Mafioso Pasta",
  >                      failure "SYS_ERR_TEM" "Kernel Hacker",
  >                      failure "SYS_ERR_IPHUS" "Analphabet Greek"
  >                     ],
  >          errors "pci_err" [
  >                      success "PCI_ERR_OK" "No PCI error",
  >                      failure "PCI_ERR_NOK" "Lost my cap",
  >                      success "PCI_ERR_CAP" "That is my cap"
  >                     ]
  >          ]
  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  \subsection{Filet-O-Fish Back-end}
  \label{sec:fof_backend}
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  At this point, there is no way we can postpone the implementation of
  the compiler back-end. So, \emph{Ave, Caesar, Morituri Te Salutant}.
  
  
  %% <- Typedefs
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Defining Type Aliases}
  %%%%%%%%%%%%%%%%%%%%
  
  
  We start with some type aliasing. In its basic form, FoF only knows
  \emph{primitive} types such as integers, floats, and user-defined
  structures, unions, and arrays. Therefore, if we are to use the
  standard |bool| or |char|, we have to inform FoF of their existence as
  well as to which primitive type they match to.
  
  > boolT :: TypeExpr
  > boolT = typedef uint64T "bool"
  
  Similarly, we can define our own aliases:
  
  > err_codeT :: TypeExpr
  > err_codeT = enumT "err_code" [] -- not right, [] is populated
  > err_code :: Int -> PureExpr
  > err_code = uint16 . toInteger
  >
  > errval_tT :: TypeExpr
  > errval_tT = typedef uintptrT "errval_t"
  
  
  %% <- Defining general functions
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Defining General Functions}
  %%%%%%%%%%%%%%%%%%%%
  
  Implementing the |err_no|, |err_push|, |err_is_ok|, and |err_is_fail|
  consists in a straightforward translation from C to FoF. Let us give a
  closer look at |err_no|, for instance. 
  
  The body of |err_no| consists in doing some bit twiddling on the error
  stack and returning this value:
  
  > err_no_int :: Integer -> [PureExpr] -> FoFCode PureExpr
  > err_no_int bitBlock (err : []) =
  >     returnc $ cast err_codeT $ (err .&. ((uint64 1 .<<. uint64 bitBlock) .-. uint64 1))
  
  We build a function out of the function body thanks to the |def|
  operator. Along with the function body, we have to pass the return
  type as well as the parameters types:
  
  > err_noF :: Integer -> FoFCode PureExpr 
  > err_noF bitBlock = def [Static, Inline] "err_no" (err_no_int bitBlock)
  >                                         err_codeT  
  >                                         [(errval_tT, Just "errval")]
  
  And we are done: |err_noF| is corresponds to the C |err_no|
  function. We will see later on how it can be called.
  
  Similarly, we define |err_pushF|. This time, we declare the function
  body in a @where@ clause. Note, however, that we have to provide the
  type of |err_push_int| as it cannot be inferred by the Haskell
  compiler.
  
  
  > err_pushF :: Integer -> FoFCode PureExpr 
  > err_pushF bitBlock = def [Static, Inline] "err_push" err_push_int errval_tT  [(errval_tT, Just "errval"),
  >                                                                               (err_codeT, Just "errcode")]
  >     where err_push_int (err : code : []) =
  >               returnc ((err .<<. uint64 bitBlock) .|. 
  >                        (cast errval_tT $ uint64 (((toInteger 1) `B.shiftL` (fromInteger bitBlock)) - 1) .&. code))
  
  And the same goes for |err_is_okF| and |err_is_failF|:
  
  > err_is_okF :: Integer -> Int -> FoFCode PureExpr
  > err_is_okF bitBlock indexFailures = def [Static, Inline] "err_is_ok" err_is_ok_int boolT [(errval_tT, Just "errval")]
  >     where err_is_ok_int (err : []) =
  >               do
  >               err_no <- err_noF bitBlock
  >               err_no_e <- call err_no [err]
  >               returnc (err_no_e .<. uint64 (toInteger indexFailures))
  >
  > err_is_failF :: Integer -> Int -> FoFCode PureExpr
  > err_is_failF bitBlock indexFailures = def [Static, Inline] "err_is_fail" err_is_fail_int boolT [(errval_tT, Just "errval")]
  >     where err_is_fail_int (err : []) =
  >               do
  >               err_no <- err_noF bitBlock
  >               err_no_e <- call err_no [err]
  >               returnc (err_no_e .>=. uint64 (toInteger indexFailures))
  
  %% <- Defining parameterized functions
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Defining Parameterized Functions}
  %%%%%%%%%%%%%%%%%%%%
  
  An example is |err_get_array|, which is used to build the
  |err_getdomain|, |err_getstring|, and |err_getcode| functions. Hence,
  |err_get_array| takes as first argument the postfix of the |err_get*|
  target. It is also provided a reference to the array that contains the
  descriptive strings. And the last argument consists of a list of pairs
  (error code, array index).
  
  The body of the |err_get_array| is a small generalization over our C
  examples: it calls |err_no| on the argument and switch over it. For
  each error code, it reads in the provided array, at the corresponding
  index. The default case simply consists in reading at latest position
  in the array, where ``undefined'' or its variant is written.
  
  > err_get_array :: Integer -> String -> PureExpr -> [(Int, PureExpr)] ->
  >                  PureExpr -> FoFCode PureExpr
  > err_get_array bitBlock name array codes defaultCode = 
  >     def [] ("err_get" ++ name) err_getstring_int (ptrT charT) [(errval_tT, Just "errval")]
  >     where err_getstring_int (err : []) =
  >               do
  >               err_no <- err_noF bitBlock
  >               err_no_e <- call err_no [err]
  >               switch err_no_e
  >                          [ (uint64 $ toInteger code, (return_array array index))
  >                            | (code, index) <- codes ]
  >                          (return_array array defaultCode)
  >               returnc (uint64 0)
  >           return_array array index =
  >               do
  >               x <- readArray array index
  >               returnc $ cast (ptrT charT) x
  
  The last function is |err_print_calltrace|. Although longer, this
  function does not involve technical aspects of FoF. We can observe the
  use of |if| and |while| operators. As well as the definition and usage
  of \emph{references}. We also make use of the |printf| operator.
  
  > err_print_calltraceF :: Integer -> Int -> PureExpr -> PureExpr -> PureExpr -> FoFCode PureExpr
  > err_print_calltraceF bitBlock indexFailures err_getdomain err_getstring err_getcode = 
  >     def [] "err_print_calltrace" err_print_calltrace_int voidT [(errval_tT, Just "errval")]
  >         where err_print_calltrace_int (err : []) =
  >                   do
  >                   err_no <- err_noF bitBlock
  >                   err_is_fail <- err_is_failF bitBlock indexFailures
  >                      
  >                   err_ref <- newRef err
  >
  >                   ifc (do 
  >                        is_fail_e <- call err_is_fail [err]
  >                        return is_fail_e)
  >                       (do 
  >                        x <- newRef $ uint16 0
  >                        iterations <- newRef $ uint16 0
  >
  >                        while (do
  >                               err_ref_val <- readRef err_ref
  >                               err_ref_no <- call err_no [err_ref_val]
  >                               writeRef x err_ref_no
  >                               return $ (err_ref_no .!=. (uint16 0)) .&. (iterations .<. ((sizeof(errval_tT) .*. (uint64 8)) ./. (uint64 bitBlock))))
  >                              (do     
  >                               err_ref_val <- readRef err_ref
  >                               err_ref_dom <- call err_getdomain [err_ref_val]
  >                               err_ref_str <- call err_getstring [err_ref_val]
  >                               err_ref_code <- call err_getcode [err_ref_val]
  >                               printf "Failure: (%15s) %20s [%10s]\\n" 
  >                                      [err_ref_dom, err_ref_str, err_ref_code]
  >                               writeRef iterations (iterations .+. (uint64 1))
  >                               writeRef err_ref (err_ref_val .>>. (uint64 bitBlock))))
  >                       (do return void)
  
  
  %% <- Defining data-structures
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Defining Data-Structures}
  %%%%%%%%%%%%%%%%%%%%
  
  The following codes involves more Haskell-specific data-processing of
  the AST, and less FoF-specific manipulations. However, this
  quasi-absence of FoF is also a good sign: FoF succeeds in being
  non-intrusive while being able to provide strong guarantees on the
  compiler's correctness.
  
  %%%%%%%%
  \paragraph{Compiling the Labels}
  %%%%%%%%
  
  The first step here is to extract the labels, ie. the error codes and
  descriptions, from the Error Definition. Once extracted, we turn them
  into FoF strings, thanks to |makeStrings|.
  
  > err_strings :: Errors -> ([String], [String], [String])
  > err_strings errors =
  >     (domains ++ ["Undefined"], 
  >      errcodes ++ ["UNDEFINED"], 
  >      errdescs ++ ["Undefined"])
  >     where domains = [ domain | ErrorClass domain _ <- errors ] 
  >           (errcodes,errdescs) = unzip $ concat [ [ (code, descr)
  >                                                    | ErrorField _ code descr  <- fields ] 
  >                                                  | ErrorClass _ fields <- errors ]
  
  Using |err_strings|, the following function builds the 3 static arrays
  |err_domains|, |err_codes|, and |err_msgs|. Remember that
  |err_strings| returns a triple of lists of strings. We instantiate
  each of these strings as static arrays, hence obtaining a list of
  arrays. Finally, we instantiate these list of arrays as static
  arrays. Hence, we obtain 3 static arrays, each containing some static
  arrays: the various strings. 
  
  > newStringIndex :: String -> (Int, String) -> 
  >                   FoFCode PureExpr
  > newStringIndex name (i, x) = newStringN (name ++ show i) x                      
  
  > err_arrays :: Errors -> FoFCode (PureExpr, PureExpr, PureExpr)
  > err_arrays errors =
  >     do
  >       let (domains, errcodes, errdescs) = err_strings errors
  >       errdomains_str <- sequence $ map (newStringIndex "errdomains_") $ zip [1..] domains
  >       errcodes_str <- sequence $ map (newStringIndex "errcodes_") $ zip [1..] errcodes
  >       errdescs_str <- sequence $ map (newStringIndex "errdescs_") $ zip [1..] errdescs
  >       errdomains_arr <- newStaticArrayN "err_domains" errdomains_str
  >       errcodes_arr <- newStaticArrayN "errcodes" errcodes_str
  >       errdescs_arr <- newStaticArrayN "errdescs" errdescs_str
  >       return (errdomains_arr, errcodes_arr, errdescs_arr)
  
  At this point, we have compiled the labels.
  
  
  %%%%%%%%
  \paragraph{Compiling the Enumeration}
  %%%%%%%%
  
  
  Before compiling the enumeration, we need to compute two lists of
  random, unique, odd and even numbers. This is achieved by the
  following function, which implementation is hidden for the sake of
  brevity. It takes a random number generator, the number $n$ of desired
  integers, and returns a pair composed by $n$ even numbers and $n$
  odd numbers.
  
  > mkRandomUnique :: StdGen -> Int -> ([Int], [Int])
  
  %if false 
  
  > mkRandomUnique gen i = mkRandomUniqueInt gen i i [] []
  >     where mkRandomUniqueInt gen 0 0 accEven accOdd = (accEven, accOdd)
  >           mkRandomUniqueInt gen i j accEven accOdd = 
  >               let (rand, gen') = next gen in
  >               let rand' = rand `mod` 65536 in
  >                   if rand' `mod` 2 == 0 then
  >                      if rand' `elem` accEven then
  >                         mkRandomUniqueInt gen' i j accEven accOdd
  >                      else 
  >                          if i == 0 then
  >                             mkRandomUniqueInt gen' i j accEven accOdd
  >                          else
  >                             mkRandomUniqueInt gen' (i-1) j (rand' : accEven) accOdd
  >                   else
  >                   if rand' `elem` accOdd then
  >                      mkRandomUniqueInt gen' i j accEven accOdd
  >                   else
  >                   if j == 0 then
  >                      mkRandomUniqueInt gen' i j accEven accOdd
  >                   else
  >                   mkRandomUniqueInt gen' i (j-1) accEven (rand' : accOdd)
  
  %endif
  
  Using these lists of even and odd numbers, we assign an identifier to
  each error and return this mapping as a list of triples, containing
  the domain, the acronym, and the unique identifier. Depending whether
  the error indicates a success or a failure, we pick the identifier,
  respectively, among the odd or even numbers.
  
  > mkEnum :: Errors -> (Int, Int, [(String, String, Int)])
  > mkEnum errors = (succCode',
  >                  succCode' + failCode,
  >                  reverse $ codes)
  >     where errorTypes = concat [ [ (typ, name,dom) 
  >                                 | ErrorField typ name _ <- fields ]
  >                               | ErrorClass dom fields <- errors ]
  >           (codes,
  >            succCode', -- note that |succCode'| is used below. Lazyness.
  >            failCode) = foldl filterCode ([], 1, 0) errorTypes
  >           filterCode (codes, succCode, failCode) 
  >                      (typ, name, dom) 
  >                      | typ == DefaultSuccess = 
  >                          let s = (dom, name, 0) in
  >                          (s : codes, succCode, failCode)
  >                      | typ == Success = 
  >                          let s = (dom, name, succCode) in
  >                          (s : codes, succCode + 1, failCode)
  >                      | typ == Failure = 
  >                          let s = (dom, name, succCode' + failCode) in
  >                          (s : codes, succCode, failCode + 1)
  
  
  
  %%%%%%%%%%%%%%%%%%%%
  \subsubsection{Putting Things Together}
  %%%%%%%%%%%%%%%%%%%%
  
  
  The back-end now consists in a straightforward recollection of the
  various, previously developed pieces. Its type is the following:
  
  > backendHeader :: StdGen -> Errors -> FoFCode PureExpr
  
  Meaning that it takes a random number generation, an Error AST and it
  generates a Semantics. We can notice which components of FoF are used
  here: Enumerations, Assert, References, Functions, Static arrays,
  Conditionals, Type definitions, and Printf.
  
  The back-end executes the following actions:
  
  > backendHeader gen errors =
  >     do
  
  Compile the type-definitions:
  
  >     alias errval_tT
  >
  >     aliasE "<stdbool.h>" boolT
  
  Compile the enumeration
  
  >     newEnum "err_code" enumErrCodes ""
  
  Compile the functions:
  
  >     err_no <- err_noF bitBlock
  >     err_push <- err_pushF bitBlock
  >     err_is_ok <- err_is_okF bitBlock numberOfSuccess
  >     err_is_fail <- err_is_failF bitBlock numberOfSuccess
  
  And we are done.
  
  >     return void
  
  %if false
  
  >         where errorCodes = concat [ [ code | ErrorField _ code _ <- fields ]
  >                                      | ErrorClass _ fields <- errors ] 
  >               noCodes = length errorCodes 
  >               (evenNumbers, oddNumbers) = mkRandomUnique gen noCodes
  >               (numberOfSuccess, numberOfCodes, labeledErrCodes) = mkEnum errors  
  >               enumErrCodes = map (\(_,x1,x2) -> (x1,x2)) labeledErrCodes
  >               idErrCodes = map (\(_,_,x) -> x) labeledErrCodes
  >               mapIdDescription = zip idErrCodes (map uint64 [1..])
  >               mapIdAcronym = mapIdDescription
  >               mapIdDomain = zip idErrCodes (map domainIndex labeledErrCodes)
  >               domains =  [ dom | ErrorClass dom _ <- errors ]
  >               domainIndex (dom,_,_) = uint64 $ toInteger $ fromJust $ dom `elemIndex` [ dom | ErrorClass dom _ <- errors ]
  >               noDomains = length domains
  >               bitBlock = (floor $ logBase 2 $ (fromInteger . toInteger) numberOfCodes) + 1
  
  %endif
  
  > backendCode :: StdGen -> Errors -> FoFCode PureExpr
  
  > backendCode  gen errors =
  >     do
  
  Compute the labels arrays:
  
  >     (err_domains, 
  >      err_codes, 
  >      err_descs) <- err_arrays errors
  
  Compile the array accessors:
  
  >     err_getstring <- err_get_array bitBlock "string" err_descs mapIdDescription (err_code noCodes)
  >     err_getcode <- err_get_array bitBlock "code" err_codes mapIdAcronym (err_code noCodes)
  >     err_getdomain <- err_get_array bitBlock "domain" err_domains mapIdDomain (err_code noDomains)
  
  Finally, compile the call-trace printer:
  
  >     err_print_calltrace <- err_print_calltraceF bitBlock numberOfSuccess err_getdomain err_getstring err_getcode
  
  And we are done.
  
  >     return void
  
  %if false
  
  >         where errorCodes = concat [ [ code | ErrorField _ code _ <- fields ]
  >                                      | ErrorClass _ fields <- errors ] 
  >               noCodes = length errorCodes 
  >               (evenNumbers, oddNumbers) = mkRandomUnique gen noCodes
  >               (numberOfSuccess, numberOfCodes, labeledErrCodes) = mkEnum errors  
  >               enumErrCodes = map (\(_,x1,x2) -> (x1,x2)) labeledErrCodes
  >               idErrCodes = map (\(_,_,x) -> x) labeledErrCodes
  >               mapIdDescription = zip idErrCodes (map uint64 [0..])
  >               mapIdAcronym = mapIdDescription
  >               mapIdDomain = zip idErrCodes (map domainIndex labeledErrCodes)
  >               domains =  [ dom | ErrorClass dom _ <- errors ]
  >               domainIndex (dom,_,_) = uint64 $ toInteger $ fromJust $ dom `elemIndex` [ dom | ErrorClass dom _ <- errors ]
  >               noDomains = length domains
  >               bitBlock = (floor $ logBase 2 $ (fromInteger . toInteger) numberOfCodes) + 1
  
  %endif
  
  %%%%%%%%%%%%%%%%
  \subsubsection{Compiling the Test-Case}
  %%%%%%%%%%%%%%%%
  
  
  At this stage, we just have to open a file, call FoF's |compile|
  function on the back-end applied to the test-case, and we are done!
  
  %if false
  
  > {-
  
  %endif
  
  > main :: IO ()
  > main = do
  >   let gen = mkStdGen 1
  >   fileH <- openFile "test_error.h" WriteMode
  >   hPutStrLn fileH $ show $ fst $ compile (backendHeader gen testE) emptyBinding
  >   hClose fileH
  
  %if false
  
  > -}
  
  %endif
  
  Thanks for your attention!
  
  
  
  \end{document}
  