qmckl/src/qmckl_context.org

# -*- mode: org -*-
# vim: syntax=c
#+TITLE: Context

This file is written in C because it is more natural to express the context in
C than in Fortran.

3 files are produced:
- a header file : =qmckl_context.h= 
- a source file : =qmckl_context.c= 
- a test   file : =test_qmckl_context.c= 

*** Header 
    #+BEGIN_SRC C :tangle qmckl_context.h
#ifndef QMCKL_CONTEXT_H
#define QMCKL_CONTEXT_H
#include "qmckl.h"
    #+END_SRC

*** Source
    #+BEGIN_SRC C :tangle qmckl_context.c
#include <stdlib.h> /* malloc */
#include "qmckl_context.h"
    #+END_SRC

*** Test
    #+BEGIN_SRC C :tangle test_qmckl_context.c
#include "qmckl_context.h"
#include <stdio.h>
int main() {
  qmckl_exit_code  rc; /* return code */
  rc = QMCKL_SUCCESS;
    #+END_SRC

* Context

  The context variable is a handle for the state of the library, and
  is stored in the following data structure, which can't be seen
  outside of the library. To simplify compatibility with other
  languages, the pointer to the internal data structure is converted
  into a 64-bit signed integer, defined in the =qmckl_context= type.
  A value of 0 for the context is equivalent to a NULL pointer.

*** Header
    #+BEGIN_SRC C :tangle qmckl_context.h
/* 64-bit integer */
typedef long long int qmckl_context ;
    #+END_SRC

*** Source
    #+BEGIN_SRC C :tangle qmckl_context.c
typedef struct qmckl_context_struct {
  struct qmckl_context_struct * prev;
  int precision;
  int range;
} qmckl_context_struct;
    #+END_SRC
  
*** Test
    We declare here the variables used in the tests.
    #+BEGIN_SRC C :tangle test_qmckl_context.c
  qmckl_context  context;
  qmckl_context  new_context;

/* This needs to be repeated in the tests because we don't want to
   expose it in the  headers.
*/
typedef struct qmckl_context_struct {
  struct qmckl_context_struct * prev;
  int precision;
  int range;
} qmckl_context_struct;
    #+END_SRC

** =qmckl_context_create=

   To create a new context, use =qmckl_context_create()=.
   - On success, returns a pointer to a context using the =qmckl_context= type
   - Returns 0 upon failure to allocate the internal data structure

*** Header
    #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_create();
    #+END_SRC

*** Source
    #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_create() {

  qmckl_context_struct*  context;

  context = (qmckl_context_struct*) malloc (sizeof(qmckl_context_struct));
  if (context == NULL) {
    return (qmckl_context) 0;
  }

  context->prev      = NULL;
  context->precision = QMCKL_DEFAULT_PRECISION;
  context->range     = QMCKL_DEFAULT_RANGE;

  return (qmckl_context) context;
}
    #+END_SRC
    
*** Test
    #+BEGIN_SRC C :tangle test_qmckl_context.c
  context = qmckl_context_create();
  if (context == (qmckl_context) 0) {
    fprintf(stderr,"qmckl_context_create\n");
    rc = QMCKL_FAILURE;
  }
  if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) {
    fprintf(stderr,"qmckl_context_copy: No access to data\n");
    rc = QMCKL_FAILURE;
  }
    #+END_SRC

** =qmckl_context_copy=

   
   This function makes a shallow copy of the current context.
   - Copying the 0-valued context returns 0
   - On success, returns a pointer to the new context using the =qmckl_context= type
   - Returns 0 upon failure to allocate the internal data structure
     for the new context

*** Header
   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_copy(const qmckl_context context);
   #+END_SRC

*** Source
   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_copy(const qmckl_context context) {

  qmckl_context_struct* old_context;
  qmckl_context_struct* new_context;

  if (context == (qmckl_context) 0) {
    return (qmckl_context) 0;
  }

  new_context = (qmckl_context_struct*) malloc (sizeof(qmckl_context_struct));
  if (new_context == NULL) {
    return (qmckl_context) 0;
  }

  old_context = (qmckl_context_struct*) context;

  new_context->prev      = old_context;
  new_context->precision = old_context->precision;
  new_context->range     = old_context->range;

  return (qmckl_context) new_context;
}
   #+END_SRC

*** Test
    #+BEGIN_SRC C :tangle test_qmckl_context.c
  new_context = qmckl_context_copy(context);
  if (new_context == (qmckl_context) 0) {
    fprintf(stderr,"qmckl_context_copy: Allocation failure\n");
    rc = QMCKL_FAILURE;
  }
  if (new_context == context ) {
    fprintf(stderr,"qmckl_context_copy: Same pointer\n");
    rc = QMCKL_FAILURE;
  }
  if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) {
    fprintf(stderr,"qmckl_context_copy: No access to data\n");
    rc = QMCKL_FAILURE;
  }
    #+END_SRC

** =qmckl_context_previous=
   
   Returns the previous context
   - On success, returns the ancestor of the current context
   - Returns 0 for the initial context
   - Returns 0 for the 0-valued context

*** Header
   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_previous(const qmckl_context context);
   #+END_SRC

*** Source
   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_previous(const qmckl_context context) {

  qmckl_context_struct* ctx;

  if (context == (qmckl_context) 0) {
    return (qmckl_context) 0;
  }

  ctx = (qmckl_context_struct*) context;
  return (qmckl_context) ctx->prev;
}
   #+END_SRC

*** Test
    #+BEGIN_SRC C :tangle test_qmckl_context.c
  if (qmckl_context_previous(new_context) == (qmckl_context) 0) {
    fprintf(stderr,"qmckl_context_copy: Null pointer\n");
    rc = QMCKL_FAILURE;
  }
  if (qmckl_context_previous(new_context) != context) {
    fprintf(stderr,"qmckl_context_copy: Wrong pointer\n");
    rc = QMCKL_FAILURE;
  }
  if (qmckl_context_previous(context) != (qmckl_context) 0) {
    fprintf(stderr,"qmckl_context_copy: Expected null pointer (1)\n");
    rc = QMCKL_FAILURE;
  }
  if (qmckl_context_previous((qmckl_context) 0) != (qmckl_context) 0) {
    fprintf(stderr,"qmckl_context_copy: Expected null pointer (2)\n");
    rc = QMCKL_FAILURE;
  }
    #+END_SRC

** =qmckl_context_destroy=
   
   Destroys the current context, leaving the ancestors untouched.
   - Succeeds if the current context is properly destroyed
   - Fails otherwise
   - Fails is the 0-valued context is given in argument
     
   The context given in parameter is overwritten by the 0-valued
   context, so a pointer is passed to the function.

*** Header
   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_exit_code qmckl_context_destroy(qmckl_context * context);
   #+END_SRC

*** Source
   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_destroy(qmckl_context *context) {

  qmckl_context_struct* ctx;

  ctx = (qmckl_context_struct*) *context;

  if (ctx == NULL) {
    return QMCKL_FAILURE;
  }

  free(ctx);
  *context = (qmckl_context) 0;
  return QMCKL_SUCCESS;
}
   #+END_SRC

*** Test
    #+BEGIN_SRC C :tangle test_qmckl_context.c
  if (new_context == (qmckl_context) 0) {
    fprintf(stderr,"qmckl_context_destroy: new_context is NULL\n");
    rc = QMCKL_FAILURE;
  }
  if (qmckl_context_destroy(&new_context) == QMCKL_FAILURE) {
    fprintf(stderr,"qmckl_context_destroy: Unable to destroy the new_context\n");
    rc = QMCKL_FAILURE;
  }
  if (new_context != (qmckl_context) 0) {
    fprintf(stderr,"qmckl_context_destroy: new_context should be NULL\n");
    rc = QMCKL_FAILURE;
  }
  if (qmckl_context_destroy((qmckl_context) 0) == QMCKL_SUCCESS) {
    fprintf(stderr,"qmckl_context_destroy: Failure expected with NULL pointer\n");
    rc = QMCKL_FAILURE;
  }
    #+END_SRC


* Precision

  The following functions set and get the expected required precision
  and range. =precision= should be an integer between 2 and 53, and
 =range= should be an integer between 2 and 11.

  The setter functions functions return a new context as a 64-bit integer.
  The getter functions return the value, as a 32-bit integer.
  The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=.

** =qmckl_context_update_precision=

   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision) {
  qmckl_context_struct* ctx;

  if (precision <  2) return QMCKL_FAILURE;
  if (precision > 53) return QMCKL_FAILURE;

  ctx = (qmckl_context_struct*) context;
  if (ctx == NULL) return QMCKL_FAILURE;

  ctx->precision = precision;
  return QMCKL_SUCCESS;
}
   #+END_SRC

** =qmckl_context_update_range=
   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range);
   #+END_SRC
   
   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range) {
  qmckl_context_struct* ctx;

  if (range <  2) return QMCKL_FAILURE;
  if (range > 11) return QMCKL_FAILURE;

  ctx = (qmckl_context_struct*) context;
  if (ctx == NULL) return QMCKL_FAILURE;

  ctx->range = range;
  return QMCKL_SUCCESS;
}
   #+END_SRC



** =qmckl_context_set_precision=

   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_set_precision(const qmckl_context context, int precision);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) {
  qmckl_context new_context;

  new_context = qmckl_context_copy(context);
  if (new_context == 0) return 0;

  if (qmckl_context_update_precision(context, precision) == QMCKL_FAILURE) return 0;

  return new_context;
}
   #+END_SRC

** =qmckl_context_set_range=
   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_set_range(const qmckl_context context, int range);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_set_range(const qmckl_context context, int range) {
  qmckl_context new_context;

  new_context = qmckl_context_copy(context);
  if (new_context == 0) return 0;

  if (qmckl_context_update_range(context, range) == QMCKL_FAILURE) return 0;

  return new_context;
}
   #+END_SRC



** =qmckl_context_get_precision=

   #+BEGIN_SRC C :tangle qmckl_context.h
int qmckl_context_get_precision(const qmckl_context context);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
int qmckl_context_get_precision(const qmckl_context context) {
  qmckl_context_struct* ctx;
  ctx = (qmckl_context_struct*) context;
  return ctx->precision;
}
   #+END_SRC

** =qmckl_context_get_range=

   #+BEGIN_SRC C :tangle qmckl_context.h
int qmckl_context_get_range(const qmckl_context context);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
int qmckl_context_get_range(const qmckl_context context) {
  qmckl_context_struct* ctx;
  ctx = (qmckl_context_struct*) context;
  return ctx->range;
}
   #+END_SRC

   

* End of files

*** Header
  #+BEGIN_SRC C :tangle qmckl_context.h
#endif
  #+END_SRC

*** Test
  #+BEGIN_SRC C :tangle test_qmckl_context.c
    return QMCKL_SUCCESS;
}
  #+END_SRC