Felix Library Packages

Contents:

Run Time Library

Contents:

Package: src/packages/configs.fdoc

Platform configs

key file
flx_config.py $PWD/buildsystem/flx_config.py
flx_config_ncurses.flx $PWD/src/tools/flx_config_ncurses.flx
key file
linux64_gcc_flx_rtl_config_params.hpp $PWD/src/config/linux64/gcc/rtl/flx_rtl_config_params.hpp
macosx64_clang_flx_rtl_config_params.hpp $PWD/src/config/macosx64/clang/rtl/flx_rtl_config_params.hpp
macosx64_gcc_flx_rtl_config_params.hpp $PWD/src/config/macosx64/gcc/rtl/flx_rtl_config_params.hpp
win64_msvc_flx_rtl_config_params.hpp $PWD/src/config/win64/msvc/rtl/flx_rtl_config_params.hpp
key file
linux64_demux_sockety_config.hpp $PWD/src/config/linux64/rtl/demux_sockety_config.hpp
macosx64_demux_sockety_config.hpp $PWD/src/config/macosx64/rtl/demux_sockety_config.hpp
win64_demux_sockety_config.hpp $PWD/src/config/win64/rtl/demux_sockety_config.hpp
key file
linux.flxh $PWD/src/config/linux/flx.flxh
macosx.flxh $PWD/src/config/macosx/flx.flxh
win.flxh $PWD/src/config/win/flx.flxh
key file
cplusplus_11.hpp share/lib/rtl/cplusplus_11.hpp
cplusplus_14.hpp share/lib/rtl/cplusplus_14.hpp
cplusplus_17.hpp share/lib/rtl/cplusplus_17.hpp
cplusplus_20.hpp share/lib/rtl/cplusplus_20.hpp
key file
clang_cplusplus_11.fpc $PWD/src/config/clang/cplusplus_11.fpc
clang_cplusplus_14.fpc $PWD/src/config/clang/cplusplus_14.fpc
clang_cplusplus_17.fpc $PWD/src/config/clang/cplusplus_17.fpc
clang_cplusplus_20.fpc $PWD/src/config/clang/cplusplus_20.fpc
key file
gcc_cplusplus_11.fpc $PWD/src/config/gcc/cplusplus_11.fpc
gcc_cplusplus_14.fpc $PWD/src/config/gcc/cplusplus_14.fpc
gcc_cplusplus_17.fpc $PWD/src/config/gcc/cplusplus_17.fpc
gcc_cplusplus_20.fpc $PWD/src/config/gcc/cplusplus_20.fpc
key file
msvc_cplusplus_11.fpc $PWD/src/config/msvc/cplusplus_11.fpc
msvc_cplusplus_14.fpc $PWD/src/config/msvc/cplusplus_14.fpc
msvc_cplusplus_17.fpc $PWD/src/config/msvc/cplusplus_17.fpc
msvc_cplusplus_20.fpc $PWD/src/config/msvc/cplusplus_20.fpc

test stuff

hello.jpg

OSX

//[macosx64_demux_sockety_config.hpp ]
#ifndef __DEMUX_SOCKETY_CONFIG_H__
#define __DEMUX_SOCKETY_CONFIG_H__
#include <sys/socket.h>
typedef socklen_t FLX_SOCKLEN_T;
#endif

//[macosx64_clang_flx_rtl_config_params.hpp ]
#ifndef __FLX_RTL_CONFIG_PARAMS_H__
#define __FLX_RTL_CONFIG_PARAMS_H__

#define FLX_HAVE_VSNPRINTF 1
#define FLX_HAVE_GNU 1
#define FLX_HAVE_GNU_BUILTIN_EXPECT 1
#define FLX_HAVE_CGOTO 0
#define FLX_HAVE_ASM_LABELS 0
#define FLX_HAVE_DLOPEN 1
#define FLX_CYGWIN 0
#define FLX_MACOSX 1
#define FLX_LINUX 0
#define FLX_WIN32 0
#define FLX_WIN64 0
#define FLX_POSIX 1
#define FLX_SOLARIS 0
#define FLX_HAVE_MSVC 0
#define FLX_HAVE_KQUEUE_DEMUXER 1
#define FLX_HAVE_POLL 1
#define FLX_HAVE_EPOLL 0
#define FLX_HAVE_EVTPORTS 0
#define FLX_HAVE_OPENMP 0
#define FLX_MAX_ALIGN 16
#endif

//[macosx64_gcc_flx_rtl_config_params.hpp ]
#ifndef __FLX_RTL_CONFIG_PARAMS_H__
#define __FLX_RTL_CONFIG_PARAMS_H__

#define FLX_HAVE_VSNPRINTF 1
#define FLX_HAVE_GNU 1
#define FLX_HAVE_GNU_BUILTIN_EXPECT 1
#define FLX_HAVE_CGOTO 1
#define FLX_HAVE_ASM_LABELS 1
#define FLX_HAVE_DLOPEN 1
#define FLX_CYGWIN 0
#define FLX_MACOSX 1
#define FLX_LINUX 0
#define FLX_WIN32 0
#define FLX_WIN64 0
#define FLX_POSIX 1
#define FLX_SOLARIS 0
#define FLX_HAVE_MSVC 0
#define FLX_HAVE_KQUEUE_DEMUXER 1
#define FLX_HAVE_POLL 1
#define FLX_HAVE_EPOLL 0
#define FLX_HAVE_EVTPORTS 0
#define FLX_HAVE_OPENMP 0
#define FLX_MAX_ALIGN 16
#endif

Linux

//[linux64_demux_sockety_config.hpp ]
#ifndef __DEMUX_SOCKETY_CONFIG_H__
#define __DEMUX_SOCKETY_CONFIG_H__
#include <sys/socket.h>
typedef socklen_t FLX_SOCKLEN_T;
#endif

//[linux64_gcc_flx_rtl_config_params.hpp ]
#ifndef __FLX_RTL_CONFIG_PARAMS_H__
#define __FLX_RTL_CONFIG_PARAMS_H__

#define FLX_HAVE_VSNPRINTF 1
#define FLX_HAVE_GNU 1
#define FLX_HAVE_GNU_BUILTIN_EXPECT 1
#define FLX_HAVE_CGOTO 1
#define FLX_HAVE_ASM_LABELS 1
#define FLX_HAVE_DLOPEN 1
#define FLX_CYGWIN 0
#define FLX_MACOSX 0
#define FLX_LINUX 1
#define FLX_WIN32 0
#define FLX_WIN64 0
#define FLX_POSIX 1
#define FLX_SOLARIS 0
#define FLX_HAVE_MSVC 0
#define FLX_HAVE_KQUEUE_DEMUXER 0
#define FLX_HAVE_POLL 1
#define FLX_HAVE_EPOLL 1
#define FLX_HAVE_EVTPORTS 0
#define FLX_HAVE_OPENMP 1
#define FLX_MAX_ALIGN 16
#endif

Windows

//[win64_msvc_flx_rtl_config_params.hpp ]
#ifndef __FLX_RTL_CONFIG_PARAMS_H__
#define __FLX_RTL_CONFIG_PARAMS_H__

#define FLX_HAVE_VSNPRINTF 1
#define FLX_HAVE_GNU 0
#define FLX_HAVE_GNU_BUILTIN_EXPECT 0
#define FLX_HAVE_CGOTO 0
#define FLX_HAVE_ASM_LABELS 0
#define FLX_HAVE_DLOPEN 0
#define FLX_CYGWIN 0
#define FLX_MACOSX 0
#define FLX_LINUX 0
#define FLX_WIN32 1
#define FLX_WIN64 1
#define FLX_POSIX 0
#define FLX_SOLARIS 0
#define FLX_HAVE_MSVC 1
#define FLX_HAVE_KQUEUE_DEMUXER 0
#define FLX_HAVE_POLL 0
#define FLX_HAVE_EPOLL 0
#define FLX_HAVE_EVTPORTS 0
#define FLX_HAVE_OPENMP 1
#define FLX_MAX_ALIGN 16
#endif

//[win64_demux_sockety_config.hpp]
#ifndef __DEMUX_SOCKETY_CONFIG_H__
#define __DEMUX_SOCKETY_CONFIG_H__
namespace flx { namespace demux {
DEMUX_EXTERN  int create_listener_socket (int *io_port, int q_len);
DEMUX_EXTERN  int create_async_listener(int *io_port, int q_len);
DEMUX_EXTERN  int nice_accept(int *listener, int *err);
DEMUX_EXTERN  int nice_connect(char const* addr, int port);
DEMUX_EXTERN  int async_connect(char const* addr, int port, int *finished, int *err);
DEMUX_EXTERN  int bind_sock(int s, int *io_port);
DEMUX_EXTERN  int make_nonblock(int s);
DEMUX_EXTERN  int make_linger(int s, int t);
DEMUX_EXTERN  int set_tcp_nodelay(int s, int dsable_nagle);
DEMUX_EXTERN  int get_socket_error(int s, int *socket_err);
}}

#endif

macro val PLAT_POSIX = true;
macro val PLAT_LINUX = true;
macro val PLAT_BSD = false;
macro val PLAT_MACOSX = false;
macro val PLAT_CYGWIN = false;
macro val PLAT_WIN32 = false;
macro val PLAT_SOLARIS = false;

macro val PLAT_POSIX = true;
macro val PLAT_LINUX = false;
macro val PLAT_BSD = true;
macro val PLAT_MACOSX = true;
macro val PLAT_CYGWIN = false;
macro val PLAT_WIN32 = false;
macro val PLAT_SOLARIS = false;

macro val PLAT_POSIX = false;
macro val PLAT_LINUX = false;
macro val PLAT_BSD = false;
macro val PLAT_MACOSX = false;
macro val PLAT_CYGWIN = false;
macro val PLAT_WIN32 = true;
macro val PLAT_SOLARIS = false;

C++ Standard Versions

//[cplusplus_11.hpp]
#if __cplusplus < 201103L
#error "C++11 required"
#endif

//[cplusplus_14.hpp]
#if __cplusplus < 201402L
#error "C++11 required"
#endif

//[cplusplus_17.hpp]
#if __cplusplus < 201703L
#error "C++11 required"
#endif

//[cplusplus_20.hpp]
#if __cplusplus < 202003L
#error "C++11 required"
#endif

//[clang_cplusplus_11.fpc]
Description: C++11 required
includes: '"cplusplus_11.hpp"'
cflags: -std=c++11

//[clang_cplusplus_14.fpc]
Description: C++14 required
includes: '"cplusplus_14.hpp"'
cflags: -std=c++14

//[clang_cplusplus_17.fpc]
Description: C++17 required
includes: '"cplusplus_17.hpp"'
cflags: -std=c++17

//[clang_cplusplus_20.fpc]
Description: C++20 required
includes: '"cplusplus_20.hpp"'
cflags: -std=c++20

//[gcc_cplusplus_11.fpc]
Description: C++11 required
includes: '"cplusplus_11.hpp"'
cflags: -std=c++11

//[gcc_cplusplus_14.fpc]
Description: C++14 required
includes: '"cplusplus_14.hpp"'
cflags: -std=c++14

//[gcc_cplusplus_17.fpc]
Description: C++17 required
includes: '"cplusplus_17.hpp"'
cflags: -std=c++17

//[gcc_cplusplus_20.fpc]
Description: C++20 required
includes: '"cplusplus_20.hpp"'
cflags: -std=c++20

//[msvc_cplusplus_11.fpc]
Description: C++11 required
includes: '"cplusplus_11.hpp"'
cflags: -std:c++11

//[msvc_cplusplus_14.fpc]
Description: C++14 required
includes: '"cplusplus_14.hpp"'
cflags: -std:c++14

//[msvc_cplusplus_17.fpc]
Description: C++17 required
includes: '"cplusplus_17.hpp"'
cflags: -std:c++17

//[msvc_cplusplus_20.fpc]
Description: C++20 required
includes: '"cplusplus_20.hpp"'
cflags: -std:c++20

#[flx_config.py]
from fbuild.path import Path
import buildsystem
from os import getenv

def target_config(ctx,target,os,bits,compiler):
    print("[fbuild] COPYING UNIVERSAL RESOURCE DATABASE")
    buildsystem.copy_to(ctx, ctx.buildroot/'host/config', Path('src/config/*.fpc').glob())

    print("[fbuild] COPYING compiler/C++ version RESOURCE DATABASE")
    buildsystem.copy_to(ctx, ctx.buildroot / 'host/config', Path('src/config/'+compiler+'/*.fpc').glob())

    print("[fbuild] COPYING generic unix RESOURCE DATABASE")
    if 'posix' in target.platform:
      buildsystem.copy_to(ctx, ctx.buildroot / 'host/config', Path('src/config/unix/*.fpc').glob())
      buildsystem.copy_to(ctx, ctx.buildroot / 'host/config', Path('src/config/unix'+bits+'/*.fpc').glob())

    print("[fbuild] COPYING " + os + " RESOURCE DATABASE")
    buildsystem.copy_to(ctx, ctx.buildroot / 'host/config', Path('src/config/'+os+'/*.fpc').glob())

    print("[fbuild] COPYING " + os + bits + " RESOURCE DATABASE")
    buildsystem.copy_to(ctx, ctx.buildroot / 'host/config', Path('src/config/'+os+bits+'/*.fpc').glob())

    print("[fbuild] COPYING " + os + " PLAT MACROS")
    buildsystem.copy_to(ctx, ctx.buildroot / 'host/lib/plat', Path('src/config/'+os+'/*.flxh').glob())

    print("C[fbuild] OPYING "+os+bits+"/"+compiler+" RTL CONFIG")
    buildsystem.copy_to(ctx, ctx.buildroot/'host/lib/rtl', Path('src/config/'+os+bits+'/'+compiler+'/rtl/*.hpp').glob())

    print("[fbuild] COPYING "+os+bits+" SOCKET CONFIG")
    buildsystem.copy_to(ctx, ctx.buildroot/'host/lib/rtl', Path('src/config/'+os+bits+'/rtl/*.hpp').glob())

    home = getenv("HOME")
    if home is not None:
        print("COPYING USER CONFIG DATA FROM " + home+"/.felix/config")
        buildsystem.copy_fpc_to_config(ctx, Path(home, ".felix", "config", "*.fpc").glob())

    # set the toolchain
    dst = ctx.buildroot / 'host/config/toolchain.fpc'
    if 'macosx' in target.platform:
        toolchain = "toolchain_"+compiler+"_macosx"
    elif "windows" in target.platform:
        toolchain= "toolchain_msvc_win"
    else:
        toolchain = "toolchain_"+compiler+"_linux"

    print("**********************************************")
    print("SETTING TOOLCHAIN " + toolchain)
    print("**********************************************")
    f = open(dst,"w")
    f.write ("toolchain: "+toolchain+"\n")
    f.close()

//[flx_config_ncurses.flx]
include "std/io/ncurses";
open Ncurses;
open C_hack;

proc config() {
  var w = initscr();

  var install  = array_calloc[char] 40;
  var target   = array_calloc[char] 40;
  var compiler = array_calloc[char] 40;
  var wordsize = array_calloc[char] 40;
  var os       = array_calloc[char] 40;

  mvwprintw(0,0,w, c"Felix target configuration tool");
  mvwprintw(1,0,w, c"INSTALL DIRECTORY:          ");
  mvwprintw(2,0,w, c"Target Subdirectory Name:   ");
  mvwprintw(3,0,w, c"Compiler family:            ");
  mvwprintw(4,0,w, c"Word size:                  ");
  mvwprintw(5,0,w, c"OS name:                    ");

  mvwgetstr(1,30,install);
  mvwgetstr(2,30,target);
  mvwgetstr(3,30,compiler);
  mvwgetstr(4,30,wordsize);
  mvwgetstr(5,30,os);

  free install;
  free target;
  free compiler;
  free worsize;
  free os;

  ignore$ #refresh;
  ignore$ wgetch(w);
  ignore$ #endwin;

}
config;

Package: src/packages/control.fdoc

Control Basics

key file
__init__.flx share/lib/std/control/__init__.flx
control.flx share/lib/std/control/control.flx

Control Synopsis

//[__init__.flx]
// stream is part of datatype, included in std/datatype/__init__
include "std/control/svc";
include "std/control/control";
include "std/control/unique";
include "std/control/iterator";
include "std/control/schannels";
include "std/control/fibres";
include "std/control/spipes";
include "std/control/chips";

//include "std/control/mux";

Misc Control Flow

//[control.flx]
open class Control
{
  open C_hack;

  // FIXPOINT OPERATOR
  fun fix[D,C] (f:(D->C)->D->C) (x:D) : C => f (fix f) x;

  /* Example use: factorial function
  fun flat_fact (g:int->int) (x:int):int =>
    if x == 0 then 1
    else x * g (x - 1)
  ;
  var fact = fix flat_fact;
  println$ fact 5;
  */

  proc _swap[t] (a:&t,b:&t) =
  {
    var tmp = *a;
    a <- *b;
    b <- tmp;
  }

  //$ infinite loop
  proc forever (bdy:unit->void)
  {
    rpeat:>
      bdy();
      goto rpeat;
    dummy:> // fool reachability checker
  }

  publish "do nothing [the name pass comes from Python]"
  proc pass(){}

  //$ C style for loop
  proc for_each
    (init:unit->void)
    (cond:unit->bool)
    (incr:unit->void)
    (bdy:unit->void)
  {
    init();
    rpeat:>
      if not (cond()) goto finish;
      bdy();
      incr();
      goto rpeat;
    finish:>
  }

  proc branch-and-link (target:&LABEL, save:&LABEL)
  {
     save <- next;
     goto *target;
     next:>
  }

  //$ throw[ret, exn] throw exception of type exn
  //$ in a context expecting type ret.
  gen throw[ret,exn] : exn -> ret = "(throw $1,*(?1*)0)";
  proc raise[exn] : exn = "(throw $1);";
  proc proc_fail:string = 'throw ::std::runtime_error($1);'
    requires Cxx_headers::stdexcept;

  // Note: must be a fun not a gen to avoid lifting.
  fun fun_fail[ret]:string -> ret = '(throw ::std::runtime_error($1),*(?1*)0)'
    requires Cxx_headers::stdexcept;

  //$ This is the type of a Felix procedural
  //$ continuations in C++ lifted into Felix.
  //$ Do not confuse this with the Felix type of the procedure.
  _gc_pointer type cont = "::flx::rtl::con_t*";

  fun entry_label : cont -> LABEL = "::flx::rtl::jump_address_t($1)";
  fun current_position : cont -> LABEL = "::flx::rtl::jump_address_t($1,$1->pc)";
  fun entry_label[T] (p:T->0):LABEL => entry_label (C_hack::cast[cont] p);

  //$ This is a hack to get the procedural continuation
  //$ currently executing, it is just the procedures
  //$ C++ this pointer.
  fun current_continuation: unit -> cont = "this";

  //$ The type of a Felix fthread or fibre, which is
  //$ a container which holds a procedural continuation.
  _gc_pointer type fthread = "::flx::rtl::fthread_t*";


  //$  Throw a continuation. This is unsafe. It should
  //$  work from a top level procedure, or any function
  //$  called by such a procedure, but may fail
  //$  if thrown from a procedure called by a function.
  //$  The library run and driver will catch the
  //$  continuation and execute it instead of the
  //$  current continuation. If the library run is used
  //$  and the continuation being executed is down the
  //$  C stack, the C stack will not have been correctly
  //$  popped. Crudely, nested drivers should rethrow
  //$  the exception until the C stack is in the correct
  //$  state to execute the continuation, but there is no
  //$  way to determine that at the moment.
  //$
  //$  Compiler generated runs ignore the exception,
  //$  the library run catches it. Exceptions typically
  //$  use a non-local goto, and they cannot pass across
  //$  a function boundary.

  proc throw_continuation(x: unit->void) { _throw (C_hack::cast[cont] x); }
  private proc _throw: cont = "throw $1;";

  //$ Type of the implementation of a  synchronous channel.
  //$ should be private but needed in this class for the data type,
  //$ and also needed in schannels to do the svc call.

  _gc_pointer type _schannel = "::flx::rtl::schannel_t*";

}

Package: src/packages/debug.fdoc

Debugging

key file
debug.flx share/lib/std/debug.flx
flx_udp_trace.hpp share/lib/rtl/flx_udp_trace.hpp
flx_udp_trace.cpp share/src/rtl/flx_udp_trace.cpp
flx_udp_trace_monitor.cxx $PWD/src/tools/flx_udp_trace_monitor.cxx

Debugging Aid.

//[debug.flx]
// the internal representation of a Felix source location
// has to be global to simplify compiler hack
type flx_location_t = "flx::rtl::flx_range_srcref_t";

class Debug
{
  const FLX_SRCLOC : flx_location_t = "#srcloc";
    // NOTE: this doesn't actually work! The replacement typically
    // occurs in the wrong place: one gets the location of FLX_SRCLOC
    // right here in the debug class .. not useful!
  ctor flx_location_t : +char * int * int * int * int = "::flx::rtl::flx_range_srcref_t($a)";
  fun filename: flx_location_t -> +char = "$1.filename";
  fun startline: flx_location_t -> int = "$1.startline";
  fun startcol: flx_location_t -> int = "$1.startcol";
  fun endline: flx_location_t -> int = "$1.endline";
  fun endcol: flx_location_t -> int = "$1.endcol";

  instance Str[flx_location_t] {
    fun str(var x:flx_location_t)=>
    string (x.filename) + ":"+ x.startline.str + "[" + x.startcol.str + "]" + "-" +
    x.endline.str + "[" + x.endcol.str + "]";
  }

  // hack to emit C++ source file locations
  const CPP_FUNCTION : +char = "__FUNCTION__";
  const CPP_FILE: +char = "__FILE__";
  const CPP_LINE: int = "__LINE__";

  // hack to emit C code an expression would generate
  fun repr_expr[t]: t -> string = '\\"$a:?1\\"';

  // hack to emit C typename of a Felix type
  const repr_type[t]:string = '\\"?1\\"';
  proc enable_local_udp_trace : 1 = "::flx::debug::enable_local_udp_trace();"
    requires header '#include "flx_udp_trace.hpp"'
  ;
  proc send_udp_trace_message : string = "::flx::debug::send_udp_trace_message($1);"
    requires header '#include "flx_udp_trace.hpp"';
  ;

}

Source Location HERE

This special symbol HERE is a value of type Debug::flx_location_t represent the current location in both Felix and C++ code. The Felix location should be the physical location in the file of the word HERE, unless the file was generated and a #line directive is in place in which case the location in the generator is used.

The translation from the parser term is perform by the Felix compiler. The translation from the C macros used are done by the C++ compiler.

UDP based trace support

This stuff only on Posix so far.

//[flx_udp_trace.hpp]
#include "flx_rtl_config.hpp"
#include <string>

namespace flx { namespace debug {
  RTL_EXTERN void enable_local_udp_trace();
  RTL_EXTERN void send_udp_trace_message (::std::string);
}}

//[flx_udp_trace.cpp]
#ifdef _WIN32
#include <stdio.h>
#include <string>
namespace flx { namespace debug {
void enable_local_udp_trace () {}
void send_udp_trace_message (::std::string msg) {
  fprintf(stderr,"[WIN32: udp_trace not available, using stderr] %s\n",msg.c_str());
}
}}
#else
#include <sys/socket.h>
#include <stdio.h>
#include <arpa/inet.h>
#include <string.h>
#include <netdb.h>
#include <string>
#include "flx_udp_trace.hpp"

namespace flx { namespace debug {
static int trace_socket = 0;
static struct sockaddr_in dst;
static int notify_first_send = 0;

void enable_local_udp_trace ()
{
  trace_socket = socket(PF_INET,SOCK_DGRAM,0); // 17=UDP
  struct sockaddr_in addr;
  memset((char *)&addr, 0, sizeof(addr));
  addr.sin_family = AF_INET;
  addr.sin_addr.s_addr = INADDR_ANY;
  addr.sin_port = 0;
  int result = bind (trace_socket, (struct sockaddr*)&addr, sizeof(addr));
  if (result != 0) {
    fprintf(stderr,"FAILED to bind Trace Output Socket!\n");
    return;
  }
  fprintf(stderr,"Bound Trace Output Socket OK!\n");

  memset((char*)&dst,0,sizeof(dst));
  dst.sin_family=AF_INET;
  dst.sin_port = htons(1153);
  inet_aton("127.0.0.1",&dst.sin_addr);
}

// Add locks later
void send_udp_trace_message (::std::string msg)
{
  if (trace_socket != 0)
  {
    char const * cp = msg.c_str();
    size_t n = msg.size();
    int result = sendto (trace_socket, cp, n,0,(struct sockaddr*)&dst, sizeof(dst));
    if (notify_first_send == 0)
    {
      notify_first_send = 1;
      if (result == n)
        fprintf(stderr, "First UDP Trace message sent OK! %d bytes = '%s'\n", result,cp);
      else
        fprintf(stderr, "First UDP Trace message send FAILED ****! Sent: %d bytes\n",result);
    }
  }
}
}} // namespaces
#endif
Simple UDP Trace monitor

A simple posix only executable tool to monitor program traces.

//[flx_udp_trace_monitor.cxx]
#include <sys/socket.h>
#include <stdio.h>
#include <arpa/inet.h>
#include <string.h>
#define BUFLEN 2000
#define PORT 1153
int main()
{
  char buffer[BUFLEN];

  int sock = socket(PF_INET,SOCK_DGRAM,0); // 17=UDP
  struct sockaddr_in addr;
  memset((char *)&addr, 0, sizeof(sockaddr));
  addr.sin_family = AF_INET;
  addr.sin_addr.s_addr = htonl(INADDR_ANY);
  addr.sin_port = htons(PORT);
  int result = bind (sock, (struct sockaddr*)&addr, sizeof(addr));
  if (result != 0)
    printf("UDP Trace Monitor: bind on port %d failed\n",PORT);
  printf("UDP Trace Monitor Listening on port %d\n",PORT);

  struct sockaddr_in writer;
  socklen_t addrlen = sizeof(writer);
  for(;;){
    memset(buffer,0,BUFLEN);
    result = recvfrom (sock, buffer, BUFLEN,0,(struct sockaddr*)&writer, &addrlen);
    printf("Received = %d\n",result);
    printf("Buffer = %s\n",buffer);
  }
}

Package: src/packages/demux.fdoc

Demux build harness

key file
demux.py $PWD/buildsystem/demux.py
flx_demux_config.hpp share/lib/rtl/flx_demux_config.hpp
key file
demux_default.fpc $PWD/src/config/demux.fpc
demux_unix.fpc $PWD/src/config/unix/demux.fpc
demux_linux.fpc $PWD/src/config/linux/demux.fpc
demux_solaris.fpc $PWD/src/config/solaris/demux.fpc
demux_macosx.fpc $PWD/src/config/macosx/demux.fpc
demux_win.fpc $PWD/src/config/win/demux.fpc
demux_msys.fpc $PWD/src/config/msys/demux.fpc
demux_cygwin.fpc $PWD/src/config/cygwin/demux.fpc 
//[demux_default.fpc]
Name: demux
Description: Event handling: select
Comment: Generated during configuration
provides_dlib: -ldemux_dynamic
provides_slib: -ldemux_static
Requires: flx_pthread
flx_requires_driver: flx_arun
macros: BUILD_DEMUX
includes: '"flx_demux.hpp"'
library: demux
headers: (.*/)?([^/\\]+\.hpp)>${2}
srcdir: src/demux
src: [^/\\]+\.cpp
src: posix/.*\.cpp

//[demux_unix.fpc]
Name: demux
Description: Event handling (poll)
Comment: Generated during configuration
provides_dlib: -ldemux_dynamic
provides_slib: -ldemux_static
Requires: flx_pthread
flx_requires_driver: flx_arun
macros: BUILD_DEMUX
includes: '"flx_demux.hpp"'
library: demux
headers: (.*/)?([^/\\]+\.hpp)>${2}
srcdir: src/demux
src: [^/\\]+\.cpp
src: posix/.*\.cpp
src: poll/.*\.cpp

//[demux_linux.fpc]
Name: demux
Description: Event handling (epoll)
Comment: Generated during configuration
provides_dlib: -ldemux_dynamic
provides_slib: -ldemux_static
Requires: flx_pthread
flx_requires_driver: flx_arun
includes: '"flx_demux.hpp"'
macros: BUILD_DEMUX
library: demux
headers: (.*/)?([^/\\]+\.hpp)>${2}
srcdir: src/demux
src: [^/\\]+\.cpp
src: posix/.*\.cpp
src: epoll/.*\.cpp

//[demux_solaris.fpc]
Name: demux
Description: Event handling (event ports)
Comment: Generated during configuration
provides_dlib: -ldemux_dynamic
provides_slib: -ldemux_static -lsocket -lnsl
Requires: flx_pthread
flx_requires_driver: flx_arun
macros: BUILD_DEMUX
includes: '"flx_demux.hpp"'
library: demux
headers: (.*/)?([^/\\]+\.hpp)>${2}
srcdir: src/demux
src: [^/\\]+\.cpp
src: posix/.*\.cpp
src: evtport/.*\.cpp

//[demux_macosx.fpc]
Name: demux
Description: Event handling (kqueue)
Comment: Generated during configuration
provides_dlib: -ldemux_dynamic
provides_slib: -ldemux_static
Requires: flx_pthread
flx_requires_driver: flx_arun
macros: BUILD_DEMUX
includes: '"flx_demux.hpp"'
library: demux
headers: (.*/)?([^/\\]+\.hpp)>${2}
srcdir: src/demux
src: [^/\\]+\.cpp
src: posix/.*\.cpp
src: kqueue/.*\.cpp

//[demux_win.fpc]
Name: demux
Description: Event handling (windows event ports with msvc)
Comment: Generated during configuration
provides_dlib: /DEFAULTLIB:demux_dynamic
requires_dlibs: /DEFAULTLIB:ws2_32 /DEFAULTLIB:mswsock
provides_slib: /DEFAULTLIB:demux_static
requires_slibs: /DEFAULTLIB:ws2_32 /DEFAULTLIB:mswsock
Requires: flx_pthread
flx_requires_driver: flx_arun
macros: BUILD_DEMUX
includes: '"flx_demux.hpp"'
library: demux
headers: (.*\\)?([^\\]+\.hpp)>${2}
srcdir: src\demux
src: [^\\]+\.cpp
src: win\\.*\.cpp

//[demux_msys.fpc]
Name: demux
Description: Event handling (windows event ports with gcc)
Comment: Generated during configuration
provides_dlib: -ldemux_dynamic
requires_dlibs: -lws2_32 -lmswsock
provides_slib: -ldemux_static
requires_slibs: -lws2_32 -lmswsock
Requires: flx_pthread
flx_requires_driver: flx_arun
macros: BUILD_DEMUX
includes: '"flx_demux.hpp"'
library: demux
headers: (.*/)?([^/\\]+\.hpp)>${2}
srcdir: src/demux
src: [^/\\]+\.cpp
src: win/.*\.cpp

//[demux_cygwin.fpc]
Name: demux
Description: Event handling (poll)
Comment: Generated during configuration
provides_dlib: -ldemux_dynamic
provides_slib: -ldemux_static
Requires: flx_pthread
flx_requires_driver: flx_arun
includes: '"flx_demux.hpp"'
macros: BUILD_DEMUX
library: demux
headers: (.*/)?([^/\\]+\.hpp)>${2}
srcdir: src/demux
src: [^/\\]+\.cpp
src: posix/.*\.cpp
src: poll/.*\.cpp

#[demux.py]
import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record

import buildsystem
from buildsystem.config import config_call

# ------------------------------------------------------------------------------

def build_runtime(phase):
    print('[fbuild] [demux]')
    path = Path(phase.ctx.buildroot/'share'/'src/demux')

    buildsystem.copy_hpps_to_rtl(phase.ctx,
        #phase.ctx.buildroot / 'lib/rtl/flx_demux_config.hpp', # portable

        # portable
        path / 'flx_demux.hpp',
        path / 'demux_demuxer.hpp',
        path / 'demux_timer_queue.hpp',
        path / 'demux_quitter.hpp',

        # windows (monolithic)
        path / 'win/demux_iocp_demuxer.hpp',
        path / 'win/demux_overlapped.hpp',
        path / 'win/demux_win_timer_queue.hpp',
        path / 'win/demux_wself_piper.hpp',

        # posix
        path / 'posix/demux_posix_demuxer.hpp',
        path / 'posix/demux_posix_timer_queue.hpp',
        path / 'posix/demux_select_demuxer.hpp',
        path / 'posix/demux_sockety.hpp',
        path / 'posix/demux_self_piper.hpp',
        path / 'posix/demux_ts_select_demuxer.hpp',

        # linux, osx 10.3 (select impl), 10.4 real.
        path / 'poll/demux_poll_demuxer.hpp',
        path / 'poll/demux_ts_poll_demuxer.hpp',

        # linux (>= 2.6)
        path / 'epoll/demux_epoll_demuxer.hpp',

        # osx (10.3 onwards)/bsd
        path / 'kqueue/demux_kqueue_demuxer.hpp',

        # solaris (9 onwards?)
        path / 'evtport/demux_evtport_demuxer.hpp',
    )

    dst = 'host/lib/rtl/demux'
    srcs = [path / '*.cpp']
    includes = [
        phase.ctx.buildroot / 'host/lib/rtl',
        phase.ctx.buildroot / 'share/lib/rtl',
    ]
    macros = ['BUILD_DEMUX']
    libs = [call('buildsystem.flx_pthread.build_runtime', phase)]
    extra_libs = []

    if 'win32' in phase.platform:
        print("DEMUX: providing WIN32 IO COMPLETION PORTS");
        srcs.extend((
            path / 'win/demux_iocp_demuxer.cpp',       # windows
            path / 'win/demux_overlapped.cpp',         # windows
            path / 'win/demux_wself_piper.cpp',        # windows
            path / 'win/demux_win_timer_queue.cpp',    # windows
        ))
        extra_libs.extend(('ws2_32', 'mswsock'))

    if 'posix' in phase.platform:
        print("DEMUX: providing POSIX SELECT");
        srcs.extend((
            path / 'posix/demux_posix_demuxer.cpp',      # posix
            path / 'posix/demux_select_demuxer.cpp',     # posix
            path / 'posix/demux_posix_timer_queue.cpp',  # posix
            path / 'posix/demux_sockety.cpp',            # posix
            path / 'posix/demux_self_piper.cpp',         # posix
            path / 'posix/demux_ts_select_demuxer.cpp',  # posix
        ))

    poll_h = config_call('fbuild.config.c.posix.poll_h', phase.platform, phase.cxx.shared)
    sys_epoll_h = config_call('fbuild.config.c.linux.sys_epoll_h', phase.platform, phase.cxx.shared)
    sys_event_h = config_call('fbuild.config.c.bsd.sys_event_h', phase.platform, phase.cxx.shared)
    port_h = config_call('fbuild.config.c.solaris.port_h', phase.platform, phase.cxx.shared)

    if poll_h.header:
        print("DEMUX: providing UNIX POLL");
        srcs.extend((
            # I've seen poll on linux and osx10.4 systems.
            # conditionally compiled and used.
            path / 'poll/demux_poll_demuxer.cpp',       # I've seen this on linux and osx10.4
            path / 'poll/demux_ts_poll_demuxer.cpp',    # ditto
        ))

    if sys_epoll_h.header:
        print("DEMUX: providing LINUX EPOLL");
        srcs.append(path / 'epoll/demux_epoll_demuxer.cpp')

    if sys_event_h.header:
        print("DEMUX: providing OSX KQUEUE");
        srcs.append(path / 'kqueue/demux_kqueue_demuxer.cpp')

    if port_h.header:
        print("DEMUX: providingd SOLARIS EVENT PORTS");
        srcs.append(path / 'evtport/demux_evtport_demuxer.cpp')

    srcs = Path.globall(srcs)

    lp = len (path)
    #print("demux: srcs = ", [str (src)[lp+1:] for src in srcs])
    #print("demux: include paths = ", [str(inc) for inc in includes])
    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.static for lib in libs],
            external_libs=extra_libs),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.shared for lib in libs],
            external_libs=extra_libs))

def build_flx(phase):
    return buildsystem.copy_flxs_to_lib(phase.ctx,
        Path('src/demux/*.flx').glob())

//[flx_demux_config.hpp]
#ifndef __FLX_DEMUX_CONFIG_H__
#define __FLX_DEMUX_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_DEMUX
#define DEMUX_EXTERN FLX_EXPORT
#else
#define DEMUX_EXTERN FLX_IMPORT
#endif
#endif

Package: src/packages/dynamic_metatyping.fdoc

Dynamic Meta-typing

key file
typedesc.flx share/lib/std/felix/dyntype/typedesc.flx

First Class Type Descriptor.

//[typedesc.flx]
include "std/felix/rtti";

class DynamicMetaTyping
{
  open Rtti;

  interface typedesc_t
  {
    name: 1 -> string;
    len: 1 -> size; // all the objects
    object_size: 1 -> size; // one object
    object_alignment: 1 -> size;
    dflt_init : address -> 0;
    destroy : address -> 0;
    copy_init : address * address -> 0;
    move_init : address * address -> 0; // leaves src dflt init
    copy_assign : address * address -> 0;
    move_assign : address * address -> 0; // leaves source dflt init
  }

  object CxxType (fcops: Rtti::fcops_t, tname:string, tlen: size)
    implements typedesc_t
  =
  {
    method fun name () => tname;

    method fun len() => tlen;

    method fun object_size() => Rtti::object_size fcops;
    method fun object_alignment() => Rtti::object_alignment fcops;

    method proc dflt_init (dst:address)
      => Rtti::dflt_init (fcops, dst);

    method proc destroy(dst:address)
      => Rtti::destroy(fcops, dst);

    method proc copy_init (dst:address, src:address)
      => Rtti::copy_init (fcops, dst, src);

    method proc move_init (dst:address, src:address)
      => Rtti::move_init (fcops, dst, src);

    method proc copy_assign (dst:address, src:address) {
      println$ "Felix CxxType.copy_assign "+dst.str+ " <- " + src.str;
      Rtti::copy_assign (fcops, dst, src);
    }

    method proc move_assign(dst:address, src:address)
      => Rtti::move_assign (fcops, dst, src);
  }

  ctor typedesc_t (ptd: gc_shape_t) =>
    let fcops = ptd.get_fcops in
    let name = ptd.cname.string in
    let esize = ptd.bytes_per_element * ptd.number_of_elements in
    CxxType (fcops, name, esize)
  ;


  typedef binproc_t = address * address -> 0; // P2
  typedef unproc_t = address -> 0; // P1
  typedef get_size_t = 1 -> size; // FZ

  // NOTE: currently NOT GC aware!

  body FelixValueType_poly[P2,A2,P1,FZ] = """
    class FelixValueType : public virtual ValueType
    {
      ?4 object_size_ptr;
      ?4 object_size_ptr;
      ?3 dflt_init_ptr;
      ?3 destroy_ptr;
      ?1 copy_init_ptr;
      ?1 move_init_ptr;
      ?1 copy_assign_ptr;
      ?1 move_assign_ptr;

      size_t object_size() { return sizeof(?1); }
      size_t object_alignment() { return alignof(?1); }

      void dflt_init_impl (void *dst) {
        ::flx::rtl::executil::run (dflt_init_ptr->call(0,dst));
      }

      void destroy_impl (void *dst) {
        ::flx::rtl::executil::run (destroy_ptr->call(0,dst));
      }

      void copy_init_impl (void *dst, void *src) {
        ::flx::rtl::executil::run (copy_init_ptr->call(0,?2(dst,src)));
      }

      void move_init_impl (void *dst, void *src) {
        ::flx::rtl::executil::run (move_init_ptr->call(0,?2(dst,src)));
      }

      void copy_assign_impl (void *dst, void *src) {
        fprintf(stderr, "C++FelixValueType.copy_assign %p<-%p\\n",dst,src);
        ::flx::rtl::executil::run (copy_assign_ptr->call(0,?2(dst,src)));
      }

      void move_assign_impl (void *dst, void *src) {
        ::flx::rtl::executil::run (move_assign_ptr->call(0,?2(dst,src)));
      }

    public:
      FelixValueType (?3 di, ?3 de, ?1 ci, ?1 mi, ?1 ca, ?1 ma) :
        dflt_init_ptr (di),
        destroy_ptr (de),
        copy_init_ptr (ci),
        move_init_ptr (mi),
        copy_assign_ptr (ca),
        move_assign_ptr (ma)
        {}
    };
  """;

  // Tricky! Declare incomplete type in header
  // Implement class in body
  header FelixValueType_class = "class FelixValueType;"
    requires FelixValueType_poly[binproc_t, address^2, unproc_t, get_size_t],
    package "flx_executil"
  ;

  type FelixValueType = "FelixValueType*" requires FelixValueType_class;

  ctor FelixValueType : copy_t * copy_t * copy_t * copy_t =
    "new FelixValueType ($1, $2, $3, $4)"
  ;

  ctor FelixValueType (x:DynamicMetaTyping::typedesc_t) =>
    FelixValueType (
      x.object_size,
      x.object_alignment,
      x.dflt_init,
      x.destroy_init,
      x.copy_init,
      x.move_init,
      x.copy_assign,
      x.move_assign
    )
  ;

  fun ValueType_from_FelixValueType: FelixValueType -> fcops_t = "(ValueType*)$1";

  object TupleType (tname:string, elts: list[typedesc_t]) implements typedesc_t =
  {
     fun align : size -> size =
       | 0uz => 0uz
       | 1uz => 1uz
       | 2uz => 2uz
       | 3uz => 4uz
       | 4uz => 4uz
       | 5uz => 8uz
       | 6uz => 8uz
       | 7uz => 8uz
       | 8uz => 8uz
       | _ => 16uz
     ;

     var n = len elts;
     assert n != 0uz;
println$ "Tuple " + tname + " with " + n.str + " fields";
     var aligned = varray[typedesc_t * size] n;
     var ofset = 0uz;
     var tl = elts;
     var counter = 0;
  next_elt:>
println$ "Offset " + ofset.str;
     match  tl with
     | #Empty => ;
     | Cons (head, (Cons (nxt, _) as tail)) =>
println$ "Add field " + counter.str + "/" + n.str;
       push_back (aligned, (head,ofset));
       // alignment rules: the offset of the next object is
       // aligned to the greater of the alignment of the current
       // and next objects
       var hz = head.len ();
       var nz = nxt.len ();
       var alignment = max (align hz, align nz);
       ofset = ((ofset + hz + alignment - 1) / alignment) * alignment;
       tl = tail ;
       ++counter;
       goto next_elt;

     | Cons (head, #Empty) =>
println$ "Add last field " + counter.str + "/" + n.str;
       push_back (aligned, (head,ofset));
       hz = head.len ();
       alignment = align hz;
       ofset = ((ofset + hz + alignment - 1) / alignment) * alignment;
     endmatch;
     var length = ofset;
     println$ "Tuple " + tname + " length= " + length.str;
     println$ "Tuple " + tname + " fields= ";
     for var i in 0uz upto n - 1uz do
       var typ,ofs = aligned.i;
       println$ "Field #"+i.str+ " at offset " + ofs.str + " type " + #(typ.name).str;
     done

    method fun len () => length;
    method fun name () => tname;

    method proc dflt_init (dst:address) =>
      for var i in 0uz upto n - 1uz do
         var typ,ofs = aligned.i;
         typ.dflt_init (dst + ofs);
      done

    method proc destroy(dst:address) =>
      for var i in 0uz upto n - 1uz do
         var typ,ofs = aligned.i;
         typ.destroy(dst + ofs);
      done



    method proc copy_init (dst:address, src:address) =>
      for var i in 0uz upto n - 1uz do
         var typ,ofs = aligned.i;
         typ.copy_init (dst + ofs, src + ofs);
      done

    method proc move_init (dst:address, src:address)  =>
     perform assert false;

    method proc copy_assign (dst:address, src:address) =>
      perform assert false;

    method proc move_assign(dst:address, src:address) =>
      perform assert false;

  }

} // end class DynamicMetaTyping

Package: src/packages/dynlink.fdoc

Dynamic Linker

key file
flx_dl.h share/lib/rtl/flx_dl.h
flx_dlopen.hpp share/lib/rtl/flx_dlopen.hpp
flx_dlopen.cpp share/src/dynlink/flx_dlopen.cpp
flx_dynlink.hpp share/lib/rtl/flx_dynlink.hpp
flx_dynlink.cpp share/src/dynlink/flx_dynlink.cpp
dynlink.flx share/lib/std/program/dynlink.flx
config_unix_dl.fpc $PWD/src/config/unix/dl.fpc
config_macosx_dl.fpc $PWD/src/config/macosx/dl.fpc
config_win_dl.fpc $PWD/src/config/win/dl.fpc
unix_flx_dynlink.fpc $PWD/src/config/unix/flx_dynlink.fpc
win_flx_dynlink.fpc $PWD/src/config/win/flx_dynlink.fpc
flx_dynlink_config.hpp share/lib/rtl/flx_dynlink_config.hpp
flx_dynlink.py $PWD/buildsystem/flx_dynlink.py

Dynamic Linkage

Synopsis

This subsystem provides the ability to load,link or otherwise access program code at run time. We use the name DLL to refer to a dynamically loaded file containing executable instructions, on Windows this is a dynamic link library which usually ends in extension .dll whilst on Linux we have shared libraries with extension .so and on OSX we use files with extension .dylib.

There is a confusing array of operations provided here which will require refactoring in the future.

The core platform dependent operations are implemented in C++ and configuration and compile time choices determine the platform supported.

These core operations are wrapped, in C++, to remove the file loading dependencies, and provide resource control integrated with the garbage collector.

We use LoadLibrary on Windows and dlopen on Unix platforms wrapped inside a C++ class flx_dynlink_t that represents a library, in Felix the type flx_library is used.

Felix generated code does not permit variables to be stored in static storage. Instead, a structure is used to contain Felix top level variables. For historical reasons objects are called <em>thread frames.</em>

Members of a thread frame are accessed in Felix bindings to C++ using the macro PTF which stands for <em>pointer to thread frame.</em>

A Felix generated shared library requires an instance to be created which is a closure: a pair consisting of the library code and a thread_frame_t object which is allocated on the heap. The closure object has the type flx_libinst_t in C++ and flx_instance in Felix.

Instances require a fixed protocol which involves the library containing exported symbols which can be linked using LoadProcAddress on Windows or dlsym on unix, which can be used to construct the required thread frame. High level Felix functions require he thread frame because it contains a pointer to the garbage collector which in turn provides the system allocator.

Higher level abstractions require more fixed symbols. In particular, there is a protocol for loading a special kind of library called a <em>plugin</em> which make separate compilation of and use of dynamic libraries particularly convenient.

Felix level dynamic loader system

This is a higher level loader which is primarily designed for loading Felix programs machined as libraries, but it can also be used for high level libraries such as plugins.

The core concept is based on Windows 3.1, in which the library is read only program code, and requires an data frame to execute. Unlike C style libraries, mutable data is not permitted in libraries. Instead, the library must provide a function to create a heap allocated data frame to store global data.

Hence, after loading, one or more instances of the library can be created by combining the code API with a data frame. Felix calls this data frame the <em>thread frame</em>.

Since each client of a library create their own instance of the library, the global variables of the client do not interfere.

The type flx_dynlink_t represents a library, whereas the type flx_libinst_t represents a pair consisting of the library together with a data frame. This provides a single entity from which to dispatch function calls which may interact by per instance data without clobbering an independent client’s use of the library.

Except in special circumstances Felix demands all code be reentrant and in particular mutable global variables are not allowed at the C level.

The special circumstances are dictated by poor quality API’s including Posix signals and of course the notorious errno.

//[flx_dynlink.hpp]
#ifndef __FLX_DYNLINK_H__
#define __FLX_DYNLINK_H__
#include "flx_rtl.hpp"
#include "flx_gc.hpp"
#include "flx_dl.h"
#include "flx_dlopen.hpp"
#include "flx_exceptions.hpp"
#include "flx_continuation.hpp"

#include <string>

namespace flx { namespace dynlink {

struct DYNLINK_EXTERN flx_dynlink_t;
struct DYNLINK_EXTERN flx_libinst_t;


/// frame creators.
typedef void *(*thread_frame_creator_t)
(
  ::flx::gc::generic::gc_profile_t*,
  void*
);

/// library initialisation routine.
typedef ::flx::rtl::con_t *(*start_t)
(
  void*,
  int,
  char **,
  FILE*,
  FILE*,
  FILE*

);

typedef ::flx::rtl::con_t *(*main_t)(void*);

/// dynamic object loader.
struct DYNLINK_EXTERN flx_dynlink_t
{
  // filename of library used for dynamic linkage
  ::std::string filename;

  // modulename of library
  // usually filename without path prefix or extension
  ::std::string modulename;

  // OS specific handle refering to the library if one is loaded
  // undefine otherwise
  FLX_LIBHANDLE library;

  // Felix specific entry point used to create thread frame.
  // Typically this function allocates the thread frame as a C++
  // object, calling its contructor.
  // A library together with a thread frame is known as an instance
  // of the library.
  thread_frame_creator_t thread_frame_creator;

  // Felix specific entry point used to initialise thread frame
  // Morally equivalent to the body of a C++ constructor,
  // this calls the libraries initialisation routine.
  // If the library is meant to be a program, this routine
  // often contains the program code.
  start_t start_sym;

  // A separate mainline, morally equivalent to C main() function.
  // Intended to be called after the start routine has completed.
  main_t main_sym;

  // Allow a default initialised default object refering to no library.
  flx_dynlink_t(bool debug);

  // set static link data into an empty dynlink object.
  void static_link(
    ::std::string modulename,
    thread_frame_creator_t thread_frame_creator,
    start_t start_sym,
    main_t main_sym);


  // initialise for static link
  // equivalent to default object followed by call to static_link method
  flx_dynlink_t(
    ::std::string modulename,
    thread_frame_creator_t thread_frame_creator,
    start_t start_sym,
    main_t main_sym,
    bool debug
  ) throw(::flx::rtl::flx_link_failure_t);

  // dynamic link library from filename and module name
  void dynamic_link_with_modulename(
     const ::std::string& filename,
     const ::std::string& modulename) throw(::flx::rtl::flx_link_failure_t);

  // With this variant the module name is calculated from the filename.
  void dynamic_link(const ::std::string& filename) throw(::flx::rtl::flx_link_failure_t);

  virtual ~flx_dynlink_t();

  bool debug;


private:
  void unlink(); // implementation of destructor only
  flx_dynlink_t(flx_dynlink_t const&); // uncopyable
  void operator=(flx_dynlink_t const&); // uncopyable
};

/// Thread Frame Initialisation.

struct DYNLINK_EXTERN flx_libinst_t
{
  void *thread_frame;
  ::flx::rtl::con_t *start_proc;
  ::flx::rtl::con_t *main_proc;
  flx_dynlink_t *lib;
  ::flx::gc::generic::gc_profile_t *gcp;
  void *world;  // FIXME: flx_world*, can't specify atm due to circularity
  bool debug;

  void create
  (
    flx_dynlink_t *lib_a,
    ::flx::gc::generic::gc_profile_t *gcp_a,
    void *world_a, // FIXME as above
    int argc,
    char **argv,
    FILE *stdin_,
    FILE *stdout_,
    FILE *stderr_,
    bool debug_
  );

  void destroy ();

  ::flx::rtl::con_t *bind_proc(void *fn, void *data);
  virtual ~flx_libinst_t();
  flx_libinst_t(bool debug);

private:
  flx_libinst_t(flx_libinst_t const&);
  void operator=(flx_libinst_t const&);
};

DYNLINK_EXTERN extern ::flx::gc::generic::gc_shape_t flx_dynlink_ptr_map;
DYNLINK_EXTERN extern ::flx::gc::generic::gc_shape_t flx_libinst_ptr_map;

}} // namespaces
#endif

Higher level wrappers for finding Felix functions.

Here make a set of higher level wrappers for finding standard protocol Felix function in DLLs. These wrappers create a closure by binding the C address of the constructor for the Felix function class in C++ to the library instance, and return that.

Closures returned by these function can be invoked as normal Felix functions and procedures. Whereas a function defined in the current files binds to the thread frame implicitly, with a library the instance is required to supply the thread frame. The closures returned by these wrappers are bound to the libraries thread frame so they can be invoked with the ordinary syntax.

Note that these operations are not type safe. If you get the type wrong all hell will break loose. This is because dlsym finds functions by their C names and C++ entities use mangled names we cannot compute in a portable way.

//[dynlink.flx]
  //$ Return a closure representing a symbol in a DLL instance
  //$ of a function of no arguments.
  noinline fun func0[R] (linst: flx_instance, sym:string) = {
    var s,tf= flx_dlsym[address --> R] (linst, sym);
    return fun () => s tf;
  }

  //$ Return a closure representing a symbol in a DLL instance
  //$ of a function of one argument.
  noinline fun func1[R,A0] (linst: flx_instance, sym:string) = {
    var s,tf= flx_dlsym[address * A0 --> R] (linst, sym);
    return fun (a0:A0) => s (tf, a0);
  }

  //$ Return a closure representing a symbol in a DLL instance
  //$ of a function of two arguments.
  noinline fun func2[R,A0,A1] (linst: flx_instance, sym:string) = {
    var s,tf= flx_dlsym[address * A0 * A1 --> R] (linst, sym);
    return fun (var a0:A0, var a1:A1) => s (tf, a0, a1);
  }

  //$ Return a closure representing a symbol in a DLL instance
  //$ of a procedure of no arguments.
  noinline fun proc0 (linst: flx_instance, sym:string) = {
    var s,tf= flx_dlsym[address --> void] (linst, sym);
    return proc () { s tf; };
  }

  //$ Return a closure representing a symbol in a DLL instance
  //$ of a procedure of one argument.
  noinline fun proc1[A0] (linst: flx_instance, sym:string) = {
    var s,tf= flx_dlsym[address * A0 --> void] (linst, sym);
    return proc (a0:A0) { s (tf, a0); };
  }

  //$ Return a closure representing a symbol in a DLL instance
  //$ of a procedure of two arguments.
  noinline fun proc2[A0,A1] (linst: flx_instance, sym:string) = {
    var s,tf= flx_dlsym[address * A0 * A1 --> void] (linst, sym);
    return proc (a0:A0,a1:A1) { s (tf, a0, a1); };
  }

Plugins.

A plugin is a special kind of DLL which supplies two fixed entry points: a setup routine, which is called to initialise the thread frame given a string argument, and a single entry point which is subsequently called and which typically returns an object type consisting of a set of methods acting on the object state and initialised thread frame context.

The setup routine typically take a string of configuration parameters, extracts them with a parser, and stores them in variables.

The current protocol is that the setup function must be called “dllname_setup”, the entry point name is passed as a string.

In order to accomodate static linking of plugins in the future, the setup and entry point symbols would need to have univerally unique names, since static linkage cannot work with duplicate definitions, so the protocol will change to require the library name as a prefix. Stay tuned.

//[dynlink.flx]
  //$ Specialised routine(s) to load stylised plugin.
  //$ Two entry points:
  //$
  //$ setup: string -> int
  //$
  //$ is called to initialise the instance globals.
  //$
  //$ entry-point: arg -> iftype
  //$
  //$ is the primary entry point, typically an object factory,
  //$ when called with an argument
  //$ of type arg_t it returns //$ an object of type iftype.
  //$
  //$ This function returns the object factory.
  //$ setup is called automatically with the supplied string.
  //$
  //$ There are 3 variants where the factory function accepts
  //$ 0, 1 and 2 arguments.
  noinline gen  load-plugin-func0[iftype] (
    dll-name: string,   // name of the DLL minus the extension
    setup-str: string="",  // string to pass to setup
    entry-point: string=""   // export name of factory function
  ) : unit -> iftype =
  {
    var entrypoint = if entry-point == "" then dll-name else entry-point;
    var linst = Dynlink::init_lib(dll-name);
    var sresult = Dynlink::func1[int,string] (linst, dll-name+"_setup") (setup-str);
    C_hack::ignore(sresult);
    if sresult != 0 call eprintln$ "[dynlink] Warning: Plugin Library " + dll-name + " set up returned " + str sresult;
    return Dynlink::func0[iftype] (linst, entrypoint);
  }

  noinline gen  load-plugin-func1[iftype, arg_t] (
    dll-name: string,   // name of the DLL minus the extension
    setup-str: string="",  // string to pass to setup
    entry-point: string=""   // export name of factory function
  ) : arg_t -> iftype =
  {
    var entrypoint = if entry-point == "" then dll-name else entry-point;
    var linst = Dynlink::init_lib(dll-name);
    var sresult = Dynlink::func1[int,string] (linst, dll-name+"_setup") (setup-str);
    C_hack::ignore(sresult);
    if sresult != 0 call eprintln$ "[dynlink] Warning: Plugin Library " + dll-name + " set up returned " + str sresult;
    return Dynlink::func1[iftype,arg_t] (linst, entrypoint);
  }

  noinline gen  load-plugin-func2[iftype, arg1_t, arg2_t] (
    dll-name: string,   // name of the DLL minus the extension
    setup-str: string="",  // string to pass to setup
    entry-point: string=""   // export name of factory function
  ) : arg1_t * arg2_t -> iftype =
  {
    var entrypoint = if entry-point == "" then dll-name else entry-point;
    var linst = Dynlink::init_lib(dll-name);
    var sresult = Dynlink::func1[int,string] (linst, dll-name+"_setup") (setup-str);
    C_hack::ignore(sresult);
    if sresult != 0 call eprintln$ "[dynlink] Warning: Plugin Library " + dll-name + " set up returned " + str sresult;
    return Dynlink::func2[iftype,arg1_t, arg2_t] (linst, entrypoint);
  }
Utilities and misc.
//[dynlink.flx]

  //$ Execute an address representing a top
  //$ level exported felix procedure's C wrapper,
  //$ this creates a 'read to run' continuation object
  //$ by both constructing the object using the thread
  //$ frame of the instance as an argument, and calling
  //$ it to fix a null return address and an arbitrary
  //$ client data pointer as arguments to the call method.
  fun bind_proc: flx_instance * address * address -> cont =
    "$1->bind_proc($2,$3)";

  //$ Get the OS dependent handle representing a loaded DLL.
  //$ Return as an address.
  fun dlib_of : flx_library -> address = "(void*)$1->library";

  //$ Throw an exception indicating the failure to
  //$ find a symbol in a DLL.
  proc dlsym_err:flx_library*string="""
    throw ::flx::rtl::flx_link_failure_t($1->filename,$2,"symbol not found");
  """;

  //$ Run a procedure represented by a string name with
  //$ given thread frame.
  noinline proc run_proc (linstance:flx_instance, p: string, data: address)
  {
    var lib = get_library linstance;
    var sym = find_sym(lib, p);
    if isNULL(sym) call dlsym_err(lib,p);
    var f = bind_proc(linstance, sym, data);
    run f;
  }


}

Dynamic Linkage support

//[flx_dynlink_config.hpp]
#ifndef __FLX_DYNLINK_CONFIG_H__
#define __FLX_DYNLINK_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_DYNLINK
#define DYNLINK_EXTERN FLX_EXPORT
#else
#define DYNLINK_EXTERN FLX_IMPORT
#endif
#endif

//[config_unix_dl.fpc]
Name: dl
Description: dynamic loading support
includes: '<dlfcn.h>'
requires_dlibs: -ldl
requires_slibs: -ldl

//[config_macosx_dl.fpc]
Name: dl
Description: dynamic loading support
includes: '<dlfcn.h>'

//[config_win_dl.fpc]
Name: dl
Description: dynamic loading support

//[unix_flx_dynlink.fpc]
Name: flx_dynlink
Description: Felix Dynamic loading support
provides_dlib: -lflx_dynlink_dynamic
provides_slib: -lflx_dynlink_static
Requires: dl flx_exceptions flx_gc flx_strutil
library: flx_dynlink
includes: '"flx_dynlink.hpp"'
macros: BUILD_DYNLINK
srcdir: src/dynlink
src: .*\.cpp

//[win_flx_dynlink.fpc]
Name: flx_dynlink
Description: Felix Dynamic loading support
provides_dlib: /DEFAULTLIB:flx_dynlink_dynamic
provides_slib: /DEFAULTLIB:flx_dynlink_static
Requires: dl flx_exceptions flx_gc flx_strutil
library: flx_dynlink
includes: '"flx_dynlink.hpp"'
macros: BUILD_DYNLINK
srcdir: src/dynlink
src: .*\.cpp

#[flx_dynlink.py]
import fbuild
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy
from fbuild.functools import call

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    print('[fbuild] [rtl] build dynlink')
    path = Path(phase.ctx.buildroot/'share'/'src/dynlink')

    srcs = [f for f in Path.glob(path / '*.cpp')]
    includes = [phase.ctx.buildroot / 'host/lib/rtl', phase.ctx.buildroot / 'share/lib/rtl']
    macros = ['BUILD_DYNLINK']
    libs = [
        call('buildsystem.flx_strutil.build_runtime', phase),
        call('buildsystem.flx_gc.build_runtime', phase),
    ]

    dst = 'host/lib/rtl/flx_dynlink'
    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            libs=[lib.static for lib in libs],
            macros=macros),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            libs=[lib.shared for lib in libs],
            macros=macros))

Package: src/packages/embed.fdoc

Driver Embedding Technology

key file
flx_world_config.hpp share/lib/rtl/flx_world_config.hpp
flx_world_config.cpp share/src/rtl/flx_world_config.cpp
flx_world.hpp share/lib/rtl/flx_world.hpp
flx_world.cpp share/src/rtl/flx_world.cpp

Embedding

This technology is designed to allow Felix to be embedded in any C or C++ program or library.

The embedding library code is used by the core drivers.

The flx_config class.

The flx_config class is used to store configuration data used by subsequent initialisation steps used to initiate a Felix world.

//[flx_world_config.hpp]

#ifndef __flx_world_config_H_
#define __flx_world_config_H_

#include "flx_rtl_config.hpp"
#include "flx_gc.hpp"
#include "flx_collector.hpp"
#include "flx_dynlink.hpp"

// for async_sched
#include <list>
#include "flx_async.hpp"
#include "flx_sync.hpp"

namespace flx { namespace run {
class RTL_EXTERN flx_config {
public:
  bool  debug;

  bool debug_threads;
  bool debug_allocations;
  bool debug_collections;
  bool report_collections;
  bool report_gcstats;

  bool debug_driver;
  bool finalise;

  size_t gc_freq;
  size_t min_mem;
  size_t max_mem;
  int gcthreads;

  double free_factor;

  bool allow_collection_anywhere;

  bool static_link;
  char *filename; // expected to live forever
  char **flx_argv;
  int flx_argc;

  // TODO: fn up in macro area
  int init(int argc, char **argv);

// interface for drivers. there's more, create_frame, etc
  create_async_hooker_t *ptr_create_async_hooker=nullptr;

  typedef ::flx::dynlink::flx_dynlink_t *(*link_library_t)(flx_config *c, ::flx::gc::generic::gc_profile_t*);
  typedef void (*init_ptr_create_async_hooker_t)(flx_config *, bool debug_driver);
  typedef int (*get_flx_args_config_t)(int argc, char **argv, flx_config* c);

  link_library_t link_library;
  init_ptr_create_async_hooker_t init_ptr_create_async_hooker;
  get_flx_args_config_t get_flx_args_config;

  flx_config (link_library_t, init_ptr_create_async_hooker_t, get_flx_args_config_t);


};
}} // namespaces
#endif

//[flx_world_config.cpp]

#include "flx_world_config.hpp"
#include <cstdlib>

static double egetv(char const *name, double dflt)
{
  char *env = ::std::getenv(name);
  double val = env?::std::atof(env):dflt;
  return val;
}

namespace flx { namespace run {

// =================================================================
// flx_config: Constructor
// =================================================================
flx_config::flx_config
(
  link_library_t link_library_arg,
  init_ptr_create_async_hooker_t init_ptr_create_async_hooker_arg,
  get_flx_args_config_t get_flx_args_config_arg
) :
  link_library(link_library_arg),
  init_ptr_create_async_hooker(init_ptr_create_async_hooker_arg),
  get_flx_args_config(get_flx_args_config_arg)
{
  //fprintf(stderr,"flx_config constrfuctor\n");
}

// =================================================================
// flx_config: Initialiser
// =================================================================

int
flx_config::init(int argc, char **argv) {
  if(get_flx_args_config(argc, argv, this)) return 1;

  debug = (bool)egetv("FLX_DEBUG", debug);
  if (debug) {
    fprintf(stderr,
      "[FLX_DEBUG] Debug enabled for %s link program\n",
      static_link ? "static" : "dynamic");
  }

  debug_threads = (bool)egetv("FLX_DEBUG_THREADS", debug);
  if (debug_threads) {
    fprintf(stderr, "[FLX_DEBUG_THREADS] Threads debug enabled\n");
  }

  debug_allocations = (bool)egetv("FLX_DEBUG_ALLOCATIONS", debug);
  if (debug_allocations) {
    fprintf(stderr, "[FLX_DEBUG_ALLOCATIONS] Allocation debug enabled\n");
  }

  debug_collections = (bool)egetv("FLX_DEBUG_COLLECTIONS", debug);
  if (debug_collections)
  {
    fprintf(stderr, "[FLX_DEBUG_COLLECTIONS] Collection debug enabled\n");
  }

  report_collections = (bool)egetv("FLX_REPORT_COLLECTIONS", debug);
  if (report_collections)
  {
    fprintf(stderr, "[FLX_REPORT_COLLECTIONS] Collection report enabled\n");
  }

  report_gcstats = (bool)egetv("FLX_REPORT_GCSTATS", report_collections);
  if (report_collections)
  {
    fprintf(stderr, "[FLX_REPORT_GCSTATS] GC statistics report enabled\n");
  }


  debug_driver = (bool)egetv("FLX_DEBUG_DRIVER", debug);
  if (debug_driver)
  {
    fprintf(stderr, "[FLX_DEBUG_DRIVER] Driver debug enabled\n");
  }

  finalise = (bool)egetv("FLX_FINALISE", 0);
  if (debug)
    fprintf(stderr,
      "[FLX_FINALISE] Finalisation %s\n", finalise ? "Enabled" : "Disabled");

  // default collection frequency is 1000 interations
  gc_freq = (size_t)egetv("FLX_GC_FREQ", 1000);
  if (gc_freq < 1) gc_freq = 1;
  if (debug)
    fprintf(stderr, "[FLX_GC_FREQ] call gc every %zu iterations\n", gc_freq);

  // default min mem is 10 Meg
  min_mem = (size_t)(egetv("FLX_MIN_MEM", 10) * 1000000.0);
  if (debug)
    fprintf(stderr, "[FLX_MIN_MEM] call gc only if more than %zu Meg heap used\n", min_mem/1000000);

  // default max mem is unlimited
  max_mem = (size_t)(egetv("FLX_MAX_MEM", 0) * 1000000.0);
  if (max_mem == 0) max_mem = (size_t)-1;
  if (debug)
    fprintf(stderr, "[FLX_MAX_MEM] terminate if more than %zu Meg heap used\n", max_mem/1000000);

  // default free factor is 10%, this is also the minimum allowed
  free_factor = egetv("FLX_FREE_FACTOR", 1.1);
  if (free_factor < 1.1) free_factor = 1.1;
  if (debug)
    fprintf(stderr, "[FLX_FREE_FACTOR] reset gc trigger %4.2f times heap used after collection\n", free_factor);

  // experimental flag to allow collection anywhere
  // later, we default this one to true if we can
  // find all the thread stacks, which should be possible
  // with gcc and probably msvc++

  allow_collection_anywhere = (bool)egetv("FLX_ALLOW_COLLECTION_ANYWHERE", 1);
  if (debug)
    fprintf(stderr, "[FLX_ALLOW_COLLECTION_ANYWHERE] %s\n", allow_collection_anywhere ? "True" : "False");

  gcthreads = (int)egetv("FLX_GCTHREADS",0);
  if (debug)
    fprintf(stderr, "[FLX_GCTHREADS] %d\n",gcthreads);

  if (debug) {
    for (int i=0; i<flx_argc; ++i)
      fprintf(stderr, "flx_argv[%d]->%s\n", i, flx_argv[i]);
  }
  return 0;
}

}} // namespaces
The flx_world class.

Objects of the flx_world class are used to represent a Felix world.

//[flx_world.hpp]

#ifndef __flx_world_H_
#define __flx_world_H_
#include "flx_rtl_config.hpp"

#include "flx_gc.hpp"
#include "flx_collector.hpp"
#include "flx_dynlink.hpp"

// for async_sched
#include <list>
#include "flx_async.hpp"
#include "flx_sync.hpp"
#include "flx_world_config.hpp"
#include "flx_async_world.hpp"

namespace flx { namespace run {

class RTL_EXTERN flx_world {
  bool debug;
  bool debug_driver;

  ::flx::gc::generic::allocator_t *allocator;

  ::flx::gc::collector::flx_collector_t *collector;

  ::flx::gc::generic::gc_profile_t *gcp;

  ::flx::dynlink::flx_dynlink_t *library;
  ::flx::dynlink::flx_libinst_t *instance;

  struct async_sched *async_scheduler;

  int explicit_dtor();
public:
  flx_config *c;
  flx_world(flx_config *);
  int setup(int argc, char **argv);

  int teardown();

  // add/remove (current pthread, stack pointer) for garbage collection
  void begin_flx_code();
  void end_flx_code();

  // returns number of pending operations scheduled by svc_general
  // return error code < 0 otherwise
  // catches all known exceptions
  int run();

  void* ptf()const { return instance->thread_frame; } // for creating con_t

  async_hooker *create_demux();

  void spawn_fthread(::flx::rtl::con_t *top);

  void external_multi_swrite (::flx::rtl::schannel_t *chan, void *data);

  async_sched *get_async_scheduler()const { return async_scheduler; }
  sync_sched *get_sync_scheduler()const { return async_scheduler->ss; }
};


}} // namespaces
#endif //__flx_world_H_

//[flx_world.cpp]

#include "flx_world.hpp"
#include "flx_eh.hpp"
#include "flx_ts_collector.hpp"
#include "flx_rtl.hpp"

using namespace ::std;
using namespace ::flx::rtl;
using namespace ::flx::pthread;
using namespace ::flx::run;

namespace flx { namespace run {

// =================================================================
// flx_world : final cleanup
// =================================================================

// terminates process!
// Not called by default (let the OS clean up)

static int do_final_cleanup(
  bool debug_driver,
  flx::gc::generic::gc_profile_t *gcp,
  ::flx::dynlink::flx_dynlink_t *library,
  ::flx::dynlink::flx_libinst_t *instance
)
{
  flx::gc::generic::collector_t *collector = gcp->collector;

  // garbage collect application objects
  {
    if (debug_driver || gcp->debug_collections)
      fprintf(stderr, "[do_final_cleanup] Finalisation: pass 1 Data collection starts ..\n");

    size_t n = collector->collect();
    size_t a = collector->get_allocation_count();

    if (debug_driver || gcp->debug_collections)
      fprintf(stderr, "[do_final_cleanup] flx_run collected %zu objects, %zu left\n", n, a);
  }

  // garbage collect system objects
  {
    if (debug_driver || gcp->debug_collections)
      fprintf(stderr, "[do_final_cleanup] Finalisation: pass 2 Final collection starts ..\n");

    collector->free_all_mem();
    size_t a = collector->get_allocation_count();

    if (debug_driver || gcp->debug_collections)
      fprintf(stderr, "[do_final_cleanup] Remaining %zu objects (should be 0)\n", a);

    if (a != 0){
      fprintf(stderr, "[do_final_cleanup] flx_run %zu uncollected objects, should be zero!! return code 5\n", a);
      return 5;
    }
  }

  if (debug_driver)
    fprintf(stderr, "[do_final_cleanup] exit 0\n");

  return 0;
}

static void *get_stack_pointer() { void *x=(void*)&x; return x; }

// =================================================================
// flx_world : run mainline pthread constructor
// =================================================================
// RUN A FELIX INSTANCE IN THE CURRENT PTHREAD
//
// CURRENTLY ONLY CALLED ONCE IN MAIN THREAD
// RETURNS A LIST OF FTHREADS
//

static fthread_list*
run_felix_pthread_ctor(
  flx::gc::generic::gc_profile_t *gcp,
  ::flx::dynlink::flx_libinst_t *instance)
{
  //fprintf(stderr, "run_felix_pthread_ctor -- the MAIN THREAD: library instance: %p\n", instance);
  flx::gc::generic::collector_t *collector = gcp->collector;
  fthread_list *active = new(*gcp, ::flx::run::fthread_list_ptr_map,false)  fthread_list(gcp);

  {
    con_t *top = instance->main_proc;
    //fprintf(stderr, "  ** MAIN THREAD: flx_main entry point : %p\n", top);
    if (top)
    {
      fthread_t *flx_main = new (*gcp, _fthread_ptr_map, false) fthread_t(top);
      active->push_front(flx_main);
    }
  }

  {
    con_t *top = instance->start_proc;
    //fprintf(stderr, "  ** MAIN THREAD: flx_start (initialisation) entry point : %p\n", top);
    if (top)
    {
      fthread_t *ft = new (*gcp, _fthread_ptr_map, false) fthread_t(top);
      active->push_front(ft);
    }
  }
  return active;
}

// =================================================================
// flx_world : run mainline pthread destructor
// =================================================================
static void run_felix_pthread_dtor(
  bool debug_driver,
  flx::gc::generic::gc_profile_t *gcp,
  ::flx::dynlink::flx_dynlink_t *library,
  ::flx::dynlink::flx_libinst_t *instance
)
{
  if (debug_driver)
    fprintf(stderr, "[run_felix_pthread_dtor] MAIN THREAD FINISHED: waiting for other threads\n");

  gcp->collector->get_thread_control()->join_all();

  if (debug_driver)
    fprintf(stderr, "[run_felix_pthread_dtor] ALL THREADS DEAD: mainline cleanup!\n");

  if (debug_driver) {
    flx::gc::generic::collector_t *collector = gcp->collector;

    size_t uncollected = collector->get_allocation_count();
    size_t roots = collector->get_root_count();
    fprintf(stderr,
      "[run_felix_pthread_dtor] program finished, %zu collections, %zu uncollected objects, roots %zu\n",
      gcp->collections, uncollected, roots);
  }
  gcp->collector->remove_root(instance);

  if (gcp->finalise)
    (void)do_final_cleanup(debug_driver, gcp, library, instance);

  if (debug_driver)
    fprintf(stderr, "[run_felix_pthread_dtor] mainline cleanup complete, exit\n");

}

// =================================================================
// flx_world : Constructor
// =================================================================
// construct from flx_config pointer
flx_world::flx_world(flx_config *c_arg) : c(c_arg) {}

int flx_world::setup(int argc, char **argv) {
  int res;
  if((res = c->init(argc, argv) != 0)) return res;

  debug = c->debug;
  debug_driver = c->debug_driver;

  if(debug_driver)
    fprintf(stderr, "[flx_world %p: setup]\n", this);

  allocator = new flx::gc::collector::malloc_free();
  if(debug_driver)
    fprintf(stderr, "[flx_world: setup] Created allocator %p\n", allocator);
  allocator->set_debug(c->debug_allocations);

  char *tracecmd = getenv("FLX_TRACE_ALLOCATIONS");
  if(tracecmd && strlen(tracecmd)>0) {
     FILE *f = fopen(tracecmd,"w");
     if(f) {
       fprintf(stderr, "Allocation tracing active, file = %s\n",tracecmd);
       allocator = new flx::gc::collector::tracing_allocator(f,allocator);
     }
     else
       fprintf(stderr, "Unable to open allocation trace file %s for output (ignored)\n",tracecmd);
  }

  // previous direct ctor scope ended at closing brace of FLX_MAIN
  // but delete can probably be moved up after collector delete (also used by explicit_dtor)
  ::flx::pthread::thread_control_t *thread_control = new ::flx::pthread::thread_control_t(c->debug_threads);
  if(debug_driver)
    fprintf(stderr, "[flx_world: setup] Created thread control object  %p\n", thread_control);

  // NB: !FLX_SUPPORT_ASYNC refers to async IO, hence ts still needed thanks to flx pthreads
  FILE *tracefile = NULL;
  {
    char *tracecmd = getenv("FLX_TRACE_GC");
    if(tracecmd && strlen(tracecmd)>0) {
      tracefile = fopen(tracecmd,"w");
      if(tracefile)
        fprintf(stderr, "GC tracing active, file = %s\n",tracecmd);
    }
  }

  // Create Garbage Collector
  collector = new flx::gc::collector::flx_ts_collector_t(
    allocator,
    thread_control,
    c->gcthreads, tracefile
  );
  collector->set_debug(c->debug_collections, c->report_gcstats);
  if(debug_driver)
    fprintf(stderr, "[flx_world: setup] Created ts collector %p\n", collector);

  // Create Collector Profile
  gcp = new flx::gc::generic::gc_profile_t(
    c->debug_driver,
    c->debug_allocations,
    c->debug_collections,
    c->report_collections,
    c->report_gcstats,
    c->allow_collection_anywhere,
    c->gc_freq,
    c->min_mem,
    c->max_mem,
    c->free_factor,
    c->finalise,
    collector
  );

  if(debug_driver)
    fprintf(stderr, "[flx_world: setup] Created gc profile object gcp=%p\n",gcp);

  library = c->link_library(c,gcp);
  collector->add_root (library);

  if(debug_driver)
    fprintf(stderr, "[flx_world: setup] Created library object %p\n", library);

  if (debug_driver)
  {
    fprintf(stderr, "[flx_world:setup] flx_run driver begins argv[0]=%s\n", c->flx_argv[0]);
    for (int i=1; i<argc-1; ++i)
      fprintf(stderr, "[flx_world:setup]                       argv[%d]=%s\n", i,c->flx_argv[i]);
  }

  // flx_libinst_t::create can run code, so add thread to avoid world_stop abort
  thread_control->add_thread(get_stack_pointer());

  // Create the usercode driver instance
  // NB: seems to destroy()ed in do_final_cleanup
  instance = new (*gcp, ::flx::dynlink::flx_libinst_ptr_map, false) ::flx::dynlink::flx_libinst_t(debug_driver);
  collector->add_root(instance);
  instance->create(
    library,
    gcp,
    this,
    c->flx_argc,
    c->flx_argv,
    stdin,
    stdout,
    stderr,
    debug_driver);

  thread_control->remove_thread();

  if (debug_driver) {
    fprintf(stderr, "[flx_world:setup] loaded library %s at %p\n", c->filename, library->library);
    fprintf(stderr, "[flx_world:setup] thread frame at %p\n", instance->thread_frame);
    fprintf(stderr, "[flx_world:setup] initial continuation at %p\n", instance->start_proc);
    fprintf(stderr, "[flx_world:setup] main continuation at %p\n", instance->main_proc);
    fprintf(stderr, "[flx_world:setup] creating async scheduler\n");
  }

  // FIXME: this doesn't belong in this subroutine
  // The above stuff sets universal variables
  // the below stuff sets variables that ONLY apply
  // to the mainline thread
  auto schedlist = run_felix_pthread_ctor(gcp, instance);

  async_scheduler = new (*gcp,async_sched_ptr_map,false) async_sched(
    this,
    debug_driver,
    gcp, schedlist,async_sched::mainline
    ); // deletes active for us!

  return 0;
}

// =================================================================
// flx_world : Explicit Destructor
// =================================================================
int flx_world::explicit_dtor()
{
  if (debug_driver)
    fprintf(stderr, "[explicit_dtor] entry\n");

  run_felix_pthread_dtor(debug_driver, gcp, library, instance);

  if (gcp->finalise)
  {
    if (debug_driver)
      fprintf(stderr, "[explicit_dtor] flx_run driver ends with finalisation complete\n");
  }
  else
  {
    if (debug_driver || gcp->debug_collections)
    {
      size_t a = gcp->collector->get_allocation_count();
      fprintf(stderr,
        "[explicit_dtor] flx_run driver ends with finalisation skipped, %zu uncollected "
          "objects\n", a);
    }
  }

  if (debug_driver)
    fprintf(stderr, "[explicit_dtor] exit 0\n");

  return 0;
}

// =================================================================
// flx_world : Teardown
//
// IRREVERSIBLY DESTROYS THE WORLD. Kills the allocator, collector,
// collector profile and thread control object.
// =================================================================
int flx_world::teardown() {
  if (debug_driver)
    fprintf(stderr, "[teardown] entry\n");

  collector->get_thread_control()->add_thread(get_stack_pointer());

  // could this override error_exit_code if something throws?
  int error_exit_code = explicit_dtor();
  if (debug_driver)
    fprintf(stderr,"[teardown] explicit dtor run code %d\n", error_exit_code);

  thread_control_base_t *thread_control = collector->get_thread_control();

  instance=0;
  library=0;
  if (debug_driver)
    fprintf(stderr,"[teardown] library & instance NULLED\n");

  // And we're done, so start cleaning up.
  delete gcp;

  delete collector;
  if (debug_driver)
    fprintf(stderr,"[teardown] collector deleted\n");

  delete allocator;
  if (debug_driver)
    fprintf(stderr,"[teardown] allocator deleted\n");

  if (debug_driver)
    fprintf(stderr, "[teardown] flx_run driver ends code=%d\n", error_exit_code);

  delete thread_control;  // RF: cautiously delete here
  if (debug_driver)
    fprintf(stderr,"[teardown] thread control deleted\n");
  return error_exit_code;
}

// =================================================================
// flx_world : Resume Felix
// =================================================================
void flx_world::begin_flx_code() {
  collector->get_thread_control() -> add_thread(get_stack_pointer());
}

// =================================================================
// flx_world :  Suspend Felix
// =================================================================
void flx_world::end_flx_code() {
  collector->get_thread_control()->remove_thread();
}


// =================================================================
// flx_world :  Run Felix Mainline
// =================================================================
int flx_world::run() {
  // this may not be called on the same thread, so let thread control know
  // when we exit, main thread is not running so pthreads can garbage collect without waiting for us

  try {
    return async_scheduler->prun();
  }
  catch (flx_exception_t &x) { return - flx_exception_handler (&x); }
  catch (std::exception &x) { return - std_exception_handler (&x); }
  catch (int &x) { fprintf (stderr, "Exception type int: %d\n", x); return -x; }
  catch (::std::string &x) { fprintf (stderr, "Exception type string : %s\n", x.c_str()); return -1; }
  catch (::flx::rtl::con_t &x) { fprintf (stderr, "Rogue continuatiuon caught\n"); return -6; }
  catch (...) { fprintf(stderr, "[flx_world:run_until_complete] Unknown exception in thread!\n"); return -5; }
}


// =================================================================
// flx_world :  Spawn fibre hook
// =================================================================
// TODO: factor into async_sched. run_felix_pthread_ctor does this twice
void flx_world::spawn_fthread(con_t *top) {
      fthread_t *ft = new (*gcp, _fthread_ptr_map, false) fthread_t(top);
  get_sync_scheduler()->push_front(ft);
}

// =================================================================
// flx_world :  External multiwrite hook
// =================================================================
void flx_world::external_multi_swrite (schannel_t *chan, void *data)
{
  async_scheduler->external_multi_swrite (chan,data);
}

// =================================================================
// flx_world :  Create Demux event polling system and thread
// =================================================================
async_hooker *flx_world::create_demux()
{
  if(debug_driver)
    fprintf(stderr,"[create_demux]: svc_general] trying to create async system..\n");

  if (c->ptr_create_async_hooker == NULL) {
    if(debug_driver)
      fprintf(stderr,"[create_demux: svc_general] trying to create async hooker..\n");
    c->init_ptr_create_async_hooker(c,debug_driver);
  }
  // Error out if we don't have the hooker function.
  if (c->ptr_create_async_hooker == NULL) {
    fprintf(stderr,
      "[create_demux: svc_general] Unable to initialise async I/O system: terminating\n");
    exit(1);
  }

  // CREATE A NEW ASYNCHRONOUS EVENT MANAGER
  // DONE ON DEMAND ONLY
  auto demux_hook = (*c->ptr_create_async_hooker)(
    gcp->collector->get_thread_control(), // thread_control object
    20000, // bound on resumable thread queue
    50,    // bound on general input job queue
    2,     // number of threads in job pool
    50,    // bound on async fileio job queue
    1      // number of threads doing async fileio
  );
  return demux_hook;
}


}} // namespaces

Package: src/packages/exceptions.fdoc

Felix RTL Exception Handling.

key file
flx_continuation.hpp share/lib/rtl/flx_continuation.hpp
flx_continuation.cpp share/src/exceptions/flx_continuation.cpp
flx_eh.hpp share/lib/rtl/flx_eh.hpp
flx_eh.cpp share/src/exceptions/flx_eh.cpp
flx_exceptions.hpp share/lib/rtl/flx_exceptions.hpp
flx_exceptions.cpp share/src/exceptions/flx_exceptions.cpp
flx_exceptions_config.hpp share/lib/rtl/flx_exceptions_config.hpp
flx_exceptions.py $PWD/buildsystem/flx_exceptions.py
unix_flx_exceptions.fpc $PWD/src/config/unix/flx_exceptions.fpc
win_flx_exceptions.fpc $PWD/src/config/win/flx_exceptions.fpc

Continuation

Needed here in the exceptions library because it can be thrown as an exception.

//[flx_continuation.hpp]
#ifndef _FLX_CONTINUATION_HPP
#define _FLX_CONTINUATION_HPP
#include "flx_exceptions_config.hpp"
#include "flx_compiler_support_headers.hpp"

// ********************************************************
/// CONTINUATION.
// ********************************************************

namespace flx {namespace rtl {
struct FLX_EXCEPTIONS_EXTERN con_t ///< abstract base for mutable continuations
{
  FLX_PC_DECL               ///< interior program counter
  union svc_req_t *p_svc;           ///< pointer to service request

  con_t();                  ///< initialise pc, p_svc to 0
  virtual con_t *resume()=0;///< method to perform a computational step
  virtual ~con_t();
  con_t * _caller;          ///< callers continuation (return address)
};
}} //namespaces
#endif

//[flx_continuation.cpp]
#include "flx_continuation.hpp"
namespace flx { namespace rtl {
// ********************************************************
// con_t implementation
// ********************************************************

con_t::con_t() : pc(0), p_svc(0), _caller(0) {
#if FLX_DEBUG_CONT
 fprintf(stderr,"Constructing %p\n",this);
#endif
}
con_t::~con_t(){
#if FLX_DEBUG_CONT
  fprintf(stderr,"Destroying %p\n",this);
#endif
}
}} // namespaces

Exceptions

Felix programs can throw a number of exceptions representing errors. Such exceptions cannot be handled. The Felix RTL catches these exceptions, displays a diagnostic, and then terminates the program.

Exceptions thrown in a thread should also terminate the program, that is, the whole containing process and any child processes if the OS supports that.

These exceptions are for fatal errors only.

Internally Felix may throw continuations to unwind the machine stack so that a long jump (non-local goto) can be executed in a top level procedure.

Exception handling is, however, supported in one very special case: it is allowed to directly wrap a C++ primitive function with a try/catch/entry construction. General Felix code can NOT be wrapped because procedures do not use the machine stack to retain continuations (return addresses).

In general C++ style dynamic exception handling is unsafe and should not be used.

//[flx_exceptions.hpp]
#ifndef __FLX_EXCEPTIONS_HPP__
#define __FLX_EXCEPTIONS_HPP__
#include "flx_exceptions_config.hpp"
#include <string>

namespace flx { namespace rtl {
// ********************************************************
// Standard C++ Exceptions
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_exception_t;
struct FLX_EXCEPTIONS_EXTERN flx_out_of_memory_t;
struct FLX_EXCEPTIONS_EXTERN flx_exec_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_range_srcref_t;
struct FLX_EXCEPTIONS_EXTERN flx_match_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_assert_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_assert2_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_axiom_check_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_switch_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_dead_frame_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_dropthru_failure_t;
struct FLX_EXCEPTIONS_EXTERN flx_link_failure_t;

// ********************************************************
/// EXCEPTION: Felix exception base abstraction.
/// Mainly used to convert catches into subroutine
/// calls which then dispatch on RTTI manually.
// ********************************************************


struct FLX_EXCEPTIONS_EXTERN flx_exception_t {
  virtual ~flx_exception_t()=0;
};

// ********************************************************
/// EXCEPTION: Out of Memory.
/// Thrown when out of memory or memory bound exceeded.
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_out_of_memory_t : flx_exception_t {
  flx_out_of_memory_t();
  virtual ~flx_out_of_memory_t();
};

// ********************************************************
/// EXCEPTION: EXEC protocol failure.
/// Thrown when trying to run a dead procedure
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_exec_failure_t : flx_exception_t {
  ::std::string filename;  ///< dll filename
  ::std::string operation; ///< faulty operation
  ::std::string what;      ///< error description
  flx_exec_failure_t(::std::string f, ::std::string o, ::std::string w);
  virtual ~flx_exec_failure_t();
};

// ********************************************************
/// SOURCE REFERENCE: to track places in user source code.
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_range_srcref_t {
  char const *filename;  ///< source file name
  int startline;   ///< first line (1 origin)
  int startcol;    ///< first column (1 origin)
  int endline;     ///< last line
  int endcol;      ///< last column
  flx_range_srcref_t(char const *f,int sl, int sc, int el, int ec);
  flx_range_srcref_t();
};

// ********************************************************
/// EXCEPTION: HALT.
/// Thrown by halt command
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_halt_t : flx_exception_t {
  ::std::string reason;         ///< halt argument
  flx_range_srcref_t flx_loc; ///< location in Felix file
  char const *cxx_srcfile;          ///< C++ file name
  int cxx_srcline;            ///< C++ line number
  flx_halt_t(flx_range_srcref_t ff, char const *cf, int cl, ::std::string reason);
  virtual ~flx_halt_t();
};

// ********************************************************
/// EXCEPTION: MATCH failure.
/// Thrown when no match cases match the argument of a match,
/// regmatch, or reglex
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_match_failure_t : flx_exception_t {
  flx_range_srcref_t flx_loc; ///< location in Felix file
  char const *cxx_srcfile;          ///< C++ file name
  int cxx_srcline;            ///< C++ line number
  flx_match_failure_t(flx_range_srcref_t ff, char const *cf, int cl);
  virtual ~flx_match_failure_t();
};

// ********************************************************
/// EXCEPTION: DROPTHRU failure.
/// Thrown when function drops off end without returning value
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_dropthru_failure_t : flx_exception_t {
  flx_range_srcref_t flx_loc; ///< location in Felix file
  char const *cxx_srcfile;          ///< C++ file name
  int cxx_srcline;            ///< C++ line number
  flx_dropthru_failure_t(flx_range_srcref_t ff, char const *cf, int cl);
  virtual ~flx_dropthru_failure_t();
};

// ********************************************************
/// EXCEPTION: ASSERT failure.
/// Thrown when user assertion fails
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_assert_failure_t : flx_exception_t {
  flx_range_srcref_t flx_loc; ///< location in Felix file
  char const *cxx_srcfile;          ///< C++ file
  int cxx_srcline;            ///< __LINE__ macro
  flx_assert_failure_t(flx_range_srcref_t ff, char const *cf, int cl);
  virtual ~flx_assert_failure_t();
};

struct FLX_EXCEPTIONS_EXTERN flx_assert2_failure_t : flx_exception_t {
  flx_range_srcref_t flx_loc; ///< location in Felix file
  flx_range_srcref_t flx_loc2; ///< second location in Felix file
  char const *cxx_srcfile;          ///< C++ file
  int cxx_srcline;            ///< __LINE__ macro
  flx_assert2_failure_t(flx_range_srcref_t ff, flx_range_srcref_t ff2, char const *cf, int cl);
  virtual ~flx_assert2_failure_t();
};

struct FLX_EXCEPTIONS_EXTERN flx_axiom_check_failure_t : flx_exception_t {
  flx_range_srcref_t flx_loc; ///< location in Felix file
  flx_range_srcref_t flx_loc2; ///< second location in Felix file
  char const *cxx_srcfile;          ///< C++ file
  int cxx_srcline;            ///< __LINE__ macro
  flx_axiom_check_failure_t (flx_range_srcref_t ff, flx_range_srcref_t ff2, char const *cf, int cl);
  virtual ~flx_axiom_check_failure_t ();
};

// ********************************************************
/// EXCEPTION: RANGE failure.
/// Thrown when a range check fails
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_range_failure_t : flx_exception_t {
  long min; long v; long max;
  flx_range_srcref_t flx_loc; ///< location in Felix file
  char const *cxx_srcfile;          ///< C++ file
  int cxx_srcline;            ///< __LINE__ macro
  flx_range_failure_t(long,long,long,flx_range_srcref_t ff, char const *cf, int cl);
  virtual ~flx_range_failure_t();
};

FLX_EXCEPTIONS_EXTERN long range_check (long l, long x, long h, flx_range_srcref_t sref, char const *cf, int cl);
FLX_EXCEPTIONS_EXTERN void print_loc(FILE *ef,flx_range_srcref_t x,char const *cf, int cl);
FLX_EXCEPTIONS_EXTERN void print_cxxloc(FILE *ef,char const *cf, int cl);


// ********************************************************
/// EXCEPTION: SWITCH failure. this is a system failure!
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_switch_failure_t : flx_exception_t {
  char const *cxx_srcfile;          ///< C++ file
  int cxx_srcline;            ///< __LINE__ macro
  flx_switch_failure_t(char const *cf, int cl);
  virtual ~flx_switch_failure_t();
};


// ********************************************************
/// EXCEPTION: DEAD FRAME failure.
/// Thrown on attempt to resume already returned procedure frame.
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_dead_frame_failure_t : flx_exception_t {
  char const *cxx_srcfile;          ///< C++ file
  int cxx_srcline;            ///< __LINE__ macro
  flx_dead_frame_failure_t(char const *cf, int cl);
  virtual ~flx_dead_frame_failure_t();
};


// ********************************************************
/// EXCEPTION: DYNAMIC LINKAGE failure. this is a system failure!
// ********************************************************

struct FLX_EXCEPTIONS_EXTERN flx_link_failure_t : flx_exception_t {
  ::std::string filename;
  ::std::string operation;
  ::std::string what;
  flx_link_failure_t(::std::string f, ::std::string o, ::std::string w);
  flx_link_failure_t(); // unfortunately this one requires a default ctor.
  virtual ~flx_link_failure_t();
};

}}
#endif

//[flx_exceptions.cpp]
#include <stdio.h>

#include "flx_exceptions.hpp"

namespace flx { namespace rtl {
// ********************************************************
// standard exceptions -- implementation
// ********************************************************
flx_exception_t::~flx_exception_t(){}

flx_exec_failure_t::flx_exec_failure_t(::std::string f, ::std::string o, ::std::string w) :
  filename(f),
  operation(o),
  what(w)
{}

flx_out_of_memory_t::flx_out_of_memory_t(){}
flx_out_of_memory_t::~flx_out_of_memory_t(){}
flx_exec_failure_t::~flx_exec_failure_t(){}

flx_range_srcref_t::flx_range_srcref_t() :
    filename(""),startline(0),startcol(0),endline(0),endcol(0){}
flx_range_srcref_t::flx_range_srcref_t(char const *f,int sl, int sc, int el, int ec) :
    filename(f),startline(sl),startcol(sc),endline(el),endcol(ec){}

flx_halt_t::flx_halt_t(flx_range_srcref_t ff, char const *cf, int cl, ::std::string r) :
   reason(r), flx_loc(ff), cxx_srcfile(cf), cxx_srcline(cl) {}
flx_halt_t::~flx_halt_t(){}

flx_match_failure_t::flx_match_failure_t(flx_range_srcref_t ff, char const *cf, int cl) :
   flx_loc(ff), cxx_srcfile(cf), cxx_srcline(cl) {}
flx_match_failure_t::~flx_match_failure_t(){}

flx_dropthru_failure_t::flx_dropthru_failure_t(flx_range_srcref_t ff, char const *cf, int cl) :
   flx_loc(ff), cxx_srcfile(cf), cxx_srcline(cl) {}
flx_dropthru_failure_t::~flx_dropthru_failure_t(){}

flx_assert_failure_t::flx_assert_failure_t(flx_range_srcref_t ff, char const *cf, int cl) :
   flx_loc(ff), cxx_srcfile(cf), cxx_srcline(cl) {}
flx_assert_failure_t::~flx_assert_failure_t(){}

flx_assert2_failure_t::flx_assert2_failure_t(flx_range_srcref_t ff, flx_range_srcref_t ff2, char const *cf, int cl) :
   flx_loc(ff), flx_loc2(ff2), cxx_srcfile(cf), cxx_srcline(cl) {}
flx_assert2_failure_t::~flx_assert2_failure_t(){}

flx_axiom_check_failure_t::flx_axiom_check_failure_t(flx_range_srcref_t ff, flx_range_srcref_t ff2, char const *cf, int cl) :
   flx_loc(ff), flx_loc2(ff2), cxx_srcfile(cf), cxx_srcline(cl) {}
flx_axiom_check_failure_t::~flx_axiom_check_failure_t(){}

flx_range_failure_t::flx_range_failure_t(long l, long x, long h, flx_range_srcref_t ff, char const *cf, int cl) :
   min(l), v(x), max(h), flx_loc(ff), cxx_srcfile(cf), cxx_srcline(cl) {}
flx_range_failure_t::~flx_range_failure_t(){}

flx_switch_failure_t::~flx_switch_failure_t(){}
flx_switch_failure_t::flx_switch_failure_t (char const *cf, int cl) :
  cxx_srcfile(cf), cxx_srcline (cl) {}

flx_dead_frame_failure_t::~flx_dead_frame_failure_t(){}
flx_dead_frame_failure_t::flx_dead_frame_failure_t(char const *cf, int cl) :
  cxx_srcfile(cf), cxx_srcline (cl) {}


flx_link_failure_t::flx_link_failure_t(::std::string f, ::std::string o, ::std::string w) :
  filename(f),
  operation(o),
  what(w)
{}

flx_link_failure_t::~flx_link_failure_t(){}
flx_link_failure_t::flx_link_failure_t(){}


long range_check (long l, long x, long h, flx_range_srcref_t sref, char const *cf, int cl)
{
  if (x>=l && x<h) return x;
  throw flx::rtl::flx_range_failure_t (l,x,h,sref,cf,cl);
}

void print_cxxloc(FILE *ef,char const *cf, int cl)
{
  fprintf(ef,"C++ location  : %s %d\n", cf, cl);
}

void print_loc(FILE *ef,flx_range_srcref_t x,char const *cf, int cl)
{
  fprintf(ef,"Felix location: %s %d[%d]-%d[%d]\n",
    x.filename,
    x.startline,
    x.startcol,
    x.endline,
    x.endcol
  );
  fprintf(ef,"C++ location  : %s %d\n", cf, cl);
}

}}

Handling Exceptions

These exception handlers are called with standard C++ exceptions or Felix exceptions, decoded as best as possible, an error message printed, and the program terminated.

Note that at the time of writing, exception decoding does not work when using clang 3.3 and the exception is thrown across a DLL boundary. This is a bug in clang handling dynamic_casts across DLL boundaries. Gcc does not have this bug.

//[flx_eh.hpp]
#ifndef __FLX_EH_H__
#define __FLX_EH_H__
#include "flx_rtl_config.hpp"
#include "flx_exceptions.hpp"

namespace flx { namespace rtl {
int FLX_EXCEPTIONS_EXTERN std_exception_handler (::std::exception const *e);
int FLX_EXCEPTIONS_EXTERN flx_exception_handler (::flx::rtl::flx_exception_t const *e);
}}

#endif

//[flx_eh.cpp]
#include <stdio.h>
#include "flx_exceptions.hpp"
#include "flx_eh.hpp"
using namespace ::flx::rtl;


int ::flx::rtl::std_exception_handler (::std::exception const *e)
{
  fprintf(stderr,"C++ STANDARD EXCEPTION %s\n",e->what());
  return 4;
}

int ::flx::rtl::flx_exception_handler (flx_exception_t const *e)
{
fprintf(stderr, "Felix exception handler\n");
  if (flx_halt_t const *x = dynamic_cast<flx_halt_t const*>(e))
  {
    fprintf(stderr,"Halt: %s \n",x->reason.data());
    print_loc(stderr,x->flx_loc,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  if (flx_link_failure_t const *x = dynamic_cast<flx_link_failure_t const*>(e))
  {
    fprintf(stderr,"Dynamic linkage error\n");
    fprintf(stderr,"filename: %s\n",x->filename.data());
    fprintf(stderr,"operation: %s\n",x->operation.data());
    fprintf(stderr,"what: %s\n",x->what.data());
    return 3;
  }
  else
  if (flx_exec_failure_t const *x = dynamic_cast<flx_exec_failure_t const*>(e))
  {
    fprintf(stderr,"Execution error\n");
    fprintf(stderr,"filename: %s\n",x->filename.data());
    fprintf(stderr,"operation: %s\n",x->operation.data());
    fprintf(stderr,"what: %s\n",x->what.data());
    return 3;
  }
  else
  if (flx_assert_failure_t const *x = dynamic_cast<flx_assert_failure_t const*>(e))
  {
    fprintf(stderr,"Assertion Failure\n");
    print_loc(stderr,x->flx_loc,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  else
  if (flx_assert2_failure_t const *x = dynamic_cast<flx_assert2_failure_t const*>(e))
  {
    fprintf(stderr,"Assertion2 Failure\n");
    print_loc(stderr,x->flx_loc,x->cxx_srcfile, x->cxx_srcline);
    print_loc(stderr,x->flx_loc2,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  if (flx_axiom_check_failure_t const *x = dynamic_cast<flx_axiom_check_failure_t const*>(e))
  {
    fprintf(stderr,"Axiom Check Failure\n");
    print_loc(stderr,x->flx_loc,x->cxx_srcfile, x->cxx_srcline);
    print_loc(stderr,x->flx_loc2,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  else
  if (flx_match_failure_t const *x = dynamic_cast<flx_match_failure_t const*>(e))
  {
    fprintf(stderr,"Match Failure\n");
    print_loc(stderr,x->flx_loc,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  else
  if (flx_switch_failure_t const *x = dynamic_cast<flx_switch_failure_t const*>(e))
  {
    fprintf(stderr,"Attempt to switch to non-existant case\n");
    print_cxxloc(stderr,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  if (flx_dead_frame_failure_t const *x = dynamic_cast<flx_dead_frame_failure_t const*>(e))
  {
    fprintf(stderr,"Attempt to resume non-live procedure frame\n");
    print_cxxloc(stderr,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  else
  if (flx_dropthru_failure_t const *x = dynamic_cast<flx_dropthru_failure_t const*>(e))
  {
    fprintf(stderr,"Function Drops Off End Failure\n");
    print_loc(stderr,x->flx_loc,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  else
  if (flx_range_failure_t const *x = dynamic_cast<flx_range_failure_t const*>(e))
  {
    fprintf(stderr,"Range Check Failure %ld <= %ld < %ld\n",x->min, x->v,x->max);
    print_loc(stderr,x->flx_loc,x->cxx_srcfile, x->cxx_srcline);
    return 3;
  }
  else
  if (dynamic_cast<flx_out_of_memory_t const*>(e))
  {
    fprintf(stderr,"Felix Out of Malloc or Specified Max allocation Exceeded");
    return 3;
  }
  else
  {
    fprintf(stderr,"Unknown Felix EXCEPTION!\n");
    return 5;
  }
}

//[flx_exceptions_config.hpp]
#ifndef __FLX_EXCEPTIONS_CONFIG_H__
#define __FLX_EXCEPTIONS_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_FLX_EXCEPTIONS
#define FLX_EXCEPTIONS_EXTERN FLX_EXPORT
#else
#define FLX_EXCEPTIONS_EXTERN FLX_IMPORT
#endif
#endif

//[unix_flx_exceptions.fpc]
Name: flx_exceptions
Description: Felix exceptions
provides_dlib: -lflx_exceptions_dynamic
provides_slib: -lflx_exceptions_static
library: flx_exceptions
macros: BUILD_FLX_EXCEPTIONS
includes: '"flx_exceptions.hpp"'
srcdir: src/exceptions
src: .*\.cpp

//[win_flx_exceptions.fpc]
Name: flx
Description: Felix exceptions
provides_dlib: /DEFAULTLIB:flx_exceptions_dynamic
provides_slib: /DEFAULTLIB:flx_exceptions_static
library: flx_exceptions
macros: BUILD_FLX_EXCEPTIONS
includes: '"flx_exceptions.hpp"'
srcdir: src/exceptions
src: .*\.cpp

#[flx_exceptions.py]
import fbuild
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    print('[fbuild] [rtl] build exceptions')
    path = Path(phase.ctx.buildroot/'share'/'src/exceptions')

    srcs = [
     path / 'flx_continuation.cpp',
     path / 'flx_exceptions.cpp',
     path / 'flx_eh.cpp',
     ]
    includes = [phase.ctx.buildroot / 'host/lib/rtl', phase.ctx.buildroot / 'share/lib/rtl']
    macros = ['BUILD_FLX_EXCEPTIONS']

    dst = 'host/lib/rtl/flx_exceptions'
    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros))

Package: src/packages/faio.fdoc

Faio: Felix Async I/O support

key file
faio_drv.hpp share/src/faio/faio_drv.hpp
faio_posixio.hpp share/lib/rtl/faio_posixio.hpp
faio_posixio.cpp share/src/faio/faio_posixio.cpp
faio_winio.hpp share/lib/rtl/faio_winio.hpp
faio_winio.cpp share/src/faio/faio_winio.cpp
faio_timer.hpp share/lib/rtl/faio_timer.hpp
faio_timer.cpp share/src/faio/faio_timer.cpp
faio.py $PWD/buildsystem/faio.py
timer.fpc $PWD/src/config/timer.fpc
unix_faio.fpc $PWD/src/config/unix/faio.fpc
win_faio.fpc $PWD/src/config/win/faio.fpc
flx_faio_config.hpp share/lib/rtl/flx_faio_config.hpp

Faio Driver

//[faio_drv.hpp]
#ifndef __FLX_FAIO_DRV_H__
#define __FLX_FAIO_DRV_H__
#include <flx_faio_config.hpp>

#include "pthread_bound_queue.hpp"
#include "demux_timer_queue.hpp"
#include "demux_demuxer.hpp"

namespace flx { namespace faio {

// this may be needed but I've lost track of where
// we get SIGPIPE, SIG_IGN from ..

#if 0
void FAIO_EXTERN sigpipe_ignorer()
{
    void (*prev_handler)(int);  // solaris is FUN.
    prev_handler = signal(SIGPIPE, SIG_IGN);

    if(SIG_ERR == prev_handler)
    {
        fprintf(stderr, "failed to install SIGPIPE ignorer\n");
        throw -1;
    }
    else if(prev_handler != SIG_IGN && prev_handler != SIG_DFL)
    {
        fprintf(stderr,"warning: blew away prev SIGPIPE handler: %p\n",
            prev_handler);
    }
}
#endif

}}
#endif

Faio I/O

//[faio_posixio.hpp]
#ifndef __FLX_FAIO_POSIXIO_H__
#define __FLX_FAIO_POSIXIO_H__
#include <flx_faio_config.hpp>

#include "flx_async.hpp"

// we don't need to piggyback much data at all. for now just the demuxer,
// so that we can be woken up, and the buffer info (this replaces the
// felix "socket" thread type, which was ugly.

#include "demux_posix_demuxer.hpp"
#include "demux_timer_queue.hpp"

namespace flx { namespace faio {

class FAIO_EXTERN socketio_wakeup : public demux::socket_wakeup {
public:
  demux::sel_param   pb;     // in: what you want, out: what you get
  int       sio_flags;  // either one of PDEMUX_{READ|WRITE}A
  class socketio_request *request;

  virtual void wakeup(demux::posix_demuxer& demux);
};

// this can handle most unix style io, that is, read & write on sockets,
// files & pipes. NICE. the fact that the socket is now in here may mean
// I can get rid of the epoll hack
// Not sure if this can be used for file fds.
class FAIO_EXTERN socketio_request : public ::flx::async::flx_driver_request_base {
public:
    socketio_wakeup sv;
    demux::posix_demuxer *pd;
    socketio_request() {}       // Lord Felix demands it. Like STL.
    socketio_request(socketio_request const&);
    void operator = (socketio_request const&);

    socketio_request(demux::posix_demuxer *pd_a, int s, char* buf, long len, bool r);
    bool start_async_op_impl();
};

// client open
class FAIO_EXTERN connect_request
  : public ::flx::async::flx_driver_request_base, public demux::connect_control_block {
public:
  demux::posix_demuxer *pd;
  connect_request() {}      // flx linkage

  connect_request(demux::posix_demuxer *pd_a,const char* addr, int port);
  bool start_async_op_impl();
  virtual void wakeup(demux::posix_demuxer&);
};

// server open
class FAIO_EXTERN accept_request
  : public ::flx::async::flx_driver_request_base, public demux::accept_control_block {
public:
  // we sometimes know that there'll be several connections to accept.
  // this'll need a different wakeup - and a different interface between
  // event source & wakeups

  demux::posix_demuxer *pd;
  accept_request() {} // flx linkage

  // eeh, give that a better name
  accept_request(demux::posix_demuxer *pd_a, int listener) : pd(pd_a) { s = listener; }

  // from flx_driver_request_base
  bool start_async_op_impl();

  // from accept_control_block
  virtual void wakeup(demux::posix_demuxer& demux);
};

}}
#endif

//[faio_posixio.cpp]
#include <stdio.h>      // printf
#include "faio_posixio.hpp"
#include "demux_sockety.hpp"    // async_connect

#include <sys/types.h>  // getsockopt & co
#include <sys/socket.h>

#include <unistd.h>     // close
#include <string.h>     // strerror - probably not portable
#include <assert.h>

using namespace flx::demux;
namespace flx { namespace faio {

connect_request::connect_request(demux::posix_demuxer *pd_a,const char* addr, int port) :pd(pd_a) { addy = addr; p = port; s=-1; }

socketio_request::socketio_request(demux::posix_demuxer *pd_a, int s, char* buf, long len, bool read)
: pd(pd_a)
{
  //fprintf(stderr,"socketio_request %p making socketio_wakeup for socket %d\n",this,s);
  sv.s = s;
  sv.request = this;
  // demux supports reading AND writing. We don't. Yet.
  sv.sio_flags = ((read) ? PDEMUX_READ : PDEMUX_WRITE);

  sv.pb.buffer = buf;
  sv.pb.buffer_size = len;
  sv.pb.bytes_written = 0;        // really bytes_processed
}

socketio_request::socketio_request(socketio_request const &a) : pd(a.pd)
{
  //fprintf(stderr, "copying socketio_request to %p\n",this);
  sv = a.sv;
  sv.request = this;
}

// EXTREME HACKERY!
void socketio_request::operator=(socketio_request const &a)
{
  //fprintf(stderr, "assigning socketio_request to %p\n",this);

  flx_driver_request_base::operator=(a);
  sv = a.sv;
  sv.request = this;
  pd = a.pd;
}

bool
socketio_request::start_async_op_impl()
{
  //fprintf(stderr,"socketio_request: socket %d start async_op_impl %p\n",sv.s,this);
  // fprintf(stderr, "adding wakeup: len %i, done %i\n",
  //   sv.pb.buffer_size, sv.pb.bytes_written);

  if(sv.s == -1) {
    fprintf(stderr, "Attempt to start_async_op on socket -1\n");
    exit(1);
  }

  // wake thread if call failed
  bool failed = (pd->add_socket_wakeup(&sv, sv.sio_flags) == -1);
  if (failed)
    fprintf(stderr,"socketio_request FAILED %p, sock=%d, dir=%d\n",this, sv.s, sv.sio_flags);
  //else
  //  fprintf(stderr,"socketio_request OK %p\n",this);
  return failed;
}


void
socketio_wakeup::wakeup(posix_demuxer& demux)
{
  //fprintf(stderr, "Wakeup, socket = %d\n",s);
  // handle read/write, return true if not finished.
  // otherwise wakeup return false.
  bool  connection_closed;

  //fprintf(stderr, "making socketio_wakeup %p\n",this);
  //fprintf(stderr,"prehandle wakeup, this: %p, read: %i, len: %i, done %i\n",
  //  this, read, pb.buffer_size, pb.bytes_written);

  // NOTE: this code does not handle the possibility of both read AND
  // write being set. That would require thinking about the what
  // the connect_closed return value meant. In any case, we don't
  // do that stuff here yet.

  if(wakeup_flags & PDEMUX_ERROR)
  {
    connection_closed = true;
    //pb.bytes_written=0;
    fprintf(stderr,"posix faio wakeup PDEMUX_ERROR, connection closed = %d\n", connection_closed);
  }

  else if(wakeup_flags & PDEMUX_EOF)
  {
    connection_closed = true;
    fprintf(stderr,"posix faio wakeup PDEMUX_EOF, connection closed = %d\n", connection_closed);
    //pb.bytes_written=0;
  }

  else if(wakeup_flags & PDEMUX_READ)
  {
    // just check that our above assumption hasn't been violated.
    assert(wakeup_flags == PDEMUX_READ);
    //fprintf(stderr,"posix faio wakeup PDEMUX_READ, reading..\n");
    connection_closed = posix_demuxer::socket_recv(s, &pb);
    //fprintf(stderr,"posix faio wakeup PDEMUX_READ, connection closed = %d\n", connection_closed);
  }
  else
  {
    // never hurts to be paranoid.
    assert(wakeup_flags == PDEMUX_WRITE);
    //fprintf(stderr,"posix faio wakeup PDEMUX_WRITE, writing..\n");
    connection_closed = posix_demuxer::socket_send(s, &pb);
    //if(connection_closed)
    //  fprintf(stderr,"posix faio wakeup PDEMUX_WRITE, connection closed = %d\n", connection_closed);
  }

  // fprintf(stderr,"posthandle wakeup, this: %p, read: %i, len: %i, done %i\n",
  //  this, read, pb.buffer_size, pb.bytes_written);
  // fprintf(stderr,"wakeup of %p, closed = %i\n", this, connection_closed);

  // wake up: time to process some data
  if(connection_closed || pb.bytes_written == pb.buffer_size)
  {
    // fprintf(stderr,"schedding %p, drv: %p, f: %p\n", this, drv, f);
    // if the connection closed, this notify should tell the caller
    // not to keep trying to write, but it doesn't .. why not?
    // who called it anyhow?
    // I think the writing code ignores error returns ..
    request->notify_finished();
    return;
  }

  // fprintf(stderr,"not schedding %p\n", this);
  fprintf(stderr, "Incomplete request on %d, waiting for more I/O\n",s);
  if(demux.add_socket_wakeup(this, sio_flags) == -1)
  fprintf(stderr,"failed to re-add_socket_wakeup\n");
}

// asynchronous connect
bool
connect_request::start_async_op_impl()
{
  //fprintf(stderr,"connect_request %p: start async_op_impl\n",this);

  // call failed or finished (!), wake up thread as no wakeup coming
  if(start(*pd) == -1) {
    fprintf(stderr, "FAILED TO SPAWN CONNECT REQUEST\n");
    return true;
  }

  // NONONONONO! Referring to this's variables after a successful start
  // gives rise to a race condition, which is bad.
  //fprintf(stderr, "CONNECT REQUEST SPAWNED\n");
  return false;     // do not reschedule after a successful start

/*
  // I've not seen this yet, don't know why.
  if(0 == socket_err) fprintf(stderr, "WOW, instant CONNECT\n");

  // call didn't fail, could be pending or finished.
  // return socket_err != EINPROGRESS, the contrapositive, sort of
  return 0 == socket_err;   // no err => finished immediately
*/
}

void
connect_request::wakeup(posix_demuxer& demux)
{
  //fprintf(stderr, "connect_request::wakeup\n");

  // fprintf(stderr,"connect woke up\n");
  connect_control_block::wakeup(demux);

  // felix thread can pick out error itself.
  notify_finished();
}


// async accept
bool
accept_request::start_async_op_impl()
{
  //fprintf(stderr,"accept_request %p: start async_op_impl\n",this);
  bool failed = (start(*pd) == -1);      // accept_control_block function
  if(failed)
    fprintf(stderr, "FAILED TO SPAWN ACCEPT REQUEST\n");
  //else
  //  fprintf(stderr, "ACCEPT REQUEST SPAWNED\n");
  return failed;
}

void
accept_request::wakeup(posix_demuxer& demux)
{
  // does the leg work.
  accept_control_block::wakeup(demux);
  //'fprintf(stderr, "faio_posix::accept_request::wakeup\n");

  if(accepted == -1)
  {
    // I don't know if this is a good idea...
    fprintf(stderr, "accept request failed (%i), retrying...\n",
      socket_err);
    // didn't get it - go back to sleep
    if(start(demux) == -1)
      fprintf(stderr, "failed again... probably was a bad idea\n");
    return;
  }

  notify_finished();
}

}}

//[faio_winio.hpp]
#ifndef __FLX_FAIO_WINIO_H__
#define __FLX_FAIO_WINIO_H__
#include <flx_faio_config.hpp>

// visual studio is quite sensitve about how you do these includes.
// THIS is the way (WinSock2.h must include Windows.h).
#include <WinSock2.h>
#include <MSWSock.h>        // AcceptEx, TF_REUSE_SOCKET, etc

#include "flx_async.hpp"
#include "demux_overlapped.hpp"   // nicely wrapped async windows calls

namespace flx { namespace faio {

// interestingly, because in windows the async objects are associated
// with an IOCP before their use, we don't actually need a demuxer here
// at all. That's kind of nice. (actually iocp_associator uses it now)

// a flx driver request to the add socket s to the drivers iocp
// this is currently the only windows driver request that uses the demuxer.
class FAIO_EXTERN iocp_associator : public ::flx::async::flx_driver_request_base {
  SOCKET  s;
public:
  demux::iocp_demuxer *iod;
  // should have result & errcode
  iocp_associator() : iod(0) {} // shouldn't this also set s?
  iocp_associator(demux::iocp_demuxer *iod_a, SOCKET associatee)
  : s(associatee), iod(iod_a) {}

  bool start_async_op_impl();
};

// flx <-> c++ stuff for async io (well, it was)

// transition to new windows async control block
class FAIO_EXTERN waio_base : public ::flx::async::flx_driver_request_base {
protected:
  ::flx::async::finote_t *fn_a;
public:
  demux::iocp_demuxer *iod;
  bool  success;          // eh?

  waio_base() : iod(0), success(false) {}
  waio_base(demux::iocp_demuxer *iod_a) : iod(iod_a), success(false) {}

  // actually wakes up thread
  virtual void iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
    LPOVERLAPPED olp, int err);
};


// listener socket must be already associated with an IOCP
// in doing an AcceptEx, it might succeed immediately - do you still
// get the IOCP wakeup?
class FAIO_EXTERN wasync_accept
  : public waio_base, public demux::acceptex_control_block
{
public:
  wasync_accept() {}  // felix linkage demands it

  wasync_accept(demux::iocp_demuxer *iod_a,SOCKET l, SOCKET a) : waio_base(iod_a) { listener = l; acceptor = a; }

  bool start_async_op_impl();

  virtual void iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
    LPOVERLAPPED olp, int err);
};

class FAIO_EXTERN connect_ex
  : public waio_base, public demux::connectex_control_block
{
public:

  connect_ex() {}     // flx linkage

  connect_ex(demux::iocp_demuxer *iod_a,SOCKET soc, const char* addr, int port)
    : waio_base(iod_a) { s = soc; addy = addr; p = port; }

  bool start_async_op_impl();

  virtual void iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
    LPOVERLAPPED olp, int err);
};

// TransmitFile here (requires file handle)
class FAIO_EXTERN wasync_transmit_file
  : public waio_base, public demux::transmitfile_control_block
{
public:
  wasync_transmit_file()
    : waio_base(0), transmitfile_control_block(INVALID_SOCKET, NULL) {}   // flx linkage

  wasync_transmit_file(demux::iocp_demuxer *iod_a,SOCKET dst)      // for reuse of socket
    : waio_base(iod_a), transmitfile_control_block(dst) {}

  wasync_transmit_file(demux::iocp_demuxer *iod_a,SOCKET dst, HANDLE src)  // actual transmitfile
    : waio_base(iod_a), transmitfile_control_block(dst, src) {}

  // from flx_request_base
  bool start_async_op_impl();

  virtual void iocp_op_finished(DWORD nbytes, ULONG_PTR udat,
    LPOVERLAPPED olp, int err);
};

// handles both WSASend & WSARecv
class FAIO_EXTERN wsa_socketio
  : public waio_base, public demux::wsasocketio_control_block
{
public:
  wsa_socketio()
    : wsasocketio_control_block(INVALID_SOCKET, NULL, false) {}

  wsa_socketio(demux::iocp_demuxer *iod_a,SOCKET src, demux::sel_param* ppb, bool read)
    : waio_base(iod_a), wsasocketio_control_block(src, ppb, read) {}

  bool start_async_op_impl();

  virtual void iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
    LPOVERLAPPED olp, int err);
};


}}
#endif  // __DWINIO__

//[faio_winio.cpp]
#include "faio_winio.hpp"
#include <stdio.h>      // printf

using namespace flx::demux;
namespace flx { namespace faio {

// way of adding sockets to the IOCP.
bool
iocp_associator::start_async_op_impl()
{
  //fprintf(stderr,"iocp_associator: start async_op_impl\n");

  // nasty: note how I'm making the user cookie constant (0).
  if(iod->associate_with_iocp((HANDLE)s, 0) != 0)
    fprintf(stderr,"associate request failed - get result here!\n");

  return true;      // wake caller
}

void
waio_base::iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
  LPOVERLAPPED olp, int err)
{
  // fprintf(stderr,"general wakeup thing - rescheduling\n");
  //fprintf(stderr,"this: %p, q: %p, f: %p, err: %i\n", this, q, f, err);

  // this tells us when things went wrong (store it)
  if(NO_ERROR != err)
    fprintf(stderr,"catchall wakeup got error: %i (should store it)\n", err);

  success = (NO_ERROR == err);  // this works pretty well
  notify_finished();
}

bool
wasync_accept::start_async_op_impl()
{
  //fprintf(stderr,"wasync_accept: start async_op_impl\n");
  return start_overlapped();
}

void
wasync_accept::iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
  LPOVERLAPPED olp, int err)
{
  waio_base::iocp_op_finished(nbytes, udat, olp, err);
}


bool
connect_ex::start_async_op_impl()
{
  //fprintf(stderr,"connect_ex: start async_op_impl\n");
  return start_overlapped();
}

void
connect_ex::iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
  LPOVERLAPPED olp, int err)
{
  waio_base::iocp_op_finished(nbytes, udat, olp, err);
}


bool
wasync_transmit_file::start_async_op_impl()
{
  //fprintf(stderr,"wasync_transmit_file: start async_op_impl\n");
  return start_overlapped();
}

void
wasync_transmit_file::iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
  LPOVERLAPPED olp, int err)
{
  waio_base::iocp_op_finished(nbytes, udat, olp, err);
}

bool
wsa_socketio::start_async_op_impl()
{
  //fprintf(stderr,"wsa_socketio: start async_op_impl\n");
  return start_overlapped();    // start overlapped op
}

// this could be factored into demux... or it might need
// to stay here... this is really a finished that isn't finished
// same goes for winfileio (I think)
void
wsa_socketio::iocp_op_finished( DWORD nbytes, ULONG_PTR udat,
  LPOVERLAPPED olp, int err)
{
  // fprintf(stderr,"wsa_socketio wakeup, nb: %li, err: %i\n", nbytes, err );
// Doing the handling myself - this can restart the the op giving us
// a possible race condition... or not? It should be sync with this call.
  // wsasocketio_control_block::iocp_op_finished(nbytes, udat, olp, err);

  ppb->bytes_written += nbytes;

  // if we're not finished, we have to reinstall our request
  // zero bytes indicates shutdown/closure, right?
  // might be using this for WSASend. Instead of broken pipes on win32,
  // instead we get WSAECONNRESET (pretty sure) on write. On read?
  if(0 == nbytes || ppb->finished())
  {
    // this'll wake us up
    waio_base::iocp_op_finished(nbytes, udat, olp, err);
  }
  else
  {
    // go back around again
    // this returns a finished flag (bad idea). it can also fail.
    // I think it would be better to know that.
    if(start_overlapped())
      fprintf(stderr, "socketio restart finished! WHAT TO DO!?!\n");
  }
}

}}

Faio Timer

//[faio_timer.hpp]
#ifndef __FLX_FAIO_TIMER_H__
#define __FLX_FAIO_TIMER_H__
#include <flx_faio_config.hpp>

#include "demux_demuxer.hpp"        // sel_param, demuxer base
#include "flx_async.hpp"
#include "demux_timer_queue.hpp"

#include "flx_rtl.hpp"

namespace flx { namespace faio {


// sleeping
class FAIO_EXTERN sleep_request
  : public ::flx::async::flx_driver_request_base, public demux::sleep_task
{
  demux::timer_queue *sleepers;
  double      delta;
public:
  sleep_request() {}        // flx linkage

  sleep_request(demux::timer_queue *sleepers_a, double d) :
    sleepers(sleepers_a), delta(d)
  {}

  // from driver request
  bool start_async_op_impl();

  void fire();

};

}} // namespace faio, flx
#endif

//[faio_timer.cpp]
#include "faio_timer.hpp"

using namespace flx::demux;
namespace flx { namespace faio {
bool
sleep_request::start_async_op_impl()
{
  //fprintf(stderr,"Sleep: start async_op_impl %p\n",this);
  sleepers->add_sleep_request(this, delta);
  return false;   // no wakeup
}

void sleep_request::fire() {
  //fprintf (stderr,"FIRE req=%p\n",this);
  notify_finished();
}

}}

//[timer.fpc]
Name: Timer
Description: Real time clock services
Requires: faio
includes:  '"faio_timer.hpp"'

//[unix_faio.fpc]
Name: faio
Description: Asynchronous I/O support
provides_dlib: -lfaio_dynamic
provides_slib: -lfaio_static
includes: '"faio_posixio.hpp"'
Requires: flx_async flx_pthread demux flx flx_gc
library: faio
macros: BUILD_FAIO
srcdir: src/faio
src: faio_(timer|posixio)\.cpp
headers: faio_(drv|timer|posixio)\.hpp

//[win_faio.fpc]
Name: faio
Description: Asynchronous I/O support
provides_dlib: /DEFAULTLIB:faio_dynamic
provides_slib: /DEFAULTLIB:faio_static
includes: '"faio_winio.hpp"'
Requires: flx_async flx_pthread demux flx flx_gc
library: faio
macros: BUILD_FAIO
srcdir: src/faio
src: faio_(timer|winio)\.cpp
headers: faio_(drv|timer|winio)\.hpp

#[faio.py]
import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    print('[fbuild] [faio]')
    path = Path(phase.ctx.buildroot/'share'/'src/faio')

    dst = 'host/lib/rtl/faio'
    srcs = [
        path / 'faio_timer.cpp',
    ]
    includes = [
        phase.ctx.buildroot / 'host/lib/rtl',
        phase.ctx.buildroot / 'share/lib/rtl'
    ]
    macros = ['BUILD_FAIO']
    libs=[
        call('buildsystem.flx_pthread.build_runtime', phase),
        call('buildsystem.flx_async.build_runtime', phase),
        call('buildsystem.demux.build_runtime', phase),
    ]

    if 'win32' in phase.platform:
        srcs.append(path / 'faio_winio.cpp')
        includes.append(Path('src', 'demux', 'win'))

    if 'posix' in phase.platform:
        srcs.append(path / 'faio_posixio.cpp')
        includes.append(Path('src', 'demux', 'posix'))

    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.static for lib in libs]),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.shared for lib in libs]))

def build_flx(phase):
    return
    #return buildsystem.copy_flxs_to_lib(phase.ctx,
    #    Path('src/faio/*.flx').glob())

//[flx_faio_config.hpp]
#ifndef __FLX_FAIO_CONFIG_H__
#define __FLX_FAIO_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_FAIO
#define FAIO_EXTERN FLX_EXPORT
#else
#define FAIO_EXTERN FLX_IMPORT
#endif
#endif

Package: src/packages/gc.fdoc

Memory Management

key file
flx_gc.hpp share/lib/rtl/flx_gc.hpp
flx_gc_private.hpp share/src/gc/flx_gc_private.hpp
flx_gc.cpp share/src/gc/flx_gc.cpp
flx_collector.hpp share/lib/rtl/flx_collector.hpp
flx_collector.cpp share/src/gc/flx_collector.cpp
pthread_thread_control_base.hpp share/lib/rtl/pthread_thread_control_base.hpp
gc.flx share/lib/std/gc.flx
rtti.flx share/lib/std/felix/rtti.flx
flx_gc.flx share/lib/std/felix/flx_gc.flx
flx_gc.py $PWD/buildsystem/flx_gc.py
unix_flx_gc.fpc $PWD/src/config/unix/flx_gc.fpc
win_flx_gc.fpc $PWD/src/config/win/flx_gc.fpc
flx_gc_config.hpp share/lib/rtl/flx_gc_config.hpp

The Felix Garbage Collector.

Felix uses a garbage collector to provide secure automatic memory management.

For reasons of C and C++ compatibility, the allocator used is just malloc. Similarly, to ensure C and C++ interoperability, Felix GC uses a naive mark and sweep algorithm instead of a faster and more modern copying collector. C/C++ objects can’t be moved easily and read or write barriers cannot be easily implemented.

The collector depends heavily on the Judy1 and JudyL
::flx::pthread::thread_control_base_t *tc;

data structures. These are ultra-high performance stores which provide fast, scalable, O(1) linear scanning both up and down, as well as random access, deletion, and insertion. Judy’s key disadvantage is that it only works with machine word size keys and (for JudyL) machine word size data.

The Felix collector is a hybrid. Heap allocated objects are associated with a shape object which provides a precise map of the location of all pointers in the object, accelerating the scan for reachable objects and reducing the number of unreachable objects that are not collected. On the other hand the machine stack of each thread is scanned conservatively, since Felix has no precise information on stack allocated data.

The GC can handle interior pointers. These are pointers to an address past the starting point of an object. However Felix does not consider a pointer “one past the end” to be interior. Care must be taken not to increment pointers into arrays past the last element. This is a deliberate design choice: a past the end pointer might be the head of a consecutively allocated object. Without this constraint an allocator might be forced to introduce padding.

The GC can also handle C pointers mixed in with Felix pointers, in other words, where an object has a designated slot for a pointer, either a Felix or C pointer may be used. It can do this because it keeps track of all objects it allocated.

The GC also assumes all objects are arrays of fixed maximum extent. It tracks the maximum number of elements the array might contain as well as the actual number used. JudyL arrays map addresses to the base shape, the array bound, and the actual usage, with missing keys designating 1 element in the last two cases.

The GC also supports finalisation. By default the finaliser of a C++ object is a function calling the object’s type’s destructor. This means a complex data structure such as an STL map can be used in Felix, provided the value type does not contain GC managed pointers (unless those pointers are marked as roots). The finaliser calls the destructor to release storage, relieving the GC of the task of tracking the individual objects comprising the data structure.

Thus, the Felix GC is more efficient that one might expect because it does not need to track every allocation, nor scan every object. In addition, the programmer is free to use C style manual allocation and deallocation for many data types. Never-the-less the GC is required for some union types and some function and procedure closures. It is also useful for many function data structures including persistent purely functional lists.

We should note that the Felix GC does have one significant drawback: although it is thread safe, and performance suffers a bit from serialisation of allocations, collections require a voluntary world stop by all threads. There is no portable way to stop threads at arbitrary times, so if one thread requests a collection, all the threads must wait until the last one yields to the stop request, and then the collection is performed.

It is also essential to be aware that the world stop uses condition variables for synchronisation. Because of this unconstrained use of native synchronisation vehicles such as a mutex, semaphore, or condition variable is not possible. For example if one thread holds a mutex locked and a second thread is waiting, and the lock holder triggers a world stop, the waiting thread cannot respond, resulting in a deadlock.

The library provides safe alternative synchronisation machinery which is aware of the GC world stop.

Thread Control Base

Note: this is part of the flx_pthread library not the flx_gc library. But only the header file is required. The thread_control_base_t destructor is defined in pthread_thread_control.cpp.

The gc constuctor requires a thread_control_base_t pointer to be passed to it. The actual thread safe collector is defined in the pthread library. A non-thread version of the thread control base might be constructed for a single threaded Felix world instantiation but we do not currently provide one as pthreads are considered mandatory for Felix.

//[pthread_thread_control_base.hpp]
#ifndef __PTHREAD_THREAD_CONTROL_BASE_HPP__
#define __PTHREAD_THREAD_CONTROL_BASE_HPP__

#include "flx_pthread_config.hpp"
#include <string.h>
#include <vector>

namespace flx { namespace pthread {

struct thread_data_t {
  thread_data_t(void *b) : stack_base(b), stack_top(0), active(true) {}
  void *stack_base;
  void *stack_top;
  bool active;
};

struct memory_range_t {
  memory_range_t(void *b_, void *e_) : b(b_), e(e_) {}
  void *b;
  void *e;
};

typedef ::std::vector<memory_range_t> memory_ranges_t;

class PTHREAD_EXTERN world_stop_notifier_t
{
public:
  virtual void notify_world_stop()=0;
  virtual ~world_stop_notifier_t();
};

class PTHREAD_EXTERN thread_control_base_t
{
public:
  virtual bool get_debug() const =0;
  virtual bool world_stop() = 0;
  virtual void world_start() = 0;
  virtual void resume() = 0;
  virtual void suspend() = 0;
  virtual void yield() = 0;
  virtual void join_all() = 0;
  virtual void add_thread(void*)=0;
  virtual void remove_thread()=0;
  virtual size_t thread_count()=0;
  virtual void register_world_stop_notifier(world_stop_notifier_t *)=0;
  virtual void unregister_world_stop_notifier(world_stop_notifier_t *)=0;

  virtual ~thread_control_base_t()=0;
  virtual  memory_ranges_t *get_block_list() = 0; // caller owns result and should delete it
};
}}
#endif
Memory Management Abstraction Interface.
//[flx_gc.hpp]

#ifndef __FLX_GC_H__
#define __FLX_GC_H__

#include <cstdlib>
#include <stddef.h>
#include "flx_gc_config.hpp"
#include "pthread_thread_control_base.hpp"
#include <string>
#include "flx_compiler_support_bodies.hpp"
#include <chrono>

// we use an STL set to hold the collection of roots
#include <set>

namespace flx {
namespace gc {
namespace generic {
// Here are the types we refer to:

struct GC_EXTERN gc_shape_t;      // the shape of collectable objects
struct GC_EXTERN collector_t;     // the collector itself
struct GC_EXTERN allocator_t;     // the allocator used
struct GC_EXTERN offset_data_t;   // private data for offset scanner
struct GC_EXTERN pointer_data_t;  // description of a pointer

This structure is used to provide the client with information about a pointer. The pointer field is the pointer about which information has been requested. If this field is not interior to an object managed by the GC, the rest of the fields are zero.

Otherwise the head field contains the lowest address of the object, also known as the <em>base</em>or <em>head</em> address. The max_elements field contains a count of the maximum number of objects which can fit in the allocated store, that is, the <em>array bound</em>. The used_elements field contains a count of the number of array slots actually used. Finally the shape field contains a pointer to the gc_shape_t object for the element type. , that is, the <em>array bound</em>.

//[flx_gc.hpp]
struct GC_EXTERN pointer_data_t
{
  void *pointer;                      //< candidate pointer
  void *head;                         //< head object
  size_t max_elements;         //< allocated slots
  size_t used_elements;        //< used slots
  gc_shape_t *shape;                  //< shape
};
<tt>gc_shape_t</tt> types

Types required for the RTTI object.

//[flx_gc.hpp]
enum gc_shape_flags_t {
  gc_flags_default    = 0,            //< collectable and mobile
  gc_flags_immobile   = 1,            //< cannot be moved
  gc_flags_persistent = 2,            //< cannot be deallocated
  gc_flags_conservative = 4           //< scan whole object conservatively
};

/// Describes runtime object shape.
typedef void finaliser_t (collector_t*, void*);
typedef void *scanner_t(collector_t*, gc_shape_t *, void *, size_t, int);
typedef ::std::string encoder_t (void *);
typedef ::std::size_t decoder_t(void *, char *, ::std::size_t);
typedef void copier_t (void*,void*);
typedef void dflt_init_t (void*);

struct GC_EXTERN gc_shape_t
{
  char const *cname;              ///< C++ typename
  ::std::size_t count;            ///< static array element count
  ::std::size_t amt;              ///< bytes allocated
  finaliser_t *finaliser;         ///< finalisation function
  ValueType *fcops;               ///< first class ops
/*
  copier_t *copy_init;
  copier_t *move_init;
  copier_t *copy_assign;
  copier_t *move_assign;
*/
  void const *private_data;       ///< private data passed to scanner
  scanner_t *scanner;             ///< scanner function
  encoder_t *encoder;             ///< encoder function
  decoder_t *decoder;             ///< encoder function
  gc_shape_flags_t flags;         ///< flags
  size_t allocations;
  size_t deallocations;
};

GC_EXTERN extern gc_shape_t _ptr_void_map;

The standard scanner scan_by_offsets uses an array containing offsets into an object where pointers are located.

//[flx_gc.hpp]
struct GC_EXTERN offset_data_t
{
  ::std::size_t n_offsets;
  ::std::size_t const *offsets;
};

GC_EXTERN scanner_t scan_by_offsets;

The standard finaliser is a template which destoys an object using the C++ destructor. In the RTTI object if the finaliser is zero, this means the compiler knew the object was a POD type with a trivial destructor, and the zero allows the collector to skip the call to a do nothing finaliser function.

//[flx_gc.hpp]

/*
 * The following template is provided as a standard wrapper
 * for C++ class destructors. The term std_finaliser<T>
 * denotes a function pointer to the wrapper for the destructor
 * of class T, which can be used as a finaliser in the shape
 * descriptor of a T. The client is cautioned than the order
 * of finalisation may not be what is expected. Finalisers
 * should be provided for all C++ objects managed by the Felix
 * collector and not refering to Felix objects,
 * but which contain pointers to other objects that need
 * to be deleted when the main object is destroyed;
 * for example a string class managing an array of char
 * requires its destructor be invoked to delete the managed
 * array, and so a finaliser wrapping the destructor must
 * be provided.
 *
 * C data types may, of course, also require destruction,
 * and Felix therefore can provide programmers with
 * the convenience of C++ destructors, even for C data types.
 */
template<class T>
void std_finaliser(collector_t*, void *t)
{
  static_cast<T*>(t) -> ~T();
}
Allocator Abstraction

The allocator is used by the gc to allocate and deallocate heap storage. Although abstract, the standard allocator use malloc and free and this is assumed by a lot of code in the RTL and is an advertised property of the Felix system. Nevertheless providing an abstraction helps with software organisation.

//[flx_gc.hpp]
/// Allocator abstraction.

struct allocator_t {
  bool debug;
  allocator_t():debug(false){}
  virtual void *allocate(::std::size_t)=0;
  virtual void deallocate(void *)=0;
  virtual ~allocator_t();
  void set_debug(bool d){debug=d;}
};
The collector abstraction

Finally the actual garbage collector abstraction.

The abstraction is essential to allow a common interface to the single threaded and thread safe collectors. The thread safe collector is just a wrapper around the unsafe collector with appropriate locking.

Those familiar with C++ object oriented techniques, may be surprised to learn their understanding of how to use virtual methods is almost certainly completely and utterly wrong! This is partly due to incorrect advice in almost every book published on the subject, and online advice from so-called experts including member of the committee itself.

The collector we present rigidly follows the correct rules which result in a quite complex structure.

//[flx_gc.hpp]

/// Collector abstraction.
struct GC_EXTERN collector_t
{
  bool debug;
  bool report_gcstats;
  void *module_registry;
  void set_debug(bool d, bool stats){debug=d;report_gcstats=stats;}
  collector_t();
  virtual ~collector_t();
  virtual ::flx::pthread::thread_control_base_t *get_thread_control()const =0;
  virtual void register_pointer(void *q, int reclimit)=0;
  ::std::chrono::time_point<::std::chrono::high_resolution_clock> start_time;
  ::std::chrono::duration<double> gc_time;

  virtual bool inrange(void *)const =0;
  // These routines just provide statistics.
  size_t get_allocation_count()const {
    return v_get_allocation_count();
  }

  size_t get_root_count()const {
    return v_get_root_count();
  }

  size_t get_allocation_amt()const {
    return v_get_allocation_amt();
  }

  // Hooks for the supplied allocator, which operate in
  // terms of shape objects rather than raw memory amounts.
  void *allocate(gc_shape_t *shape, size_t x) {
    return v_allocate(shape,x);
  }

  // The mark and sweep collector algorithm.
  size_t collect() {
    //fprintf(stderr, "Collecting\n");
    ::std::chrono::time_point< ::std::chrono::high_resolution_clock> start_time, end_time;
    start_time = ::std::chrono::high_resolution_clock::now();
    size_t x = v_collect();
    end_time = ::std::chrono::high_resolution_clock::now();
    ::std::chrono::duration<double> elapsed = end_time - start_time;

    if (debug)
      fprintf(stderr, "Collecting DONE in %10.5f seconds\n", elapsed.count());
    gc_time += elapsed;
    return x;
  }

  // Routines to add and remove roots.
  void add_root(void *memory) {
    v_add_root(memory);
  }

  void remove_root(void *memory) {
    v_remove_root(memory);
  }

  void free_all_mem() {
    //fprintf(stderr,"Dispatching to free all mem\n");
    v_free_all_mem();
  }

  void finalise(void *frame) {
    v_finalise(frame);
  }

  // Integrity check for the data structure being managed.
  // array management
  virtual void set_used(void *memory, size_t)=0;
  virtual void incr_used(void *memory, ptrdiff_t)=0;
  virtual size_t get_used(void *memory)=0;
  virtual size_t get_count(void *memory)=0;
  virtual void *create_empty_array( gc_shape_t *shape, size_t count)=0;

  virtual pointer_data_t get_pointer_data(void *)=0;
private:
  virtual size_t v_get_allocation_count()const=0;
  virtual size_t v_get_root_count()const=0;
  virtual size_t v_get_allocation_amt()const=0;
  virtual void *v_allocate(gc_shape_t *shape, size_t)=0;
  virtual void v_finalise(void *fp)=0;
  virtual size_t v_collect()=0;
  virtual void v_add_root(void *memory)=0;
  virtual void v_remove_root(void *memory)=0;
  virtual void v_free_all_mem()=0;

  // It doesn't make any sense to copy collector objects
  // about.
  void operator=(collector_t const&);
  collector_t(collector_t const&);
};

// The gc_profile_t is a grab bag of controls related to the collector.
struct GC_EXTERN gc_profile_t {
  bool debug_driver;
  bool debug_allocations;     ///< allocator debug on/off
  bool debug_collections;     ///< collector debug on/off
  bool report_collections;    ///< collector debug on/off
  bool report_gcstats;        ///< print final gc statistics
  bool allow_collection_anywhere; ///< enable collect on allocate

  size_t gc_freq;      ///< how often to collect
  size_t gc_counter;   ///< counter to check if time to collect

  size_t min_mem;      ///< min memory before collection
  size_t max_mem;      ///< throw out of memory if above here
  size_t threshhold;   ///< collection trigger point
  double free_factor;         ///< reset threshhold to used memory
                              ///< by this factor after collection

  size_t collections;  ///< number of collections done
  bool finalise;              ///< whether Felix should collect on exit
  flx::gc::generic::collector_t *collector;

  size_t maybe_collect(); ///< function which maybe collects
  size_t actually_collect(); ///< function which actually collects

  void *allocate(
    flx::gc::generic::gc_shape_t *shape,
    size_t count,
    bool allow_gc
  );

  gc_profile_t (
    bool debug_driver_,
    bool debug_allocations_,
    bool debug_collections_,
    bool report_collections_,
    bool report_gcstats_,
    bool allow_collection_anywhere_,
    size_t gc_freq_,
    size_t min_mem_,
    size_t max_mem_,
    double free_factor_,
    bool finalise_,
    flx::gc::generic::collector_t *collector
  );
  ~gc_profile_t();
};

}}} // end namespaces

/*
 * The following two routines are used to provide
 * C++ type safe heap allocation. There are no corresponding
 * delete routines, please use the destroy function.
 *
 * Note these routines are now placed
 * in the global namespace to accomodate Metrowerks
 * compiler on Mac OS.
 */
GC_EXTERN void *operator new
(
  ::std::size_t,
  flx::gc::generic::gc_profile_t &,
  flx::gc::generic::gc_shape_t &,
  bool
);

/*
 * Define an empty delete to make msvc happy.
 */
GC_EXTERN void operator delete(
  void*,
  flx::gc::generic::gc_profile_t &,
  flx::gc::generic::gc_shape_t &,
  bool
);

#endif

//[flx_gc_private.hpp]

#define _ROUNDUP(i,n) ((i + n - 1) / n * n)
#define _ALIGN(i) _ROUNDUP(i,FLX_MAX_ALIGN)
Memory Management Abstraction Implementation.
//[flx_gc.cpp]

#include <cstdlib>
#include <cstdio>
#include <cassert>
#include "flx_gc.hpp"
#include "flx_exceptions.hpp"
#include "flx_gc_private.hpp"
#include <Judy.h>

// for std::max
#include <algorithm>

#ifdef max
#undef max
#endif


namespace flx {
namespace gc {
namespace generic {
gc_shape_t _ptr_void_map = {
  "void",
  0,0,
  0, // no finaliser
  0, // fcops
  0,
  0,
  0,
  0,
  gc::generic::gc_flags_default,
  0UL, 0UL
};

allocator_t::~allocator_t(){}
collector_t::~collector_t(){
  if (report_gcstats)
  {
    ::std::chrono::duration<double> elapsed =
      ::std::chrono::high_resolution_clock::now() - start_time
    ;
    fprintf(stderr, "Deleting collector total time = %4.5f seconds, gc time = %4.5f = %3.2f%%\n",
      elapsed.count(), gc_time.count(), gc_time.count() * 100.0 / elapsed.count()
    );
  }
}

collector_t::collector_t()
  : debug(false)
  , report_gcstats(false)
  , module_registry(0)
  , gc_time(0.0)
  , start_time(::std::chrono::high_resolution_clock::now())
{}

gc_profile_t::gc_profile_t (
  bool debug_driver_,
  bool debug_allocations_,
  bool debug_collections_,
  bool report_collections_,
  bool report_gcstats_,
  bool allow_collection_anywhere_,
  size_t gc_freq_,
  size_t min_mem_,
  size_t max_mem_,
  double free_factor_,
  bool finalise_,
  flx::gc::generic::collector_t *collector_
) :
  debug_driver(debug_driver_),
  debug_allocations(debug_allocations_),
  debug_collections(debug_collections_),
  report_collections(report_collections_),
  report_gcstats(report_gcstats_),
  allow_collection_anywhere(allow_collection_anywhere_),
  gc_freq(gc_freq_),
  gc_counter(0),
  min_mem(min_mem_),
  max_mem(max_mem_),
  threshhold(min_mem_),
  free_factor(free_factor_),
  collections(0),
  finalise(finalise_),
  collector(collector_)
{
}

gc_profile_t::~gc_profile_t() { }

size_t gc_profile_t::maybe_collect() {
  ++gc_counter;
  if(debug_collections) fprintf(stderr,"Maybe collect?\n");
  if (gc_counter < gc_freq) return 0;
  if(collector->get_allocation_amt() < threshhold) return 0;
  return actually_collect();
}

size_t gc_profile_t::actually_collect() {
  if(debug_collections || report_collections)
    fprintf(stderr,"[flx_gc:gc_profile_t] actually_collect\n");
  gc_counter = 0;
  size_t collected = collector->collect();
  size_t allocated = collector->get_allocation_amt();
  if (allocated > max_mem) throw flx::rtl::flx_out_of_memory_t();
  threshhold = std::max ( min_mem,
    (size_t) (free_factor * (double)allocated))
  ;
  if(debug_collections || report_collections)
  {
    size_t objs = collector->get_allocation_count();
    size_t roots = collector->get_root_count();
    fprintf(stderr,
      "actually collected %zu objects, still allocated: %zu roots, %zu objects, %zu bytes\n",
      collected, roots, objs, allocated
    );
  }
  return collected;
}

void *gc_profile_t::allocate(
  flx::gc::generic::gc_shape_t *shape,
  size_t count,
  bool allow_gc
)
{
  void *p = 0;
  ::std::size_t amt = count * shape->amt * shape->count;
  bool tried_collection = false;

  // if we would exceed the threshhold and collection is allowed, do it
  if (amt + collector->get_allocation_amt() > threshhold && allow_collection_anywhere && allow_gc)
  {
    if (report_collections)
      fprintf(stderr,"[flx_gc:gc_profile_t] Threshhold %zu would be exceeded, collecting\n", threshhold);
    actually_collect();
    if (report_collections)
      fprintf(stderr,"[flx_gc:gc_profile_t] New Threshhold %zu\n", threshhold);
    tried_collection = true;
  }

  // now try the allocation
  try {
    p = collector -> allocate(shape,count);
  }
  // if we ran out of physical memory
  catch (flx::rtl::flx_out_of_memory_t& exn)
  {
    if (debug_allocations || debug_collections || report_collections)
      fprintf(stderr,"[flx_gc:gc_profile_t] Out of physical memory\n");

    if (allow_collection_anywhere && allow_gc && !tried_collection)
    {
      actually_collect();
      tried_collection = true;
      try {
        p = collector -> allocate(shape,count);
      }
      catch (flx::rtl::flx_out_of_memory_t& exn) // fatal error
      {
         fprintf(stderr,"[flx_gc:gc_profile_t] Allocation failed [after forced collection]\n");
         throw exn;
      }
    }
    else
    {
      fprintf(stderr,"[flx_gc:gc_profile_t] Allocation failed [collection not allowed or already tried]\n");
      throw exn; // fatal error
    }
  }

  assert (p);
  return p;
}

/*
 *  This is the default scanner for compiler generated RTTI objects.
 *  It uses an array of offsets into the object to tell where the pointers are.
 *  We must pass this routine the collector, the RTTI shape of the object,
 *  a pointer to the head (lowest byte) of the object, a count of the number
 *  of copies of the object are present consecutively, and a recursion limit.
 *
 *  The count is there because all Felix heap objects are varrays, even if they're
 *  merely length 1. Note that this dynamic array count is the number of used
 *  slots in the varray not the allocated length. Note also the elements of the
 *  varray can themselves be arrays with static lengths. The actual RTTI object
 *  describes a single element of the inner static length array, so we have to
 *  multiply the RTTI static length by the dynamic length.
 */
void *scan_by_offsets(collector_t *collector, gc_shape_t *shape, void *p, size_t dyncount, int reclimit)
{
  Word_t fp = (Word_t)p;

  // calculate the absolute number of used array slots
  size_t n_used = dyncount  * shape->count;

  // find the array of offsets
  offset_data_t const *data = (offset_data_t const *)shape->private_data;
  ::std::size_t n_offsets = data->n_offsets;
  ::std::size_t const *offsets = data->offsets;

  //fprintf(stderr, "scan by offsets: shape %s has %d offsets\n", shape->cname, (int)n_offsets);
  // if the number of used slots is one and there is only one offset
  // then there is only one possible pointer in the object at the specified offset
  // so just return the value stored at that offset immediately
  if (n_used * n_offsets == 1) // tail rec optimisation
  {
      void **pq = (void**)(void*)((unsigned char*)fp + offsets[0]);
      void *q = *pq;
      if(q) return q; // tail rec optimisation
  }
  else
  // otherwise we have to scan through all the offsets in every array element
  for(size_t j=0; j<n_used; ++j)
  {
    for(unsigned int i=0; i<n_offsets; ++i)
    {
      void **pq = (void**)(void*)((unsigned char*)fp + offsets[i]);
      void *q = *pq;
      //fprintf(stderr, "scan by offsets %s, #%d, offset %zu, address %p, value %p\n",
      //  shape->cname, i, offsets[i], pq, q);
      // instead of returning the pointer, register it for later processing
      if(collector->inrange(q))
      {
        collector->register_pointer(q, reclimit);
      }
    }
    // on to the next array element
    fp=(Word_t)(void*)((unsigned char*)fp+shape->amt);
  }
  // return 0 to indicate we registered pointers, instead of returning just one.
  return 0;
}

}}} // end namespaces

// in global namespace now ..
//
// NOTE: Felix arrays are two dimensional. The shape.amt field is the size of
// one element. The shape.count field is the number of elements for a static
// array type. The dynamic length is for varrays, it is stored in a judy array
// associated with the array address. If there is nothing in the judy array,
// the dynamic length is one. C++ operator new allocates arrays of dynamic length 1.
//
void *operator new(
  std::size_t amt,
  flx::gc::generic::gc_profile_t &gcp,
  flx::gc::generic::gc_shape_t &shape,
  bool allow_gc
)
{
  if (amt != shape.amt * shape.count)
  {
    fprintf(stderr,"Shape size error: allocator size = %zu\n",amt);
    fprintf(stderr,"Shape %s element size = %zu, element count = %zu\n",shape.cname,shape.amt,shape.count);
    abort();
  }
  void *p = gcp.allocate(&shape,1,allow_gc); // dynamic array count = 1
  return p;
}

void operator delete(
  void*,
  flx::gc::generic::gc_profile_t &,
  flx::gc::generic::gc_shape_t &,
  bool
)
{
}
Collector interface.
//[flx_collector.hpp]

#ifndef __FLX_COLLECTOR_H__
#define __FLX_COLLECTOR_H__
#include <cstddef>
#include "flx_gc.hpp"
#include <map>
#include "pthread_thread.hpp"
#include <Judy.h>

namespace flx {
namespace gc {
namespace collector {
using namespace generic;

struct GC_EXTERN malloc_free;
struct GC_EXTERN tracing_allocator;
struct GC_EXTERN flx_collector_t;

/// Allocator using malloc and free.
struct GC_EXTERN malloc_free : public virtual allocator_t
{
  void *allocate(::std::size_t);
  void deallocate(void *);
  ~malloc_free();
};

/// Allocator which saves allocations and deallocations
/// to a file, delegating operations to a servant allocator
struct GC_EXTERN tracing_allocator : public virtual allocator_t
{
  allocator_t *servant;
  FILE *tracefile;
  tracing_allocator(FILE *, allocator_t *);
  void *allocate(::std::size_t);
  void deallocate(void *);
  ~tracing_allocator();
};


struct mark_thread_context_t
{
  flx_collector_t *collector;
  pthread::memory_ranges_t *px;
  int reclimit;
};


/// Naive Mark and Sweep Collector.
struct GC_EXTERN flx_collector_t : public collector_t
{
  flx_collector_t(allocator_t *, flx::pthread::thread_control_base_t *, int _gcthreads, FILE *tf);
  ~flx_collector_t();

  // RF: added to allow implementation of non-leaky drivers.
  void impl_free_all_mem(); // clear all roots, sweep.

  void set_used(void *memory, size_t);
  void incr_used(void *memory, ptrdiff_t);
  size_t get_used(void *memory);
  size_t get_count(void *memory);
  void *create_empty_array( gc_shape_t *shape, size_t count);
  gc_shape_t *get_shape(void *memory);
  flx::pthread::thread_control_base_t *get_thread_control()const;
  void register_pointer(void *q, int reclimit);
  ::flx::gc::generic::pointer_data_t get_pointer_data(void *);

protected:

  /// allocator
  void *impl_allocate(gc_shape_t *ptr_map, size_t);

  /// collector (returns number of objects collected)
  size_t impl_collect();

  // add and remove roots
  void impl_add_root(void *memory);
  void impl_remove_root(void *memory);

  //
  void check();

  // statistics
  size_t impl_get_allocation_count()const;
  size_t impl_get_root_count()const;
  size_t impl_get_allocation_amt()const;
  void impl_finalise(void *fp);

private:
  /// allocator
  void *v_allocate(gc_shape_t *ptr_map, size_t);

  /// collector (returns number of objects collected)
  size_t v_collect();

  // add and remove roots
  void v_add_root(void *memory);
  void v_remove_root(void *memory);
  void v_free_all_mem();

  // statistics
  size_t v_get_allocation_count()const;
  size_t v_get_root_count()const;
  size_t v_get_allocation_amt()const;

private:
  void judyerror(char const*);
  size_t allocation_count;
  size_t root_count;
  size_t allocation_amt;

  uintptr_t minptr;
  uintptr_t maxptr;

  bool inrange(void *p)const { return minptr <= uintptr_t(p) && uintptr_t(p) < maxptr; }
  void unlink(void *frame);
  void v_finalise(void *frame);
  void post_delete(void *frame);
  void delete_frame(void *frame);
  size_t reap();

  // top level mark, calls mark_single or mark_multi
  void mark(pthread::memory_ranges_t*);

  // single threaded mark
  void mark_single(pthread::memory_ranges_t*, int);

  // multithreaded mark: single thread enters and creates
  // worker threads which run mark_thread routine below
  void mark_multi(pthread::memory_ranges_t*,int reclimit, int nthreads);

public: // unfortunately, due to dispatch machinery
  // worker thread
  void mark_thread(mark_thread_context_t *);

private:
  int gcthreads;
  size_t sweep(); // calls scan_object

  typedef std::map<void *,size_t, std::less<void *> > rootmap_t;
  rootmap_t roots;
  bool parity;
  allocator_t *allocator;
  flx::pthread::thread_control_base_t *thread_control;


  // JudyL array and error object
  void *j_shape;
  void *j_nalloc;
  void *j_nused;
  FILE *tracefile;
public:
  struct memdata_t {
    void *head;
    gc_shape_t *pshape;
    size_t nbytes;
  };
  void scan_object(void *memory, int reclimit);
  memdata_t check_interior (void *memory);

  ::std::mutex j_tmp_lock;
  ::std::condition_variable j_tmp_cv;
  int j_tmp_waiting;
  void *j_tmp;
  JError_t je;
};

}}} // end namespaces
#endif
Collector Implementation

Tracefile used for performance simulations on Judy alternatives. Tracefile codes: Format:

opcode filecode: address

Op Codes

G: Get F: First N: Next L: Last I: Insert D: Delete C: Delete whole array

File codes:

S: shape JudyL A: allocated JudyL U: used JudyL T: temporary Judy1

//[flx_collector.cpp]

#include <cstdlib>
#include <map>
#include <limits.h>
#include <cassert>
#include <cstdio>
#include <cstddef>
#include "flx_rtl_config.hpp"
#include "flx_collector.hpp"
#include "flx_exceptions.hpp"
#include "flx_gc_private.hpp"

#include <stdint.h>
#define lobit(p) (p & (uintptr_t)1u)
#define hibits(p) (p & ~(uintptr_t)1u)
#define SHAPE(p) ((gc_shape_t *)hibits(p))

//#include "flx_rtl.hpp"
namespace flx {
namespace gc {
namespace collector {

static int mcount FLX_UNUSED = 0;

malloc_free::~malloc_free(){}

void *malloc_free::allocate(::std::size_t amt)
{
  void *p = malloc(amt);
  if(debug)
    fprintf(stderr,"[gc] Malloc %zd bytes, address = %p\n",amt,p);
  if(p)return p;
  else {
    fprintf(stderr,"[gc] Felix: Malloc out of memory, blk=%zu\n",amt);
    throw flx::rtl::flx_out_of_memory_t();
  }
}

void malloc_free::deallocate(void *p)
{
  if(debug)
    fprintf(stderr,"[gc] Free %p\n",p);
  free(p);
}

tracing_allocator::tracing_allocator (
  FILE *tf,
  allocator_t *slave)
: tracefile(tf), servant(slave) {}

void *tracing_allocator::allocate (::std::size_t amt)
{
   void *memory = servant->allocate(amt);
   fprintf(tracefile,"A: %p\n",memory);
   return memory;
}

void tracing_allocator::deallocate (void *p)
{
   fprintf(tracefile,"D: %p\n",p);
   servant->deallocate(p);
}

tracing_allocator::~tracing_allocator() {
  fclose(tracefile);
  delete servant;
  fprintf(stderr, "[gc] Allocation tracing terminated, file closed, slave allocator deleted\n");
}


void *flx_collector_t::v_allocate(gc_shape_t *ptr_map, size_t x) {
  return impl_allocate(ptr_map, x);
}

void flx_collector_t::v_finalise(void *frame) {
  impl_finalise(frame);
}

size_t flx_collector_t::v_collect() {
  // NO MUTEX
  return impl_collect();
}

void flx_collector_t::v_add_root(void *memory) {
  impl_add_root(memory);
}

void flx_collector_t::v_remove_root(void *memory) {
  impl_remove_root(memory);
}

void flx_collector_t::v_free_all_mem() {
  //fprintf(stderr, "Dispatching to impl free all mem\n");
  impl_free_all_mem();
}

size_t flx_collector_t::v_get_allocation_count()const {
  return impl_get_allocation_count();
}

size_t flx_collector_t::v_get_root_count()const {
  return impl_get_root_count();
}

size_t flx_collector_t::v_get_allocation_amt()const {
  return impl_get_allocation_amt();
}

size_t flx_collector_t::impl_get_allocation_count()const
{
  return allocation_count;
}

size_t flx_collector_t::impl_get_root_count()const
{
  return root_count;
}

size_t flx_collector_t::impl_get_allocation_amt()const
{
  return allocation_amt;
}


flx_collector_t::flx_collector_t(
  allocator_t *a,
  pthread::thread_control_base_t *tc,
  int _gcthreads,
  FILE *tf
)
  :
  allocation_count(0)
  ,root_count(0)
  ,allocation_amt(0)
  ,parity(false)
  ,allocator(a)
  ,thread_control(tc)
  ,j_shape(0)
  ,j_nalloc(0)
  ,j_nused(0)
  ,j_tmp(0)
  ,minptr(~uintptr_t(0))
  ,maxptr(0)
  ,tracefile(tf)
  ,gcthreads(_gcthreads)
{
  if(tf)
    fprintf(stderr, "[flx_collector_t] Tracefile active\n");
}

flx::pthread::thread_control_base_t *flx_collector_t::get_thread_control()const
{
  return thread_control;
}

void flx_collector_t::judyerror(char const *loc)
{
  fprintf(stderr, "[gc] JUDY ERROR %d in %s\n",je.je_Errno,loc);
  abort();
}

void * flx_collector_t::impl_allocate(gc_shape_t *shape, size_t nobj)
{
  // calculate how much memory to request
  ::std::size_t amt = nobj * shape->amt * shape->count;
  //fprintf(stderr, "req amt = %zu\n",amt);
  if(amt & 1) ++amt; // round up to even number
  //fprintf(stderr, "rounded req amt = %zu\n",amt);

  // allocate a block
  void *fp = (void *)allocator->allocate(amt);
  assert(fp); // Got some memory!

  //++shape->allocations;

  // for use when things go wrong
  char error_buffer[2048];
  snprintf(error_buffer, 2047,
    "[gc] Allocated %p, shape=%s[%zd][%zu][#a=%zu,#d=%zu]\n",
    fp,shape->cname,shape->count,nobj,shape->allocations,shape->deallocations);

  Word_t *p = (Word_t*)(void*)JudyLIns(&j_shape,(Word_t)fp,&je);
  if(tracefile)
     fprintf(tracefile,"IS: %p\n",fp);
  *p = ((Word_t)(void*)shape) | (parity & 1);
  if (nobj != (uintptr_t)1) // array
  {
//fprintf(stderr, "Inserting into j_nalloc=%p\n",j_nalloc);
    Word_t *p = (Word_t*)(void*)JudyLIns(&j_nalloc,(Word_t)fp,&je);
//fprintf(stderr, "  new j_nalloc=%p\n",j_nalloc);
//fprintf(stderr, "  slot for insert=%p\n",p);
    if(tracefile)
       fprintf(tracefile,"IA: %p\n",fp);
    *p = nobj;
  }

  size_t n_objects = get_count(fp);
  if (nobj != n_objects)
  {

    fprintf(stderr,
        "Insertion into j_nalloc (%p) failed: address %p, [nobj=%zu != get_count(fp)=%zu]\n",
        j_nalloc, fp, nobj, n_objects);

    { // get_count(fp) conflates size 1 with NULL pointer, the following will disambiguate
      Word_t *p = (Word_t*)(void*)JudyLGet(j_nalloc,(Word_t)fp,&je);
      fprintf(stderr,
          "  p==NULL: %s\n",
          ((p == NULL) ? "true" : "false") );
    }

    // finally output error_buffer if there's an error
    fprintf(stderr, "%s", error_buffer);

    assert (nobj == n_objects);
  }

  // update statistics
  allocation_count++;
  allocation_amt += amt;
  //fprintf(stderr,"ADDING %zu to allocation amt, result %zu\n",amt,allocation_amt);
  // return client memory pointer
  minptr=::std::min(minptr,uintptr_t(fp));
  maxptr=::std::max(maxptr,uintptr_t(fp)+amt);
  return fp;
}

// NOTE: although 1 is the default if there is no entry,
// it is allowed to have an entry with 1
// indeed, set_used always creates an entry
void flx_collector_t::set_used(void *memory, size_t n)
{
  if (memory == NULL && n==0) return;
  assert(memory);

  // this check is expensive, but set_used is not used often
  assert(n<=get_count(memory));
  //fprintf(stderr,"Set used of %p to %zu\n",memory,n);
  Word_t *p = (Word_t*)(void*)JudyLGet(j_nused,(Word_t)memory,&je);
  if(tracefile)
    fprintf(tracefile,"GU: %p\n",memory);
  if(p==(Word_t*)PPJERR)judyerror("set_used");
  if(p==NULL)
  {
    //fprintf(stderr,"set_used: No recorded usage! Creating store for data\n");
    p = (Word_t*)(void*)JudyLIns(&j_nused,(Word_t)memory,&je);
    if(tracefile)
       fprintf(tracefile,"IU: %p\n",memory);
  }
  //fprintf(stderr,"Slot for %p usage is address %p\n",memory,p);
  *p = (Word_t)n;
}

void flx_collector_t::incr_used(void *memory, ptrdiff_t n)
{
  if (n==0) return;
  assert(memory);
  //fprintf(stderr,"Incr used of %p by %zu\n",memory,n);
  //assert(get_used(memory) + n <= get_count(memory));
  ptrdiff_t newused = (ptrdiff_t)get_used(memory) + n;
  if (newused < 0 || newused > get_count(memory)) {
    fprintf(stderr,"Address %p count %d used %d increment %d\n",
      memory,(int)get_count(memory), (int)get_used(memory),(int)n);
    fprintf(stderr,"Type %s\n",get_shape(memory)->cname);
    assert(false);
  }

  Word_t *p = (Word_t*)(void*)JudyLGet(j_nused,(Word_t)memory,&je);
  if(tracefile)
    fprintf(tracefile,"GU: %p\n",memory);
  if(p==(Word_t*)PPJERR)judyerror("incr_used");
  if(p==NULL)
  {
    //fprintf(stderr,"incr_used: No recorded usage! Creating store for data\n");
    p = (Word_t*)(void*)JudyLIns(&j_nused,(Word_t)memory,&je);
    if(tracefile)
      fprintf(tracefile,"IU: %p\n",memory);
    if(p==(Word_t*)PPJERR)judyerror("incr_used: new slot");
    *p = newused;
  }
  else *p=newused;
}

// actual number of used slots in an array
size_t flx_collector_t::get_used(void *memory)
{
  if(memory==NULL) return 0;
  //fprintf(stderr, "Get used of %p\n",memory);
  Word_t *p = (Word_t*)(void*)JudyLGet(j_nused,(Word_t)memory,&je);
  if(tracefile)
    fprintf(tracefile,"GU: %p\n",memory);
  if(p==(Word_t*)PPJERR)judyerror("get_used");
  //fprintf(stderr, "Used slot at address %p\n",p);
  size_t z = p!=NULL?*p:1; // defaults to 1 for non-array support
  //fprintf(stderr,"Used of %p is %zu\n",memory,z);
  return z;
}

// max number of available slots in an array
size_t flx_collector_t::get_count(void *memory)
{
  if(memory==NULL) return 0;
  //fprintf(stderr, "Get count of %p\n",memory);
  Word_t *p = (Word_t*)(void*)JudyLGet(j_nalloc,(Word_t)memory,&je);
  if(tracefile)
    fprintf(tracefile,"GA: %p\n",memory);
  if(p==(Word_t*)PPJERR)judyerror("get_count");
  //fprintf(stderr, "Count slot at address %p\n",p);
  size_t z = p!=NULL?*p:1; // defaults to 1 for non-array support
  //fprintf(stderr,"Count of %p is %zu\n\n",memory,z);
  return z;
}

// REQUIRES memory to be head pointer (not interior)
gc_shape_t *flx_collector_t::get_shape(void *memory)
{
  if(memory == NULL) return &::flx::gc::generic::_ptr_void_map;
  assert(memory);
  //fprintf(stderr, "Get shape of %p\n",memory);
  Word_t *pshape= (Word_t*)JudyLGet(j_shape,(Word_t)memory,&je);
  if(tracefile)
    fprintf(tracefile,"GS: %p\n",memory);
  if(pshape==(Word_t*)PPJERR)judyerror("get_shape");
  if(pshape==NULL) {
    fprintf(stderr,"get_shape %p found NULL\n",memory);
    abort();
  }
  return (gc_shape_t *)(*pshape & (~(uintptr_t)1));
}

void *flx_collector_t::create_empty_array(
  flx::gc::generic::gc_shape_t *shape,
  size_t count
)
{
  if (count==0) return NULL;
  void *p = allocate(shape,count);
  assert(p);
  set_used (p, 0); // make sure to override default 1 slot usage
  if(get_used(p) != 0 || get_count(p) != count) {
    fprintf(stderr,"create empty array type %s address %p request count=%zu, actual count=%zu ,used=%zu\n",
     p,shape->cname, count, get_count(p), get_used(p));
    fprintf(stderr, "FATAL CONSTRUCTOR FAILURE\n");
    assert (false);
  }
  return p;
}


void flx_collector_t::impl_finalise(void *fp)
{
  assert(fp!=NULL);
  //fprintf(stderr, "Finaliser for %p\n", fp);
  gc_shape_t *shape = get_shape(fp); // inefficient, since we already know the shape!
  //fprintf(stderr, "Got shape %p=%s\n", shape,shape->cname);
  void (*finaliser)(collector_t*, void*) = shape->finaliser;
  //fprintf(stderr, "Got finaliser %p\n", finaliser);
  if (finaliser)
  {
    unsigned char *cp = (unsigned char*)fp;
    size_t n_used = get_used(fp) * shape->count;
    size_t eltsize = shape->amt;
    //fprintf(stderr, "Finalising at %p for type %s %zu objects each size %zu\n", cp, shape->cname, n_used, eltsize);
    for(size_t j = 0; j<n_used; ++j)
    {
      (*finaliser)(this,(void*)cp);
      cp += eltsize;
    }
  }
}

void flx_collector_t::unlink(void *fp)
{
  // check we have a pointer to an object
  assert(fp!=NULL);

  // call the finaliser if there is one
  //fprintf(stderr,"Unlink: Calling finaliser for %p\n",fp);
  impl_finalise(fp);

  allocation_count--;
  gc_shape_t *shape = get_shape(fp);
  size_t n_objects = get_count(fp);
  size_t nobj = shape -> count * n_objects;
  ::std::size_t size = shape->amt * nobj;
  if (size & 1) ++size;
  //fprintf(stderr, "Uncounting %zu bytes\n", size);
  allocation_amt -= size;

  // unlink the frame from the collectors list
  //fprintf(stderr,"Removing address from Judy lists\n");
  JudyLDel(&j_shape, (Word_t)fp, &je);
  JudyLDel(&j_nused, (Word_t)fp, &je);
  JudyLDel(&j_nalloc, (Word_t)fp, &je);
  if(tracefile) {
    fprintf(tracefile,"DS: %p\n",fp);
    fprintf(tracefile,"DA: %p\n",fp);
    fprintf(tracefile,"DU: %p\n",fp);
  }
  //fprintf(stderr,"Finished unlinking\n");
}

void flx_collector_t::post_delete(void *fp)
{
  Judy1Set(&j_tmp,(Word_t)fp,&je);
  if(tracefile)
    fprintf(tracefile,"IT: %p\n",fp);

}

void flx_collector_t::delete_frame(void *fp)
{
  allocator->deallocate(fp);
}

size_t flx_collector_t::reap ()
{
  size_t count = 0;
  Word_t next=(Word_t)NULL;
  int res = Judy1First(j_tmp,&next,&je);
  if(tracefile)
    fprintf(tracefile,"FT: %p\n",next);
  while(res) {
    delete_frame((void*)next);
    ++count;
    res = Judy1Next(j_tmp,&next,&je);
    if(tracefile)
      fprintf(tracefile,"NT: %p\n",next);
  }
  Judy1FreeArray(&j_tmp,&je);
  if(tracefile)
    fprintf(tracefile,"CT:\n");
  if(debug)
  {
    fprintf(stderr,"[gc] Reaped %zu objects\n",count);
    fprintf(stderr,"[gc] Still allocated %zu objects occupying %zu bytes\n", get_allocation_count(), get_allocation_amt());
  }
  return count;
}


//#include <valgrind/memcheck.h>

/* This is the top level mark routine
 * Its job is to mark all objects that are reachable
 * so a subsequent reaping phase can delete all
 * the objects that are NOT marked
 *
 * This mark bit is the low bit of the RTTI shape object pointer
 * stored in the j_shape Judy1Array.
 *
 * The meaning of this bit alternates between calls to the collector.
 * Initially all objects are considered garbage and the flag is toggled
 * to indicate the object is reachable.
 *
 * On the next pass the reachable value is reconsidered to mean
 * garbage and the flag toggled again. This saves a pass over
 * all objects marking them garbage before then tracing roots
 * to find which ones are not.
 */

void flx_collector_t::mark(pthread::memory_ranges_t *px)
{
  // The recursion limit is a stopper so recursions
  // won't blow the machine stack and also wipe out the cache
  // regularly. Our overall routine is iterative with limited
  // recursion. The recursions are faster but the iteration
  // can handle data type like lists of millions of elements
  // which would otherwise recurse millions of times.
  //
  int reclimit = 64;
  if(debug)
    fprintf(stderr,"[gc] Collector: Running mark\n");

  // sanity check
  assert (root_count == roots.size());

  // the j_tmp Judy1 array is just a set of pointers which
  // we have not yet examined. When we find pointers we stash
  // them in this set rather than examining them immediately.
  // Later we come back and examine them. This buffers the recursion
  // a bit. The set has to be empty initially.
  assert(j_tmp == 0);
  if (gcthreads < 2)
    mark_single(px,reclimit);
  else
    mark_multi(px,reclimit,gcthreads);
}

static void run_mark_thread(mark_thread_context_t *mtc)
{
  mtc->collector->mark_thread(mtc);
}

void flx_collector_t::mark_multi(pthread::memory_ranges_t *px,int reclimit, int nthreads)
{
//fprintf(stderr, "starting %d mark threads\n", nthreads);
  j_tmp_waiting = 0;
  mark_thread_context_t mtc {this,px, reclimit};
  ::std::vector< ::std::thread> mark_threads;
  for (int i=0; i<gcthreads; ++i)
    mark_threads.push_back (::std::thread (run_mark_thread, &mtc));
  for (int i=0; i<gcthreads; ++i)
    mark_threads[i].join();
//fprintf(stderr, "multithread mark finished\n");
}

// this method is run simultaneously by multiple threads
void flx_collector_t::mark_thread(mark_thread_context_t *mtc)
{
//fprintf(stderr, "multithread mark thread running\n");
  int reclimit = mtc->reclimit;
  pthread::memory_ranges_t *px  = mtc->px;
  // px is a set of memory ranges representing the stacks
  // of all pthreads including this one at the point the
  // collector got invoked. All the other threads than this
  // one must be stopped. The stack are found by recording the
  // base stack value when launching the thread, and using
  // the value when a thread stops to allow collection as the
  // high value. The stack contains all the machine registers
  // at this point too, since we used a long_jmp into a local
  // variable to put the registers on the stack.
  if(px)
  {
    // for all pthreads
    std::vector<pthread::memory_range_t>::iterator end = (*px).end();
    for(
      std::vector<pthread::memory_range_t>::iterator i = (*px).begin();
      i != end;
      ++i
    )
    {
      // get the stack extent for one pthread
      pthread::memory_range_t range = *i;
      if(debug)
      {
        size_t n = (char*)range.e - (char*)range.b;
        fprintf(stderr, "[gc] Conservate scan of memory %p->%p, %zu bytes\n",range.b, range.e, n);
      }
      //VALGRIND_MAKE_MEM_DEFINED(range.b, (char*)range.e-(char*)range.b);
      void *end = range.e;
      // for all machine words on the stack
      // this WILL FAIL if the stack isn't an exact multiple
      // of the size of a machine word
      for ( void *i = range.b; i != end; i = (void*)((void**)i+1))
      {
        //if(debug)
        // fprintf(stderr, "[gc] Check if *%p=%p is a pointer\n",i,*(void**)i);
        // conservative scan of every word on every stack
        scan_object(*(void**)i, reclimit);
      }
      if(debug)
        fprintf(stderr, "[gc] DONE: Conservate scan of memory %p->%p\n",range.b, range.e);
    }
  }

  // Now scan all the registered roots
  if(debug)
    fprintf(stderr, "[gc] Scanning roots\n");
  rootmap_t::iterator const end = roots.end();
  for(
    rootmap_t::iterator i = roots.begin();
    i != end;
    ++i
  )
  {
    if(debug)
      fprintf(stderr, "[gc] Scanning root %p\n", (*i).first);
    scan_object((*i).first, reclimit);
  }

  // Now, scan the temporary set in j_tmp  until it is empty
  // When we're processing an object with scan_object
  // if its an actual Felix object we mark it reachable
  // and then scan all the pointers in it: usually those pointers
  // are not scanned immediately by scan object but simply put
  // into the set j_tmp to schedule them for scanning.
  //
  // Note: Judy1First finds the first key greater than or equal to the given one,
  // it returns 0 if there is no such key.
  Word_t toscan;
  int res;
again:
  {
    ::std::unique_lock< ::std::mutex> dummy(j_tmp_lock);
retry:
    toscan = 0;
    res = Judy1First(j_tmp,&toscan,&je); // get one object scheduled for scanning
    if (!res) {
       ++j_tmp_waiting;
       if (j_tmp_waiting == gcthreads) {
         j_tmp_cv.notify_all();
         goto endoff;
       }
       j_tmp_cv.wait(dummy);
       --j_tmp_waiting;
       goto retry;
    }
    Judy1Unset(&j_tmp,toscan,&je);         // remove it immediately
  }
  scan_object((void*)toscan, reclimit);  // scan it, it will either be marked or discarded
  goto again;

endoff:
  assert(j_tmp == 0);

  if(debug)
    fprintf(stderr, "[gc] Done Scanning roots\n");
}



void flx_collector_t::mark_single(pthread::memory_ranges_t *px, int reclimit)
{
  // px is a set of memory ranges representing the stacks
  // of all pthreads including this one at the point the
  // collector got invoked. All the other threads than this
  // one must be stopped. The stack are found by recording the
  // base stack value when launching the thread, and using
  // the value when a thread stops to allow collection as the
  // high value. The stack contains all the machine registers
  // at this point too, since we used a long_jmp into a local
  // variable to put the registers on the stack.
  if(px)
  {
    // for all pthreads
    std::vector<pthread::memory_range_t>::iterator end = (*px).end();
    for(
      std::vector<pthread::memory_range_t>::iterator i = (*px).begin();
      i != end;
      ++i
    )
    {
      // get the stack extent for one pthread
      pthread::memory_range_t range = *i;
      if(debug)
      {
        size_t n = (char*)range.e - (char*)range.b;
        fprintf(stderr, "[gc] Conservate scan of memory %p->%p, %zu bytes\n",range.b, range.e, n);
      }
      //VALGRIND_MAKE_MEM_DEFINED(range.b, (char*)range.e-(char*)range.b);
      void *end = range.e;
      // for all machine words on the stack
      // this WILL FAIL if the stack isn't an exact multiple
      // of the size of a machine word
      for ( void *i = range.b; i != end; i = (void*)((void**)i+1))
      {
        //if(debug)
        // fprintf(stderr, "[gc] Check if *%p=%p is a pointer\n",i,*(void**)i);
        // conservative scan of every word on every stack
        scan_object(*(void**)i, reclimit);
      }
      if(debug)
        fprintf(stderr, "[gc] DONE: Conservate scan of memory %p->%p\n",range.b, range.e);
    }
  }

  // Now scan all the registered roots
  if(debug)
    fprintf(stderr, "[gc] Scanning roots\n");
  rootmap_t::iterator const end = roots.end();
  for(
    rootmap_t::iterator i = roots.begin();
    i != end;
    ++i
  )
  {
    if(debug)
      fprintf(stderr, "[gc] Scanning root %p\n", (*i).first);
    scan_object((*i).first, reclimit);
  }

  // Now, scan the temporary set in j_tmp  until it is empty
  // When we're processing an object with scan_object
  // if its an actual Felix object we mark it reachable
  // and then scan all the pointers in it: usually those pointers
  // are not scanned immediately by scan object but simply put
  // into the set j_tmp to schedule them for scanning.
  //
  // Note: Judy1First finds the first key greater than or equal to the given one,
  // it returns 0 if there is no such key.
  Word_t toscan = 0;
  int res = Judy1First(j_tmp,&toscan,&je); // get one object scheduled for scanning
  //if(tracefile)
  //  fprintf(tracefile,"FT: %p\n",toscan);
  while(res) {
    Judy1Unset(&j_tmp,toscan,&je);         // remove it immediately
    if(tracefile)
      fprintf(tracefile,"DT: %p\n",toscan);
    scan_object((void*)toscan, reclimit);  // scan it, it will either be marked or discarded
    toscan = 0;
    res = Judy1First(j_tmp,&toscan,&je);
    if(tracefile)
      fprintf(tracefile,"FT: %p\n",toscan);
  }
  assert(j_tmp == 0);

  if(debug)
    fprintf(stderr, "[gc] Done Scanning roots\n");
}



size_t flx_collector_t::sweep()
{
  if(debug)
    fprintf(stderr,"[gc] Collector: Sweep, garbage bit value=%d\n",(int)parity);
  size_t sweeped = 0;
  void *current = NULL;
  Word_t *pshape = (Word_t*)JudyLFirst(j_shape,(Word_t*)&current,&je); // GE
  if(tracefile)
    fprintf(tracefile,"FS: %p\n",current);
  if(pshape==(Word_t*)PPJERR)judyerror("sweep");

  while(pshape!=NULL)
  {
    if((*pshape & (uintptr_t)1) == (parity & (uintptr_t)1))
    {
      if(debug)
        fprintf(stderr,"[gc] Garbage   %p=%s[%zd][%zu/%zu] [#a=%zu,#d=%zu]\n",
          current,
          SHAPE(*pshape)->cname,
          SHAPE(*pshape)->count,
          get_used(current),
          get_count(current),
          SHAPE(*pshape)->allocations,
          SHAPE(*pshape)->deallocations
        );
      ++ sweeped;
      //fprintf(stderr,"Incr deallocation count ..\n");
      //++((gc_shape_t *)(*pshape & ~(uintptr_t)1))->deallocations;
      //fprintf(stderr,"Unlinking ..\n");
      unlink(current);
      //fprintf(stderr,"Posting delete ..\n");
      post_delete(current);
      //fprintf(stderr,"Reaping done\n");
    }
    else
    {
      if(debug)
        fprintf(stderr,"[gc] Reachable %p=%s[%zd][%zu/%zu] [#a=%zu,#d=%zu]\n",
          current,
          SHAPE(*pshape)->cname,
          SHAPE(*pshape)->count,
          get_used(current),
          get_count(current),
          SHAPE(*pshape)->allocations,
          SHAPE(*pshape)->deallocations
        );
    }

    //fprintf(stderr,"Calling Judy for next object\n");
    pshape = (Word_t*)JudyLNext(j_shape,(Word_t*)(void*)&current,&je); // GT
    if(tracefile)
      fprintf(tracefile,"NS: %p\n",current);
    //fprintf(stderr,"Judy got next object %p\n",pshape);
  }

  parity = !parity;
  if(debug)
    fprintf(stderr,"[gc] Sweeped %zu\n",sweeped);
  return reap();
}

void flx_collector_t::impl_add_root(void *memory)
{
  if(!memory)
  {
    fprintf(stderr, "[gc] GC ERROR: ADD NULL ROOT\n");
    abort();
  }
  rootmap_t::iterator iter = roots.find(memory);
  if(iter == roots.end())
  {
    std::pair<void *const, size_t> entry(memory,(uintptr_t)1);
    if(debug)
      fprintf(stderr,"[gc] Add root %p=%s\n", memory,get_shape(memory)->cname);
    roots.insert (entry);
    root_count++;
  }
  else {
    if(debug)
      fprintf(stderr,"[gc] Increment root %p to %zu\n", memory, (*iter).second+1);
    ++(*iter).second;
  }
}

void flx_collector_t::impl_remove_root(void *memory)
{
  rootmap_t::iterator iter = roots.find(memory);
  if(iter == roots.end())
  {
    fprintf(stderr, "[gc] GC ERROR: REMOVE ROOT %p WHICH IS NOT ROOT\n", memory);
    abort();
  }
  if((*iter).second == (uintptr_t)1)
  {
    if(debug)
      fprintf(stderr,"[gc] Remove root %p\n", memory);
    roots.erase(iter);
    root_count--;
  }
  else {
    if(debug)
      fprintf(stderr,"[gc] Decrement root %p to %zu\n", memory, (*iter).second-1);
    --(*iter).second;
  }
}

/* This is the fun bit!
 * Register pointer is called by scan object, indirectly
 * via the custom scanner.
 * It then recursively calls scan_object on that pointer,
 * providing a standard recursive descent.
 *
 * HOWEVER if the recursion limit is reached during this process,
 * instead of recursing it just stashes the pointer in the
 * j_tmp collection for later processing.
 *
 * So recursions over small tree structures proceed as normal,
 * but when you get a long list or array to handle the recursion
 * is stopped before it blows the stack, and the data is just stashed
 * for later processing by the top level iterative loop
 */

// unfortunately requires a dynamic test to determine
// if we're using the threaded mark routine or not
void flx_collector_t::register_pointer(void *q, int reclimit)
{
  if (inrange(q)) {
    if(reclimit==0)
    {
      if(gcthreads>1)
      {
        ::std::unique_lock< ::std::mutex> dummy(j_tmp_lock);
        Judy1Set(&j_tmp,(Word_t)q,&je);
        j_tmp_cv.notify_one();
      }
      else {
        Judy1Set(&j_tmp,(Word_t)q,&je);
      }
      if(tracefile)
        fprintf(tracefile,"IT: %p\n",q);
    }
    else scan_object(q, reclimit-1);
  }
}

::flx::gc::generic::pointer_data_t flx_collector_t::get_pointer_data (void *p)
{
  ::flx::gc::generic::pointer_data_t pdat;
  pdat.head = NULL;
  pdat.max_elements = 0;
  pdat.used_elements = 0;
  pdat.shape = NULL;
  pdat.pointer = p;

  Word_t cand = (Word_t)p;
  Word_t head = cand;
  Word_t *ppshape = (Word_t*)JudyLLast(j_shape,&head, &je);
  if(tracefile)
    fprintf(tracefile,"LS: %p\n",head);
  if(ppshape==(Word_t*)PPJERR)judyerror("get_pointer_data");
  if(ppshape == NULL) return pdat; // no lower object
  gc_shape_t *pshape = SHAPE(*ppshape);
  size_t max_slots = get_count((void*)head);
  size_t used_slots = get_used((void*)head);
  size_t n = max_slots * pshape->count * pshape->amt;
  if(cand >= (Word_t)(void*)((unsigned char*)(void*)head+n)) return pdat; // not interior
  pdat.head = (void*)head;
  pdat.max_elements = max_slots;
  pdat.used_elements = used_slots;
  pdat.shape = pshape;
  return pdat;
}

/* Given some word siuze value p, we have to decide what it is.
 * If its a pointer into an allocated object, since we got here
 * that object is reachable so we ensure that object is marked
 * reachable so it won't be reaped
 */

// if a pointer is interior, then
// if marked reachable already return NULL,NULL
// else mark as reachable and return head,shape
flx_collector_t::memdata_t flx_collector_t::check_interior (void *p)
{
  Word_t reachable = (parity & (uintptr_t)1) ^ (uintptr_t)1;
  if(debug)
    fprintf(stderr,"[gc] Scan object %p, reachable bit value = %d\n",p,(int)reachable);

  // Now find the shape of the object into which the pointer points,
  // if it is a Felix allocated object. First, we use JudyLLast
  // which finds the value less than or equal to the given key.
  if (!inrange(p)) return memdata_t{NULL,NULL,0};
  Word_t cand = (Word_t)p;
  Word_t head=cand;
  Word_t *ppshape = (Word_t*)JudyLLast(j_shape,&head,&je);
  if(ppshape==(Word_t*)PPJERR)judyerror("check_interior");

  // if the pointer returned by Judy is NULL, there is no
  // allocated object at or lower then the given address so exit
  if(ppshape == NULL) return memdata_t{NULL,NULL,0}; // no lower object
  /*
  if(debug)
  {
    fprintf(stderr,"Found candidate object %p, &shape=%p, shape(1) %p\n",(void*)fp,(void*)w,(void*)(*w));
    fprintf(stderr," .. type=%s!\n",((gc_shape_t*)(*w & ~(uintptr_t)1))->cname);
  }
  */

  // if the object lower then the given pointer is already
  // marked reachable, there's nothing to do (all the pointers
  // it reaches should also be marked) so just exit.
  if( (*ppshape & (uintptr_t)1) == reachable) return memdata_t {NULL,NULL,0};   // already handled

  // get the actual shape of the candidate object
  // don't forget to mask out the low bit which is the reachability flag
  gc_shape_t *pshape = SHAPE(*ppshape);

  // calculate the length of the candidate object in bytes
  size_t exterior_count = get_count((void*)head);
  size_t n = exterior_count * pshape->count * pshape->amt;

  // if our pointer is greater than or equal to the "one past the end"
  // pointer of the object, it is not a pointer interior to that object
  // but a foreign pointer and must be ignored
  if(cand >= (Word_t)(void*)((unsigned char*)(void*)head+n)) return memdata_t{NULL,NULL,0}; // not interior
  if(debug)
    fprintf(stderr,"[gc] MARKING object %p, shape %p, type=%s\n",(void*)head,pshape,pshape->cname);

  // otherwise we have an iterior or head pointer to the object
  // so set the reachable flag in the judy shape array
  *ppshape = (*ppshape & ~(uintptr_t)1) | reachable;
  return memdata_t {(void*)head,pshape,n};
}

void flx_collector_t::scan_object(void *p, int reclimit)
{

  // CAN p be NULL?? If so a fast exit could be done
  // no point if it can't be null though

  // The reachability flag is the low bit object type pointer.
  // The sense of the flag alternative between 0 and 1 meaning
  // reachable on successive collections. This is an optimisation
  // which saves marking all object unreachable first, then marking
  // the reachable ones reachable. We just use the previous reachable
  // marking to mean unreachable next time, then flip the bit for each
  // reachable object. The value parity records the sense and is flipped
  // at the start of each GC pass.
  //Word_t reachable = (parity & (uintptr_t)1) ^ (uintptr_t)1;
again:
   memdata_t memdata = check_interior(p);
   if(memdata.head == NULL) return;
/*
  //if(debug)
  //  fprintf(stderr,"[gc] Scan object %p, reachable bit value = %d\n",p,(int)reachable);

  // Now find the shape of the object into which the pointer points,
  // if it is a Felix allocated object. First, we use JudyLLast
  // which finds the value less than or equal to the given key.
  if (!inrange(p)) return;
  Word_t cand = (Word_t)p;
  Word_t head=cand;
  Word_t *ppshape = (Word_t*)JudyLLast(j_shape,&head,&je);
  if(ppshape==(Word_t*)PPJERR)judyerror("scan_object");

  // if the pointer returned by Judy is NULL, there is no
  // allocated object at or lower then the given address so exit
  if(ppshape == NULL) return; // no lower object

  //if(debug)
  //{
  //  fprintf(stderr,"Found candidate object %p, &shape=%p, shape(1) %p\n",(void*)fp,(void*)w,(void*)(*w));
  //  fprintf(stderr," .. type=%s!\n",((gc_shape_t*)(*w & ~(uintptr_t)1))->cname);
  //}
  //

  // if the object lower then the given pointer is already
  // marked reachable, there's nothing to do (all the pointers
  // it reaches should also be marked) so just exit.
  if( (*ppshape & (uintptr_t)1) == reachable) return;   // already handled

  // get the actual shape of the candidate object
  // don't forget to mask out the low bit which is the reachability flag
  gc_shape_t *pshape = SHAPE(*ppshape);

  // calculate the length of the candidate object in bytes
  size_t n = get_count((void*)head) * pshape->count * pshape->amt;

  // if our pointer is greater than or equal to the "one past the end"
  // pointer of the object, it is not a pointer interior to that object
  // but a foreign pointer and must be ignored
  if(cand >= (Word_t)(void*)((unsigned char*)(void*)head+n)) return; // not interior
  if(debug)
    fprintf(stderr,"[gc] MARKING object %p, shape %p, type=%s\n",(void*)head,pshape,pshape->cname);

  // otherwise we have an iterior or head pointer to the object
  // so set the reachable flag in the judy shape array
  *ppshape = (*ppshape & ~(uintptr_t)1) | reachable;
*/

  // Now we have to look for pointers contained in the object

  // The first branch here is not used at the moment,
  // and is a hard coded way to do a conservative scan on the object

  if(memdata.pshape->flags & gc_flags_conservative)
  {
    size_t n_used = get_used((void*)memdata.head) * memdata.pshape->count;
    // end of object, rounded down to size of a void*
    void **end = (void**)(
      (unsigned char*)(void*)memdata.head +
      n_used * memdata.nbytes / sizeof(void*) * sizeof(void*)
    );
    for ( void **i = (void**)memdata.head; i != end; i = i+1)
    {
      if(debug)
      //  fprintf(stderr, "Check if *%p=%p is a pointer\n",i,*(void**)i);
      if(reclimit==0) {

// LOCK REQUIRED XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        Judy1Set(&j_tmp,(Word_t)*i,&je);
// END LOCK XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        if(tracefile)
          fprintf(tracefile,"IT: %p\n",*i);
      }
      else
        scan_object(*i,reclimit -1);
    }
  }

  // This is the normal processing.
  else
  {
    // Calculate the dynamic count of used elements in the object.
    // All Felix objects are varrays which have an allocated and used
    // element count. The RTTI object always describes one element.
    size_t dyncount = get_used((void*)memdata.head);

    // if don't have a scanner for the object it is atomic,
    // that is it contains no pointers.
    // Otherwise call the scanner.
    if(memdata.pshape->scanner) {
      void *r = memdata.pshape->scanner(this, memdata.pshape,memdata.head,dyncount,reclimit);
      // If the scanner returns a non-zero value it is the sole pointer
      // in the object. So reset our argument and jump to the start of
      // this routine: self-tail-recursion optimisation.
      if (r) { p = r; goto again; }
      // Otherwise the scanner has registered the pointers it found that
      // need further examination. We do not do that examination here
      // recursively, or inside the scanner, because it might blow the stack.
      // Instead we just return, so a flat iteration loop can grab things
      // out of the registered pointer buffer and drive the process
      // with a flat loop.
    }
  }
}



size_t flx_collector_t::impl_collect()
{
  // THIS IS A BIT OF A HACK
  // but world_stop() is bugged!!
  // This is a temporary fix.
  FLX_SAVE_REGS;
  if (thread_control == NULL || thread_control->world_stop())
  {
    //if(debug)
    //  fprintf(stderr,"[gc] Collecting, thread %lx\n", (size_t)flx::pthread::get_current_native_thread());
    pthread::memory_ranges_t * mr = thread_control? thread_control -> get_block_list() : NULL;
    mark(mr);
    delete mr;
    size_t collected = sweep();
    if(thread_control) thread_control->world_start();
    //if(debug)
    //  fprintf(stderr,"[gc] FINISHED collect, thread %lx\n", (size_t)flx::pthread::get_current_native_thread());
    return collected;
  }
  else {
    if(debug)
      fprintf(stderr,"[gc] RACE: someone else is collecting, just yield\n");
    if(thread_control)thread_control->yield();
    return 0ul;
  }
}

void flx_collector_t::impl_free_all_mem()
{
  //fprintf(stderr,"impl_free_all_mem -- freeing roots\n");
  roots.clear();
  root_count = 0;
  //fprintf(stderr,"freeing all heap with sweep()\n");
  sweep();
}

flx_collector_t::~flx_collector_t()
{
   if(tracefile) {
     fclose(tracefile);
     fprintf(stderr,"Closed FLX_TRACE_GC file\n");
   }

  //THIS IS VERY DANGEROUS! What if don't want to collect
  //the garbage for efficiency reasons???
  //
  // ELIDED .. already caused a bug!
  //
  //free_all_mem();
}

}}} // end namespaces

Garbage Collector Interface

//[gc.flx]

//$ Generic garbage collector interface.
//$ This class provides a generic interface to the GC,
//$ that is, one that is independent of the GC representation.
open class Gc
{
  fun _collect: unit -> size = "PTF gcp->actually_collect()"
    requires property "needs_gc";

  //$ Invoke the garbage collector.
  proc collect() {
    if Env::getenv "FLX_REPORT_COLLECTIONS" != "" do
      eprintln "[Gc::collect] Program requests collection";
      var collected = _collect();
      eprintln$ "[Gc::collect] Collector collected " + collected.str + " objects";
    else
      C_hack::ignore(_collect());
    done
  }

  //$ Get the total number of bytes currently allocated.
  fun gc_get_allocation_amt : unit -> size= "PTF gcp->collector->get_allocation_amt()"
    requires property "needs_gc";

  //$ Get the total number of objects currently allocated.
  fun gc_get_allocation_count : unit -> size = "PTF gcp->collector->get_allocation_count()"
    requires property "needs_gc";

  //$ Get the total number of roots.
  fun gc_get_root_count : unit -> size = "PTF gcp->collector->get_root_count()"
    requires property "needs_gc";

  proc add_root: address  = "PTF gcp->collector->add_root ($1);"
    requires property "needs_gc";

  proc remove_root: address  = "PTF gcp->collector->remove_root ($1);"
    requires property "needs_gc";

}

Rtti introspection

//[rtti.flx]
class Rtti {

  //$ The type of the collector.
  type collector_t = "::flx::gc::generic::collector_t*";

  //$ The type of an RTTI record.
  type gc_shape_t = "::flx::gc::generic::gc_shape_t*";
  fun ==: gc_shape_t * gc_shape_t -> bool = "$1==$2";

  fun isNULL: gc_shape_t -> bool = "$1==0";
  typedef gc_shape_flags_t = uint;
    val gc_flags_default = 0;
    val gc_flags_immobile = 1;
    val gc_flags_persistent = 2;
    val gc_flags_conservative = 4;

  //$ The type of a finalisation function.
  typedef gc_finaliser_t = collector_t * address --> void;
  typedef gc_encoder_t = address --> string;
  typedef gc_decoder_t = address * +char * size --> size;

  type fcops_t = "ValueType*";
  fun get_fcops : gc_shape_t -> fcops_t = "$1->fcops";
  fun isNULL: fcops_t -> bool = "$1==0";

  fun object_size: fcops_t -> size = "$1->object_size()";
  fun object_alignment: fcops_t -> size = "$1->object_alignment()";
  proc dflt_init : fcops_t * address = "$1->dflt_init($2);";
  proc destroy : fcops_t * address = "$1->destroy($2);";
  proc copy_init : fcops_t * address * address  = "$1->copy_init($2,$3);";
  proc move_init : fcops_t * address * address  = "$1->move_init($2,$3);";
  proc copy_assign: fcops_t * address * address  = "$1->copy_assign($2,$3);";
  proc move_assign: fcops_t * address * address  = "$1->move_assign($2,$3);";

  //$ The C++ name of the Felix type.
  fun cname: gc_shape_t -> +char = "$1->cname";

  //$ The static number of elements in an array type.
  //$ Note this is not the size of a varray!
  fun number_of_elements: gc_shape_t -> size = "$1->count";

  //$ Number of bytes in one element.
  fun bytes_per_element: gc_shape_t -> size = "$1->amt";

  //$ The finaliser function.
  fun finaliser: gc_shape_t -> gc_finaliser_t  = "$1->finaliser";

  //$ The encoder function.
  fun encoder : gc_shape_t -> gc_encoder_t = "$1->encoder";

  //$ The decoder function.
  fun decoder: gc_shape_t -> gc_decoder_t = "$1->decoder";

  //$ Check for offset data
  fun uses_offset_table : gc_shape_t -> bool = "$1->scanner == ::flx::gc::generic::scan_by_offsets";

  //$ The number of pointers in the base type.
  //$ If the type is an array that's the element type.
  fun _unsafe_n_offsets: gc_shape_t -> size = "((::flx::gc::generic::offset_data_t const *)($1->private_data))->n_offsets";

  fun n_offsets (shape: gc_shape_t) : size =>
    if uses_offset_table shape then _unsafe_n_offsets shape else 0uz
  ;

  //$ Pointer to the offset table.
  fun _unsafe_offsets: gc_shape_t -> +size = "const_cast< ::std::size_t *>(((::flx::gc::generic::offset_data_t const *)($1->private_data))->offsets)";

  fun offsets (shape: gc_shape_t) : +size =>
    if uses_offset_table shape then _unsafe_offsets shape else C_hack::cast[+size] 0
  ;

  //$ Flags.
  fun flags: gc_shape_t -> gc_shape_flags_t = "$1->flags";

  //$ Global head of the compiled shape list.
  //$ This is actually the first type, since they're linked together.
  fun shape_list_head : unit -> gc_shape_t = "PTF shape_list_head";

  //$ C++ type_info for the type.
  type type_info = "::std::type_info" requires header "#include <typeinfo>";

  //$ C++ source name of the type.
  fun name : type_info -> string = "::std::string($1.name())";

  //$ C++ Type_info of a type.
  const typeid[T]: type_info = "typeid(?1)";

  // PLATFORM DEPENDENT, REQUIRES cxxabi.h.
  // Only sure to work for gcc.
  private proc _gxx_demangle: string * &string = """{
    int status;
    char *tmp=abi::__cxa_demangle($1.c_str(), 0,0, &status);
    string s= string(tmp);
    std::free(tmp);
    *$2= s;
    }
  """ requires header "#include <cxxabi.h>";

  //$ For gcc only, the C++ name a mangled name represents.
  fun gxx_demangle(s:string) :string =
  {
    var r: string;
    _gxx_demangle(s, &r);
    return r;
  }

  proc _link_shape[T]: &gc_shape_t = """
    ::flx::gc::generic::gc_shape_t *p = (gc_shape_t*)malloc(sizeof(gc_shape_t));
    PTF shape_list_head = p;
    p->cname = typeid(?1).name();
    p->count = 1;
    p->amt = sizeof(?1);
    p->finaliser = ::flx::gc::generic::std_finaliser<?1>;
    p->n_offsets = 0;
    p->offsets = 0;
    p->flags = ::flx::gc::generic::gc_flags_default;
    *$1 = p;
    """ requires property "needs_gc";

  //$ Create a new shape record.
  //$ This routine constructs a new shape record on the heap.
  //$ It fills in some of the data based on the type.
  //$ Then it stores the shape at the user specified address.
  //$ Since the shape is represented in Felix by a pointer,
  //$ subsequent modifications carry through to the linked shape object.
  //$ This routine is only useful for adding a shape record for a statically
  //$ known type: that's useful because not all statically known types get
  //$ shape records: the compiler only generates them if the shape is
  //$ required because an object of that type is allocated on the heap.
  gen link_shape[T]()= { var p: gc_shape_t; _link_shape[T] (&p); return p; }
}

Low level Garbage Collector Access

//[flx_gc.flx]
class Collector
{
  open Rtti;
  struct pointer_data_t
  {
     pointer: address;
     head: address;
     max_elements: size;  // dynamic slots
     used_elements: size; // dynamic slots used
     shape:gc_shape_t;
  };

  private type raw_pointer_data_t = "::flx::gc::generic::pointer_data_t" ;
  private fun get_raw_pointer_data: address -> raw_pointer_data_t =
    "PTF gcp->collector->get_pointer_data($1)"
    requires property "needs_gc"
  ;
  fun get_pointer_data (p:address) => C_hack::reinterpret[pointer_data_t](get_raw_pointer_data p);

  fun is_felix_pointer (pd: pointer_data_t) => not (isNULL pd.head);
  fun is_head_pointer (pd: pointer_data_t) => pd.pointer == pd.head;
  fun repeat_count (pd: pointer_data_t) => pd.used_elements *  pd.shape.number_of_elements;
  fun allocated_bytes (pd: pointer_data_t) => pd.max_elements *
    pd.shape.number_of_elements * pd.shape.bytes_per_element
  ;

  //$ Diagnostic routine, dump pointer data and
  //$ computed values.
  proc print_pointer_data (pd: pointer_data_t)
  {
    println$ "Candidate pointer = " + pd.pointer.str;
    println$ "Valid=" + pd.Collector::is_felix_pointer.str;
    if pd.Collector::is_felix_pointer do
      println$ "Is head=" + pd.Collector::is_head_pointer.str;
      var shape = pd.shape;
      println$ "Element type =  " + shape.cname.string;
      println$ "Pod[has no finaliser] = " + shape.finaliser.address.isNULL.str;
      var bpe = shape.bytes_per_element;
      println$ "Bytes per element = " + bpe.str;
      println$ "Static array length = " + shape.number_of_elements.str;
      println$ "Dynamic array length = " + pd.used_elements.str;
      println$ "Max dynamic array length = " + pd.max_elements.str;
      var nelts = pd.used_elements * shape.number_of_elements;
      println$ "Aggregate number of used elements " + nelts.str;
      println$ "Store to serialise: " + (nelts * bpe) . str;
    done
  }

  //$ Diagnostic routine, print info about a pointer.
  proc print_pointer_data (p:address)
  {
    var pd = Collector::get_pointer_data p;
    print_pointer_data (pd);
  }
  proc print_pointer_data[T] (p:&T) => print_pointer_data (C_hack::cast[address] p);
  proc print_pointer_data[T] (p:cptr[T]) => print_pointer_data (C_hack::cast[address] p);
  proc print_pointer_data[T] (p:+T) => print_pointer_data (C_hack::cast[address] p);

}

Bootstrap Build System

#[flx_gc.py]
import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    path = Path(phase.ctx.buildroot/'share'/'src/gc')
    dst = 'host/lib/rtl/flx_gc'
    srcs = Path.glob(path / '*.cpp')
    includes = [
        phase.ctx.buildroot / 'host/lib/rtl',
        phase.ctx.buildroot / 'share/lib/rtl',
    ]
    macros = ['BUILD_FLX_GC']
    libs = [
        call('buildsystem.judy.build_runtime', phase),
        call('buildsystem.flx_exceptions.build_runtime', phase),
    ]

    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.static for lib in libs]),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.shared for lib in libs]))

Configuration Database Records

//[unix_flx_gc.fpc]
Name: flx_gc
Platform: Unix
Description: Felix default garbage collector (Unix)
provides_dlib: -lflx_gc_dynamic
provides_slib: -lflx_gc_static
includes: '"flx_gc.hpp"'
library: flx_gc
macros: BUILD_FLX_GC
Requires: judy flx_exceptions
srcdir: src/gc
src: .*\.cpp

//[win_flx_gc.fpc]
Name: flx_gc
Platform: Windows
Description: Felix default garbage collector (Windows)
provides_dlib: /DEFAULTLIB:flx_gc_dynamic
provides_slib: /DEFAULTLIB:flx_gc_static
includes: '"flx_gc.hpp"'
Requires: judy
library: flx_gc
macros: BUILD_FLX_GC
Requires: judy flx_exceptions
srcdir: src/gc
src: .*\.cpp

//[flx_gc_config.hpp]
#ifndef __FLX_GC_CONFIG_H__
#define __FLX_GC_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_FLX_GC
#define GC_EXTERN FLX_EXPORT
#else
#define GC_EXTERN FLX_IMPORT
#endif
#endif

Package: src/packages/linux.fdoc

Specialised Linux Support

key file
plat_linux.hpp $PWD/src/plat/plat_linux.hpp
plat_linux.cpp $PWD/src/plat/plat_linux.cpp

Linux Support

Stuff that works on Linux but not other platforms.

We only have a function here to get the number of CPUs, the Linux way. Since it parses the /proc/stat file, this suggests a more general way of accessing the /proc directory would make sense.

//[plat_linux.hpp]
#ifndef __PLAT_LINUX_H__
#define __PLAT_LINUX_H__
int get_cpu_nr();
#endif

//[plat_linux.cpp]
#define STAT "/proc/stat"
#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
#include <string.h>

#include "plat_linux.hpp"

// return number of cpus
int get_cpu_nr()
{
   FILE *fp;
   char line[16];
   int proc_nb, cpu_nr = -1;

   if ((fp = fopen(STAT, "r")) == NULL) {
      fprintf(stderr, ("Cannot open %s: %s\n"), STAT, strerror(errno));
      exit(1);
   }

   while (fgets(line, 16, fp) != NULL) {

      if (strncmp(line, "cpu ", 4) && !strncmp(line, "cpu", 3)) {
         char* endptr = NULL;
         proc_nb = strtol(line + 3, &endptr, 0);

         if (!(endptr && *endptr == '\0')) {
           fprintf(stderr, "unable to parse '%s' as an integer in %s\n", line + 3, STAT);
           exit(1);
         }

         if (proc_nb > cpu_nr)
            cpu_nr = proc_nb;
      }
   }

   fclose(fp);

   return (cpu_nr + 1);
}

Package: src/packages/judy.fdoc

Judy Arrays

key file
judy.py $PWD/buildsystem/judy.py
unix32_judy.fpc $PWD/src/config/unix32/judy.fpc
unix64_judy.fpc $PWD/src/config/unix64/judy.fpc
win64_judy.fpc $PWD/src/config/win64/judy.fpc

Judy Builder

#[judy.py]
import fbuild
import fbuild.db
from fbuild.builders.file import copy, copy_regex
from fbuild.path import Path
from fbuild.record import Record

import buildsystem
from buildsystem.config import config_call

# ------------------------------------------------------------------------------
def build_judytables(ctx, tablegen:fbuild.db.SRC, dst) -> fbuild.db.DST:

“”“Create the judytable generator executable.”“”

# Make sure the directory exists. dst.parent.makedirs()

# We have to run the tablegen from the working directory to get the files # generated in the right place. ctx.execute(tablegen.abspath(),

msg1=tablegen.name, msg2=dst, cwd=dst.parent, color=’yellow’)

return dst

def prepend_macros(ctx, src, macros, dst) -> fbuild.db.DST:

“”“Generate a new version of the input file which has the given macros added to the top as #define’s”“” # Make sure the directory exists. dst.parent.makedirs() src = Path(src) dst = Path(dst) outfile = open(dst, ‘wb’) try:

for macro in macros:
outfile.write(bytes(‘#ifndef ‘+macro+’n’+
‘#define ‘+macro+’ 1n’+ ‘#endifn’, ‘ascii’))

outfile.write(bytes(‘#include “../JudyCommon/’+src.name+’”’, ‘ascii’)) ctx.logger.check(‘ * generate’, ‘%s as #define %s and #include %s’ % (dst, ‘,’.join(macros), src), color=’yellow’)

finally: outfile.close() return dst

# ——————————————————————————

def build_runtime(phase):

“”” Builds the judy runtime library, and returns the static and shared library versions. “”“

path = Path(phase.ctx.buildroot/’share’/’src/judy/src’)

# Copy the header into the runtime library. buildsystem.copy_to(phase.ctx,

phase.ctx.buildroot / ‘share/lib/rtl’, [path / ‘Judy.h’])
types = config_call(‘fbuild.config.c.c99.types’,
phase.platform, phase.c.static)

#if types.voidp.size == 8: macros = [‘JU_64BIT’] print (“64 bit JUDY”)

macros.append(‘BUILD_JUDY’) #Apply this to all source files.

#macros.append(‘DEBUG’) #Apply this to all source files. # above fails with link error because the debug routines # simply don’t exist

srcs = [
path / ‘JudyCommon/JudyMalloc.c’, path / ‘JudySL/JudySL.c’, path / ‘JudyHS/JudyHS.c’] + ( path / ‘Judy1’ / ‘.c’).glob() + ( path / ‘JudyL’ / ‘.c’).glob()
includes = [path,
path / ‘JudyCommon’, path / ‘JudyL’, path / ‘Judy1’]
static = buildsystem.build_c_static_lib(phase, ‘host/lib/rtl/judy’,
srcs=srcs, macros=macros, includes=includes)
shared = buildsystem.build_c_shared_lib(phase, ‘host/lib/rtl/judy’,
srcs=srcs, macros=macros, includes=includes)

return Record(static=static, shared=shared)

//[unix32_judy.fpc]
Name: Judy
Description: Judy arrays
provides_dlib: -ljudy_dynamic
provides_slib: -ljudy_static
includes: '"Judy.h"'
library: judy
macros: JU_32BIT BUILD_JUDY
srcdir: src/judy/src
headers: Judy\.h
src: (JudyCommon/JudyMalloc|JudySL/.*|JudyHS/.*|Judy1/.*|JudyL/.*)\.c
build_includes: src/judy/src src/judy/src/Judy1 src/judy/src/JudyL src/judy/src/JudyHS src/judy/src/JudyCommon

//[unix64_judy.fpc]
Name: Judy
Description: Judy arrays
provides_dlib: -ljudy_dynamic
provides_slib: -ljudy_static
includes: '"Judy.h"'
library: judy
macros: JU_64BIT BUILD_JUDY
srcdir: src/judy/src
headers: Judy\.h
src: (JudyCommon/JudyMalloc|JudySL/.*|JudyHS/.*|Judy1/.*|JudyL/.*)\.c
build_includes: src/judy/src src/judy/src/Judy1 src/judy/src/JudyL src/judy/src/JudyHS src/judy/src/JudyCommon

//[win64_judy.fpc]
Name: Judy WIN32 64 BIT
Description: Judy arrays
provides_dlib: /DEFAULTLIB:judy_dynamic
provides_slib: /DEFAULTLIB:judy_static
includes "Judy.h"
library: judy
macros: JU_64BIT BUILD_JUDY
srcdir: src\judy\src
headers: Judy\.h
src: (JudyCommon\\JudyMalloc|JudySL\\.*|JudyHS\\.*|Judy1\\.*|JudyL\\.*)\.c
build_includes: src\judy\src src\judy\src\Judy1 src\judy\src\JudyL src\judy\src\JudyHS src\judy\src\JudyCommon

Package: src/packages/rtl.fdoc

Run Time Library

key file
flx_rtl.py $PWD/buildsystem/flx_rtl.py
flx_compiler_support_bodies.hpp share/lib/rtl/flx_compiler_support_bodies.hpp
flx_compiler_support_headers.hpp share/lib/rtl/flx_compiler_support_headers.hpp
flx_executil.cpp share/src/rtl/flx_executil.cpp
flx_executil.hpp share/lib/rtl/flx_executil.hpp
flx_executil.fpc $PWD/src/config/flx_executil.fpc
flx_main.cpp share/src/rtl/flx_main.cpp
flx_rtl.cpp share/src/rtl/flx_rtl.cpp
flx_rtl.hpp share/lib/rtl/flx_rtl.hpp
flx_rtl_shapes.cpp share/src/rtl/flx_rtl_shapes.cpp
flx_rtl_shapes.hpp share/lib/rtl/flx_rtl_shapes.hpp
plat_linux.cpp share/src/rtl/plat_linux.cpp
plat_linux.hpp share/lib/rtl/plat_linux.hpp
flx_rtl_config.hpp share/lib/rtl/flx_rtl_config.hpp
flx_rtl_config.h share/lib/rtl/flx_rtl_config.h
flx_rtl_core.fpc $PWD/src/config/flx_rtl_core.fpc
flx_thread_free_rtl_core.fpc $PWD/src/config/flx_thread_free_rtl_core.fpc
sysdlist.flx share/lib/std/control/sysdlist.flx
unix_flx.fpc $PWD/src/config/unix/flx.fpc
win_flx.fpc $PWD/src/config/win/flx.fpc

Bootstrap builder.

#[flx_rtl.py]
import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy

import buildsystem
from buildsystem.config import config_call

# ------------------------------------------------------------------------------

def build_runtime(phase):
    path = Path(phase.ctx.buildroot/'share'/'src', 'rtl')

    print("[fbuild] [rtl] MAKING RTL ******* ")

    srcs = [f for f in Path.glob(path / '*.cpp')]
    includes = [
        phase.ctx.buildroot / 'host/lib/rtl',
        phase.ctx.buildroot / 'share/lib/rtl'
    ]
    macros = ['BUILD_RTL']
    libs = [
        call('buildsystem.flx_uint256_t.build_runtime', phase),
        #call('buildsystem.flx_integer.build_runtime', phase),
        call('buildsystem.flx_strutil.build_runtime', phase),
        call('buildsystem.flx_dynlink.build_runtime', phase),
        call('buildsystem.flx_async.build_runtime', phase),
        call('buildsystem.flx_exceptions.build_runtime', phase),
        call('buildsystem.flx_gc.build_runtime', phase),
    ]

    dlfcn_h = config_call('fbuild.config.c.posix.dlfcn_h',
        phase.platform,
        phase.cxx.static,
        phase.cxx.shared)

    if dlfcn_h.dlopen:
        external_libs = dlfcn_h.external_libs
    else:
        external_libs = []

    dst = 'host/lib/rtl/flx'
    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.static for lib in libs],
            external_libs=external_libs),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.shared for lib in libs],
            external_libs=external_libs))

Compiler Support

//[flx_compiler_support_headers.hpp]
#ifndef __FLX_COMPILER_SUPPORT_HEADERS_H__
#define __FLX_COMPILER_SUPPORT_HEADERS_H__
#include "flx_rtl_config.hpp"
#if defined(FLX_PTF_STATIC_STRUCT) || defined(FLX_PTF_STATIC_PTR)
#error "FLX_PTF_STATIC_STRUCT and FLX_PTF_STATIC_PTR no longer supported"
#endif

#define PTF ptf->
#define FLX_POINTER_TO_THREAD_FRAME ptf

// for declarations in header file
#define FLX_FMEM_DECL thread_frame_t *ptf;
#define FLX_FPAR_DECL_ONLY thread_frame_t *_ptf
#define FLX_FPAR_DECL thread_frame_t *_ptf,
#define FLX_APAR_DECL_ONLY thread_frame_t *ptf
#define FLX_APAR_DECL thread_frame_t *ptf,
#define FLX_DCL_THREAD_FRAME

#if FLX_CGOTO
  #define FLX_LOCAL_LABEL_VARIABLE_TYPE void*
  #define FLX_PC_DECL void *pc;
  #define FLX_KILLPC pc = &&_flx_dead_frame;
#else
  #define FLX_PC_DECL int pc;
  #define FLX_LOCAL_LABEL_VARIABLE_TYPE int
  #define FLX_KILLPC pc = -1;
#endif

#define t typename
#define t2 t,t
#define t3 t,t,t
#define t4 t,t,t,t
#define p template <
#define s > struct
template <typename, int> struct _fix; // fixpoint
template <t,t> struct _ft;            // function
template <t,t> struct _cft;           // cfunction
template <t,int> struct _at;          // array
template <t> struct _pt;              // procedure
  p t2 s _tt2;                        // tuples
  p t3 s _tt3;
  p t4 s _tt4;
  p t,t4 s _tt5;
  p t2,t4 s _tt6;
  p t3,t4 s _tt7;
#undef t
#undef t2
#undef t3
#undef t4
#undef p
#undef s
#endif

//[flx_compiler_support_bodies.hpp]
#ifndef __FLX_COMPILER_SUPPORT_BODIES_H__
#define __FLX_COMPILER_SUPPORT_BODIES_H__
#include "flx_compiler_support_headers.hpp"

#include <algorithm>

//
// convert an rvalue to an lvalue
template<typename T>
T const &lvalue(T const &x)
{
  return x;
}

// this reinterpret cast works with rvalues too
template<typename T, typename U>
T &reinterpret(U const &x) {
  return reinterpret_cast<T&>(const_cast<U&>(x));
}

// dflt init
template<typename T>
void dflt_init(T *p){ new(p) T(); }

// destroy object
template<typename T>
void destroy(T *p){ p->T::~T(); }

// copy initialise
template<typename T>
void copy_init (T *dst, T *src)
{
  new(dst) T(*src);
}

// move initialise
template<typename T>
void move_init (T *dst, T *src)
{
  new(dst) T(::std::move(*src));
}

// move initialise, destroy src
template<typename T>
void dmove_init (T *dst, T *src)
{
  new(dst) T(::std::move(*src));
  destroy (src);
}

// copy assign
template<typename T>
void copy_assign (T *dst, T *src)
{
  *dst = *src;
}

// move assign
template<typename T>
void move_assign (T *dst, T *src)
{
  *dst = ::std::move(*src);
}

// move assign, destroy src
template<typename T>
void dmove_assign (T *dst, T *src)
{
  *dst = ::std::move(*src);
  destroy (src);
}

class ValueType
{
  virtual size_t object_size_impl()=0;
  virtual size_t object_alignment_impl()=0;
  virtual void dflt_init_impl (void *)=0;
  virtual void destroy_impl (void *)=0;
  virtual void copy_init_impl(void *, void *)=0;
  virtual void move_init_impl(void *, void *)=0;
  virtual void copy_assign_impl(void *, void *)=0;
  virtual void move_assign_impl(void *, void *)=0;
public:
  size_t object_size() { return object_size_impl(); }
  size_t object_alignment() { return object_size_impl(); }
  void dflt_init(void *dst) { dflt_init_impl(dst); }
  void destroy(void *dst) { destroy_impl (dst); }

  void copy_init (void *dst, void *src) { copy_init_impl(dst,src); }
  void move_init (void *dst, void *src) { move_init_impl(dst,src); }
  void copy_assign(void *dst, void *src) { copy_assign_impl(dst,src); }
  void move_assign(void *dst, void *src) { move_assign_impl(dst,src); }
};

template<typename T>
class CxxValueType : public virtual ValueType
{
  size_t object_size_impl() { return sizeof(T); }
  size_t object_alignment_impl() { return alignof(T); }
  void dflt_init_impl(void *dst) { ::dflt_init<T>((T*)dst); }
  void destroy_impl(void *dst) { ::dflt_init<T>((T*)dst); }
  void copy_init_impl(void *dst, void *src) { ::copy_init<T>((T*)dst,(T*)src); }
  void move_init_impl(void *dst, void *src) { ::move_init<T>((T*)dst,(T*)src); }
  void copy_assign_impl(void *dst, void *src) { ::copy_assign<T>((T*)dst,(T*)src); }
  void move_assign_impl(void *dst, void *src) { ::move_assign<T>((T*)dst,(T*)src); }
};

// object does NOT own the product description array
// should use a shared pointer thing I guess
class ProductType : public virtual ValueType
{
  size_t n;
  ValueType **cp;
public:
  ProductType (ValueType **p, size_t m) : cp(p), n(n) {}
  ~ProductType();
  size_t object_size_impl() override;
  size_t object_alignment_impl() override;
  void dflt_init_impl (void *) override;
  void destroy_impl (void *) override;
  void copy_init_impl(void *, void *) override;
  void move_init_impl(void *, void *) override;
  void copy_assign_impl(void *, void *) override;
  void move_assign_impl(void *, void *) override;
};


template<typename T0, typename T1>
struct _tt2 {
  T0 mem_0;
  T1 mem_1;
  _tt2() {}
  _tt2 (T0 _a0, T1 _a1) : mem_0(_a0), mem_1(_a1) {}
};

template<typename T0, typename T1, typename T2>
struct _tt3 {
  T0 mem_0;
  T1 mem_1;
  T2 mem_2;
  _tt3() {}
  _tt3 (T0 _a0, T1 _a1, T2 _a2) :
    mem_0(_a0), mem_1(_a1),mem_2(_a2)
    {}
};

template<typename T0, typename T1, typename T2, typename T3>
struct _tt4 {
  T0 mem_0;
  T1 mem_1;
  T2 mem_2;
  T3 mem_3;
  _tt4() {}
  _tt4 (T0 _a0, T1 _a1, T2 _a2, T3 _a3) :
    mem_0(_a0), mem_1(_a1),mem_2(_a2), mem_3(_a3)
    {}
};

template<typename T0, typename T1, typename T2, typename T3, typename T4>
struct _tt5 {
  T0 mem_0;
  T1 mem_1;
  T2 mem_2;
  T3 mem_3;
  T4 mem_4;
  _tt5() {}
  _tt5 (T0 _a0, T1 _a1, T2 _a2, T3 _a3, T4 _a4) :
    mem_0(_a0), mem_1(_a1),mem_2(_a2), mem_3(_a3), mem_4(_a4)
    {}
};


#define FLX_EXEC_FAILURE(f,op,what) \
  throw ::flx::rtl::flx_exec_failure_t (f,op,what)

#define FLX_HALT(f,sl,sc,el,ec,s) \
  throw ::flx::rtl::flx_halt_t (::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),__FILE__,__LINE__,s)

// note call should be trace(&v,...) however that requires
// compiler support to make a trace record for each tracepoint
// so we use NULL for now

#ifdef FLX_ENABLE_TRACE
#define FLX_TRACE(v,f,sl,sc,el,ec,s) \
  ::flx::rtl::flx_trace (NULL,::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),__FILE__,__LINE__,s)
#else
#define FLX_TRACE(v,f,sl,sc,el,ec,s)
#endif

#define FLX_MATCH_FAILURE(f,sl,sc,el,ec) \
  throw ::flx::rtl::flx_match_failure_t (::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),__FILE__,__LINE__)

#define FLX_DROPTHRU_FAILURE(f,sl,sc,el,ec) \
  throw ::flx::rtl::flx_dropthru_failure_t (::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),__FILE__,__LINE__)

#define FLX_ASSERT_FAILURE(f,sl,sc,el,ec) \
  throw ::flx::rtl::flx_assert_failure_t (::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),__FILE__,__LINE__)

#define FLX_ASSERT2_FAILURE(f,sl,sc,el,ec,f2,sl2,sc2,el2,ec2) \
  throw ::flx::rtl::flx_assert2_failure_t (\
    ::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),\
    ::flx::rtl::flx_range_srcref_t(f2,sl2,sc2,el2,sc2),\
    __FILE__,__LINE__)

#define FLX_AXIOM_CHECK_FAILURE(f,sl,sc,el,ec,f2,sl2,sc2,el2,ec2) \
  throw ::flx::rtl::flx_axiom_check_failure_t (\
    ::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),\
    ::flx::rtl::flx_range_srcref_t(f2,sl2,sc2,el2,sc2),\
    __FILE__,__LINE__)

#define FLX_RANGE_FAILURE(mi,v,ma,f,sl,sc,el,ec) \
  throw ::flx::rtl::flx_range_failure_t (mi,v,ma,::flx::rtl::flx_range_srcref_t(f,sl,sc,el,ec),__FILE__,__LINE__)

// for generated code in body file
#define INIT_PC pc=0;
    ///< interior program counter

#if FLX_CGOTO
  #ifdef __clang__
  #define FLX_START_SWITCH (&&_start_switch); _start_switch: if(pc)goto *pc;
  #else
  #define FLX_START_SWITCH _start_switch: if(pc)goto *pc;
  #endif
  #define FLX_LOCAL_LABEL_ADDRESS(x) &&case_##x
  #define FLX_SET_PC(x) pc=&&case_##x;
  #define FLX_CASE_LABEL(x) case_##x:;
  #define FLX_DECLARE_LABEL(n,i,x) \
    extern void f##i##_##n##_##x(void) __asm__("l"#i"_"#n"_"#x);
  #define FLX_LABEL(n,i,x) x:\
    __asm__(".global l"#i"_"#n"_"#x);\
    __asm__("l"#i"_"#n"_"#x":");\
    __asm__(""::"g"(&&x));
  #define FLX_FARTARGET(n,i,x) (void*)&f##i##_##n##_##x
  #define FLX_END_SWITCH \
    _flx_dead_frame: throw ::flx::rtl::flx_dead_frame_failure_t(__FILE__,__LINE__);
#else
  #define FLX_START_SWITCH _start_switch: switch(pc){case 0:;
  #define FLX_LOCAL_LABEL_ADDRESS(x) x
  #define FLX_SET_PC(x) pc=x;
  #define FLX_CASE_LABEL(x) case x:;
  #define FLX_DECLARE_LABEL(n,i,x)
  #define FLX_LABEL(n,i,x) case n: x:;
  #define FLX_FARTARGET(n,i,x) n
  #define FLX_END_SWITCH \
    case -1: throw ::flx::rtl::flx_dead_frame_failure_t(__FILE__,__LINE__);\
    default: throw ::flx::rtl::flx_switch_failure_t(__FILE__,__LINE__); }
#endif

//
// We do a direct long jump to a target as follows:
//
// If the target frame is just ourself (this)
// we set the pc and just goto the start of the procedure,
// allowing the switch/computed goto there to do the local jump.
//
// If the target is foreign, we force the foreign frame pc
// to the target pc, and then return that frame to the driver
// so it will resume that procedure, executing the starting switch,
// which now jumps to the required location.
//
#define FLX_DIRECT_LONG_JUMP(ja) \
  { \
    ::flx::rtl::jump_address_t j = ja; \
    if(j.target_frame == this) { \
      pc = j.local_pc; \
      goto _start_switch; \
    } else { \
      j.target_frame->pc = j.local_pc; \
      return j.target_frame; \
    } \
  }

#define FLX_RETURN \
{ \
  con_t *tmp = _caller; \
  _caller = 0; \
  return tmp; \
}

#define FLX_NEWP(x) new(*PTF gcp,x##_ptr_map,true)x

#define FLX_FINALISER(x) \
static void x##_finaliser(::flx::gc::generic::collector_t *, void *__p){\
  ((x*)__p)->~x();\
}


#define FLX_FMEM_INIT_ONLY : ptf(_ptf)
#define FLX_FMEM_INIT : ptf(_ptf),
#define FLX_FPAR_PASS_ONLY ptf
#define FLX_FPAR_PASS ptf,
#define FLX_APAR_PASS_ONLY _ptf
#define FLX_APAR_PASS _ptf,
#define _PTF _ptf->
#define _PTFV _ptf
#define FLX_PASS_PTF 1
#define FLX_EAT_PTF(x) x
#define FLX_DEF_THREAD_FRAME

#define FLX_FRAME_WRAPPERS(mname,name) \
extern "C" FLX_EXPORT mname::thread_frame_t *name##_create_thread_frame(\
  ::flx::gc::generic::gc_profile_t *gcp,\
  ::flx::run::flx_world *world\
) {\
  mname::thread_frame_t *p = new(*gcp,mname::thread_frame_t_ptr_map,false) mname::thread_frame_t();\
  p->world = world;\
  p->gcp = gcp;\
  return p;\
}

// init is a heap procedure
#define FLX_START_WRAPPER(mname,name,x)\
extern "C" FLX_EXPORT ::flx::rtl::con_t *name##_flx_start(\
  mname::thread_frame_t *__ptf,\
  int argc,\
  char **argv,\
  FILE *stdin_,\
  FILE *stdout_,\
  FILE *stderr_\
) {\
  __ptf->argc = argc;\
  __ptf->argv = argv;\
  __ptf->flx_stdin = stdin_;\
  __ptf->flx_stdout = stdout_;\
  __ptf->flx_stderr = stderr_;\
  return (new(*__ptf->gcp,mname::x##_ptr_map,false) \
    mname::x(__ptf)) ->call(0);\
}

// init is a stack procedure
#define FLX_STACK_START_WRAPPER_PTF(mname,name,x)\
extern "C" FLX_EXPORT ::flx::rtl::con_t *name##_flx_start(\
  mname::thread_frame_t *__ptf,\
  int argc,\
  char **argv,\
  FILE *stdin_,\
  FILE *stdout_,\
  FILE *stderr_\
) {\
  __ptf->argc = argc;\
  __ptf->argv = argv;\
  __ptf->flx_stdin = stdin_;\
  __ptf->flx_stdout = stdout_;\
  __ptf->flx_stderr = stderr_;\
  mname::x(__ptf).stack_call();\
  return 0;\
}


// init is a stack procedure, no PTF
#define FLX_STACK_START_WRAPPER_NOPTF(mname,name,x)\
extern "C" FLX_EXPORT ::flx::rtl::con_t *name##_flx_start(\
  mname::thread_frame_t *__ptf,\
  int argc,\
  char **argv,\
  FILE *stdin_,\
  FILE *stdout_,\
  FILE *stderr_\
) {\
  __ptf->argc = argc;\
  __ptf->argv = argv;\
  __ptf->flx_stdin = stdin_;\
  __ptf->flx_stdout = stdout_;\
  __ptf->flx_stderr = stderr_;\
  mname::x().stack_call();\
  return 0;\
}


// init is a C procedure, passed PTF
#define FLX_C_START_WRAPPER_PTF(mname,name,x)\
extern "C" FLX_EXPORT ::flx::rtl::con_t *name##_flx_start(\
  mname::thread_frame_t *__ptf,\
  int argc,\
  char **argv,\
  FILE *stdin_,\
  FILE *stdout_,\
  FILE *stderr_\
) {\
  __ptf->argc = argc;\
  __ptf->argv = argv;\
  __ptf->flx_stdin = stdin_;\
  __ptf->flx_stdout = stdout_;\
  __ptf->flx_stderr = stderr_;\
  mname::x(__ptf);\
  return 0;\
}

// init is a C procedure, NOT passed PTF
#define FLX_C_START_WRAPPER_NOPTF(mname,name,x)\
extern "C" FLX_EXPORT ::flx::rtl::con_t *name##_flx_start(\
  mname::thread_frame_t *__ptf,\
  int argc,\
  char **argv,\
  FILE *stdin_,\
  FILE *stdout_,\
  FILE *stderr_\
) {\
  mname::x();\
  return 0;\
}


#endif

RTL

//[flx_rtl.hpp]
#ifndef __FLX_RTL_H__
#define __FLX_RTL_H__

#include "flx_rtl_config.hpp"
#include "flx_exceptions.hpp"
#include "flx_gc.hpp"
#include "flx_serialisers.hpp"
#include "flx_rtl_shapes.hpp"
#include "flx_compiler_support_headers.hpp"
#include "flx_compiler_support_bodies.hpp"
#include "flx_continuation.hpp"
#include "flx_svc.hpp"

#include <string>
#include <functional>
#include <cstdint>
#include <mutex>
#include <list>
#include <atomic>
#include "flx_spinlock.hpp"

namespace flx { namespace rtl {

typedef void *void_pointer;

// ********************************************************
// Compact Linear Type and projection
// ********************************************************

typedef ::std::uint64_t cl_t;

// ********************************************************
// Felix system classes
// ********************************************************


struct RTL_EXTERN muxguard;

// MOVED TO flx_exceptions
//struct RTL_EXTERN con_t;     // continuation
struct RTL_EXTERN jump_address_t;     // label variable type
struct RTL_EXTERN fthread_t; // f-thread

struct RTL_EXTERN _uctor_;   // union constructor
//struct RTL_EXTERN _variant_;   // variant constructor
struct RTL_EXTERN schannel_t;   // synchronous channel type
struct RTL_EXTERN clptr_t;  // pointer to compact linear product component
struct RTL_EXTERN clprj_t;  // compact linear projection

struct RTL_EXTERN muxguard {
private:
   muxguard() = delete;
   muxguard(muxguard const&) = delete;
   muxguard *operator=(muxguard const&)=delete;
  ::std::mutex *m;
public:
  muxguard (::std::mutex *p);
  ~muxguard ();
};


// MOVE THIS TO RTL AND PROVIDE SUITABLE RTTI SO GC KNOWS ABOUT THE FRAME POINTER
struct RTL_EXTERN jump_address_t
{
  con_t *target_frame;
  FLX_LOCAL_LABEL_VARIABLE_TYPE local_pc;

  jump_address_t (con_t *tf, FLX_LOCAL_LABEL_VARIABLE_TYPE lpc) :
    target_frame (tf), local_pc (lpc)
  {}
  jump_address_t () : target_frame (0), local_pc(0) {}
  jump_address_t (con_t *tf) : target_frame(tf), local_pc(0) {}
  // default copy constructor and assignment
};

// ********************************************************
/// FTHREAD. Felix threads
// ********************************************************

struct RTL_EXTERN fthread_t // fthread abstraction
{
  con_t *cc;                    ///< current continuation
  fthread_t *next;              ///< link to next fthread, to be used in scheduler queue and schannels
  fthread_t();                  ///< dead thread, suitable for assignment
  fthread_t(con_t*);            ///< make thread from a continuation
  svc_req_t *run();               ///< run until dead or driver service request
  void kill();                  ///< kill by detaching the continuation
  svc_req_t *get_svc()const;      ///< get current service request of waiting thread
private: // uncopyable
  fthread_t(fthread_t const&) = delete;
  void operator=(fthread_t const&) = delete;
};


// ********************************************************
/// SCHANNEL. Synchronous channels
// ********************************************************

struct RTL_EXTERN schannel_t
{
  fthread_t *top; // has to be public for offsetof macro

  void push_reader(fthread_t *);        ///< add a reader
  fthread_t *pop_reader();              ///< pop a reader, NULL if none
  void push_writer(fthread_t *);        ///< add a writer
  fthread_t *pop_writer();              ///< pop a writer, NULL if none
  schannel_t();

private: // uncopyable
  schannel_t(schannel_t const&) = delete;
  void operator= (schannel_t const&) = delete;
};

// ********************************************************
/// VARIANTS. Felix union type
/// note: non-polymorphic, so ctor can be inline
// ********************************************************

struct RTL_EXTERN _uctor_
{
  int variant;  ///< Variant code
  void *data;   ///< Heap variant constructor data
  _uctor_() : variant(-1), data(0) {}
  _uctor_(int i, void *d) : variant(i), data(d) {}
  _uctor_(int *a, _uctor_ x) : variant(a[x.variant]), data(x.data) {}
};


// ********************************************************
/// VARIANTS. Felix variant type
/// note: non-polymorphic, so ctor can be inline
// ********************************************************

/* NOT USED ANY MORE
struct RTL_EXTERN _variant_
{
  char const *vname;  ///< Variant code
  void *vdata;   ///< Heap variant constructor data
  _variant_() : vname(""), vdata(0) {}
  _variant_(char const *n, void *d) : vname(n), vdata(d) {}
};
*/


// ********************************************************
/// COMPACT LINEAR PROJECTIONS
// ********************************************************

struct RTL_EXTERN clprj_t
{
  cl_t divisor;
  cl_t modulus;
  clprj_t () : divisor(1), modulus(-1) {}
  clprj_t (cl_t d, cl_t m) : divisor (d), modulus (m) {}

};

// reverse compose projections left \odot right
inline clprj_t rcompose (clprj_t left, clprj_t right) {
  return clprj_t (left.divisor * right.divisor, right.modulus);
}

// apply projection to value
inline cl_t apply (clprj_t prj, cl_t v) {
  return v / prj.divisor % prj.modulus;
}

// ********************************************************
/// COMPACT LINEAR POINTERS
// ********************************************************

struct RTL_EXTERN clptr_t
{
  cl_t *p;
  cl_t divisor;
  cl_t modulus;
  clptr_t () : p(0), divisor(1),modulus(-1) {}
  clptr_t (cl_t *_p, cl_t d, cl_t m) : p(_p), divisor(d),modulus(m) {}

  // upgrade from ordinary pointer
  clptr_t (cl_t *_p, cl_t siz) : p (_p), divisor(1), modulus(siz) {}
};

// apply projection to pointer
inline clptr_t applyprj (clptr_t cp, clprj_t d)  {
  return  clptr_t (cp.p, d.divisor * cp.divisor, d.modulus);
}

// dereference
inline cl_t clt_deref(clptr_t q) { return *q.p / q.divisor % q.modulus; }

// storeat
inline void storeat (clptr_t q, cl_t v) {
    *q.p = *q.p - (*q.p / q.divisor % q.modulus) * q.divisor + v * q.divisor;
    //*q.p -= ((*q.p / q.divisor % q.modulus) - v) * q.divisor; //???
}

struct flx_trace_t
{
  size_t count;
  int enable_trace;
};

extern RTL_EXTERN int flx_enable_trace;

RTL_EXTERN void flx_trace(flx_trace_t* tr,flx_range_srcref_t sr, char const *file, int line, char const *msg);

}} // namespaces

#endif

//[flx_rtl.cpp]
#include "flx_rtl.hpp"
#include "flx_rtl_shapes.hpp"

#include <cstdio>
#include <cassert>
#include <cstddef>
#include <stdint.h>
#include "flx_exceptions.hpp"
#include "flx_collector.hpp"
#include "flx_serialisers.hpp"
#include "flx_continuation.hpp"

// main run time library code

namespace flx { namespace rtl {


muxguard::muxguard (::std::mutex *p): m(p) { if (m)m->lock(); }
muxguard::~muxguard () { if (m)m->unlock(); }

// ********************************************************
// fthread_t implementation
// ********************************************************

fthread_t::fthread_t() : cc(nullptr), next(nullptr) {}
fthread_t::fthread_t(con_t *a) : cc(a), next(nullptr) {}

void fthread_t::kill() { cc = nullptr; }

svc_req_t *fthread_t::get_svc()const { return cc?cc->p_svc:nullptr; }

svc_req_t *fthread_t::run() {
  if(!cc) return nullptr; // dead
restep:
  cc->p_svc = nullptr;
step:
  //fprintf(stderr,"[fthread_t::run::step] cc=%p->",cc);
  try { cc = cc->resume(); }
  catch (con_t *x) { cc = x; }

  //fprintf(stderr,"[fthread_t::run::step] ->%p\n",cc);
  if(!cc) return nullptr; // died

  if(cc->p_svc)
  {
    //fprintf(stderr,"[fthread_t::run::service call] ->%d\n",cc->p_svc);
    switch(cc->p_svc->svc_req)
    {
/*
      case svc_get_fthread:
        // NEW VARIANT LAYOUT RULES
        // One less level of indirection here
        //**(fthread_t***)(cc->p_svc->data) = this;
        *(fthread_t**)(cc->p_svc->data) = this;
        goto restep;      // handled
*/
      //case svc_yield:
      //  goto restep;

      // we don't know what to do with the request,
      // so pass the buck to the driver
      default:
        return cc->p_svc;
    }
  }
  goto step;
}

// ********************************************************
// schannel_t implementation
// ********************************************************

schannel_t::schannel_t () : top(nullptr) {}

// PRECONDITION: channel is empty or has readers
void schannel_t::push_reader(fthread_t *r)
{
  r->next = top;
  top = r;
}

// PRECONDITION: channel is empty or has writers
void schannel_t::push_writer(fthread_t *w)
{
  w->next = top;
  top = (fthread_t*)((uintptr_t)w | 1u);
}

fthread_t *schannel_t::pop_reader()
{
  if (top == nullptr || (uintptr_t)top & 1u) return nullptr; // NULL or low bit set
  fthread_t *tmp = top;
  top = tmp->next;
  tmp->next = nullptr; // for GC
  return tmp;
}

fthread_t *schannel_t::pop_writer()
{
  if (!((uintptr_t)top & 1u)) return nullptr; // low bit clear (includes NULL case)
  fthread_t *tmp = (fthread_t*)((uintptr_t)top & ~(uintptr_t)1u); // mask out low bit
  top = tmp->next;
  tmp->next = nullptr; // for GC
  return tmp;
}
// ********************************************************
// trace feature
// ********************************************************

int flx_enable_trace=1;
size_t flx_global_trace_count=0uL;

void flx_trace(flx_trace_t* tr,flx_range_srcref_t sr, char const *file, int line, char const *msg)
{
  if(!flx_enable_trace)return;
  flx_global_trace_count++;
  if(tr)
  {
    tr->count++;
    if(tr->enable_trace)
    {
      fprintf(stderr,"%zu : %s\n",tr->count,msg);
      print_loc(stderr,sr,file,line);
    }
  }
  else
  {
    fprintf(stderr,"%zu : %s\n",flx_global_trace_count,msg);
    print_loc(stderr,sr,file,line);
  }
}
}}

ProductType::~ProductType(){}

size_t ProductType::object_size_impl() {
  size_t s = 0;
  for (int i=0; i<n; ++i) s+=cp[i]->object_size();
  return s;
}

size_t ProductType::object_alignment_impl() {
  size_t s = 0;
  for (int i=0; i<n; ++i) s = ::std::max(s,cp[i]->object_alignment());
  return s;
}

// if a is aligned then a%amt == 0
// otherwise a%amt is the amount over the previously aligned
// address, so we subtract it to get the previously aligned address
// and then add the amt back to get the next one.
uintptr_t round_up (uintptr_t a, size_t amt) {
  size_t adj = a % amt;
  return adj? a + amt - a%amt:a;
}
#define INCR(p,a) *(unsigned char **)p += a;

void *round_up (void *a, size_t amt) {
  return (void*)round_up((uintptr_t)a, amt);
}

void ProductType::dflt_init_impl (void *p) {
  for (int i = 0; i<n; ++i) {
    auto vt = cp[i];
    p = round_up(p,vt->object_alignment());
    vt->dflt_init(p);
    INCR(p,vt->object_size());
  }
};

void ProductType::destroy_impl (void *p) {
  for (int i = 0; i<n; ++i) {
    auto vt = cp[i];
    p = round_up(p,vt->object_alignment());
    vt->destroy(p);
    INCR(p,vt->object_size());
  }
}

void ProductType::copy_init_impl(void *dst, void *src) {
  for (int i = 0; i<n; ++i) {
    auto vt = cp[i];
    auto align = vt->object_alignment();
    src = round_up(src,align);
    dst = round_up(dst,align);
    vt->copy_init(dst,src);
    auto z = vt->object_size();
    INCR(src,z);
    INCR(dst,z);
  }
}

void ProductType::move_init_impl(void *dst, void *src) {
  for (int i = 0; i<n; ++i) {
    auto vt = cp[i];
    auto align = vt->object_alignment();
    src = round_up(src,align);
    dst = round_up(dst,align);
    vt->move_init(dst,src);
    auto z = vt->object_size();
    INCR(src, z);
    INCR(dst, z);
  }
}

void ProductType::copy_assign_impl(void *dst, void *src) {
  for (int i = 0; i<n; ++i) {
    auto vt = cp[i];
    auto align = vt->object_alignment();
    src = round_up(src,align);
    dst = round_up(dst,align);
    vt->copy_assign(dst,src);
    auto z = vt->object_size();
    INCR(src, z);
    INCR(dst, z);
  }
}

void ProductType::move_assign_impl(void *dst, void *src) {
  for (int i = 0; i<n; ++i) {
    auto vt = cp[i];
    auto align = vt->object_alignment();
    src = round_up(src,align);
    dst = round_up(dst,align);
    vt->move_assign(dst,src);
    auto z = vt->object_size();
    INCR(src, z);
    INCR(dst, z);
  }
}

Exec Util

//[flx_executil.hpp]
#ifndef FLX_EXECUTIL
#define FLX_EXECUTIL
#include "flx_rtl_config.hpp"
#include "flx_rtl.hpp"
#include "flx_sync.hpp"
#include "flx_gc.hpp"

namespace flx { namespace rtl { namespace executil {
  RTL_EXTERN void run(flx::rtl::con_t *c);
  RTL_EXTERN void frun (::flx::gc::generic::gc_profile_t* gcp, ::flx::rtl::con_t *p);
}}}
#endif

//[flx_executil.cpp]
#include "flx_executil.hpp"
namespace flx { namespace rtl { namespace executil {
void run(::flx::rtl::con_t *p)
{
  while(p)
  {
    try { p=p->resume(); }
    catch (::flx::rtl::con_t *x) { p = x; }
  }
}

void frun (::flx::gc::generic::gc_profile_t* gcp, ::flx::rtl::con_t *p)
{
  ::flx::run::fthread_list *q = new(*gcp,::flx::run::fthread_list_ptr_map,false) ::flx::run::fthread_list(gcp);

  ::flx::run::sync_sched *ss =
     new(*gcp,::flx::run::sync_sched_ptr_map,false) ::flx::run::sync_sched(false, gcp, q)
  ;

  ::flx::rtl::fthread_t *ft =
    new(*gcp,::flx::rtl::_fthread_ptr_map,false) ::flx::rtl::fthread_t(p)
  ;

  gcp->collector->add_root(ss);
  ss->frun();
  gcp->collector->remove_root(ss);
}

}}}

//[flx_executil.fpc]
Name: flx_executil
Description: Felix mini scheduler
Requires: flx
includes: '"flx_executil.hpp"'

Main

//[flx_main.cpp]
#include "flx_rtl_config.hpp"
#include "flx_rtl.hpp"
// THIS IS A DO NOTHING MAINLINE FOR USE WHEN STATICALLY LINKING
#include "stdio.h"
extern "C" RTL_EXTERN ::flx::rtl::con_t *flx_main( void *p){
  //fprintf(stderr, "DUMMY flx_main()\n");
  return 0;
}

Shapes

//[flx_rtl_shapes.hpp]
#ifndef __FLX_RTL_SHAPES_HPP__
#define __FLX_RTL_SHAPES_HPP__
#include "flx_rtl_config.hpp"
#include "flx_gc.hpp"

namespace flx { namespace rtl {
// ********************************************************
// Shape (RTTI) objects for system classes
// con_t is only an abstract base, so has no fixed shape
// shapes for instance types generated by Felix compiler
// we provide a shape for C 'int' type as well
// ********************************************************

// special: just the offset data for a pointer
RTL_EXTERN extern ::flx::gc::generic::offset_data_t const _address_offset_data;

RTL_EXTERN extern ::flx::gc::generic::gc_shape_t _fthread_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t schannel_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t _uctor_ptr_map;
//RTL_EXTERN extern ::flx::gc::generic::gc_shape_t _variant_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t _int_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t _address_ptr_map;
//RTL_EXTERN extern ::flx::gc::generic::gc_shape_t _caddress_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t clptr_t_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t clprj_t_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t jump_address_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t cl_t_ptr_map;

}}
#endif

//[flx_rtl_shapes.cpp]
#include "flx_rtl_shapes.hpp"
#include "flx_rtl.hpp"
#include "flx_dynlink.hpp"
#include <stddef.h>

namespace flx { namespace rtl {
// ********************************************************
//OFFSETS for fthread_t
// ********************************************************
static const std::size_t _fthread_offsets[2]={
    offsetof(fthread_t,cc),
    offsetof(fthread_t,next)
};

static ::flx::gc::generic::offset_data_t const _fthread_offset_data = { 2, _fthread_offsets };

::flx::gc::generic::gc_shape_t _fthread_ptr_map = {
  "rtl::fthread_t",
  1,sizeof(fthread_t),
  0,
  0, // fcops
  &_fthread_offset_data,
  ::flx::gc::generic::scan_by_offsets,
  ::flx::gc::generic::tblit<fthread_t>,::flx::gc::generic::tunblit<fthread_t>,
  gc::generic::gc_flags_immobile,
  0UL, 0UL
};


// ********************************************************
//OFFSETS for schannel_t
// ********************************************************
static const std::size_t schannel_offsets[1]={
    offsetof(schannel_t,top),
};

static ::flx::gc::generic::offset_data_t const schannel_offset_data = { 1, schannel_offsets };

::flx::gc::generic::gc_shape_t schannel_ptr_map = {
  "rtl::schannel_t",
  1,sizeof(schannel_t),
  0, // no finaliser
  0, // fcops
  &schannel_offset_data, // scanner data
  ::flx::gc::generic::scan_by_offsets, // scanner
  ::flx::gc::generic::tblit<schannel_t>,  // encoder
  ::flx::gc::generic::tunblit<schannel_t>,  // decoder
  gc::generic::gc_flags_default,
  0UL, 0UL
};

// ********************************************************
// _uctor_ implementation
// ********************************************************
//OFFSETS for _uctor_
static const std::size_t _uctor_offsets[1]= {
  offsetof(_uctor_,data)
};

static ::flx::gc::generic::offset_data_t const _uctor_offset_data = { 1, _uctor_offsets };

static CxxValueType<_uctor_> _uctor_fcops {};

::flx::gc::generic::gc_shape_t _uctor_ptr_map = {
  "rtl::_uctor_",
  1,
  sizeof(_uctor_),
  0, // finaliser
  &_uctor_fcops, // fcops
  &_uctor_offset_data, // scanner data
  ::flx::gc::generic::scan_by_offsets, // scanner
  ::flx::gc::generic::tblit<_uctor_>, // encoder
  ::flx::gc::generic::tunblit<_uctor_>,  // decoder
  gc::generic::gc_flags_default
};

/*
// ********************************************************
// _variant_ implementation
// ********************************************************
//OFFSETS for _variant_
static const std::size_t _variant_offsets[1]= {
  offsetof(_variant_,vdata)
};

static CxxValueType<_variant_> _variant_fcops {};

static ::flx::gc::generic::offset_data_t const _variant_offset_data = { 1, _variant_offsets };

::flx::gc::generic::gc_shape_t _variant_ptr_map = {
  "rtl::_variant_",
  1,
  sizeof(_variant_),
  0, // finaliser
  &_variant_fcops, // fcops
  &_variant_offset_data, // scanner data
  ::flx::gc::generic::scan_by_offsets, // scanner
  ::flx::gc::generic::tblit<_variant_>, // encoder
  ::flx::gc::generic::tunblit<_variant_>,  // decoder
  gc::generic::gc_flags_default
};
*/

static CxxValueType<int> int_fcops {};

// ********************************************************
// jump_address implementation
// ********************************************************
//OFFSETS for jump_address
static const std::size_t jump_address_offsets[1]= {
  offsetof(jump_address_t,target_frame)
};

static ::flx::gc::generic::offset_data_t const
  jump_address_offset_data = { 1, jump_address_offsets }
;

static CxxValueType<jump_address_t> jump_address_t_fcops {};

::flx::gc::generic::gc_shape_t jump_address_ptr_map = {
  "rtl::jump_address_t",
  1,
  sizeof(_uctor_),
  0, // finaliser
  &jump_address_t_fcops, // fcops
  &jump_address_offset_data, // scanner data
  ::flx::gc::generic::scan_by_offsets, // scanner
  ::flx::gc::generic::tblit<jump_address_t>, // encoder
  ::flx::gc::generic::tunblit<jump_address_t>,  // decoder
  gc::generic::gc_flags_default
};

// ********************************************************
// int implementation
// ********************************************************


::flx::gc::generic::gc_shape_t _int_ptr_map = {
  "rtl::int",
  1,
  sizeof(int),
  0, // finaliser
  &int_fcops,
  //0, // fcops
  0, // scanner data
  0, // scanner
  ::flx::gc::generic::tblit<int>, // encoder
  ::flx::gc::generic::tunblit<int>,  // decoder
  gc::generic::gc_flags_default,
  0UL, 0UL
};

// ********************************************************
// cl_t implementation
// ********************************************************

static CxxValueType<cl_t> cl_t_fcops {};

::flx::gc::generic::gc_shape_t cl_t_ptr_map = {
  "rtl::cl_t",
  1,
  sizeof(cl_t),
  0, // finaliser
  &cl_t_fcops, // fcops
  0, // scanner data
  0, // scanner
  ::flx::gc::generic::tblit<cl_t>,
  ::flx::gc::generic::tunblit<cl_t>,
  gc::generic::gc_flags_default,
  0UL, 0UL
};

// ********************************************************
// clptr_t implementation
// ********************************************************

static CxxValueType<clptr_t> clptr_t_fcops {};

static const std::size_t _clptr_t_offsets[1]={ 0 };
::flx::gc::generic::offset_data_t const _clptr_t_offset_data = { 1, _clptr_t_offsets };


::flx::gc::generic::gc_shape_t clptr_t_ptr_map = {
  "rtl::clptr_t",
  1,
  sizeof(clptr_t),
  0, // finaliser
  &clptr_t_fcops, // fcops
  &_clptr_t_offset_data, // scanner data
  ::flx::gc::generic::scan_by_offsets, // scanner
  ::flx::gc::generic::tblit<clptr_t>,
  ::flx::gc::generic::tunblit<clptr_t>,
  gc::generic::gc_flags_default,
  0UL, 0UL
};

// ********************************************************
// clprj_t implementation
// ********************************************************

static CxxValueType<clprj_t> clprj_t_fcops {};

::flx::gc::generic::offset_data_t const _clprj_t_offset_data = { 0, NULL };


::flx::gc::generic::gc_shape_t clprj_t_ptr_map = {
  "rtl::clprj_t",
  1,
  sizeof(clprj_t),
  0, // finaliser
  &clprj_t_fcops, // fcops
  0, // scanner data
  ::flx::gc::generic::scan_by_offsets, // scanner
  ::flx::gc::generic::tblit<clprj_t>,
  ::flx::gc::generic::tunblit<clprj_t>,
  gc::generic::gc_flags_default,
  0UL, 0UL
};


// ********************************************************
// pointer implementation
// ********************************************************

//OFFSETS for address
static const std::size_t _address_offsets[1]={ 0 };
::flx::gc::generic::offset_data_t const _address_offset_data = { 1, _address_offsets };

static ::std::string address_encoder (void *p) {
  return ::flx::gc::generic::blit (p,sizeof (void*));
}

static size_t address_decoder (void *p, char *s, size_t i) {
  return ::flx::gc::generic::unblit (p,sizeof (void*),s,i);
}


// ********************************************************
// address implementation : MUST BE LAST because the compiler
// uses "address_ptr_map" as the back link for generated shape tables
// ********************************************************

::flx::gc::generic::gc_shape_t _address_ptr_map = {
  "rtl::address",
  1,
  sizeof(void*),
  0, // finaliser
  0, // fcops
  &_address_offset_data, /// scanner data
  ::flx::gc::generic::scan_by_offsets, // scanner
  ::flx::gc::generic::tblit<void*>, // encoder
  ::flx::gc::generic::tunblit<void*>, // decoder
  gc::generic::gc_flags_default,
  0UL, 0UL
};


}}

Plat Linux

//[plat_linux.hpp]
#ifndef __PLAT_LINUX_H__
#define __PLAT_LINUX_H__
int get_cpu_nr();
#endif

//[plat_linux.cpp]
#define STAT "/proc/stat"
#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
#include <string.h>

#include "plat_linux.hpp"

// return number of cpus
int get_cpu_nr()
{
   FILE *fp;
   char line[16];
   int proc_nb, cpu_nr = -1;

   if ((fp = fopen(STAT, "r")) == NULL) {
      fprintf(stderr, ("Cannot open %s: %s\n"), STAT, strerror(errno));
      exit(1);
   }

   while (fgets(line, 16, fp) != NULL) {

      if (strncmp(line, "cpu ", 4) && !strncmp(line, "cpu", 3)) {
         char* endptr = NULL;
         proc_nb = strtol(line + 3, &endptr, 0);

         if (!(endptr && *endptr == '\0')) {
           fprintf(stderr, "unable to parse '%s' as an integer in %s\n", line + 3, STAT);
           exit(1);
         }

         if (proc_nb > cpu_nr)
            cpu_nr = proc_nb;
      }
   }

   fclose(fp);

   return (cpu_nr + 1);
}

Macro config stuff

Here flx_rtl_config.hpp depends on flx_rtl_config.h which depends on flx_rtl_config_params.hpp which is generated by the configuration system.

//[flx_rtl_config.hpp]
#ifndef __FLX_RTL_CONFIG_HPP__
#define __FLX_RTL_CONFIG_HPP__
#include "flx_rtl_config.h"

#include <stdint.h>
// get variant index code and pointer from packed variant rep
#define FLX_VP(x) ((void*)((uintptr_t)(x) & ~(uintptr_t)0x03))
#define FLX_VI(x) ((int)((uintptr_t)(x) & (uintptr_t)0x03))

// make a packed variant rep from index code and pointer
#define FLX_VR(i,p) ((void*)((uintptr_t)(p)|(uintptr_t)(i)))


// get variant index code and pointer from nullptr variant rep
#define FLX_VNP(x) (x)
#define FLX_VNI(x) ((int)(x!=0))

// make a nullptr variant rep from index code and pointer
#define FLX_VNR(i,p) (p)


#endif

//[flx_rtl_config.h]
#ifndef __FLX_RTL_CONFIG_H__
#define __FLX_RTL_CONFIG_H__

#include "flx_rtl_config_params.hpp"
#include <setjmp.h>

#if FLX_HAVE_GNU_BUILTIN_EXPECT
#define FLX_UNLIKELY(x) __builtin_expect(long(x),0)
#define FLX_LIKELY(x) __builtin_expect(long(x),1)
#else
#define FLX_UNLIKELY(x) x
#define FLX_LIKELY(x) x
#endif


#define FLX_SAVE_REGS \
  jmp_buf reg_save_on_stack; \
  setjmp (reg_save_on_stack)

//
#if FLX_HAVE_CGOTO && FLX_HAVE_ASM_LABELS
#define FLX_CGOTO 1
#else
#define FLX_CGOTO 0
#endif

#if FLX_WIN32 && !defined(_WIN32_WINNT)
#define _WIN32_WINNT 0x0600 // Require Windows NT5 (2K, XP, 2K3)
#endif

#if FLX_WIN32 && !defined(WINVER)
#define WINVER 0x0600 // Require Windows NT5 (2K, XP, 2K3)
#endif

#if FLX_WIN32
// vs windows.h just LOVES to include winsock version 1 headers by default.
// that's bad for everyone, so quit it.
#define _WINSOCKAPI_

// windows.h defines min/max macros, which can cause all sorts of confusion.
#ifndef NOMINMAX
#define NOMINMAX
#endif
#endif


#if FLX_WIN32
  #if defined(FLX_STATIC_LINK)
    #define FLX_EXPORT
    #define FLX_IMPORT
  #else
    #define FLX_EXPORT __declspec(dllexport)
    #define FLX_IMPORT __declspec(dllimport)
  #endif
#else
  // All modules on Unix are compiled with -fvisibility=hidden
  // All API symbols get visibility default
  // whether or not we're static linking or dynamic linking (with -fPIC)
  #define FLX_EXPORT __attribute__((visibility("default")))
  #define FLX_IMPORT __attribute__((visibility("default")))
#endif

#ifdef BUILD_RTL
#define RTL_EXTERN FLX_EXPORT
#else
#define RTL_EXTERN FLX_IMPORT
#endif

#if FLX_MACOSX && !FLX_HAVE_DLOPEN
#define FLX_MACOSX_NODLCOMPAT 1
#else
#define FLX_MACOSX_NODLCOMPAT 0
#endif

#if FLX_HAVE_GNU
#define FLX_ALWAYS_INLINE __attribute__ ((always_inline))
#define FLX_NOINLINE __attribute__ ((noinline))
#define FLX_CONST __attribute__ ((const))
#define FLX_PURE __attribute__ ((pure))
#define FLX_GXX_PARSER_HACK (void)0,
#define FLX_UNUSED __attribute__((unused))
#else
#define FLX_ALWAYS_INLINE
#define FLX_NOINLINE
#define FLX_CONST
#define FLX_PURE
#define FLX_GXX_PARSER_HACK
#define FLX_UNUSED
#endif

#endif

//[flx_rtl_core.fpc]
Description: Felix Core Run Time Libraries
Requires: flx flx_gc
Requires: flx_exceptions flx_pthread flx_async
Requires: re2 flx_dynlink demux faio
Requires: flx_uint256_t
Requires: sqlite3

//[flx_thread_free_rtl_core.fpc]
Description: Felix Core Run Time Libraries (no threads, no async I/O)
Requires: flx flx_gc flx_thread_free_run
Requires: flx_exceptions
Requires: re2 flx_dynlink
Requires: flx_uint256_t
Requires: sqlite3

//[unix_flx.fpc]
Name: flx
Description: Felix core runtime support
provides_dlib: -lflx_dynamic
provides_slib: -lflx_static
Requires: flx_gc flx_exceptions flx_pthread flx_dynlink
library: rtl
includes:  '"flx_rtl.hpp"'  <iostream> <cstdio> <cstddef> <cassert> <climits> <string>
macros: BUILD_RTL
srcdir: src/rtl
src: .*\.cpp

//[win_flx.fpc]
Name: flx
Description: Felix core runtime support
provides_dlib: /DEFAULTLIB:flx_dynamic
provides_slib: /DEFAULTLIB:flx_static
Requires: flx_gc flx_exceptions flx_pthread flx_dynlink
library: rtl
includes:  '"flx_rtl.hpp"' <iostream> <cstdio> <cstddef> <cassert> <climits> <string>
macros: BUILD_RTL
srcdir: src/rtl
src: .*\.cpp

Package: src/packages/spinlock.fdoc

Spinlocks

key file
flx_spinlock.hpp share/lib/rtl/flx_spinlock.hpp
flx_spinlock.cpp share/src/rtl/flx_spinlock.cpp
pthread_fast_lock.hpp share/lib/rtl/pthread_fast_lock.hpp
pthread_fast_lock.cpp $PWD/CRAP/src/pthread/pthread_fast_lock.cpp
pthread_fast_lock.flx $PWD/CRAP/lib/std/pthread/pthread_fast_lock.flx

Spinlock

//[flx_spinlock.hpp]
#ifndef _FLX_SPINLOCK_HPP
#define _FLX_SPINLOCK_HPP
#include "flx_rtl_config.hpp"

#include <atomic>

namespace flx { namespace rtl {

// C++ compliant Lockable
struct RTL_EXTERN flx_spinlock {
private:
  flx_spinlock(flx_spinlock const&)=delete; // no copying
  flx_spinlock(flx_spinlock &&)=delete; // no moving
  flx_spinlock &operator=(flx_spinlock const &)=delete; // no assignment

  ::std::atomic_flag volatile flag;
public:
  flx_spinlock() noexcept; // init to clear
  void lock() volatile;
  void unlock() volatile;
};

struct RTL_EXTERN spinguard {
private:
  spinguard() = delete;
  spinguard(spinguard const&) = delete;
  spinguard *operator=(spinguard const&)=delete;
  bool cond;
  ::std::atomic_flag *plock;
public:
  spinguard (bool,::std::atomic_flag *p);
  ~spinguard ();
};
}}

#endif

//[flx_spinlock.cpp]
#include "flx_spinlock.hpp"

using namespace std;
using namespace flx;
using namespace rtl;

flx_spinlock::flx_spinlock() noexcept { flag.clear(memory_order_release); }
void flx_spinlock::lock() volatile { while(flag.test_and_set(memory_order_acquire)); }
void flx_spinlock::unlock() volatile { flag.clear(memory_order_release); }


spinguard::spinguard (bool cond_, ::std::atomic_flag *p): cond(cond_), plock(p) {
  if (cond) while (plock->test_and_set(std::memory_order_acquire));
}
spinguard::~spinguard () { if (cond)plock->clear(std::memory_order_release); }

Fast Resource Lock

This is a fast application level lock to be used for serialisation of transient accessed to data structures. It is a mutex, however unlike system mutex, it is safe to use with the Felix GC.

System mutex are NOT GC safe because in Felix every allocation may potentially trigger a garbage collection which requires a world stop. Since world stops are cooperative, the collector must wait until all threads have voluntarily yielded, usually by themselves performing an allocation or an explicit call to perform a collection, but suicide should work too.

However if a thread blocks trying to lock a mutex held by another thread which is now stopped for the GC, we have a deadlock. So a user level lock must have a timeout and a spin loop which includes regular checking for a GC world stop request.

It would be acceptable if the check were done atomically with blocking on a lock request followed by another check, because locking itself does not change reachability state. With those semantics, it’s fine for the thread to block, provided the GC counts it as having yielded, and it cannot unblock during the GC. That basically means unlocking must also do the check, to ensure blocked threads stay blocked.

//[pthread_fast_lock.hpp]
/*
#ifndef __pthread_fast_lock__
#define __pthread_fast_lock__
#include "flx_pthread_config.hpp"
#include "pthread_thread_control_base.hpp"
#include <atomic>

namespace flx { namespace rtl {

class PTHREAD_EXTERN fast_lock
{
  ::std::atomic_flag flag;
  ::flx::pthread::thread_control_base_t *tc;
public:
  fast_lock(::flx::pthread::thread_control_base_t *);
  fast_lock() = delete;
  fast_lock(fast_lock const&)  = delete;
  void operator = (fast_lock const&) = delete;
  void lock();
  void unlock();
};
}}
#endif
*/

//[pthread_fast_lock.cpp]
/*
#include "pthread_fast_lock.hpp"
#include <chrono>
#include <thread>
#include <mutex>

namespace flx { namespace rtl {
fast_lock::fast_lock(::flx::pthread::thread_control_base_t *tc_) : tc(tc_) { flag.clear(); }
void fast_lock::unlock() { flag.clear(); }
void fast_lock::lock() {
  while (!flag.test_and_set())
  {
    tc->yield();
fprintf(stderr, "thread_fast_lock: thread %p calling std::this_thread::yield()",::flx::pthread::mythrid());
    ::std::this_thread::sleep_for(::std::chrono::nanoseconds (200));
  }
}

}}
*/

//[pthread_fast_lock.flx]
/*
class FastLock
{
   type fast_lock = "::flx::rtl::fast_lock*"
     requires header '#include "pthread_fast_lock.hpp"';
   ctor fast_lock : unit = "new ::flx::rtl::fast_lock(PTF gcp->collector->get_thread_control())";
   proc delete : fast_lock = "delete $1;";
   proc lock : fast_lock = "$1->lock();";
   proc unlock : fast_lock = "$1->unlock();";

}
*/

Package: src/packages/svc.fdoc

Service Requests

key file
flx_svc.hpp share/lib/rtl/flx_svc.hpp
flx_svc.cpp share/src/rtl/flx_svc.cpp
svc.flx share/lib/std/control/svc.flx

Service Request layout

//[flx_svc.hpp]
#ifndef __FLX_SVC_H__
#define __FLX_SVC_H__
#include "flx_rtl_config.hpp"

namespace flx { namespace async { struct flx_driver_request_base; }}

namespace flx { namespace rtl {
// ********************************************************
// SERVICE REQUEST CODE
// THESE VALUES MUST SYNCH WITH THE STANDARD LIBRARY
// ********************************************************

enum svc_t               // what the dispatch should do
{                        // when the resume callback returns
  svc_yield = 0,
  svc_general=1,               // temporary hack by RF
  svc_spawn_process=2,
  svc_spawn_pthread=3,
  svc_spawn_fthread=4,           // schedule fthread and invoke
  svc_schedule_fthread=5,    // schedule fthread (continue)
  svc_sread=6,                 // synchronous read
  svc_swrite=7,                // synchronous write
  svc_multi_swrite=8,         // multi-write
  svc_kill=9,                  // kill fthread
  svc_end
};

RTL_EXTERN char const *describe_service_call(int);

struct svc_general_req_t {
  svc_general_req_t () {} // unfortunately required even though unsafe due to way compiler generates code
  svc_t tag;
  struct flx::async::flx_driver_request_base *pgeneral;
  svc_general_req_t (svc_t t, struct flx::async::flx_driver_request_base *d) : tag(t), pgeneral(d) {}
};

struct svc_sio_req_t {
  svc_sio_req_t () {} // unfortunately required even though unsafe due to way compiler generates code
  svc_t tag;
  struct schannel_t *chan;
  void **data;
  svc_sio_req_t(svc_t t, schannel_t *s, void **d) : tag(t), chan(s), data(d) {}
};
struct svc_fthread_req_t {
  svc_fthread_req_t() {} // unfortunately required even though unsafe due to way compiler generates code
  svc_t tag;
  struct fthread_t *fthread;
  svc_fthread_req_t (svc_t t, fthread_t *f) : tag(t), fthread(f) {}
};

union svc_req_t {
  svc_req_t() {} // unsafe as above
  svc_t svc_req;
  svc_general_req_t svc_general_req;
  svc_sio_req_t svc_sio_req;
  svc_fthread_req_t svc_fthread_req;
};

}} // namespaces
#endif

//[flx_svc.cpp]
#include "flx_svc.hpp"

namespace flx { namespace rtl {
static char const *svc_desc[10] = {
  "svc_yield",
  "svc_general",
  "svc_spawn_process",
  "svc_spawn_pthread",
  "svc_spawn_fthread",
  "svc_schedule_fthread"
  "svc_sread",
  "svc_swrite",
  "svc_kill",
  "svc_multi_swrite",
};

char const *describe_service_call(int x)
{
  if (x < 0 || x >12) return "Unknown service call";
  else return svc_desc[x];
}

}}

//[svc.flx]
open class Svc
{
  type svc_yield_req_t = "::flx::rtl::svc_t";
  type svc_general_req_t = "::flx::rtl::svc_general_req_t";
  type svc_sio_req_t = "::flx::rtl::svc_sio_req_t";
  type svc_fthread_req_t = "::flx::rtl::svc_fthread_req_t";
  type driver_request_base = "struct ::flx::async::flx_driver_request_base*";

  fun svc_yield            : 1 -> svc_yield_req_t = "::flx::rtl::svc_yield";
  fun svc_general          : driver_request_base-> svc_general_req_t = "::flx::rtl::svc_general_req_t (::flx::rtl::svc_general,$1)";
  fun svc_spawn_process    : fthread -> svc_fthread_req_t = "::flx::rtl::svc_fthread_req_t (::flx::rtl::svc_spawn_process,$1)";
  fun svc_spawn_pthread    : fthread -> svc_fthread_req_t = "::flx::rtl::svc_fthread_req_t (::flx::rtl::svc_spawn_pthread,$1)";
  fun svc_spawn_fthread    : fthread -> svc_fthread_req_t = "::flx::rtl::svc_fthread_req_t (::flx::rtl::svc_spawn_fthread,$1)";
  fun svc_schedule_fthread : fthread -> svc_fthread_req_t = "::flx::rtl::svc_fthread_req_t (::flx::rtl::svc_schedule_fthread,$1)";
  fun svc_sread            : _schannel * &address -> svc_sio_req_t = "::flx::rtl::svc_sio_req_t (::flx::rtl::svc_sread,$1,$2)";
  fun svc_swrite           : _schannel * &address -> svc_sio_req_t = "::flx::rtl::svc_sio_req_t (::flx::rtl::svc_swrite,$1,$2)";
  fun svc_multi_swrite     : _schannel * &address -> svc_sio_req_t = "::flx::rtl::svc_sio_req_t (::flx::rtl::svc_multi_swrite,$1,$2)";
  fun svc_kill             : fthread -> svc_fthread_req_t = "::flx::rtl::svc_fthread_req_t (::flx::rtl::svc_kill,$1)";

  proc svc(var svc_req:svc_yield_req_t) { _svc svc_req; }
  proc svc(var svc_req:svc_general_req_t) { _svc svc_req; }
  proc svc(var svc_req:svc_fthread_req_t) { _svc svc_req; }
  proc svc(var svc_req:svc_sio_req_t) { _svc svc_req; }
}

Package: src/packages/rtl-threads.fdoc

Run Time Library Pthread support.

key file
pthread_thread_control.cpp share/src/pthread/pthread_thread_control.cpp
flx_ts_collector.hpp share/lib/rtl/flx_ts_collector.hpp
flx_ts_collector.cpp share/src/pthread/flx_ts_collector.cpp
flx_pthread.py $PWD/buildsystem/flx_pthread.py
flx_pthread_config.hpp share/lib/rtl/flx_pthread_config.hpp
key file
unix_flx_pthread.fpc $PWD/src/config/unix/flx_pthread.fpc
win_flx_pthread.fpc $PWD/src/config/win/flx_pthread.fpc
linux_pthread.fpc $PWD/src/config/linux/pthread.fpc
default_pthread.fpc $PWD/src/config/pthread.fpc

Thread Control

//[pthread_thread_control.cpp]
#include "pthread_thread.hpp"
#include <stdio.h>
#include <cstdlib>
#include <cassert>

#define FLX_SAVE_REGS \
  jmp_buf reg_save_on_stack; \
  setjmp (reg_save_on_stack)


namespace flx { namespace pthread {

world_stop_notifier_t::~world_stop_notifier_t(){}

static void *get_stack_pointer() {
  void *x;
  void *y = (void*)&x;
  return y;
}

// SHOULD BE MUTEX PROTECETD
void thread_control_t::register_world_stop_notifier(world_stop_notifier_t *p)
{
//fprintf(stderr,"World stop notifier registered: %p\n", p);
  for (size_t i=0; i<world_stop_notifier_array_length; ++i)
    if(p == world_stop_notifier_array[i]) return;
  world_stop_notifier_array = (world_stop_notifier_t**)realloc(world_stop_notifier_array,
    sizeof(world_stop_notifier_t*) * (world_stop_notifier_array_length + 1));
  world_stop_notifier_array[world_stop_notifier_array_length] = p;
  ++world_stop_notifier_array_length;
}

// SHOULD BE MUTEX PROTECETD
void thread_control_t::unregister_world_stop_notifier(world_stop_notifier_t *p)
{
  size_t i = 0;
  for (i=0; i<world_stop_notifier_array_length; ++i)
    if(p == world_stop_notifier_array[i]) break;
  if (i == world_stop_notifier_array_length) return;
  for (size_t j =  i + 1; j < world_stop_notifier_array_length; ++j)
    world_stop_notifier_array[j-1] = world_stop_notifier_array[j];
  --world_stop_notifier_array_length;
  world_stop_notifier_array = (world_stop_notifier_t**)realloc(world_stop_notifier_array,
    sizeof(world_stop_notifier_t*) * (world_stop_notifier_array_length));
}

void thread_control_t::world_stop_notify()
{
if (world_stop_notifier_array_length > 0)
  //fprintf(stderr, "thread_control_t::world_stop_notify() notifying %zu objects\n",
  //  world_stop_notifier_array_length);
  for (size_t i=0; i<world_stop_notifier_array_length; ++i)
    world_stop_notifier_array[i]->notify_world_stop();
}

bool thread_control_t::get_debug()const { return debug; }

thread_control_base_t::~thread_control_base_t(){}

thread_control_t::thread_control_t (bool d) :
  do_world_stop(false), thread_counter(0), active_counter(0), debug(d),
  world_stop_notifier_array(0), world_stop_notifier_array_length(0)
  {
    if(debug)
      fprintf(stderr,"INITIALISING THREAD CONTROL OBJECT\n");
  }

size_t thread_control_t::thread_count()
  {
    ::std::unique_lock< ::std::mutex> m(stop_mutex);
    return thread_counter;
  }

size_t thread_control_t::active_count()
  {
    ::std::unique_lock< ::std::mutex> m(stop_mutex);
    return active_counter;
  }

void thread_control_t::add_thread(void *stack_base)
  {
    ::std::unique_lock< ::std::mutex> m(stop_mutex);
    uintptr_t id = mythrid();
    threads.insert (std::make_pair(id, thread_data_t (stack_base)));
    ++thread_counter;
    ++active_counter;
    if(debug)
      fprintf(stderr, "Adding thread %p base %p, count=%zu\n", (void*)(uintptr_t)id, stack_base, thread_counter);
    stop_guard.notify_all();
  }

void thread_control_t::remove_thread()
  {
    ::std::unique_lock< ::std::mutex> m(stop_mutex);
    uintptr_t id = mythrid();
    if (threads.erase(id) == 0)
    {
      fprintf(stderr, "Remove thread %p which is not registered\n", (void*)(uintptr_t)id);
      std::abort();
    }
    --thread_counter;
    --active_counter;
    if(debug)
      fprintf(stderr, "Removed thread %p, count=%zu\n", (void*)(uintptr_t)id, thread_counter);
    stop_guard.notify_all();
  }

// stop the world!

// NOTE: ON EXIT, THE MUTEX REMAINS LOCKED

bool thread_control_t::world_stop()
  {
    stop_mutex.lock();
    if(debug)
      fprintf(stderr,"Thread %p Stopping world, active threads=%zu\n", (void*)mythrid(), active_counter);
    if (do_world_stop) {
      stop_mutex.unlock();
      return false; // race! Someone else beat us
    }
    do_world_stop = true;

    // this calls the notify_world_stop() method of all the
    // objects such as condition variables that are registered
    // in the notification list. That method is expected to do a notify_all()
    // on the condition variable.

    world_stop_notify();

    // this is for the thread control objects own condition variable
    // which is used to count the number of threads that have suspended

    stop_guard.notify_all();

    while(active_counter>1) {
      if(debug)
        for(
          thread_registry_t::iterator it = threads.begin();
          it != threads.end();
          ++it
        )
        {
          fprintf(stderr, "Thread = %p is %s\n",(void*)(uintptr_t)(*it).first, (*it).second.active? "ACTIVE": "SUSPENDED");
        }
      if(debug)
        fprintf(stderr,"Thread %p Stopping world: begin wait, threads=%zu\n",  (void*)mythrid(), thread_counter);
      stop_guard.wait(stop_mutex);
      if(debug)
        fprintf(stderr,"Thread %p Stopping world: checking threads=%zu\n", (void*)mythrid(), thread_counter);
    }
    // this code has to be copied here, we cannot use 'yield' because
    // it would deadlock ourself
    {
      uintptr_t id = mythrid();
      FLX_SAVE_REGS;
      void *stack_pointer = get_stack_pointer();
      if(debug)
        fprintf(stderr,"World stop thread=%p, stack=%p!\n",(void*)(uintptr_t)id, stack_pointer);
      thread_registry_t::iterator it = threads.find(id);
      if(it == threads.end()) {
        fprintf(stderr,"MAIN THREAD: Cannot find thread %p in registry\n",(void*)(uintptr_t)id);
        abort();
      }
      (*it).second.stack_top = stack_pointer;
      if(debug)
        fprintf(stderr,"Stack size = %zu\n",(size_t)((char*)(*it).second.stack_base -(char*)(*it).second.stack_top));
    }
    if(debug)
      fprintf(stderr,"World STOPPED\n");
    return true; // we stopped the world
  }

// used by mainline to wait for other threads to die
void thread_control_t::join_all()
  {
    ::std::unique_lock< ::std::mutex> m(stop_mutex);
    if(debug)
      fprintf(stderr,"Thread %p Joining all\n", (void*)mythrid());
    while(do_world_stop || thread_counter>1) {
      unsafe_stop_check();
      stop_guard.wait(stop_mutex);
    }
    if(debug)
      fprintf(stderr,"World restarted: do_world_stop=%d, Yield thread count now %zu\n",do_world_stop,thread_counter);
  }

// restart the world
void thread_control_t::world_start()
  {
    if(debug)
      fprintf(stderr,"Thread %p Restarting world\n", (void*)mythrid());
    do_world_stop = false;
    stop_mutex.unlock();
    stop_guard.notify_all();
  }

memory_ranges_t *thread_control_t::get_block_list()
{
  memory_ranges_t *v = new std::vector<memory_range_t>;
  thread_registry_t::iterator end = threads.end();
  for(thread_registry_t::iterator i = threads.begin();
    i != end;
    ++i
  )
  {
    thread_data_t const &td = (*i).second;
    // !(base < top) means top <= base, i.e. stack grows downwards
    assert(!std::less<void*>()(td.stack_base,td.stack_top));
    // from top upto base..
    v->push_back(memory_range_t(td.stack_top, td.stack_base));
  }
  return v;
}

void thread_control_t::suspend()
{
  ::std::unique_lock< ::std::mutex> m(stop_mutex);
  if(debug)
    fprintf(stderr,"[suspend: thread= %p]\n", (void*)mythrid());
  unsafe_suspend();
}

void thread_control_t::resume()
{
  ::std::unique_lock< ::std::mutex> m(stop_mutex);
  if(debug)
    fprintf(stderr,"[resume: thread= %p]\n", (void*)mythrid());
  unsafe_resume();
}


void thread_control_t::unsafe_suspend()
{
  void *stack_pointer = get_stack_pointer();
  uintptr_t id = mythrid();
  if(debug)
    fprintf(stderr,"[unsafe_suspend:thread=%p], stack=%p!\n",(void*)(uintptr_t)id, stack_pointer);
  thread_registry_t::iterator it = threads.find(id);
  if(it == threads.end()) {
    if(debug)
      fprintf(stderr,"[unsafe_suspend] Cannot find thread %p in registry\n",(void*)(uintptr_t)id);
      abort();
  }
  (*it).second.stack_top = stack_pointer;
  (*it).second.active = false;
  if(debug) // VC++ is bugged, doesn't support %td format correctly?
    fprintf(stderr,"[unsafe_suspend: thread=%p] stack base %p > stack top %p, Stack size = %zd\n",
      (void*)(uintptr_t)id,
      (char*)(*it).second.stack_base,
      (char*)(*it).second.stack_top,
      (size_t)((char*)(*it).second.stack_base -(char*)(*it).second.stack_top));
  --active_counter;
  if(debug)
    fprintf(stderr,"[unsafe_suspend]: active thread count now %zu\n",active_counter);
  stop_guard.notify_all();
  if(debug)
    fprintf(stderr,"[unsafe_suspend]: stop_guard.notify_all() done");
}

void thread_control_t::unsafe_resume()
{
  if(debug)
    fprintf(stderr,"[unsafe_resume: thread %p]\n", (void*)mythrid());
  stop_guard.notify_all();
  if(debug)
    fprintf(stderr,"[unsafe_resume]: stop_guard.notify_all() done");
  while(do_world_stop) stop_guard.wait(stop_mutex);
  if(debug)
    fprintf(stderr,"[unsafe_resume]: stop_guard.wait() done");
  ++active_counter;
  uintptr_t id = mythrid();
  thread_registry_t::iterator it = threads.find(id);
  if(it == threads.end()) {
    if(debug)
      fprintf(stderr,"[unsafe_resume: thread=%p] Cannot find thread in registry\n",(void*)(uintptr_t)id);
      abort();
  }
  (*it).second.active = true;
  if(debug) {
    fprintf(stderr,"[unsafe_resume: thread=%p] resumed, active count= %zu\n",
      (void*)mythrid(),active_counter);
  }
  stop_guard.notify_all();
  if(debug)
    fprintf(stderr,"[unsafe_resume]: stop_guard.notify_all() done");
}

// mutex already held
void thread_control_t::unsafe_stop_check()
{
//fprintf(stderr, "Unsafe stop check ..\n");
  if (do_world_stop)
  {

    if(debug)
      fprintf(stderr,"[unsafe_stop_check: thread=%p] world_stop detected\n",
        (void*)mythrid());
    FLX_SAVE_REGS;
    unsafe_suspend();
    unsafe_resume();
  }
//fprintf(stderr, "Unsafe stop check finishes\n");
}

void thread_control_t::yield()
{
//fprintf(stderr,"Thread control yield starts\n");
  ::std::unique_lock< ::std::mutex> m(stop_mutex);
  if(debug)
    fprintf(stderr,"[Thread_control:yield: thread=%p]\n", (void*)mythrid());
//fprintf(stderr,"Unsafe stop check starts\n");
  unsafe_stop_check();
//fprintf(stderr,"Unsafe stop check done\n");
}

}}

Thread Safe Collector.

The thread safe collector class flx_ts_collector_t is derived from the flx_collector_t class. It basically dispatches to its base with locks as required.

//[flx_ts_collector.hpp]

#ifndef __FLX_TS_COLLECTOR_H__
#define __FLX_TS_COLLECTOR_H__
#include "flx_collector.hpp"
#include "pthread_thread.hpp"
#include <thread>
#include <mutex>

namespace flx {
namespace gc {
namespace collector {

/// Naive thread safe Mark and Sweep Collector.
struct PTHREAD_EXTERN flx_ts_collector_t :
  public flx::gc::collector::flx_collector_t
{
  flx_ts_collector_t(allocator_t *, flx::pthread::thread_control_t *, int _gcthreads, FILE*);
  ~flx_ts_collector_t();

private:
  /// allocator
  void *v_allocate(gc_shape_t *ptr_map, size_t);

  /// collector (returns number of objects collected)
  size_t v_collect();

  // add and remove roots
  void v_add_root(void *memory);
  void v_remove_root(void *memory);

  // statistics
  size_t v_get_allocation_count()const;
  size_t v_get_root_count()const;
  size_t v_get_allocation_amt()const;

private:
  mutable ::std::mutex mut;
};


}}} // end namespaces

#endif

//[flx_ts_collector.cpp]
#include "flx_rtl_config.hpp"
#include "flx_ts_collector.hpp"

namespace flx {
namespace gc {
namespace collector {

flx_ts_collector_t::flx_ts_collector_t(allocator_t *a, flx::pthread::thread_control_t *tc,int _gcthreads, FILE *tf) :
  flx_collector_t(a,tc,_gcthreads,tf)
{}

flx_ts_collector_t::~flx_ts_collector_t(){}

void *flx_ts_collector_t::v_allocate(gc_shape_t *ptr_map, size_t x) {
  ::std::unique_lock< ::std::mutex> dummy(mut);
  return impl_allocate(ptr_map,x);
}

size_t flx_ts_collector_t::v_collect() {
  // NO MUTEX
  //if(debug)
  //  fprintf(stderr,"[gc] Request to collect, thread_control = %p, thread %p\n", thread_control, (size_t)flx::pthread::get_current_native_thread());
  return impl_collect();
}

void flx_ts_collector_t::v_add_root(void *memory) {
  ::std::unique_lock< ::std::mutex> dummy(mut);
  impl_add_root(memory);
}

void flx_ts_collector_t::v_remove_root(void *memory) {
  ::std::unique_lock< ::std::mutex> dummy(mut);
  impl_remove_root(memory);
}

size_t flx_ts_collector_t::v_get_allocation_count()const {
  ::std::unique_lock< ::std::mutex> dummy(mut);
  return impl_get_allocation_count();
}

size_t flx_ts_collector_t::v_get_root_count()const {
  ::std::unique_lock< ::std::mutex> dummy(mut);
  return impl_get_root_count();
}

size_t flx_ts_collector_t::v_get_allocation_amt()const {
  ::std::unique_lock< ::std::mutex> dummy(mut);
  return impl_get_allocation_amt();
}


}}} // end namespaces

Build System

#[flx_pthread.py]
import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy

import buildsystem
from buildsystem.config import config_call

# ------------------------------------------------------------------------------

def build_runtime(phase):
    print('[fbuild] [rtl] build pthread')
    path = Path(phase.ctx.buildroot/'share'/'src/pthread')

    srcs = Path.glob(path / '*.cpp')
    includes = [
      phase.ctx.buildroot / 'host/lib/rtl',
      phase.ctx.buildroot / 'share/lib/rtl']
    macros = ['BUILD_PTHREAD']
    flags = []
    libs = [
        call('buildsystem.flx_gc.build_runtime', phase),
    ]
    external_libs = []

    pthread_h = config_call('fbuild.config.c.posix.pthread_h',
        phase.platform,
        phase.cxx.shared)

    dst = 'host/lib/rtl/flx_pthread'
    if pthread_h.pthread_create:
        flags.extend(pthread_h.flags)
        libs.extend(pthread_h.libs)
        external_libs.extend(pthread_h.external_libs)

    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            cflags=flags,
            libs=[lib.static for lib in libs],
            external_libs=external_libs,
            lflags=flags),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            cflags=flags,
            libs=[lib.shared for lib in libs],
            external_libs=external_libs,
            lflags=flags))

Configuration Database

//[unix_flx_pthread.fpc]
Name: Flx_pthread
Description: Felix Pre-emptive threading support

provides_dlib: -lflx_pthread_dynamic
provides_slib: -lflx_pthread_static
includes: '"pthread_thread.hpp"'
Requires: flx_gc flx_exceptions pthread
library: flx_pthread
macros: BUILD_PTHREAD
srcdir: src/pthread
src: .*\.cpp

//[win_flx_pthread.fpc]
Name: Flx_pthread
Description: Felix Pre-emptive threading support

provides_dlib: /DEFAULTLIB:flx_pthread_dynamic
provides_slib: /DEFAULTLIB:flx_pthread_static
includes: '"pthread_thread.hpp"'
Requires: flx_gc flx_exceptions pthread
library: flx_pthread
macros: BUILD_PTHREAD
srcdir: src/pthread
src: .*\.cpp

//[default_pthread.fpc]
Description: pthread support defaults to no requirements

//[linux_pthread.fpc]
Description: Linux pthread support
requires_dlibs: -lpthread
requires_slibs: -lpthread

//[flx_pthread_config.hpp]
#ifndef __FLX_PTHREAD_CONFIG_H__
#define __FLX_PTHREAD_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_PTHREAD
#define PTHREAD_EXTERN FLX_EXPORT
#else
#define PTHREAD_EXTERN FLX_IMPORT
#endif
#endif

Package: src/packages/rtl-pthread-impl.fdoc

Pthread implementation

key file
pthread_thread.hpp share/lib/rtl/pthread_thread.hpp
pthread_posix_thread.cpp share/src/pthread/pthread_posix_thread.cpp
pthread_win_thread.cpp share/src/pthread/pthread_win_thread.cpp

Pthreads

The pthread_thread.hpp defines pthreads and the system pthread control class. The control is implemented separately.

Felix pthreads are tightly integrated with the garbage collector via the pthread control class. This is necessary because the collector must stop all the pthreads before it can reliably sweep the thread stacks for roots.

Thread control also ensure Felix programs do not terminate until all managed pthreads have completed.

The Felix system uses detached threads. We provide joinable threads here too, but Felix programmers should use detached threads and pchannels for synchronisation.

//[pthread_thread.hpp]
#ifndef __FLX_PTHREAD_THREAD_H__
#define __FLX_PTHREAD_THREAD_H__
#include "flx_pthread_config.hpp"

#if FLX_WIN32
#include <windows.h>
#else
#include <pthread.h>
#endif

// auto pthread, because I forget how to deallocate them nicely
// could init in the constructor, but ultimately you don't want the thread
// barging in before you've finished doing other stuff
// Addendum (20051128): doing stdio in turns out to be not very safe.
// I don't know if printf et al are supposed to be thread safe (most impls
// seem to try to be) but I sometimes get deadlocks in ppc64 os x 10.4.2
// with 4.0.1 when printfing to stdout. Nasty.

#include "pthread_thread_control_base.hpp"

#include <utility>
#include <map>
#include <vector>
#include <functional>
#include <thread>
#include <mutex>
#include <condition_variable>

namespace flx { namespace pthread {

// ********************************************************
/// Posix Threads. This class simply wraps the creation
/// and joining of threads. It is not safe.
// ********************************************************

#ifdef _WIN32
typedef HANDLE flx_native_thread_t;
#else
typedef pthread_t flx_native_thread_t;
#endif

flx_native_thread_t PTHREAD_EXTERN get_current_native_thread();


// FELIX THREAD IDENTIFIER (native thread id cast to uintptr_t)
uintptr_t PTHREAD_EXTERN mythrid();

// THREAD REGISTRY: a map from the FELIX THREAD ID to thread data
typedef std::map<uintptr_t, thread_data_t, std::less<uintptr_t> > thread_registry_t;

// ********************************************************
// MASTER THREAD CONTROL OBJECT
// PROVIDES WORLD STOP SERVICES for the GARBAGE COLLECTOR
//
// A singleton unmanaged object owned by the flx_world object
// ********************************************************

class PTHREAD_EXTERN thread_control_t : public virtual thread_control_base_t
{
    thread_control_t (thread_control_t const &) = delete; // uncopyable
    void operator=(thread_control_t const&) = delete; // uncopyable

    // THREAD CONTROL VARIABLES
    bool do_world_stop;     // flag to say we want to stop the world
    size_t thread_counter;  // total Felix threads (not counting demux etc)
    size_t active_counter;  // total active Felix threads (not suspended for world stop yet_

    ::std::condition_variable_any stop_guard;
    ::std::mutex stop_mutex;

    // WORLD STOP NOTIFICATION REGISTRY
    // .. a set of condition variables that a thread could be waiting on
    // .. the registry is used to wake them up so they notice the
    // world stop flag
    world_stop_notifier_t **world_stop_notifier_array;
    size_t world_stop_notifier_array_length;

    // THREAD REGISTRY
    thread_registry_t threads;


    // PRIVATE METHODS
    void unsafe_stop_check();
    void unsafe_suspend();
    void unsafe_resume();
    void world_stop_notify();

public:
    bool debug;

    // PUBLIC METHODS
    bool get_debug()const override;
    thread_control_t (bool);
    size_t thread_count() override;
    size_t active_count();
    void add_thread(void*) override;
    void remove_thread() override;
    bool world_stop() override;
    void join_all()  override;
    void world_start() override;
    void yield() override;
    void suspend() override;
    void resume() override;
    void register_world_stop_notifier(world_stop_notifier_t *) override;
    void unregister_world_stop_notifier(world_stop_notifier_t *) override;
    memory_ranges_t *get_block_list() override; // called owns result and should delete it
};

struct tstart_t
{
  void (*sr)(void*);
  void *cd;
  thread_control_base_t *tc;
  ::std::mutex *spawner_lock;
  ::std::condition_variable_any *spawner_cond;
  bool *spawner_flag;

  tstart_t(void (*s)(void*),void* c,thread_control_base_t *t, ::std::mutex *sl, ::std::condition_variable_any *sc, bool *sf)
    : sr(s), cd(c), tc(t), spawner_lock(sl), spawner_cond(sc), spawner_flag(sf)
  {}
};

// a class for threads that can't be joined. upon exit all their resources
// are freed. they just evaporate. probably the best type of thread.
class PTHREAD_EXTERN flx_detached_thread_t {
  flx_native_thread_t thr;        ///< the thread
  flx_detached_thread_t(flx_detached_thread_t const&); // uncopyable
  void operator=(flx_detached_thread_t const&); // uncopyable
public:
  flx_detached_thread_t();
  ~flx_detached_thread_t();
  int init(void (*start)(void*), void* udat, thread_control_base_t*, ::std::mutex *, ::std::condition_variable_any *, bool*);
};

// rf: joinable threads. is it an error to not join joinable threads?
class PTHREAD_EXTERN flx_thread_t {
  flx_native_thread_t thr;        ///< the thread
  flx_thread_t(flx_thread_t const&); // uncopyable
  void operator=(flx_thread_t const&); // uncopyable
public:
  flx_thread_t();
  ~flx_thread_t();
  int init(void (*start)(void*), void* udat, thread_control_base_t*);
  void join();
};

/// RAII wrapper for thread class
class PTHREAD_EXTERN flx_thread_wrapper_t {
  flx_thread_t thread;
  flx_thread_wrapper_t(flx_thread_wrapper_t const&); // uncopyable
  void operator=(flx_thread_wrapper_t const&); // uncopyable
public:
  ~flx_thread_wrapper_t();
  flx_thread_wrapper_t(void (*start)(void*), void* udat, thread_control_base_t *tc);
};

}}
#endif

//[pthread_posix_thread.cpp]
#include "pthread_thread.hpp"
#if FLX_POSIX
#include <stdio.h>
#include <string.h>  // strerror
#include <cstdlib>
#include <setjmp.h>
#include <functional> // less
#include <assert.h>

namespace flx { namespace pthread {

flx_native_thread_t get_current_native_thread() { return pthread_self(); }
uintptr_t mythrid() { return (uintptr_t)pthread_self(); }

static void *get_stack_pointer() {
  void *x;
  void *y = (void*)&x;
  return y;
}

extern "C" void *flx_pthread_start_wrapper(void *e)
{
  void *stack_base = get_stack_pointer();
  tstart_t *ehd = (tstart_t*)e;
  thread_control_base_t *tc = ehd -> tc;
  if(tc == 0)
  {
    fprintf(stderr, "ERROR: flx_pthread_start_wrapper got NULL thread control object\n");
    assert(tc);
  }
  bool debug = tc->get_debug();
  if(debug)
    fprintf(stderr,"Spawned Thread %p start stack base = %p, tc=%p\n",
       (void*)mythrid(),stack_base, tc);
  if(debug)
      fprintf(stderr,"Thread registering itself\n");
  tc->add_thread(stack_base);
  if(debug)
    fprintf(stderr,"Registered: Spawned Thread %p stack base = %p\n",
      (void*)mythrid(),stack_base, tc);


  void (*sr)(void*)=ehd->sr; // client function
  void *cd = ehd->cd;        // client data
  if(debug)
    fprintf(stderr,"ehd->spawner_lock = %p\n",ehd->spawner_lock);

  if(ehd->spawner_lock)
  {
    ::std::unique_lock< ::std::mutex> dummy(*ehd->spawner_lock);
    if (debug)
      fprintf(stderr,"Thread %p acquired mutex\n", (void*)mythrid());
    if (debug)
      fprintf(stderr,"Thread %p notifying spawner it has registered itself\n", (void*)mythrid());
    *ehd->spawner_flag=true;
    ehd->spawner_cond->notify_all();
    if (debug)
      fprintf(stderr,"Thread %p releasing mutex\n", (void*)mythrid());
  }
  delete ehd;
  if (debug)
    fprintf(stderr,"Thread %p yielding\n", (void*)mythrid());
  tc->yield();
  try {
    if (debug)
      fprintf(stderr,"Thread %p running client code\n", (void*)mythrid());
    (*sr)(cd);
  }
  catch (...) {
    fprintf(stderr,"Uncaught exception in thread\n");
    ::std::exit(1);
  }
  if (debug)
    fprintf(stderr,"Thread %p unregistering\n", (void*)mythrid());
  tc->remove_thread();
  return NULL;
}


extern "C" void *nonflx_pthread_start_wrapper(void *e)
{
  void *stack_base = get_stack_pointer();
  tstart_t *ehd = (tstart_t*)e;
  void (*sr)(void*)=ehd->sr; // client function
  void *cd = ehd->cd;        // client data

  if(ehd->spawner_lock)
  {
    ::std::unique_lock< ::std::mutex> dummy(*ehd->spawner_lock);
    *ehd->spawner_flag=true;
    ehd->spawner_cond->notify_all();
  }
  delete ehd;
  try {
    (*sr)(cd);
  }
  catch (...) {
    fprintf(stderr,"Uncaught exception in thread\n");
    ::std::exit(1);
  }
  return NULL;
}


// ---- detached threads ----------

flx_detached_thread_t::flx_detached_thread_t(flx_detached_thread_t const&){} // uncopyable
void flx_detached_thread_t::operator=(flx_detached_thread_t const&){} // uncopyable

int
flx_detached_thread_t::init(void (*start)(void*), void* udat, thread_control_base_t *tc,
  ::std::mutex * m, ::std::condition_variable_any *c,bool *flag)
{
  pthread_attr_t attr;
  pthread_attr_init(&attr);
  pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
  pthread_attr_setstacksize(&attr, 1048576ul * 100ul ); // 100Meg .. should get from control/env of something
  int res = pthread_create(&thr, &attr, flx_pthread_start_wrapper,
    new tstart_t(start, udat, tc, m,c,flag));
  if(res)
  {
     fprintf(stderr, "WARNING: flx_detached_thread_t: pthread_create failed: %s\n",
       strerror(res));
  }
  pthread_attr_destroy(&attr);
  return res;
}

flx_detached_thread_t::~flx_detached_thread_t() { }
flx_detached_thread_t::flx_detached_thread_t() { }

// ---- joinable threads ----------
flx_thread_t::flx_thread_t(flx_thread_t const&){} // uncopyable
void flx_thread_t::operator=(flx_thread_t const&){} // uncopyable

int
flx_thread_t::init(void (*start)(void*), void* udat, thread_control_base_t*tc)
{
  int res = pthread_create(&thr, NULL, nonflx_pthread_start_wrapper,
    new tstart_t(start, udat, tc,NULL,NULL,NULL));
  if(res)
  {
     fprintf(stderr, "WARNING: flx_thread_t: pthread_create failed: %s\n",
       strerror(res));
  }
  return res;
}

void flx_thread_t::join() {
  int res = pthread_join(thr, NULL);
  if(res)
  {
     fprintf(stderr, "flx_thread_t: FATAL: pthread_join failed: %s\n",
       strerror(res));
#ifdef exit
     // Someone wants to replace exit with their own thing ...
     exit(1);
#else
     std::exit(1);
#endif
  }
}

flx_thread_t::~flx_thread_t() { }
flx_thread_t::flx_thread_t() { }

// ---- joinable thread wrapper ----------

flx_thread_wrapper_t::flx_thread_wrapper_t(flx_thread_wrapper_t const&){} // uncopyable
void flx_thread_wrapper_t::operator=(flx_thread_wrapper_t const&){} // uncopyable

flx_thread_wrapper_t::flx_thread_wrapper_t(void (*start)(void*), void* udat, thread_control_base_t*tc)
{
  int res = thread.init(start,udat,tc);
  {
    if(res)
    {
       fprintf(stderr, "FATAL: flx_thread_wapper_t: flx_thread_t.init failed: %s\n",
         strerror(res));
#ifdef exit
     // Someone wants to replace exit with their own thing ...
     exit(1);
#else
     std::exit(1);
#endif
    }
  }
}

flx_thread_wrapper_t::~flx_thread_wrapper_t() { thread.join(); }
}}

#endif

//[pthread_win_thread.cpp]
#include "pthread_thread.hpp"
#if FLX_WIN32
#include <stdio.h>
#include <cstdlib>
#include <assert.h>

namespace flx { namespace pthread {

flx_native_thread_t get_current_native_thread() { return GetCurrentThread(); }
uintptr_t mythrid() { return (uintptr_t)GetCurrentThreadId(); }

static void *get_stack_pointer() {
  void *x;
  void *y = (void*)&x;
  return y;
}

DWORD WINAPI flx_pthread_start_wrapper(LPVOID e)
{
  void *stack_base = get_stack_pointer();
  tstart_t *ehd = (tstart_t*)e;
  thread_control_base_t *tc = ehd -> tc;
  if(tc == 0)
  {
    fprintf(stderr, "ERROR: flx_pthread_start_wrapper got NULL thread control object\n");
    assert(tc);
  }
  bool debug = tc->get_debug();
  if(debug)
    fprintf(stderr,"Spawned Thread %p start stack base = %p, tc=%p\n",
       (void*)mythrid(),stack_base, tc);
  if(debug)
    fprintf(stderr,"Spawned Thread %p start stack base = %p, tc=%p\n",(void*)mythrid(),stack_base, tc);
  if(tc->get_debug())
    fprintf(stderr,"Thread registering itself\n");
  tc->add_thread(stack_base);
  if(debug)
    fprintf(stderr,"Registered: Spawned Thread %p stack base = %p\n",
      (void*)mythrid(),stack_base, tc);
  void (*sr)(void*)=ehd->sr;
  void *cd = ehd->cd;
  if(debug)
    fprintf(stderr,"ehd->spawner_lock = %p\n",ehd->spawner_lock);

  if(ehd->spawner_lock)
  {
    ::std::unique_lock< ::std::mutex> dummy(*ehd->spawner_lock);
    if (debug)
      fprintf(stderr,"Thread %p acquired mutex\n", (void*)mythrid());
    if (debug)
      fprintf(stderr,"Thread %p notifying spawner it has registered itself\n", (void*)mythrid());
    *ehd->spawner_flag=true;
    ehd->spawner_cond->notify_all();
    if (debug)
      fprintf(stderr,"Thread %p releasing mutex\n", (void*)mythrid());
  }
  delete ehd;
  if (debug)
    fprintf(stderr,"Thread %p yielding\n", (void*)mythrid());
  tc->yield();
  try {
    if (debug)
      fprintf(stderr,"Thread %p running client code\n", (void*)mythrid());
    (*sr)(cd);
  }
  catch (...) {
    fprintf(stderr,"Uncaught exception in thread\n");
    ::std::exit(1);
  }
  if (debug)
    fprintf(stderr,"Thread %p unregistering\n", (void*)mythrid());
  tc->remove_thread();
  return 0;
}

DWORD WINAPI nonflx_pthread_start_wrapper(LPVOID e)
{
  void *stack_base = get_stack_pointer();
  tstart_t *ehd = (tstart_t*)e;
  void (*sr)(void*)=ehd->sr;
  void *cd = ehd->cd;
  if(ehd->spawner_lock)
  {
    ::std::unique_lock< ::std::mutex> dummy(*ehd->spawner_lock);
    *ehd->spawner_flag=true;
    ehd->spawner_cond->notify_all();
  }
  delete ehd;
  try {
    (*sr)(cd);
  }
  catch (...) {
    fprintf(stderr,"Uncaught exception in thread\n");
    ::std::exit(1);
  }
  return 0;
}


// ---- detached threads ----------

flx_detached_thread_t::flx_detached_thread_t(flx_detached_thread_t const&){} // uncopyable
void flx_detached_thread_t::operator=(flx_detached_thread_t const&){} // uncopyable

// returns -1 on failure with error in GetLastError, 0 if all good.
int
flx_detached_thread_t::init(void (*start)(void*), void *lParam, thread_control_base_t *tc,
  ::std::mutex * m, ::std::condition_variable_any *c,bool *flag)
{
  DWORD thread_id = 0;
  thr = (HANDLE)CreateThread(NULL, 1048576ul * 100ul, // 100Meg .. should use control/env
    (LPTHREAD_START_ROUTINE)flx_pthread_start_wrapper,
    new tstart_t(start,lParam, tc, m, c, flag), 0,
    &thread_id
  );

  if(!thr)
  {
    DWORD err = GetLastError();
    fprintf(stderr, "flx_detached_thread_t: CreateThread failed: %i\n", err);
    return err;
  }
  return 0;
}

flx_detached_thread_t::~flx_detached_thread_t() { CloseHandle(thr); }
flx_detached_thread_t::flx_detached_thread_t() { }

// ---- joinable threads ----------
flx_thread_t::flx_thread_t(flx_thread_t const&){} // uncopyable
void flx_thread_t::operator=(flx_thread_t const&){} // uncopyable


flx_thread_t::flx_thread_t() { }
flx_thread_t::~flx_thread_t() { }

// this should be idempotent
void
flx_thread_t::join()
{
  // Let's try and wait for the thread to finish, however first I have to
  // tell it to finish up.

  DWORD  wait_res = WaitForSingleObject(thr, INFINITE);

  // will this give me my return status? how do I get that?
  if(WAIT_FAILED == wait_res)
  {
    fprintf(stderr,"WARNING: thread wait failed (%li)\n", GetLastError());
  }

  // I've already tried waiting on the  thread's #include <stdlib> exit
  if(!CloseHandle(thr))
  {
    fprintf(stderr,"FATAL: failed to delete thread (%li)\n", GetLastError());
    std::exit(1);
  }
}

// returns -1 on failure with error in GetLastError, 0 if all good.
int
flx_thread_t::init(void (*fn)(void*), void *lParam, thread_control_base_t *tc)
{
  DWORD thread_id = 0;
  thr= (HANDLE)CreateThread(NULL, 0,
    (LPTHREAD_START_ROUTINE)nonflx_pthread_start_wrapper,
    new tstart_t(fn,lParam, tc,NULL,NULL,NULL), 0,
    &thread_id
  );

  if(!thr)
  {
    DWORD err = GetLastError();
    fprintf(stderr, "WARNING: flx_thread_t: CreateThread failed: %i\n", err);
    return err;
  }

  return 0;
}

// ---- joinable thread wrapper ----------
flx_thread_wrapper_t::flx_thread_wrapper_t(void (*f)(void*), void *lParam, thread_control_base_t*tc)
{
  int res = thread.init(f,lParam,tc);
  if(res)
  {
    fprintf(stderr,"flx_thread_wrapper_t: FATAL: flx_thread_t.init failed\n");
    std::exit(1);
  }
}
flx_thread_wrapper_t::~flx_thread_wrapper_t() { thread.join(); }

}}

#endif

Package: src/packages/rtl-conditionvariable.fdoc

Condition Variable

key file
pthread_condv.hpp share/lib/rtl/pthread_condv.hpp
pthread_condv.cpp share/src/pthread/pthread_condv.cpp

Condition Variable

//[pthread_condv.hpp]
#ifndef __FLX_PTHREAD_CONDV_HPP__
#define __FLX_PTHREAD_CONDV_HPP__
#include <condition_variable>
#include <chrono>
#include "flx_pthread_config.hpp"
#include "pthread_thread_control_base.hpp"

namespace flx { namespace pthread {
class PTHREAD_EXTERN flx_condv_t : public world_stop_notifier_t
{
  ::std::mutex m;
  ::std::condition_variable_any cv;
  void notify_world_stop() override;
  thread_control_base_t *tc;
public:
   flx_condv_t (thread_control_base_t *);
   void lock();
   void unlock();
   void wait();
   void timed_wait(double seconds);
   void signal();
   void broadcast();
   ~flx_condv_t();
};

}}
#endif

//[pthread_condv.cpp]
#include "pthread_condv.hpp"
#include <stdint.h>

namespace flx { namespace pthread {
// constructor
flx_condv_t::flx_condv_t(thread_control_base_t *tc_): tc(tc_) {
//fprintf(stderr, "Creating condition variable %p\n", this);
  tc->register_world_stop_notifier(this);
}

void flx_condv_t::notify_world_stop() { cv.notify_all(); }

void flx_condv_t::lock() { m.lock(); }

void flx_condv_t::unlock() { m.unlock(); }

// mutex must be LOCKED on entry to WAIT
// mutex will be LOCKED on exit from WAIT
void flx_condv_t::wait() {
  m.unlock();
  tc->yield();
  m.lock();
  cv.wait_for(m,::std::chrono::seconds (1));  // unlocks mutex on entry, relocks on exit
}

void flx_condv_t::timed_wait(double seconds) {
  m.unlock();
  tc->yield();
  m.lock();
  cv.wait_for(m,::std::chrono::microseconds ((uint64_t)(seconds*1000000.0)));
}

void flx_condv_t::signal() { cv.notify_one(); }

void flx_condv_t::broadcast() { cv.notify_all(); }

flx_condv_t::~flx_condv_t() { tc->unregister_world_stop_notifier(this); }

}}

Package: src/packages/rtl-boundqueue.fdoc

Bound Queue

key file
pthread_bound_queue.hpp share/lib/rtl/pthread_bound_queue.hpp
pthread_bound_queue.cpp share/src/pthread/pthread_bound_queue.cpp
flx_bound_queue.fpc $PWD/src/config/flx_bound_queue.fpc

Bound Queue

//[pthread_bound_queue.hpp]
#ifndef __FLX_PTHREAD_BOUND_QUEUE_H__
#define __FLX_PTHREAD_BOUND_QUEUE_H__
#include "flx_pthread_config.hpp"
#include "flx_gc.hpp"
#include <thread>
#include <mutex>
#include <condition_variable>

// interface for a consumer/producer queue. threads requesting a resource
// that isn't there block until one is available. push/pop re-entrant

namespace flx { namespace pthread {

// ********************************************************
/// Thread safe bounded queue.
///
/// The queue can be locked by setting bound=0.
/// In this state it can only be unlocked by setting a non-zero bound.
///
/// If the bound is set to 1 (the default),
/// then the queue is always either empty or full.
/// An empty queue blocks readers until a writer sends some data.
/// A full queue blocks writers, until a reader reads the data.
/// Note that when the queue is empty a writer can write data
/// and continues without waiting for the data to be read.
// ********************************************************

class PTHREAD_EXTERN bound_queue_t :public world_stop_notifier_t {
  thread_control_base_t *tc;
  ::std::condition_variable_any size_changed;
  ::std::mutex member_lock;
  size_t bound;
  void notify_world_stop() override;
  void wait();
  void wait_no_world_stop_check(); // used by async system
public:
  void *lame_opaque; // has to be public for the scanner to find it
  bound_queue_t(thread_control_base_t *tc_, size_t);
  ~bound_queue_t();
  void enqueue(void*);
  void enqueue_no_world_stop_check(void*); // used by async system
  void* dequeue();
  void* maybe_dequeue();
  void resize(size_t);
  void wait_until_empty();
  size_t len();
};

PTHREAD_EXTERN ::flx::gc::generic::scanner_t bound_queue_scanner;

}} // namespace pthread, flx
#endif

//[pthread_bound_queue.cpp]
#include "pthread_bound_queue.hpp"
#include <queue>        // stl to the bloated rescue
#include <stdio.h>      // debugging in scanner

using namespace std;

namespace flx { namespace pthread {
typedef deque<void*> void_queue;

#define ELTQ ((void_queue*)lame_opaque)

void bound_queue_t::notify_world_stop()
{
  size_changed.notify_all();
}

bound_queue_t::bound_queue_t(thread_control_base_t *tc_, size_t n) : bound(n), tc(tc_)
{
//fprintf(stderr, "Creating bound queue %p, thread_control base=%p\n", this,tc);
  lame_opaque = new void_queue;
  tc->register_world_stop_notifier(this);
}

// Much care is needed deleting a queue.
// A safe method is possible .. but not provided here
bound_queue_t::~bound_queue_t()
{
//fprintf(stderr,"Deleting bound queue %p\n",this);
  tc->unregister_world_stop_notifier(this);
  delete ELTQ;
}

void bound_queue_t::wait() {
//fprintf(stderr, "Bound queue waiting.. %p\n", this);
  member_lock.unlock();
//fprintf(stderr, "Unocked mutex, now doing a tc yield q=%p, tc=%p\n", this,tc);
  tc->yield();
//fprintf(stderr, "tc yield done, relocking mutex q=%p\n", this);
  member_lock.lock();
//fprintf(stderr, "locked mutex again, waiting on possible size change in queue %p\n",this);
  size_changed.wait_for(member_lock, ::std::chrono::duration<int>(1)); // 1second
//fprintf(stderr, "possible size change in queue detected %p\n", this);
}

void bound_queue_t::wait_no_world_stop_check() {
  size_changed.wait_for(member_lock, ::std::chrono::duration<int>(1)); // 1second
}


// get the number of element in the queue
// (NOT the bound!)
size_t bound_queue_t::len() {
  ::std::unique_lock< ::std::mutex>   l(member_lock);
  return ELTQ->size();
}

void bound_queue_t::wait_until_empty() {
  ::std::unique_lock< ::std::mutex>   l(member_lock);
  while(!ELTQ->empty()) wait();
}

void
bound_queue_t::enqueue(void* elt)
{
  ::std::unique_lock< ::std::mutex>   l(member_lock);
  while(ELTQ->size() >= bound) wait(); // guard against spurious wakeups!
  ELTQ->push_back(elt);
  size_changed.notify_all(); // cannot return an error
}

void
bound_queue_t::enqueue_no_world_stop_check(void* elt)
{
  ::std::unique_lock< ::std::mutex>   l(member_lock);
  while(ELTQ->size() >= bound) wait_no_world_stop_check(); // guard against spurious wakeups!
  ELTQ->push_back(elt);
  size_changed.notify_all(); // cannot return an error
}


void*
bound_queue_t::dequeue()
{
//fprintf(stderr, "Trying to dequeue from bound queue\n");
  ::std::unique_lock< ::std::mutex>   l(member_lock);
  while(ELTQ->empty())  wait(); // guard against spurious wakeups!
  void *elt = ELTQ->front();
  ELTQ->pop_front();
  size_changed.notify_all();
  return elt;
}

void*
bound_queue_t::maybe_dequeue()
{
  ::std::unique_lock< ::std::mutex>   l(member_lock);
  void *elt = NULL;
  if (ELTQ->size() > 0)
  {
    elt = ELTQ->front();
    ELTQ->pop_front();
    size_changed.notify_all();
  }
  return elt;
}


void
bound_queue_t::resize(size_t n)
{
  ::std::unique_lock< ::std::mutex>   l(member_lock);
  bound = n;
  // get things rolling again
  size_changed.notify_all();
}

using namespace flx;;
using namespace gc;
using namespace generic;

void *bound_queue_scanner(
  collector_t *collector,
  gc_shape_t *shape, void *pp,
  size_t dyncount,
  int reclimit
)
{
  // input is a pointer to a pointer to a bound queue object
  void *p = *(void**)pp;
  bound_queue_t *bq = (bound_queue_t*)p;
  void_queue *pq = (void_queue*) bq->lame_opaque;
  printf("Scanning bound queue %p->%p\n", pp, p);

  ::std::deque<void*>::const_iterator stl_end = pq->end();
  for(
    ::std::deque<void*>::const_iterator iter= pq->begin();
    iter < stl_end;
    ++iter
  ) {
    void *value = *iter;
    printf("bound_queue scanning p=%p\n",value);
    collector->register_pointer(value,reclimit);
  }
  return 0;
}


}}

//[flx_bound_queue.fpc]
Name: Pthread Bound Queue
Requires: flx_pthread flx_gc
includes: '"pthread_bound_queue.hpp"'

Package: src/packages/rtl-monitor.fdoc

monitor

key file
pthread_monitor.hpp share/lib/rtl/pthread_monitor.hpp
pthread_monitor.cpp share/src/pthread/pthread_monitor.cpp

Monitor

//[pthread_monitor.hpp]
#ifndef __FLX_PTHREAD_MONITOR_H__
#define __FLX_PTHREAD_MONITOR_H__
#include "flx_pthread_config.hpp"
#include <thread>
#include <mutex>
#include <condition_variable>
#include <atomic>
#include "pthread_thread_control_base.hpp"

// interface for a consumer/producer queue. threads requesting a resource
// that isn't there block until one is available. push/pop re-entrant

namespace flx { namespace pthread {

struct monitor_data_t
{
  void *user_data;
  ::std::atomic<bool> flag;
  monitor_data_t (void* u) : user_data(u), flag(false) {}
};


class PTHREAD_EXTERN monitor_t {
  ::std::atomic<monitor_data_t*> volatile data;
  thread_control_base_t *tc;
public:
  monitor_t(thread_control_base_t *);
  ~monitor_t();
  void enqueue(void*);
  void* dequeue();
};

}} // namespace pthread, flx
#endif

//[pthread_monitor.cpp]
#include "pthread_monitor.hpp"
#include <string.h>       // strerror
#include <assert.h>
#include <thread>
#include <atomic>
#include "pthread_thread.hpp"

using namespace std;

#define NQFENCE ::std::memory_order_seq_cst
#define DQFENCE ::std::memory_order_seq_cst


namespace flx { namespace pthread {

monitor_t::monitor_t(thread_control_base_t *tc_) : tc(tc_), data(0) {}
monitor_t::~monitor_t() { }

static void sleep(thread_control_base_t *tc, size_t ns)
{
  assert(tc);
  tc->yield();
//  ::std::this_thread::sleep_for(::std::chrono::milliseconds(ns));
//fprintf(stderr, "pthread_monitor: sleep: thread %p calling std::this_thread::yield()\n",::flx::pthread::mythrid());
  ::std::this_thread::yield();
}

void
monitor_t::enqueue(void* elt)
{
//fprintf(stderr, "pthread_monitor: enqueue : thread %p, this=%p \n",::flx::pthread::mythrid(),this);

  // wrap user data up with a flag so this thread
  // can wait until our user data elt is consumed
  monitor_data_t monitor_data (elt);
  monitor_data_t *p = &monitor_data;

  // swap user data into the monitor
  // note we might get back a value some other thread put there
  // in which case we keep swapping until we get a NULL
  // which means we no longer have any data to put into the monitor
  while ( (p = ::std::atomic_exchange_explicit(&data, p, NQFENCE))) sleep (tc,1);

  // wait for the *original* data to be consumed
  // note that some other thread may have swapped that data
  // into its own space and will be trying as above to swap it
  // into the monitor for a NULL.
  while (!monitor_data.flag.load()) sleep(tc,1);
}

void*
monitor_t::dequeue()
{
//fprintf(stderr, "pthread_monitor: dequeue : thread %p , this=%p\n",::flx::pthread::mythrid(),this);
  monitor_data_t *p = 0;

  // Swap NULL into the monitor until we get a non-NULL value back.
  while ( !(p = ::std::atomic_exchange_explicit (&data, p, DQFENCE))) sleep(tc,1);

  // grab the user data
  void *elt = p->user_data;

  // signal that we have the data
  p->flag.store(true);
  // the writer that was originally responsible for putting
  // the data we read into the monitor may now proceed
  return elt; // return data
}

}}

Package: src/packages/rtl-lfbag.fdoc

Lock Free Bag

key file
pthread_lf_bag.hpp share/lib/rtl/pthread_lf_bag.hpp
pthread_lf_bag.cpp share/src/pthread/pthread_lf_bag.cpp
pthread_lf_bag.flx share/lib/std/pthread/pthread_lf_bag.flx

Lock Free Bag

A lock free thread safe bag for holding non-null pointers.

//[pthread_lf_bag.hpp]
#ifndef __FLX_PTHREAD_LF_BAG_H__
#define __FLX_PTHREAD_LF_BAG_H__

#include "flx_pthread_config.hpp"
#include <stdint.h>
#include <atomic>
#include "pthread_thread_control_base.hpp"

namespace flx { namespace pthread {

struct PTHREAD_EXTERN pthread_lf_bag {
  ::std::atomic <void *> * volatile a;
  size_t n;
  thread_control_base_t *tc;

  // for statistics
  size_t throughput;

  // these indices are for optimisation purposes ONLY
  // the head points at the next element to dequeue or a bit earlier
  ::std::atomic<size_t> head;

  // we can't use unsigned type because the value may go negative
  // if dequeue operations decrement the counter before the enqueue
  // that pushed the data does.
  ::std::atomic<int32_t> used;

  pthread_lf_bag (thread_control_base_t *tc_, size_t n_);

  // the destructor is not safe!
  // to make it safe one needs to be sure the queue is empty
  // AND that no more values will be enqueued.
  // This is very hard to do. Using a smart ptr for the bag
  // ensures there will be no more enqueue operations started
  // but not that one is not in progress. The queue may appear
  // empty during the progress of such final enqueue operations.
  // there is no safe way to ensure the queue will remain empty.
  ~pthread_lf_bag();

  void enqueue(void *d);
  void *dequeue ();
};

}} // namespaces
#endif

//[pthread_lf_bag.cpp]
// simple very efficient lock free bag
#include <atomic>
#include <chrono>
#include <algorithm>
#include <thread>
#include <stdlib.h>
#include "pthread_lf_bag.hpp"
#include <assert.h>
#include <pthread_thread.hpp>

using namespace flx::pthread;

// 10 ms max sleep, that's 10,000,000 nanoseconds
#define MAXSLEEP (size_t)10000000

static void sleep(thread_control_base_t *tc, size_t ns)
{
fprintf(stderr, "pthread_lf_bag: sleep: thread %p calling std::this_thread::yield()",::flx::pthread::mythrid());
  assert(tc);
  tc->yield();
  //::std::this_thread::sleep_for(::std::chrono::nanoseconds(ns));
  ::std::this_thread::yield();
}

#define NQFENCE ::std::memory_order_seq_cst
#define DQFENCE ::std::memory_order_seq_cst


  pthread_lf_bag::pthread_lf_bag (thread_control_base_t *tc_, size_t n_) :
    n (n_), tc(tc_), head(0), used(0),
    throughput(0),
    a((::std::atomic<void*>*)calloc (n_ , sizeof (void*)))
  {}

  // the destructor is not safe!
  // to make it safe one needs to be sure the queue is empty
  // AND that no more values will be enqueued.
  // This is very hard to do. Using a smart ptr for the bag
  // ensures there will be no more enqueue operations started
  // but not that one is not in progress. The queue may appear
  // empty during the progress of such final enqueue operations.
  // there is no safe way to ensure the queue will remain empty.
  pthread_lf_bag::~pthread_lf_bag() { }

  void pthread_lf_bag::enqueue(void *d)
  {
wait:
    size_t stime = 1;
    while (used.load(::std::memory_order_seq_cst) == n) sleep(tc,stime);
    size_t i = (head + used) % n;
    while
    (
      (d = ::std::atomic_exchange_explicit(a + i, d,
        NQFENCE))
    )
    {
      if (used.load(::std::memory_order_seq_cst) == n) goto wait; // lost the race
      i = (i + 1) % n;
      if (i == head) sleep(tc,stime);
    }
    ++used;
  }

  void *pthread_lf_bag::dequeue ()
  {
wait:
    size_t stime = 1;
    while (used.load(::std::memory_order_seq_cst) == 0) sleep(tc,stime );

    size_t i = head.load(::std::memory_order_seq_cst);
    void *d = nullptr;
    while
    (
      !(d = ::std::atomic_exchange_explicit(a + i, d,
        DQFENCE))
    )
    {
      if (used.load(::std::memory_order_seq_cst) == 0) goto wait; // lost the race
      i = (i + 1) % n;
      if (i == head) sleep(tc,stime);
    }
    head.store (i,::std::memory_order_seq_cst);
    --used;
    ++throughput;
    return d;
  }

//[pthread_lf_bag.flx]
class LockFreeBag
{
  type lf_bag = "::std::shared_ptr<::flx::pthread::pthread_lf_bag>"
    requires
      header '#include "pthread_lf_bag.hpp"',
      package "pthread",
      Cxx11_headers::memory
  ;
  // note: unmanaged container at the moment!!
  ctor lf_bag : size = """
     ::std::shared_ptr<::flx::pthread::pthread_lf_bag>
     (new ::flx::pthread::pthread_lf_bag(PTF gcp->collector->get_thread_control(),$1))
  """;
  proc enqueue : lf_bag * address = "$1->enqueue ($2);";
  gen dequeue : lf_bag -> address = "$1->dequeue ()";
  gen len : lf_bag -> size = "$1->n";
  gen used : lf_bag -> size = "$1->used.load()";
}

Package: src/packages/rtl-slist.fdoc

slist

key file
flx_slist.cpp share/src/rtl/flx_slist.cpp
flx_slist.hpp share/lib/rtl/flx_slist.hpp

Singly linked list of pointers

Not used any more.

//[flx_slist.hpp]
#ifndef __FLX_SLIST_H__
#define __FLX_SLIST_H__
#include "flx_rtl_config.hpp"
#include "flx_gc.hpp"
#include "flx_serialisers.hpp"

namespace flx { namespace rtl {
struct RTL_EXTERN slist_t;   // singly linked list of void*
struct RTL_EXTERN slist_node_t;   // singly linked list of void*
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t slist_node_ptr_map;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t slist_ptr_map;

// ********************************************************
/// SLIST. singly linked lists: SHARABLE and COPYABLE
/// SLIST manages pointers to memory managed by the collector
// ********************************************************

struct RTL_EXTERN slist_node_t {
  slist_node_t *next;
  void *data;
  slist_node_t(slist_node_t *n, void *d) : next(n), data(d) {}
};


struct RTL_EXTERN slist_t {
  slist_t(){}

  gc::generic::gc_profile_t *gcp;
  struct slist_node_t *head;

  slist_t (gc::generic::gc_profile_t*); ///< create empty list

  void push(void *data);                ///< push a gc pointer
  void *pop();                          ///< pop a gc pointer
  bool isempty()const;
};

}}
#endif

//[flx_slist.cpp]
#include "flx_slist.hpp"
namespace flx { namespace rtl {

// ********************************************************
// slist implementation
// ********************************************************

slist_t::slist_t(::flx::gc::generic::gc_profile_t *_gcp) : gcp (_gcp), head(0) {}

bool slist_t::isempty()const { return head == 0; }

void slist_t::push(void *data)
{
  head = new(*gcp,slist_node_ptr_map,false) slist_node_t(head,data);
}

// note: never fails, return NULL pointer if the list is empty
void *slist_t::pop()
{
  if(head) {
    void *data = head->data;
    head=head->next;
    return data;
  }
  else return 0;
}

// ********************************************************
//OFFSETS for slist_node_t
// ********************************************************
static const std::size_t slist_node_offsets[2]={
    offsetof(slist_node_t,next),
    offsetof(slist_node_t,data)
};

static ::flx::gc::generic::offset_data_t const slist_node_offset_data = { 2, slist_node_offsets };
::flx::gc::generic::gc_shape_t slist_node_ptr_map = {
  "rtl::slist_node_t",
  1,sizeof(slist_node_t),
  0, // no finaliser,
  0, // fcops
  &slist_node_offset_data,
  ::flx::gc::generic::scan_by_offsets,
  ::flx::gc::generic::tblit<slist_node_t>,::flx::gc::generic::tunblit<slist_node_t>,
  ::flx::gc::generic::gc_flags_default,
  0UL, 0UL
};


// ********************************************************
//OFFSETS for slist_t
// ********************************************************
static const std::size_t slist_offsets[1]={
    offsetof(slist_t,head)
};
static ::flx::gc::generic::offset_data_t const slist_offset_data = { 1, slist_offsets };

static CxxValueType<slist_t> _slist_t_fcops {};

::flx::gc::generic::gc_shape_t slist_ptr_map = {
  "rtl::slist_t",
  1,sizeof(slist_t),
  0, // no finaliser
  &_slist_t_fcops, // fcops
  &slist_offset_data,
  ::flx::gc::generic::scan_by_offsets,
  ::flx::gc::generic::tblit<slist_t>,::flx::gc::generic::tunblit<slist_t>,
  ::flx::gc::generic::gc_flags_default,
  0UL, 0UL
};

}}

Package: src/packages/rtl-sysdlist.fdoc

Sysdlist

key file
flx_sysdlist.cpp share/src/rtl/flx_sysdlist.cpp
flx_sysdlist.hpp share/lib/rtl/flx_sysdlist.hpp
sysdlist.flx share/lib/datatype/sysdlist.flx

Double linked list of pointers

Not used any more.

//[flx_sysdlist.hpp]
#ifndef __FLX_SYSDLIST_H__
#define __FLX_SYSDLIST_H__
#include "flx_rtl_config.hpp"
#include "flx_gc.hpp"

#include <list>

namespace flx { namespace rtl {

struct RTL_EXTERN sysdlist_t {
  sysdlist_t();
  ::std::list<void*> data;
};

RTL_EXTERN extern ::flx::gc::generic::scanner_t scan_sysdlist;
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t sysdlist_t_ptr_map;


}}
#endif

//[flx_sysdlist.cpp]
#include "flx_sysdlist.hpp"

namespace flx { namespace rtl {
sysdlist_t::sysdlist_t () {}

void *scan_sysdlist(
  ::flx::gc::generic::collector_t *collector,
  ::flx::gc::generic::gc_shape_t *shape,
  void *p,
  size_t dyncount,
  int reclimit
)
{
  auto q = reinterpret_cast<::flx::rtl::sysdlist_t*>(p);

  // calculate the absolute number of used array slots
  size_t n_used = dyncount  * shape->count;
  for (size_t j=0; j<n_used; ++j)
    for (auto elt  : q->data)
      if (collector->inrange(elt))
        collector->register_pointer (elt, reclimit -1);
  return nullptr;
}
// ********************************************************
// SHAPE for sysdlist_t
// ********************************************************

::flx::gc::generic::gc_shape_t sysdlist_t_ptr_map = {
  "rtl::sysdlist_t",
  1,sizeof(sysdlist_t),
  0, // no finaliser,
  0, // fcops
  0, // no offset data
  scan_sysdlist,
  0,0, // no serialisation as yet
  ::flx::gc::generic::gc_flags_default,
  0UL, 0UL
};
}}

Sysdlist

Doubly linked gc aware list of adresses.

//[sysdlist.flx]
class SysDlist {
  _gc_pointer type sysdlist[T] = "::flx::rtl::sysdlist_t*";
  ctor[T] sysdlist[T] : 1 = "new (*(ptf->gcp), ::flx::rtl::sysdlist_t_ptr_map, true) ::flx::rtl::sysdlist_t()";
  proc push_front[T] : sysdlist[T] * &T = "$1->data.push_front((void*)$2);";
  proc push_back[T]: sysdlist[T] * &T = "$1->data.push_front((void*)$2);";
  fun front[T]: sysdlist[T]  -> &T = "(?1*)$1->data.front();";
  gen pop_front[T]: sysdlist[T] -> @T = """
  (?1*)(
    ([&] ()
    {
      if ($1->data.empty()) return (void*)nullptr;
      auto x = $1->data.front();
      $1->data.pop_front();
      return x;
    })
    ()
  )""";

  gen unsafe_pop_front[T](x:sysdlist[T]): &T => C_hack::cast[&T](pop_front x);

  fun empty[T]: sysdlist[T] -> bool = "$1->data.empty()";
  fun len[T]: sysdlist[T] -> size = "$1->data.size()";
}

Package: src/packages/rtl-waitablebool.fdoc

Waitable bool

key file
pthread_waitable_bool.hpp share/lib/rtl/pthread_waitable_bool.hpp
pthread_waitable_bool.cpp share/src/pthread/pthread_waitable_bool.cpp

Shared Boolean

Used by demux_quitter

//[pthread_waitable_bool.hpp]
#ifndef __FLX_PTHREAD_WAIT_BOOL_H__
#define __FLX_PTHREAD_WAIT_BOOL_H__
#include "flx_pthread_config.hpp"
#include <thread>
#include <mutex>
#include <condition_variable>

namespace flx { namespace pthread {

// a waitable boolean.
class PTHREAD_EXTERN waitable_bool {
  ::std::mutex cv_lock;       // to work with the condition var
  ::std::condition_variable_any finished_cond;
  bool finished;   // might seem redundant, but that's how CVs work.
public:
  waitable_bool();

  void wait_until_true();
  void signal_true();
};

}} // namespace pthread, flx
#endif // __FLX_PTHREAD_WAIT_BOOL_H__

//[pthread_waitable_bool.cpp]
#include "pthread_waitable_bool.hpp"

namespace flx { namespace pthread {

waitable_bool::waitable_bool()
  : finished(false)
{
  // nothing
}

// can be called from any thread
void
waitable_bool::wait_until_true()
{
  ::std::unique_lock< ::std::mutex> locker(cv_lock);

  // wait for the wakeup to say it's finished
  while(!finished)
  {
    finished_cond.wait(cv_lock);
  }
}

void
waitable_bool::signal_true()
{
  { // the mutex is required for the memory barrier..
    ::std::unique_lock< ::std::mutex> locker(cv_lock);
    finished = true;
  }
  finished_cond.notify_all();
  // do absolutely NOTHING here as a typical use of this class is to
  // wait for a thread exit and then destruct its resources, which could
  // very well include this object. boom.
}

} }

Package: src/packages/serialisation.fdoc

Serialisation Support

key file
flx_serialisers.hpp share/lib/rtl/flx_serialisers.hpp
flx_serialisers.cpp share/src/gc/flx_serialisers.cpp
flx_judy_scanner.hpp share/lib/rtl/flx_judy_scanner.hpp
flx_judy_scanner.cpp share/src/gc/flx_judy_scanner.cpp
serialise.flx share/lib/std/felix/serialise.flx

Serialisers

Generic Serialisation
//[flx_serialisers.hpp]
#ifndef __FLX_SERIALISERS_HPP__
#define __FLX_SERIALISERS_HPP__

#include "flx_gc.hpp"
namespace flx { namespace gc { namespace generic {
GC_EXTERN encoder_t string_encoder;
GC_EXTERN decoder_t string_decoder;

GC_EXTERN ::std::string blit (void *, size_t);
GC_EXTERN size_t unblit (void *, size_t, char*, size_t);

GC_EXTERN ::std::string string_blit (::std::string const&);

template<class T>
::std::string tblit(void *p)
{
  return blit (p, sizeof(T));
}

template<class T>
size_t tunblit(void *p, char *s, size_t i)
{
  return unblit (p, sizeof(T), s, i);
}


}}}

#endif

//[flx_serialisers.cpp]
#include "flx_serialisers.hpp"
#include <string>
#include <cstring>
#include <cstddef>

namespace flx { namespace gc { namespace generic {

// This is an encoder for a primitive string.
::std::string string_encoder (void *p)
{
  return *(::std::string*)p;
}

// This is NOT an encoder. It's a utility wrapper which
// takes a variable length string and returns another
// string prefixed by the length.
//
// This function is applied to all user defined encoders,
// to get a length managed serialisation.
::std::string string_blit (::std::string const &s)
{
  ::std::size_t n = s.size();
  ::std::string b = blit (&n, sizeof(::std::size_t));
  b+=s;
  return b;
}

// This is a utility for encoding a pod of size n.
// We don't need a length because it is statically known.
::std::string blit (void *p, ::std::size_t n) {
  return ::std::string((char*)p,n);
}

::std::size_t string_decoder (void *p, char *s, ::std::size_t i)
{
   ::std::size_t n;
   ::std::memcpy (&n,s + i,sizeof(::std::size_t));
   new (p) ::std::string(s+i+sizeof(::std::size_t), n);
   return i + sizeof(::std::size_t) + n;
}

::std::size_t unblit (void *p, ::std::size_t n, char *s, ::std::size_t i)
{
  ::std::memcpy (p,s+i,n);
  return i + n;
}

}}}
Judy Serialisers
//[flx_judy_scanner.hpp]
#include "flx_gc.hpp"

namespace flx { namespace gc { namespace generic {
GC_EXTERN scanner_t Judy1_scanner;
GC_EXTERN scanner_t JudyL_scanner;
GC_EXTERN scanner_t JudySL_scanner;
}}}

//[flx_judy_scanner.cpp]
#include "flx_judy_scanner.hpp"
#include <Judy.h>

namespace flx { namespace gc { namespace generic {

void *Judy1_scanner(collector_t *collector, gc_shape_t *shape, void *pp, size_t dyncount, int reclimit)
{
  void *p = *(void**)pp;
  //printf("Scanning judy1 array %p->%p\n", pp, p);
  JError_t je;
  Word_t key = 0;
  int res = Judy1First(p, &key, &je);
  while(res) {
    //printf("Judy1 scanning p=%p\n",key);
    collector->register_pointer((void*)key,reclimit);
    res = Judy1Next(p,&key, &je);
  }
  return 0;
}

void *JudyL_scanner(collector_t *collector, gc_shape_t *shape, void *pp, size_t dyncount, int reclimit)
{
  void *p = *(void**)pp;
  //printf("Scanning judyL array %p->%p\n", pp, p);
  JError_t je;
  Word_t key = 0;
  Word_t *pval = 0;
  pval = (Word_t*)JudyLFirst(p, &key, &je);
  while(pval) {
    //printf("JudyL scanning p=%p\n",key);
    collector->register_pointer((void*)key,reclimit);
    //printf("JudyL scanning p=%p\n",key);
    collector->register_pointer((void*)*pval,reclimit);
    pval = (Word_t*)JudyLNext(p, &key, &je);
  }
  return 0;
}

void *JudySL_scanner(collector_t *collector, gc_shape_t *shape, void *pp, size_t dyncount, int reclimit)
{
  void *p = *(void**)pp;
  //fprintf(stderr,"Scanning judySL array %p->%p\n", pp, p);
  JError_t je;
  unsigned char *key = (unsigned char*)::std::malloc(10000); // HACK
  *key = 0;
  Word_t *pval = 0;
  pval = (Word_t*)JudySLFirst(p, key, &je);
  while(pval) {
    //printf("JudyL scanning p=%s, v=%p\n",key,*pval);
    collector->register_pointer((void*)*pval,reclimit);
    pval = (Word_t*)JudySLNext(p, key, &je);
  }
  ::std::free(key);
  return 0;
}


}}} // end namespaces

Serialisation functions

//[serialise.flx]
class Serialise
{
  open Collector;
  open Rtti;
  open Judy;

  //$ Encode binary image of a type, without length.
  fun blit[T] (p: &T) => string ( C_hack::cast[+char] p, C_hack::sizeof[T]);
  fun ncode [T] (var v: T) => blit &v;

  //$ Decode a type
  gen unblit[T] (p: &T, s: +char, i:size) : size =
  {
     Memory::memcpy(p.address,(s+i).address,C_hack::sizeof[T]);
     return i + C_hack::sizeof[T];
  }

  // Despite the name this is the general heap object encoder
  // sans pointers and head adjustment.
  fun encode_varray (p:address) : string =
  {
    var pd = Collector::get_pointer_data p;
    assert pd.is_felix_pointer;
    var shape = pd.shape;

    var has_encoder = not shape.encoder.C_hack::cast[address].isNULL;
    var has_pointers = shape._unsafe_n_offsets == 0uz;

    // write shape
    var out = ncode shape;

    // write head pointer
    out += ncode pd.head;

    // write max slots
    out += ncode pd.max_elements;

    // write used slots
    out += ncode pd.used_elements;

    assert has_encoder;
    var dynamic_slot_size = shape.bytes_per_element * shape.number_of_elements;
    for var i:size in 0uz upto pd.used_elements.size  - 1uz do
      // write out each encoded value
      out += shape.encoder (pd.head + i * dynamic_slot_size);
    done
    return out;
  }

  fun find_pointers (p:address) : list[address] =
  {
    //println$ "Find pointers for object " + p.str;
    var pd = Collector::get_pointer_data p;
    if not pd.is_felix_pointer do
      //println$ "Not Felix pointer";
      return Empty[address];
    done
    //Collector::print_pointer_data pd;
    var shape = pd.shape;
    var head = pd.head;
    var n_offsets = shape.Rtti::n_offsets;
    //println$ "Number of offsets " + n_offsets.str;
    var pointers = Empty[address];
    if n_offsets > 0uz do
      var offsets = shape.Rtti::offsets;
      var repeat_count = pd.used_elements.size * shape.number_of_elements;
      var element_size = shape.bytes_per_element;
      for var sindex in 0uz upto repeat_count - 1uz do
        for var oindex in 0uz upto n_offsets - 1uz do
          var bindex = sindex * element_size + *(offsets+oindex);
          var ptr = *((head + bindex).C_hack::cast[&address]);
          pointers = Cons (ptr, pointers);
        done
      done
    done
    return pointers;
  }

  // data structure to represent pointer closure
  struct pclosure
  {
     processed: J1Array;
     waiting: J1Array;
  };

  // initially empty
  ctor pclosure () => pclosure (#J1Array, #J1Array);

  // add a pointer to the waiting set,
  // provided it isn't already processed or waiting
  proc add_pointer (self: &pclosure) (p:address)
  {
    var pd = Collector::get_pointer_data p;
    if pd.is_felix_pointer do
      var je : JError_t;
      var ret : int;
      var w = pd.head.Judy::word;
      if not (w \in self*.processed or w \in self*.waiting) do
        Judy1Set (self*.waiting, w, &je, &ret);
      done
    done
  }

  // get a pointer from the waiting set, put it in
  // the processed set, and return it, None if the
  // waiting set is empty.
  gen iterator (self: &pclosure) () : opt[address] =
  {
    var w: word = 0.word;
    var je : JError_t;
    var ret: int;
    Judy1First(self*.waiting,&w,&je,&ret);
    if ret == 1 do
      Judy1Unset(self*.waiting, w, &je, &ret);
      Judy1Set (self*.processed, w, &je, &ret);
      return Some w.address;
    else
      return None[address];
    done
   }

  fun find_closure (p:address) : list[address] =
  {
     var xpc = #pclosure;
     var pd = Collector::get_pointer_data p;
     add_pointer &xpc pd.head;
     for ptr in &xpc do
       //println$ "Processing pointer " + ptr.str;
       iter (add_pointer &xpc) (find_pointers ptr);
     done
     var lst = list[address] (pd.head);
     var a: word = 0.word;
     var ret: int;
     Judy1First (xpc.processed, &a, &je, &ret);
     while ret == 1 do
       if a.address != pd.head do
         lst = Cons (a.address, lst);
       done
       Judy1Next(xpc.processed, &a, &je, &ret);
     done
     var w:word;
     var je:JError_t;
     Judy1FreeArray (xpc.processed, &je, &w);
     // pc.waiting should be empty already
     // original pointer is LAST in the list!
     return lst;
  }

  fun encode_closure (alst:list[address]) : string =
  {
    var b = "";
    iter proc (elt:address) { b+=encode_varray elt; } alst;
    return b;
  }

  fun encode_pointer_closure (p:address) =>
     p.find_closure.encode_closure
  ;

  gen create_empty_varray : gc_shape_t * size -> address =
    "(PTF gcp->collector->create_empty_array($1,$2))"
    requires property "needs_gc"
  ;

  proc set_used: address * size =
    "PTF gcp->collector->set_used($1,$2);"
    requires property "needs_gc"
  ;

  gen decode_varray (ss:string) : address =
  {
    var s = ss.cstr;
    var i = 0uz;

    // get header data
    var shape: gc_shape_t;
    var head: address;
    var maxslots : size;
    var usedslots: size;
    i = unblit (&shape, s, i);
    i = unblit (&head, s, i);
    i = unblit (&maxslots, s, i);
    i = unblit (&usedslots, s, i);
    assert not shape.decoder.C_hack::cast[address].isNULL;
    var dynamic_slot_size = shape.bytes_per_element * shape.number_of_elements;
    var p = create_empty_varray (shape, maxslots);
    for var slot in 0uz upto usedslots - 1uz do
      i = (shape.decoder ( p + slot * dynamic_slot_size, s, i));
    done
    set_used (p, usedslots);
    return p;
  }

  gen decode_pointer_closure (ss:string) : address =
  {
    // A map from old object head to new head
    var pmap = #JLArray;
    var je : JError_t;

    // create set of objects from serialised data
    // return a pointer to the last one which is
    // assumed to be the root of the closure
    gen create_objects () : address =
    {
      var s = ss.cstr;
      var n = ss.len;
      var i = 0uz;
      var pnew : &word;
      while i != n do
        // get header data
        var shape: gc_shape_t;
        var head: address;
        var maxslots : size;
        var usedslots: size;
        i = unblit (&shape, s, i);
        i = unblit (&head, s, i);
        i = unblit (&maxslots, s, i);
        i = unblit (&usedslots, s, i);
        assert not shape.decoder.C_hack::cast[address].isNULL;
        var dynamic_slot_size = shape.bytes_per_element * shape.number_of_elements;
        var p = create_empty_varray (shape, maxslots);
        for var slot in 0uz upto usedslots - 1uz do
          i = (shape.decoder ( p + slot * dynamic_slot_size, s, i));
        done
        set_used (p, usedslots);

        JudyLIns(pmap,head.word,&je,&pnew);
        pnew <- p.word;
      done
      return head; // root pointer is last in list!
    }

    // Adjust a pointer at the given address
    proc adjust_pointer (pptr:&address)
    {
      var oldptr = *pptr;
      var oldhead = oldptr.word;
      var pnew2 : &word;
      // find the equal or next lowest old object address
      // and the associated new object address
      JudyLLast(pmap,&oldhead,&je,&pnew2);
      if not isNULL pnew2 do
        var newhead2 = *pnew2;
        var pd2 = Collector::get_pointer_data newhead2.address;
        var nbytes = pd2.shape.bytes_per_element * pd2.max_elements.size * pd2.shape.number_of_elements;
        if oldptr < oldhead.address + nbytes do
           pptr <- newhead2.address + (oldptr - oldhead.address);
        done
      done
    }

    // Adjust all the pointers in one of the new objects
    proc adjust_all_pointers (newhead:address)
    {
      var pd = Collector::get_pointer_data newhead;
      var shape = pd.shape;
      var head = pd.head;
      var n_offsets = shape.Rtti::n_offsets;
      //println$ "Number of offsets " + n_offsets.str;
      if n_offsets > 0uz do
        var offsets = shape.Rtti::offsets;
        var repeat_count = pd.used_elements.size * shape.number_of_elements;
        var element_size = shape.bytes_per_element;
        for var sindex in 0uz upto repeat_count - 1uz do
          for var oindex in 0uz upto n_offsets - 1uz do
            var bindex = sindex * element_size + *(offsets+oindex);
            var pptr = ((head + bindex).C_hack::cast[&address]);
            adjust_pointer (pptr);
          done
        done
      done
    }

    var rootp = create_objects();

    // Adjust all the pointers in all of the new objects
    var old : word = 0.word;
    var pnew : &word;
    JudyLFirst(pmap, &old, &je, &pnew);
    while not (isNULL pnew) do
      var newhead = (*pnew).address;
      adjust_all_pointers (newhead);
      JudyLNext(pmap, &old, &je, &pnew);
    done
    return rootp;
  }
}

Package: src/packages/strutil.fdoc

String Support Utilities.

key file
flx_strutil.hpp share/lib/rtl/flx_strutil.hpp
flx_strutil.cpp share/src/strutil/flx_strutil.cpp
flx_i18n.hpp share/lib/rtl/flx_i18n.hpp
flx_i18n.cpp share/src/strutil/flx_i18n.cpp
unix_flx_strutil.fpc $PWD/src/config/unix/flx_strutil.fpc
win_flx_strutil.fpc $PWD/src/config/win/flx_strutil.fpc
flx_i18n.fpc $PWD/src/config/flx_i18n.fpc
flx_strutil_config.hpp share/lib/rtl/flx_strutil_config.hpp
flx_strutil.py $PWD/buildsystem/flx_strutil.py

String utilities

//[flx_strutil.hpp]

#ifndef __FLX_STRUTIL_HPP_
#define __FLX_STRUTIL_HPP_

#include <string>
#include <sstream>
#include <iomanip>
#include <cstdarg>
#include <cstdlib>
#include <cstring>


#include "flx_strutil_config.hpp"

//RF: was only to commented out to fix macosx problem,
//but lets see what happens to all the other builds.
//#ifndef MACOSX
//template class RTL_EXTERN std::basic_string<char>;
//#endif

namespace flx { namespace rtl { namespace strutil {
  using namespace std;
  template<class T>
  basic_string<T> mul(basic_string<T> s, int n) {
    basic_string<T> r = "";
    while(n--) r+=s;
    return r;
  }

  // normalise string positions Python style
  // note substr requires 0<=b<=size, 0<=n,
  // however n>size is OK
  template<class T>
  basic_string<T> substr(basic_string<T> const &s, int b, int e)
  {
    int n = s.size();
    if(b<0)  b=b+n;
    if(b<0)  b=0;
    if(b>=n) b=n;
    if(e<0)  e=e+n;
    if(e<0)  e=0;
    if(e>=n) e=n;
    int m =  e-b;
    if(m<0)  m=0;
    return s.substr(b,m);
  }

  template<class T>
  T subscript(basic_string<T> const &s, int i)
  {
    int n = s.size();
    if(i<0)  i=i+n;
    return i<0 || i >= n ? T(0) : s[i];
  }

  template<class T>
  string str(T const &t) {
    std::ostringstream x;
    x << t;
    return x.str();
  }

  template<class T>
  string fmt_default(T const &t, int w, int p) {
    std::ostringstream x;
    x << std::setw(w) << std::setprecision(p) << t;
    return x.str();
  }

  template<class T>
  string fmt_fixed(T const &t, int w, int p) {
    std::ostringstream x;
    x << std::fixed << std::setw(w) << std::setprecision(p) << t;
    return x.str();
  }

  template<class T>
  string fmt_scientific(T const &t, int w, int p) {
    std::ostringstream x;
    x << std::scientific << std::setw(w) << std::setprecision(p) << t;
    return x.str();
  }


  STRUTIL_EXTERN string atostr(char const *a);
  STRUTIL_EXTERN string flx_asprintf(char const *fmt,...);

  STRUTIL_EXTERN string flxid_to_cid(string const&);
  STRUTIL_EXTERN string filename_to_modulename (string const&);
  STRUTIL_EXTERN size_t string_hash(string const &s);
  STRUTIL_EXTERN char *flx_strdup(char const *);
  STRUTIL_EXTERN char *flx_cstr(::std::basic_string<char> const&);

}}}

#endif

//[flx_strutil.cpp]

#include <stdio.h>
#include <cstdint>
#include <cstring>

#include "flx_strutil.hpp"

namespace flx { namespace rtl { namespace strutil {

  char *flx_strdup(char const *p) {
    if (p==0) return NULL;
    auto n = ::std::strlen (p);
    auto q = (char*) ::std::malloc(n+1);
    strcpy (q,p);
    return q;
  }

  char *flx_cstr(::std::basic_string<char> const& s) {
    auto n = s.size();
    auto q = (char*) ::std::malloc(n+1);
    auto p = s.c_str();
    ::std::memcpy(q,p,n);
    q[n] = 0;
    return q;
  }

  string atostr(char const *a) {
    if(a) return a;
    else return "";
  }

  size_t string_hash(string const &s)
  {
    size_t hash = 5381;
    int c;
    char const *str = s.c_str();
    while (c = *str++)
        hash = (hash * 33 + c) % (size_t)1073741823ll; /* hash * 33 + c */
    return hash;
  }

  string flxid_to_cid (string const &s)
  {
    string out = "";
    int n = s.size();
    // leading digit
    if (n > 1 && s[0] >= '0' && s[0] <= '9') out += "_";
    for (int i = 0; i < n; ++i)
    {
      char ch = s[i];
      /* from http://www.w3.org/TR/html4/sgml/entities.html */
      switch (ch)
      {
        case ' ': out += "__sp_"; break;
        case '!': out += "__excl_"; break;
        case '"': out += "__quot_"; break;
        case '#': out += "__num_"; break;
        case '$': out += "__dollar_"; break;
        case '%': out += "__percnt_"; break;
        case '&': out += "__amp_"; break;
        case '\'':  out +=  "__apos_"; break;
        case '(': out += "__lpar_"; break;
        case ')': out += "__rpar_"; break;
        case '*': out += "__ast_"; break;
        case '+': out += "__plus_"; break;
        case ',': out += "__comma_"; break;
        case '-': out += "__hyphen_"; break;
        case '.': out += "__period_"; break;
        case '/': out += "__sol_"; break;
        case ':': out += "__colon_"; break;
        case ';': out += "__semi_"; break;
        case '<': out += "__lt_"; break;
        case '=': out += "__equals_"; break;
        case '>': out += "__gt_"; break;
        case '?': out += "__quest_"; break;
        case '@': out += "__commat_"; break;
        case '[': out += "__lsqb_"; break;
        case '\\': out += "__bsol_"; break;
        case ']': out += "__rsqb_"; break;
        case '^': out += "__caret_"; break;
        case '`': out += "__grave_"; break;
        case '{': out += "__lcub_"; break;
        case '|': out += "__verbar_"; break;
        case '}': out += "__rcub_"; break;
        case '~': out += "__tilde_"; break;
        default: out += string (1,ch);
      }
   }
   if (out.size() > 40)
     return out.substr(0,4) + flx_asprintf("_hash_%zu",string_hash(out));
   else
     return out;
  }

  string chop_extension (string const &s)
  {
     int n = s.size();
     for(int i = n - 1; i >= 0; --i)
     {
       if (s[i] == '/') return s;
       if (s[i] == '\\') return s;
       if (s[i] == '.') return s.substr(0,i);
     }
     return s;
  }

  string basename (string const &s)
  {
     int n = s.size();
     for(int i = n - 1; i >= 0; --i)
     {
       if (s[i] == '/') return s.substr (i+1,n-i);
       if (s[i] == '\\') return s.substr (i+1,n-i);
     }
     return s;
  }
  string filename_to_modulename (string const &s)
  {
     string a = basename (s);
     a = chop_extension (a);
     a = flxid_to_cid (a);
     return a;
  }

#ifdef FLX_HAVE_VSNPRINTF
  string flx_asprintf(char const *fmt,...){
    va_list ap;
    va_start(ap,fmt);
    //printf("vsnprintf TRIAL\n");
    int n = vsnprintf(NULL,0,fmt,ap);
    //printf("vsnprintf size=%d\n",n);
    va_end(ap);
    char *res = new char[n + 1];
    va_start(ap,fmt);
    vsnprintf(res,n+1,fmt,ap);
    va_end(ap);
    string s = string(res);
    delete [] res;
    return s;
  }
#else
  // THIS IS UNSAFE .. but Windows sucks.
  // It documents vsnprintf .. but doesn't provide it
  string flx_asprintf(char const *fmt,...){
    //printf("vsnprintf EMULATION!\n");
    va_list ap;
    int n = 10000; // hack, WILL crash if not enough
    char *res = new char[n+1];
    va_start(ap,fmt);
    vsprintf(res,fmt,ap);
    va_end(ap);
    string s = string(res);
    delete [] res;
    return s;
  }
#endif

}}}

//[flx_strutil_config.hpp]
#ifndef __FLX_STRUTIL_CONFIG_H__
#define __FLX_STRUTIL_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_STRUTIL
#define STRUTIL_EXTERN FLX_EXPORT
#else
#define STRUTIL_EXTERN FLX_IMPORT
#endif
#endif

//[unix_flx_strutil.fpc]
Name: flx_strutil
Description: String utilities
provides_dlib: -lflx_strutil_dynamic
provides_slib: -lflx_strutil_static
includes: '"flx_strutil.hpp"'
macros: BUILD_STRUTIL
library: flx_strutil
srcdir: src/strutil
src: .*\.cpp

//[win_flx_strutil.fpc]
Name: flx_strutil
Description: String utilities
provides_dlib: /DEFAULTLIB:flx_strutil_dynamic
provides_slib: /DEFAULTLIB:flx_strutil_static
includes: '"flx_strutil.hpp"'
macros: BUILD_STRUTIL
library: flx_strutil
srcdir: src/strutil
src: .*\.cpp
UTF codec.
//[flx_i18n.hpp]

#ifndef __FLX_I18N_H__
#define __FLX_I18N_H__
#include <string>
#include "flx_strutil_config.hpp"

namespace flx { namespace rtl { namespace i18n {
   STRUTIL_EXTERN std::string utf8(unsigned long);
}}}
#endif

//[flx_i18n.cpp]

#include "flx_i18n.hpp"
namespace flx { namespace rtl { namespace i18n {
  std::string utf8(unsigned long i)
  {
    char s[7];
    if (i < 0x80UL )
    {
      s[0]= i;
      s[1]= 0;
    }
    else if (i < 0x800UL )
    {
      s[0]=0xC0u | (i >> 6ul)  & 0x1Fu;
      s[1]=0x80u | i           & 0x3Fu;
      s[2]=0;
    }
    else if (i < 0x10000UL )
    {
      s[0]=0xE0u | (i >> 12ul) & 0xFu;
      s[1]=0x80u | (i >> 6ul)  & 0x3Fu;
      s[2]=0x80u | i           & 0x3F;
      s[3]=0;
    }
    else if (i < 0x200000UL )
    {
      s[0]=0xF0u | (i >> 18ul) & 0x7u;
      s[1]=0x80u | (i >> 12ul) & 0x3Fu;
      s[2]=0x80u | (i >> 6ul)  & 0x3Fu;
      s[3]=0x80u | i           & 0x3F;
      s[4]=0;
    }
    else if (i < 0x4000000UL )
    {
      s[0]=0xF8u | (i >> 24ul) & 0x3u;
      s[1]=0x80u | (i >> 18ul) & 0x3Fu;
      s[2]=0x80u | (i >> 12ul) & 0x3Fu;
      s[3]=0x80u | (i >> 6ul)  & 0x3Fu;
      s[4]=0x80u | i           & 0x3Fu;
      s[5]=0;
    }
    else
    {
      s[0]=0xFCu | (i >> 30ul) & 0x1u;
      s[1]=0x80u | (i >> 24ul) & 0x3Fu;
      s[2]=0x80u | (i >> 18ul) & 0x3Fu;
      s[3]=0x80u | (i >> 12ul) & 0x3Fu;
      s[4]=0x80u | (i >> 6ul)  & 0x3Fu;
      s[5]=0x80u | i           & 0x3Fu;
      s[6]=0;
    }
    return s;
  }
}}}

Config database entry

//[flx_i18n.fpc]
Name: flx_i18n
Description: Internationalisation support, Unicode, utf8
Requires: flx_strutil
includes: '"flx_i18n.hpp"'

#[flx_strutil.py]
import fbuild
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    print('[fbuild] [rtl] build strutil')
    path = Path(phase.ctx.buildroot/'share'/'src'/'strutil')
    srcs = [f for f in Path.glob(path / '*.cpp')]
    includes = [phase.ctx.buildroot / 'host/lib/rtl', phase.ctx.buildroot / 'share/lib/rtl']
    macros = ['BUILD_STRUTIL']

    dst = 'host/lib/rtl/flx_strutil'
    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros))

Package: src/packages/sync.fdoc

Synchronous Scheduler

key file
flx_sync.hpp share/lib/rtl/flx_sync.hpp
flx_sync.cpp share/src/rtl/flx_sync.cpp

Synchronous Support System

This class encapsulate the core Felix synchronous scheduling mechanism and services synchronous service calls.

The scheduler method frun executes fthread_t fibres from the scheduler queue active, performing synchronous service calls made by the fibres until it is unable to proceed.

It then suspends and returns a code indication one of two conditions. Either the scheduler is blocked because there are no more active fibres on the queue to resume, or, it has received a non-synchronous service request it is unable to satisfy, in which case it returns delegated indicating it is delegating the responsibility to satisfy the service request to its caller.

The variable request contains the service call which the scheduler is delegating.

The scheduler itself is a finite state machine with three states: it is ready to resume the current fibre, it is ready to get the next fibre from the queue, or it is blocked because the current fibre has gone and the queue is empty.

Synchronous reads and writes can suspend or activate fibres. The special external multiwrite provides a way to populate the scheduler queue externally by pushing waiting fibres off a synchronous channel into the active queue.

//[flx_sync.hpp]

#ifndef __FLX_SYNC_H__
#define __FLX_SYNC_H__

#include "flx_gc.hpp"
#include "flx_rtl.hpp"
#include <list>
#include <atomic>
#include "flx_async.hpp"
#include "pthread_thread.hpp"

namespace flx { namespace run {

// *************************************
// fthread_list has grown to include the async control object
// and its ready list
//
// this object contains the data shared by multiple pthreads
// pooled to run coroutines concurrently
// *************************************

struct RTL_EXTERN fthread_list {
  ::flx::gc::generic::gc_profile_t *gcp;
  fthread_list(fthread_list const&) = delete;
  fthread_list& operator=(fthread_list const&) = delete;
public:
  // INVARIANT fthread_first==nullptr equiv fthread_last=nullptr
  ::flx::rtl::fthread_t *fthread_first; // has to be public for shape spec
  ::flx::rtl::fthread_t *fthread_last; // WEAK

  ::std::atomic_flag qisblocked;

  // FIXME: THESE SHOULDNT BE ATOMIC BECAUSE IDIOT C++ MIGHT MUTEX WRAP THEM
  // Instead they should only be used inside our spinlock
  ::std::atomic<int> thread_count; // n threads sharing list
  ::std::atomic<int> busy_count; // n threads actually working

//  ::std::mutex active_lock;
//  ::std::mutex *pactive_lock;

  bool lockneeded;
  ::std::atomic_flag active_lock;

  size_t async_count; // pending async jobs
  async_hooker* async; // async dispatch and ready list object

  fthread_list (::flx::gc::generic::gc_profile_t *gcp);
  ~fthread_list ();

  void push_back(::flx::rtl::fthread_t *);
  void push_front(::flx::rtl::fthread_t *);
  ::flx::rtl::fthread_t *pop_front();

  // DIAGNOSTICS ONLY
  size_t size() const;
  ::flx::rtl::fthread_t *front()const;
};
RTL_EXTERN extern ::flx::gc::generic::gc_shape_t fthread_list_ptr_map;


// This class handles synchronous channel I/O and fthreads
struct RTL_EXTERN sync_sched {
  sync_sched () = delete;
  sync_sched (sync_sched const&) = delete;
  sync_sched &operator=(sync_sched const&) = delete;

  bool debug_driver;

  // the garbage collector and general control object
  ::flx::gc::generic::collector_t *collector;

  // scheduler queue
  fthread_list *active;

  // temporary for currently running fibre
  ::flx::rtl::fthread_t *ft;

  // variable to hold service request
  ::flx::rtl::svc_req_t *request;

  // type for the state of the scheduler
  // when it suspends by returning.
  enum fstate_t { blocked, delegated };

  // debugging helper to get a description of
  // the suspended scheduler state
  static char const * get_fstate_desc(fstate_t);

  // debugging helper to get a description of
  // the running scheduler state
  char const * get_fpc_desc();

  sync_sched (
    bool debug_driver_,
    ::flx::gc::generic::gc_profile_t *gcp_,
    fthread_list *active_
  );

private:
  // helper routines.
  void impl_push_front(::flx::rtl::fthread_t*);

public:
  void push_front(::flx::rtl::fthread_t*);
  fstate_t frun();

  // a special routine to allow a multiwrite to be performed
  // from outside the scheduler whilst it is suspended.
  void external_multi_swrite(::flx::rtl::schannel_t*, void*);
protected:
  // handlers for synchronous service calls.
  void do_yield();
  void do_spawn_fthread();
  void do_schedule_fthread();
  void do_sread();
  void do_swrite();
  void do_multi_swrite();
  void do_kill();
  void show_state();
};

RTL_EXTERN extern ::flx::gc::generic::gc_shape_t sync_sched_ptr_map;


}}

#endif

//[flx_sync.cpp]

#include <stdio.h>

#include "flx_sync.hpp"

using namespace flx::rtl;

namespace flx { namespace run {

// ********************************************************
// SHAPE for sync_sched
// ********************************************************

static const std::size_t sync_sched_offsets[2]={
    offsetof(sync_sched,active),
    offsetof(sync_sched,ft)
};

static ::flx::gc::generic::offset_data_t const sync_sched_offset_data = { 2, sync_sched_offsets };

::flx::gc::generic::gc_shape_t sync_sched_ptr_map = {
  "rtl::sync_sched",
  1,sizeof(sync_sched),
  0, // no finaliser,
  0, // fcops
  &sync_sched_offset_data,
  ::flx::gc::generic::scan_by_offsets,
  0,0, // no serialisation as yet
  ::flx::gc::generic::gc_flags_default,
  0UL, 0UL
};



// ***************************************************
// fthread_list
// ***************************************************
fthread_list::fthread_list(::flx::gc::generic::gc_profile_t *gcp_) :
  thread_count(1),
  busy_count(0),
  async_count(0),
  async(nullptr),
  //pactive_lock(nullptr),
  lockneeded(false),
  active_lock(),
  gcp(gcp_),
  fthread_first(nullptr),
  fthread_last(nullptr)
{
  qisblocked.clear();
  active_lock.clear();
}
fthread_list::~fthread_list () {
  fprintf(stderr,"[fthread_list: destructor] Pthread %p delete async queue\n",(void*)::flx::pthread::mythrid());
  delete async;
}


fthread_t *fthread_list::front() const {
  return fthread_first;
}

fthread_t *fthread_list::pop_front() {
  auto tmp = fthread_first;
  if (!tmp) return nullptr; // queue empty

  // point at next
  fthread_first = tmp->next;
  // if next is null, null out last pointer
  if(!fthread_first) fthread_last = nullptr;

  tmp->next = nullptr; // for GC, null out link
  return tmp;
}

// INVARIANT fthread_first==nullptr equiv fthread_last=nullptr
// PRECONDITION: p != nullptr
void fthread_list::push_front(fthread_t *p) {
  p->next = fthread_first;
  fthread_first = p;
  if (!fthread_last) fthread_last = p;
}

// INVARIANT fthread_first==nullptr equiv fthread_last=nullptr
// PRECONDITION: p != nullptr
void fthread_list::push_back(fthread_t *p) {
  if(!fthread_last) fthread_first=fthread_last=p;
  else {
    fthread_last->next = p;
    fthread_last = p;
  }
}

size_t fthread_list::size()const {
  auto count = 0;
  for(auto it=fthread_first; it; it=it->next)++count; return count;
}

// ********************************************************
// SHAPE for fthread_list
// ********************************************************

static const std::size_t fthread_list_offsets[1]={
    offsetof(fthread_list,fthread_first) // fthread_last is weak
};

static ::flx::gc::generic::offset_data_t const fthread_list_offset_data = { 1, fthread_list_offsets };

::flx::gc::generic::gc_shape_t fthread_list_ptr_map = {
  "rtl::fthread_list",
  1,sizeof(fthread_list),
  0, // no finaliser,
  0, // fcops
  &fthread_list_offset_data,
  ::flx::gc::generic::scan_by_offsets,
  0,0, // no serialisation as yet
  ::flx::gc::generic::gc_flags_default,
  0UL, 0UL
};


// ***************************************************
// sync_sched
// ***************************************************
char const *sync_sched::get_fstate_desc(fstate_t fs)
{
  switch(fs)
  {
    case blocked: return "blocked";
    case delegated: return "delegated";
    default: return "Illegal fstate_t";
  }
}

char const *sync_sched::get_fpc_desc()
{
  if (ft)
    return "Next request pos";
  else
  {
    if (active->size() > 0) return "Next fthread pos";
    else return "Out of active threads";
  }
}


sync_sched::sync_sched (
  bool debug_driver_,
  ::flx::gc::generic::gc_profile_t *gcp_,
  fthread_list *active_
) :
  debug_driver(debug_driver_),
  collector(gcp_->collector),
  active(active_),
  ft(nullptr)
{}


void sync_sched::show_state () {
    if (debug_driver)
      fprintf(stderr, "CUR[%p] ACT[%p]\n",ft,
        active->size()?active->front():NULL);
  }

// used by async to activate fthread in ready (async complete) queue
void sync_sched::push_front(fthread_t *f) {
  spinguard dummy(active->lockneeded,&(active->active_lock));
  impl_push_front(f);
}
void sync_sched::impl_push_front(fthread_t *f)
  {
    if(ft) active->push_front(ft);
    ft = f;
  }

void sync_sched::do_yield()
    {
      if(debug_driver)
         fprintf(stderr,"[sync: svc_yield] yield");

      spinguard dummy(active->lockneeded,&(active->active_lock));
      active->push_back(ft);
      ft = active->pop_front();
    }

void sync_sched::do_spawn_fthread()
    {
      spinguard dummy(active->lockneeded,&(active->active_lock));
      fthread_t *ftx = request->svc_fthread_req.fthread;
      if(debug_driver)
        fprintf(stderr,"[sync: svc_spawn_fthread] Spawn fthread %p\n",ftx);
      impl_push_front(ftx);
    }

void sync_sched::do_schedule_fthread()
    {
      spinguard dummy(active->lockneeded,&(active->active_lock));
      fthread_t *ftx = request->svc_fthread_req.fthread;
      if(debug_driver)
        fprintf(stderr,"[sync: svc_schedule_fthread] Schedule fthread %p\n",ftx);
      active->push_back(ftx);
    }

// FIXME: HANDLE NULL. Read & Write variable addresses can be NULL
// if the data type is unit
void sync_sched::do_sread()
    {
      spinguard dummy(active->lockneeded,&(active->active_lock));
      svc_sio_req_t pr = request->svc_sio_req;
      schannel_t *chan = pr.chan;
      if(debug_driver)
        fprintf(stderr,"[sync: svc_read] Fibre %p Request to read on channel %p\n",ft,chan);
      if(chan==NULL) goto svc_read_none;
    svc_read_next:
      {
        fthread_t *writer= chan->pop_writer();
        if(writer == 0) goto svc_read_none;       // no writers
        if(writer->cc == 0) goto svc_read_next;   // killed
        svc_sio_req_t pw = writer->get_svc()->svc_sio_req;
        if (pr.data && pw.data) {
          if(debug_driver)
            fprintf(stderr,"[sync: svc_read] Writer @%p=%p, read into %p\n",
              pw.data,*pw.data, pr.data);
          *pr.data= *pw.data;
        }
        if(debug_driver)
          fprintf(stderr,"[sync: svc_read] current fibre %p FED, fibre %p UNBLOCKED\n",ft, writer);

        // WE are the reader, stay current, push writer
        // onto active list
        active->push_front(writer);
show_state();
        return;
      }

    svc_read_none:
      if(debug_driver)
        fprintf(stderr,"[sync: svc_read] No writers on channel %p: fibre %p HUNGRY\n",chan,ft);
      chan->push_reader(ft);
      ft = active->pop_front();
show_state();
      return;
    }

void sync_sched::do_swrite()
    {
      spinguard dummy(active->lockneeded,&(active->active_lock));
      svc_sio_req_t pw = request->svc_sio_req;
      schannel_t *chan = pw.chan;
      if(debug_driver)
         fprintf(stderr,"[sync: svc_write] Fibre %p Request to write on channel %p\n",ft,chan);
      if(chan==NULL)goto svc_write_none;
    svc_write_next:
      {
        fthread_t *reader= chan->pop_reader();
        if(reader == 0) goto svc_write_none;     // no readers
        if(reader->cc == 0) goto svc_write_next; // killed
        svc_sio_req_t pr = reader->get_svc()->svc_sio_req;
        if (pr.data && pw.data) {
          if(debug_driver)
            fprintf(stderr,"[sync: svc_write] Writer @%p=%p, read into %p\n",
              pw.data,*pw.data, pr.data);
          *pr.data= *pw.data;
        }
        if(debug_driver)
          fprintf(stderr,"[sync: svc_write] hungry fibre %p FED\n",reader);

        // WE are the writer, push us onto the active list
        // and make the reader on the channel current
        impl_push_front(reader);
show_state();
        return;
      }
    svc_write_none:
      if(debug_driver)
        fprintf(stderr,"[sync: svc_write] No readers on channel %p: fibre %p BLOCKING\n",chan,ft);
      chan->push_writer(ft);
      ft = active->pop_front();
show_state();
      return;
    }

// NOTE: not protected by mutex
void sync_sched::external_multi_swrite (schannel_t *chan, void *data)
    {
      if(chan==NULL) return;
    svc_multi_write_next:
      fthread_t *reader= chan->pop_reader();
      if(reader == 0)  return;    // no readers left
      if(reader->cc == 0) goto svc_multi_write_next; // killed
      {
        svc_sio_req_t pr = reader->get_svc()->svc_sio_req;
        if(debug_driver)
           fprintf(stderr,"[sync: svc_multi_write] Write data %p, read into %p\n",
             data, pr.data);
        *pr.data = data;
        impl_push_front(reader);
      }
      goto svc_multi_write_next;
    }

void sync_sched::do_multi_swrite()
    {
      spinguard dummy(active->lockneeded,&(active->active_lock));
      svc_sio_req_t pw = request->svc_sio_req;
      void *data = pw.data;
      schannel_t *chan = pw.chan;
      if(debug_driver)
        fprintf(stderr,"[sync: svc_multi_write] Request to write on channel %p\n",chan);
      external_multi_swrite (chan, data);
    }

void sync_sched::do_kill()
    {
      spinguard dummy(active->lockneeded,&(active->active_lock));
      fthread_t *ftx = request->svc_fthread_req.fthread;
      if(debug_driver)fprintf(stderr,"[sync: svc_kill] Request to kill fthread %p\n",ftx);
      ftx -> kill();
      return;
    }


// NOTE: the currently running fibre variable is owned
// by this sync scheduler and is not shared, so access to
// it does not required serialisation

sync_sched::fstate_t sync_sched::frun()
{
  if (debug_driver)
     fprintf(stderr,"[sync] frun: pthread %p, entry ft=%p, active size=%d\n",
        (void*)::flx::pthread::mythrid(), ft,(int)active->size());
dispatch:
  if (ft == 0) {
     spinguard dummy(active->lockneeded,&(active->active_lock));
     ft = active->pop_front();
     if (debug_driver)
       fprintf(stderr,"[sync] pthread %p fetching fthread %p\n",(void*)::flx::pthread::mythrid(),ft);
  }
  if (ft == 0) {
    return blocked;
  }
  request = ft->run();        // run fthread to get request
  if(request == 0)            // euthenasia request
  {
    spinguard dummy(active->lockneeded,&(active->active_lock));
    ft = 0;
    goto dispatch;
  }

  if (debug_driver)
    fprintf(stderr,"[flx_sync:sync_sched] dispatching service request %d\n", request->svc_req);
  switch(request->svc_req)
  {
    case svc_yield: do_yield(); goto dispatch;

    case svc_spawn_fthread : do_spawn_fthread(); goto dispatch;
    case svc_schedule_fthread: do_schedule_fthread(); goto dispatch;

    case svc_sread: do_sread(); goto dispatch;

    case svc_swrite: do_swrite(); goto dispatch;

    case svc_multi_swrite: do_multi_swrite(); goto dispatch;

    case svc_kill: do_kill(); goto dispatch;

    default:
      return delegated;
  }
}

}}

Package: src/packages/async.fdoc

Asynchronous I/O and thread scheduling

key file
flx_async_world.hpp share/lib/rtl/flx_async_world.hpp
flx_async_world.cpp share/src/rtl/flx_async_world.cpp
flx_async.hpp share/lib/rtl/flx_async.hpp
flx_async.cpp share/src/flx_async/flx_async.cpp
flx_async.py $PWD/buildsystem/flx_async.py
unix_flx_async.fpc $PWD/src/config/unix/flx_async.fpc
win_flx_async.fpc $PWD/src/config/win/flx_async.fpc

The Asychronous Support System

//[flx_async_world.hpp]

#ifndef __flx_async_world_H_
#define __flx_async_world_H_

#include "flx_gc.hpp"
#include "flx_collector.hpp"
#include "flx_sync.hpp"

namespace flx { namespace run {

// This class handles pthreads and asynchronous I/O
// It shares operations with sync_sched by interleaving
// based on state variables.
//
// NOTE: currently async_sched is NOT garbage collected
// Hence, the synchronous scheduler is creates must
// be made a GC root
struct RTL_EXTERN async_sched
{
  enum thread_kind_t {mainline,embedded,pthread,process};
  thread_kind_t thread_kind;
  static char const *str(thread_kind_t);

  // weak pointer
  struct flx_world *world;

  bool debug_driver;


  // weak pointer
  ::flx::gc::generic::gc_profile_t *gcp;

  // Strong pointer
  sync_sched *ss;  // (d, gcp, active), (ft, request), (pc, fs)

  async_sched(
    flx_world *world_arg,
    bool d,
    ::flx::gc::generic::gc_profile_t *g,
    fthread_list *a, thread_kind_t
  );
  ~async_sched();

  int prun();
  void do_spawn_pthread();
  void do_spawn_process();
  void spawn_impl(fthread_list*, thread_kind_t);
  void do_general();

  void external_multi_swrite(::flx::rtl::schannel_t *, void *data);
private:
  bool nonblocking_schedule_queued_fthreads();
};

RTL_EXTERN extern ::flx::gc::generic::gc_shape_t async_sched_ptr_map;


}} // namespaces
#endif //__flx_async_world_H_

//[flx_async_world.cpp ]


#include "flx_world.hpp"
#include "flx_async_world.hpp"
#include "flx_sync.hpp"
#include <assert.h>

using namespace ::flx::rtl;
using namespace ::flx::pthread;

namespace flx { namespace run {

// ********************************************************
// SHAPE for async_sched
// ********************************************************

static const std::size_t async_sched_offsets[1]={
    offsetof(async_sched,ss)
};

static ::flx::gc::generic::offset_data_t const async_sched_offset_data = { 1, async_sched_offsets };

::flx::gc::generic::gc_shape_t async_sched_ptr_map = {
  "flx::run::async_sched",
  1,sizeof(async_sched),
  0, // no finaliser,
  0, // fcops
  &async_sched_offset_data,
  ::flx::gc::generic::scan_by_offsets,
  0,0, // no serialisation as yet
  ::flx::gc::generic::gc_flags_default,
  0UL, 0UL
};

// ***************************************************
// Async_sched: Thread kind pretty printer
// ***************************************************


char const *async_sched::str(thread_kind_t k) {
  switch (k) {
  case mainline: return "mainline";
  case embedded: return "embedded";
  case pthread: return "pthread";
  case process: return "process";
  }
}

// ***************************************************
// Async_sched: CONSTRUCTOR
// ***************************************************

async_sched::async_sched(
    flx_world *world_arg,
    bool d,
    ::flx::gc::generic::gc_profile_t *g,
    fthread_list *a, thread_kind_t k
  ) :
    world(world_arg),
    debug_driver(d),
    gcp(g),
    thread_kind(k)
  {
    ss = new(*gcp,sync_sched_ptr_map, false) sync_sched(debug_driver, gcp, a);
    ++a->thread_count;
    ++a->busy_count;
    if (debug_driver)
      fprintf(stderr, "prun %p: async scheduler, creating and rooting synchronous scheduler! threads=1,busy=1\n",(void*)mythrid());
  }


// ***************************************************
// Async_sched: DESTRUCTOR
// ***************************************************
async_sched::~async_sched() {
  try
  {
    --ss->active->thread_count;
    if (debug_driver)
      fprintf(stderr, "prun %p: Terminating async scheduler, threads=%d\n",(void*)mythrid(), ss->active->thread_count.load());
    if (debug_driver)
      fprintf(stderr, "prun %p: async scheduler, fibre queue length %d, async_cound=%d\n",
         (void*)mythrid(), ss->active->size(), ss->active->async_count);
    if (debug_driver)
      fprintf(stderr, "prun %p: async scheduler returns!\n",(void*)mythrid());
  }
  catch (...) { fprintf(stderr, "Unknown exception deleting async!\n"); }
}

// ***************************************************
// Async_sched: Thread procedure
// ***************************************************
static void prun_pthread_entry(void *data) {
  async_sched *d = (async_sched*)data;
  d->prun();
}

// ***************************************************
// Async_sched: SPAWNING
// ***************************************************

// SPAWNING A NEW FELIX PTHREAD
// CREATES ITS OWN PRIVATE ASYNC SCHEDULER
// CREATES ITS OWN PRIVATE SYNC SCHEDULER
// SHARES WORLD INCLUDING COLLECTOR
// REGISTERS IN THREAD_CONTROL
void async_sched::do_spawn_process()
{
  // this is safe (at the moment) because, if the active list
  // is already in use by other processes, we're just overwriting
  // the lock pointer with its existing value. If the list isn't
  // in use by other processes, the lock pointer is NULL,
  // but this thread is the one running the current process,
  // so it can't race with itself.
  ss->active->lockneeded = true;
  spawn_impl (ss->active,process);
}
void async_sched::do_spawn_pthread()
{
  fthread_list *pactive = new(*gcp, ::flx::run::fthread_list_ptr_map,false) fthread_list(gcp);
  spawn_impl (pactive,pthread);
}

void async_sched::spawn_impl(fthread_list *pactive, thread_kind_t k) {

  fthread_t *ftx = ss->request->svc_fthread_req.fthread;
  if (debug_driver)
    fprintf(stderr, "[prun %p: spawn_pthread] Spawn pthread %p\n", (void*)mythrid(), ftx);
  {
    spinguard dummy(pactive->lockneeded, &(pactive->active_lock));
    // SHOULD THIS BE HERE?? The async scheduler isn't created yet.
    // maybe we should do this "properly" after it is (in the next statement!)
    // NO NO! This is ALL BAD! Some OTHER thread might run this routine!
    pactive->push_front(ftx);
  }
  void *data = new  (*gcp, async_sched_ptr_map, false) async_sched(world,debug_driver, gcp, pactive,k);

  if (debug_driver)
    fprintf(stderr, "[prun %p: spawn_pthread] Starting new pthread, thread counter= %zu\n",
      (void*)mythrid(), gcp->collector->get_thread_control()->thread_count());

  {
    // We use a hard (not Felix aware) lock here
    // because the Felix system is in an incoherent state
    // between the OS thread spawn, and the thread's registration
    ::std::mutex spawner_lock;
    ::std::condition_variable_any spawner_cond;
    bool spawner_flag = false;
    ::std::unique_lock< ::std::mutex> locktite(spawner_lock);
    flx_detached_thread_t().init(prun_pthread_entry, data, gcp->collector->get_thread_control(),
      &spawner_lock, &spawner_cond,
      &spawner_flag
    );

    if (debug_driver)
      fprintf(stderr,
        "[prun: spawn_pthread] Thread %p waiting for spawned thread to register itself\n",
        (void*)get_current_native_thread());

    while (!spawner_flag)
      spawner_cond.wait(spawner_lock);

    if (debug_driver)
      fprintf(stderr,
        "[prun: spawn_pthread] Thread %p notes spawned thread has registered itself\n",
        (void*)get_current_native_thread());
  }
}
// ***************************************************
// Async_sched: ASYNC REQUEST DISPATCH
// ***************************************************
void async_sched::do_general()
{
  if (debug_driver)
    fprintf(stderr, "[prun %p: svc_general] from fthread=%p\n", (void*)mythrid(),ss->ft);

  if(debug_driver)
    fprintf(stderr, "[prun %p: svc_general] async=%p, ptr_create_async_hooker=%p\n",
      (void*)mythrid(), ss->active-> async,
      world->c->ptr_create_async_hooker)
    ;
  if (!ss->active->async)
  {
    ss->active->async = world->create_demux();
  }
  ++ss->active->async_count;
  if (debug_driver)
    fprintf(stderr,
       "[prun: svc_general] Async system created: %p, count %zu\n",
       ss->active->async,ss->active->async_count);
  ::flx::async::flx_driver_request_base *dreq =  ss->request->svc_general_req.pgeneral;
  if (debug_driver)
    fprintf(stderr, "[prun: svc_general] Request object %p\n", dreq);

  // requests are now ALWAYS considered asynchronous
  // even if the request handler reschedules them immediately
  ss->active->async->handle_request(dreq, ss->ft);
  if (debug_driver)
    fprintf(stderr, "[prun: svc_general] Request object %p captured fthread %p \n", dreq, ss->ft);
  if (debug_driver)
    fprintf(stderr, "[prun: svc_general] Request object %p\n", dreq);
  gcp->collector->add_root(ss->ft);
  ss->ft = 0;
  if(debug_driver)
    fprintf(stderr,"[prun: svc_general] request dispatched..\n");
}

// calls thread_control_t::yield which does a world stop check
static void sleep(thread_control_base_t *tc, size_t ns)
{
  assert(tc);
  tc->yield();
  ::std::this_thread::sleep_for(::std::chrono::milliseconds(1000)); // 1 second, temporarily
  ::std::this_thread::yield();
}


// ***************************************************
// Async_sched:  MASTER SCHEDULER
// ***************************************************
int async_sched::prun() {
sync_run:
  // RUN SYNCHRONOUS SCHEDULER
  if (debug_driver)
    fprintf(stderr, "prun %s %p: sync_run\n", str(thread_kind),(void*)mythrid());

  if (debug_driver)
    fprintf(stderr, "prun %s %p: Before running: Sync state is %s\n", str(thread_kind),(void*)mythrid(),
      ss->get_fpc_desc());

  sync_sched::fstate_t fs = ss->frun();

  if (debug_driver)
    fprintf(stderr, "prun %s %p: After running: Sync state is %s/%s\n", str(thread_kind),(void*)mythrid(),
      ss->get_fstate_desc(fs), ss->get_fpc_desc());

  switch(fs)
  {
    // HANDLE DELEGATED SERVICE REQUESTS
    case sync_sched::delegated:
      if (debug_driver)
        fprintf(stderr, "sync_sched %p:delegated request %d\n", str(thread_kind),(void*)mythrid(), ss->request->svc_req);
      switch (ss->request->svc_req)
      {
        case svc_spawn_pthread: do_spawn_pthread(); goto sync_run;
        case svc_spawn_process: do_spawn_process(); goto sync_run;

        case svc_general: do_general(); goto sync_run;

        default:
          fprintf(stderr,
            "prun: Unknown service request code 0x%x\n", ss->request->svc_req);
          abort();
      }

    // SCHEDULE ANY ASYNCHRONOUSLY QUEUED FTHREADS
    case sync_sched::blocked: // ran out of active threads - are there any in the async queue?
      --ss->active->busy_count;
      switch (thread_kind)
      {
        case mainline:
        case pthread:
          // gain exclusive control
          while(!ss->active->qisblocked.test_and_set());
          if (ss->active->async_count > 0)
          {
            if (debug_driver)
              fprintf(stderr, "prun: %s %p Async blocking\n", str(thread_kind), (void*)mythrid());
            ss->ft = ss->active->async->dequeue(); // get fibre
            gcp->collector->remove_root(ss->ft); // transfer ownership
            --ss->active->async_count; // accounting
            ss->active->qisblocked.clear(); // release control
            ++ss->active->busy_count;
            goto sync_run; // do work
          }
          if (ss->active->busy_count.load() == 0) {
            // no work to do, no jobs pending, and no workers to make work, so return
            if (debug_driver)
              fprintf(stderr, "prun: %s %p Async returning\n", str(thread_kind), (void*)mythrid());
            return 0;
          }
          else  // some processes are busy, they might make work so delay and retry later
          {
            ss->active->qisblocked.clear(); // release control
            // DELAY
            if (debug_driver)
              fprintf(stderr, "prun: %s %p Async delaying thread_count=%d, busy_count=%d\n",
                str(thread_kind), (void*)mythrid(), ss->active->thread_count.load(),ss->active->busy_count.load());
            sleep(gcp->collector->get_thread_control(), 10.00); // nanoseconds
            ++ss->active->busy_count;
            goto sync_run;
          }

        case process:
          if (ss->active->qisblocked.test_and_set())
          {
            if (ss->active->async_count > 0)
            {
              if (debug_driver)
                fprintf(stderr, "prun: %s %p Async WAIT\n", str(thread_kind), (void*)mythrid());
              auto ftp = ss->active->async->maybe_dequeue(); // get fibre
              if(ftp != nullptr) {
                ss->push_front(ftp);
                gcp->collector->remove_root(ftp); // transfer ownership
                --ss->active->async_count; // accounting
              }
              ss->active->qisblocked.clear(); // release control
              ++ss->active->busy_count;
              goto sync_run; // do work
            }
            if (ss->active->busy_count.load() == 0) {
              // no work to do, no jobs pending, and no workers to make work, so return
              if (debug_driver)
                fprintf(stderr, "prun: %s %p Async returning\n", str(thread_kind), (void*)mythrid());
              return 0;
            }
          }

          // DELAY
          sleep(gcp->collector->get_thread_control(), 10.00); // nanoseconds
          ++ss->active->busy_count;
          goto sync_run;

        case embedded:
          if (ss->active->qisblocked.test_and_set())
            if(nonblocking_schedule_queued_fthreads()) goto sync_run;
          return ss->active->async_count;
       }

    default:
      fprintf(stderr, "prun: Unknown frun return status 0x%4x\n", fs);
      abort();
  } // switch

}

// ***************************************************
// Async_sched:  COMPLETED ASYNC RETRIEVAL
// ***************************************************

// this routine is used when there are no fthreads left on the
// sync scheduler list
//
// assuming async is enabled, it checks to see if there are
// pending async jobs. If so and the block flag is set,
// it blocks the pthread until at least one of the pending jobs completes.
// The routine returns true of some async jobs completed and put on
// the sync scheduler active list.

// As it is, this routine cannot be called with block_flag set
// by multiple threads. First, critical sections are not protected.
// However even if they were, if two threads block with async->dequeue,
// then one might empty all the pending fibres out and return,
// leaving all the rest of the thread locked up.

// One solution is to simply poll to see if there's anything
// read to fetch. If so fetch it, fine. If not, return, wait a bit,
// and try again. This introduces an uncomfortable lag though.
//
// Another solution is to have the first thread block,
// and then have the other threads suspend with a condition variable.
// They check:
//  (a) there is no stuff on the active list
//  (b) there is stuff on the async list
//  (c) there is no thread already waiting on the async list
// If these conditions are met the thread goes to sleep and waits
// for a signal.
//
// Note if there is no thread waiting but (a) and (b) are met,
// the thread can dive in and become the waiter.


bool async_sched::nonblocking_schedule_queued_fthreads() {
  if (debug_driver) {
    fprintf(stderr,
      "prun %s %p: out of active synchronous threads, trying async, pending=%zu\n", str(thread_kind), (void*)mythrid(), ss->active->async_count);
  }
  int scheduled_some = 0;
  if (ss->active->async && ss->active->async_count > 0) {
      fthread_t* ftp = ss->active->async->maybe_dequeue();
      while (ftp) {
        if (debug_driver)
          fprintf(stderr, "prun %p:ret mode: Async Retrieving fthread %p\n", (void*)mythrid(), ftp);
        gcp->collector->remove_root(ftp);
        ss->push_front(ftp);
        --ss->active->async_count;
        ++scheduled_some;
        ftp = ss->active->async->maybe_dequeue();
    }
  }
  return scheduled_some != 0;
}


// ***************************************************
// Async_sched:  EXTERNAL MULTIWRITE HOOK
// ***************************************************

void async_sched::external_multi_swrite(::flx::rtl::schannel_t *chan, void *data)
  {
    ss->external_multi_swrite (chan,data);
  }


}} // namespaces
The Asynchronous I/O interface.

The embedding system depends on the interface but not the implementation.

//[flx_async.hpp]
#ifndef __FLX_ASYNC_H__
#define __FLX_ASYNC_H__
#include "flx_rtl_config.hpp"
#include "flx_rtl.hpp"
#include "pthread_bound_queue.hpp"

#ifdef BUILD_ASYNC
#define ASYNC_EXTERN FLX_EXPORT
#else
#define ASYNC_EXTERN FLX_IMPORT
#endif

// GLOBAL NAMESPACE!

class ASYNC_EXTERN async_hooker {
public:
  virtual flx::rtl::fthread_t *dequeue()=0;
  virtual flx::rtl::fthread_t *maybe_dequeue()=0;
  virtual void handle_request(::flx::async::flx_driver_request_base *data, flx::rtl::fthread_t *ss)=0;
  virtual ~async_hooker();
};

typedef
async_hooker *
create_async_hooker_t
(
  ::flx::pthread::thread_control_base_t*,
  int n0,   // bound on resumable thread queue
  int n1,   // bound on general input job queue
  int m1,   // number of threads in job pool
  int n2,   // bound on async fileio job queue
  int m2    // number of threads doing async fileio
);

extern "C" {
ASYNC_EXTERN async_hooker *
create_async_hooker
(
  ::flx::pthread::thread_control_base_t*,
  int n0,   // bound on resumable thread queue
  int n1,   // bound on general input job queue
  int m1,   // number of threads in job pool
  int n2,   // bound on async fileio job queue
  int m2    // number of threads doing async fileio
);
}

namespace flx { namespace async {
struct ASYNC_EXTERN finote_t
{
  virtual void signal()=0;
  virtual ~finote_t();
};

class ASYNC_EXTERN wakeup_fthread_t : public finote_t
{
  ::flx::rtl::fthread_t *f;
  ::flx::pthread::bound_queue_t *q;
public:
  wakeup_fthread_t(::flx::pthread::bound_queue_t *q_a, ::flx::rtl::fthread_t *f_a);
  void signal () { q->enqueue(f); }
};


class ASYNC_EXTERN flx_driver_request_base {
    finote_t *fn;
    virtual bool start_async_op_impl() = 0;
public:
    flx_driver_request_base();
    virtual ~flx_driver_request_base(); // so destructors work

    // returns finished flag (async may fail or immediately finish)
    void start_async_op(finote_t *fn_a);
    void notify_finished();
};

}}

#endif

//[flx_async.cpp]
#include "flx_async.hpp"
#include "pthread_bound_queue.hpp"
#include "flx_rtl.hpp"
#include <cassert>
#include <stdio.h>

using namespace ::flx::rtl;
using namespace ::flx::pthread;
using namespace ::flx::async;

async_hooker::~async_hooker(){ }

namespace flx { namespace async {

// FINISHED NOTIFIER
finote_t::~finote_t(){}

// DERIVED NOTIFIER WHICH DOES FTHREAD WAKEUP
// BY ENQUEUING THE FTHREAD INTO THE READY QUEUE
wakeup_fthread_t::wakeup_fthread_t(
  ::flx::pthread::bound_queue_t *q_a,
  ::flx::rtl::fthread_t *f_a)
: f(f_a), q(q_a) {}

// ASYNC HOOKER IMPLEMENTATION STAGE 1
// Introduces new virtual get_ready_queue().
class async_hooker_impl : public async_hooker {
public:
  virtual bound_queue_t *get_ready_queue()=0;
  ~async_hooker_impl() {}
  void handle_request(flx::async::flx_driver_request_base *pgeneral,fthread_t *ss)
  {
    flx::async::flx_driver_request_base* dreq = pgeneral;
    finote_t *fn = new wakeup_fthread_t(get_ready_queue(),ss);
    dreq->start_async_op(fn);
  }
};


// ASYNC HOOKER IMPLEMENTATION STAGE 2
// Provides the ready queue and the dequeuing operations
class proto_async : public async_hooker_impl
{
    bound_queue_t async_ready;

public:
   proto_async(thread_control_base_t *tc, int n0, int n1, int m1, int n2, int m2) :
     async_ready(tc,n0)
   {}

  ~proto_async(){}

  bound_queue_t *get_ready_queue() { return &async_ready; }

  fthread_t* dequeue()
  {
    return (fthread_t*)async_ready.dequeue();
  }
  fthread_t* maybe_dequeue()
  {
    return (fthread_t*)async_ready.maybe_dequeue();
  }
};


// DRIVER REQUEST BASE
// THIS IS USED TO BUILD REQUESTS
// PROVIDES DEFAULT NOTIFY_FINISHED ROUTINE WHICH USE FINOTE SIGNAL
// DO ASYNC OP JUST CALLS DRIVED CLASS DO_ASYNC_OP_IMPL
flx_driver_request_base::flx_driver_request_base() : fn(0) {}
flx_driver_request_base::~flx_driver_request_base() {}       // so destructors work

void flx_driver_request_base:: start_async_op(finote_t *fn_a)
{
  //fprintf(stderr,"start async op %p, set fn = %p\n",this,fn_a);
  assert(fn==0);
  fn = fn_a;
  bool completed =  start_async_op_impl();
  if(completed)
  {
    fprintf(stderr,"instant complete\n");
    notify_finished();
  }
  else
  {
    //fprintf(stderr,"Pending\n");
  }
}

void flx_driver_request_base:: notify_finished()
{
  //fprintf(stderr, "faio_req=%p, Notify finished %p\n", this,fn);
  assert(fn!=0);
  finote_t *fin = fn;
  fn=0;
  fin->signal();
  delete fin;
  //fprintf(stderr, "faio_req=%p, FINISHED\n",this);
}

}}

async_hooker *create_async_hooker(thread_control_base_t *tc, int n0,int n1,int m1,int n2,int m2) {
  return new ::flx::async::proto_async(tc,n0,n1,m1,n2,m2);
}

Config

//[unix_flx_async.fpc]
Name: flx_async
Description: Async hook
provides_dlib: -lflx_async_dynamic
provides_slib: -lflx_async_static
includes: '"flx_async.hpp"'
Requires: flx_pthread flx_gc flx
macros: BUILD_ASYNC
library: flx_async
srcdir: src/flx_async
src: .*\.cpp

//[win_flx_async.fpc]
Name: flx_async
Description: Async hook
provides_dlib: /DEFAULTLIB:flx_async_dynamic
provides_slib: /DEFAULTLIB:flx_async_static
includes: '"flx_async.hpp"'
Requires: flx_pthread flx_gc flx
macros: BUILD_ASYNC
library: flx_async
srcdir: src/flx_async
src: .*\.cpp

#[flx_async.py]
import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    path = Path (phase.ctx.buildroot/'share'/'src/flx_async')
    #buildsystem.copy_hpps_to_rtl(phase.ctx,
    #    path / 'flx_async.hpp',
    #)

    dst = 'host/lib/rtl/flx_async'
    suffix = '.so'
    srcs = [phase.ctx.buildroot/'share'/'src/flx_async/flx_async.cpp']
    includes = [
        phase.ctx.buildroot / 'host/lib/rtl',
        phase.ctx.buildroot / 'share/lib/rtl'
    ]
    macros = ['BUILD_ASYNC']
    libs = [
        call('buildsystem.flx_pthread.build_runtime', phase),
        call('buildsystem.flx_gc.build_runtime', phase),
    ]

    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.static for lib in libs]),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            libs=[lib.shared for lib in libs]))

Standard Library

Contents:

Datatypes

Contents:

Package: src/packages/algebra.fdoc

key file
init.flx share/lib/std/algebra/__init__.flx
set.flx share/lib/std/algebra/set.flx
container.flx share/lib/std/algebra/container.flx
equiv.flx share/lib/std/algebra/equiv.flx
pord.flx share/lib/std/algebra/partialorder.flx
tord.flx share/lib/std/algebra/totalorder.flx
group.flx share/lib/std/algebra/group.flx
ring.flx share/lib/std/algebra/ring.flx
trig.flx share/lib/std/algebra/trig.flx
real.flx share/lib/std/algebra/real.flx
complex.flx share/lib/std/algebra/complex.flx
integer.flx share/lib/std/algebra/integer.flx
bits.flx share/lib/std/algebra/bits.flx
sequence.flx share/lib/std/algebra/sequence.flx
monad.flx share/lib/std/algebra/monad.flx

Core Algebraic Structures.

Synopsis.
//[init.flx]
include "std/algebra/predicate";        // in logic.fdoc
include "std/algebra/set";              // in algebra.fdoc
include "std/algebra/container";        // in algebra.fdoc
include "std/algebra/equiv";            // in algebra.fdoc
include "std/algebra/partialorder";     // in algebra.fdoc
include "std/algebra/totalorder";       // in algebra.fdoc
include "std/algebra/sequence";         // in algebra.fdoc
include "std/algebra/group";            // in algebra.fdoc
include "std/algebra/ring";             // in algebra.fdoc
include "std/algebra/bits";             // in algebra.fdoc
include "std/algebra/integer";          // in algebra.fdoc
include "std/algebra/trig";             // in algebra.fdoc
include "std/algebra/real";             // in algebra.fdoc
include "std/algebra/complex";          // in algebra.fdoc
include "std/algebra/monad";            // in algebra.fdoc
Description.

In this section we provide abstract definitions of some basic mathematical stuctures which will be used to specify operations on numeric types.

We use polymorphic classes to do this. A class is introduced by the class keyword followed by its name, then a list of type variables in square brackets. Then the body is presented enclosed in curly braces.

Two kinds of specification are allowed in a polymorphic class: function definitions and assertions.

Functions.

There are two kinds of function definitions. A function or procedure specified with the adjective virtual may have a specialisation provided in an instance declaration. Virtual functions may have definitions, in which case the definition is merely a default. It can be replaced in a specialising instance. However the definition should be taken as a semantic specification which the specialisation should adhere too.

The set of virtual functions of a polymorphic class is known as the <em>basis</em> of the class.

A non-virtual function can be defined in terms of virtual functions and other non-virtual functions. Non virtual functions cannot be specialised by the programmer. Instead, they are automatically specialised by the system for an instance.

Assertions

A polymorphic class may also contain assertions. These are function like specifications which specify semantic constraints.

An axiom specifies a basic assertion, it specifies a class property in terms of relations between the class functions. Since Felix only supports first order assertional logic, higher order semantics must be specified in comments.

If a class contains virtual functions with definitions, the definition is also considered as axiomatic.

The set of all axioms, including those in comments, is known as the <em>assertional basis</em> or <em>semantic specification</em> of the class. Additionally some reductions may be or imply an extension of the semantic basis.

A lemma is an assertion which can be derived from the semantic specifications by logical reasoning. In particular, lemmas in principle should be self-evident, simple and useful and able to be deduced by an automatic theorm proving program.

A theorem is a more complicated derived assertion, which would be too hard to prove with an automatic theorem prover. Instead, it should be derivable with a proof assistant (such as Coq), given various unspecified strategies, tactics and hints.

Sets.

A <em>set</em> is any type with a membership predicate \(\in\) spelled \in. You can also use function mem. The parser also maps in to operator \in.

We also provide a reversed form \(\owns\) spelled \owns, and negated forms \(ni\) spelled \ni or \notin.

Three combinators are provided as well, \(\cap\) spelled cap provides intersection, \(\cup\) spelled \cup provides the usual set union, and \(\setminus\) spelled \setminus the asymmetic set difference or subtraction.

Note that sets are not necessarily finite.

//[set.flx]
// note: eq is not necessarily required for a membership test
// for example: string member of regexp doesn't require
// string equality
// Set need not be finite (example regexp again)
// A list is a set, despite the duplications
class Set[c,t] {
  fun mem (elt:t, container:c):bool => elt \in container;
  virtual fun \in : t * c-> bool;
  fun \owns (container:c, elt:t) => elt \in container;
  fun \ni (container:c, elt:t) => elt \in container;
  fun \notin (elt:t, container:c) => not (elt \in container);

  fun \cup[c2 with Set[c2,t]]
    (x:c, y:c2) =>
    { e : t | e \in x or e \in y }
  ;

  fun \cap[c2 with Set[c2,t]]
    (x:c, y:c2) =>
    { e : t | e \in x and e \in y }
  ;

  fun \setminus[c2 with Set[c2,t]]
    (x:c, y:c2) =>
    { e : t | e \in x and e \notin y }
  ;
}
Set forms.

A set_form is a record type with a single member has_elt which returns true if it’s argument is intended as a member of some particular set.

We construe a set_form as a Set by providing an instance.

A set_form is basically just the membership predicate remodelled as a noun by encapsulating the predicate in a closure and thereby abstracting it.

//[set.flx]
interface set_form[T] { has_elt: T -> bool; }

instance[T] Set[set_form[T], T] {
  fun \in (elt:T, s:set_form[T]) => s.has_elt elt;
}
open[T] Set[set_form[T],T];

// INVERSE image of a set under a function
// For a function f: t -> t2, an element e
// is in a restriction of the domain t if its
// image in t2 is in the specified set.
fun invimg[t,c2,t2 with Set[c2,t2]]
  (f:t->t2, x:c2) : set_form[t] =>
  { e : t | (f e) \in x }
;
Cartesian Product of set_forms.

This uses some advanced instantiation technology to allow you to define the cartesian product of a sequence of sets using the infix TeX operator \(\otimes\) which is spelled \otimes. There’s also a left associative binary operator \(\times\) spelled \times.

//[set.flx]

fun \times[U,V] (x:set_form[U],y:set_form[V]) =>
  { u,v : U * V | u \in x and v \in y }
;

fun \otimes[U,V] (x:set_form[U],y:set_form[V]) =>
  { u,v : U * V | u \in x and v \in y }
;

fun \otimes[U,V,W] (head:set_form[U], tail:set_form[V*W]) =>
  { u,v,w : U * V * W | u \in head and (v,w) \in tail }
;

fun \otimes[NH,OH,OT] (head:set_form[NH], tail:set_form[OH**OT]) =>
  { h,,(oh,,ot) : NH ** (OH ** OT) | h \in head and (oh,,ot) \in tail }
;
Containers.
//[container.flx]
// roughly, a finite Set
class Container [c,v]
{
  inherit Set[c,v];
  virtual fun len: c -> size;
  fun \Vert (x:c) => len x;
  virtual fun empty(x: c): bool => len x == size(0);
}
Orders
Equivalence Relation.

An equivalence relation is a reflexive, symmetric, transitive relation. It is one of the most fundamental concepts in mathematics. One can show that for any set \(S\) , for any element \(s \in S\) , the subset \(\lbrack s\rbrack\) of \(S\) consisting of all elements equivalent to \(s\) are also equivalent to each other, and not equivalent to any other element outside that set.

Therefore, every equivalence relation on a set \(S\) specifies a partition of \(S\) which is a set of subsets of \(S\) known as equivalence classes, or just plain classes, such that no two classes have a common intersection, and the union of the classes spans the whole set.

In other words a partition consists of a disjoint union of subsets.

The most fundamential relation in computing which is required to be an equivalence relation is the equality operator. In particular, it allows us to have distinct encodings of a value, but still consider them equal semantically, and to provide an operational measure of that equivalence.

As a simple example, consider that the rational numbers \(1/2\) and \(2/4\) have distinct encodings but none-the-less are semantically equivalent.

An online reference on Wikibooks

//[equiv.flx]
// equality: technically, equivalence relation
class Eq[t] {
  virtual fun == : t * t -> bool;
  virtual fun != (x:t,y:t):bool => not (x == y);

  axiom reflex(x:t): x == x;
  axiom sym(x:t, y:t): (x == y) == (y == x);
  axiom trans(x:t, y:t, z:t): x == y and y == z implies x == z;

  fun eq(x:t, y:t)=> x == y;
  fun ne(x:t, y:t)=> x != y;
  fun \ne(x:t, y:t)=> x != y;
  fun \neq(x:t, y:t)=> x != y;
}
Partial Order

A proper partial order \(\subset\) spelled \subset is a transitive, antisymmetric irreflexive relation.

We also provide an improper operator \(\subseteq\) spelled \subseteq which is transitive, antisymmetric, and reflexive, for which either the partial order or equivalence operator == applies.

The choice of operators is motivated by the canonical exemplar of subset containment relations.

//[pord.flx]
// partial order
class Pord[t]{
  inherit Eq[t];
  virtual fun \subset: t * t -> bool;
  virtual fun \supset(x:t,y:t):bool =>y \subset x;
  virtual fun \subseteq(x:t,y:t):bool => x \subset y or x == y;
  virtual fun \supseteq(x:t,y:t):bool => x \supset y or x == y;

  fun \subseteqq(x:t,y:t):bool => x \subseteq y;
  fun \supseteqq(x:t,y:t):bool => x \supseteq y;

  fun \nsubseteq(x:t,y:t):bool => not (x \subseteq y);
  fun \nsupseteq(x:t,y:t):bool => not (x \supseteq y);
  fun \nsubseteqq(x:t,y:t):bool => not (x \subseteq y);
  fun \nsupseteqq(x:t,y:t):bool => not (x \supseteq y);

  fun \supsetneq(x:t,y:t):bool => x \supset y;
  fun \supsetneqq(x:t,y:t):bool => x \supset y;
  fun \supsetneq(x:t,y:t):bool => x \supset y;
  fun \supsetneqq(x:t,y:t):bool => x \supset y;

  axiom trans(x:t, y:t, z:t): \subset(x,y) and \subset(y,z) implies \subset(x,z);
  axiom antisym(x:t, y:t): \subset(x,y) or \subset(y,x) or x == y;
  axiom reflex(x:t, y:t): \subseteq(x,y) and \subseteq(y,x) implies x == y;
}
Bounded Partial Order

A partial order may bave an upper or lower bound known as the supremum and infimum, respectively. If these values are in the type, they are called the maximum and minimum, respectively.

//[pord.flx]
class UpperBoundPartialOrder[T] {
  inherit Pord[T];
  virtual fun upperbound: 1 -> T;
}
class LowerBoundPartialOrder[T] {
  inherit Pord[T];
  virtual fun lowerbound: 1 -> T;
}
class BoundPartialOrder[T] {
  inherit LowerBoundPartialOrder[T];
  inherit UpperBoundPartialOrder[T];
}
Total Order

A total order is a partial order with a totality law.

However we do not derive it from our partial order because we use different comparison operators. Here we use the standard ascii art comparison operators commonly found in programming languages along with the more beautiful TeX operators used in mathematical papers.

The spelling of the TeX operators can be found by holding the mouse over the symbol briefly.

//[tord.flx]
// total order
class Tord[t]{
  inherit Eq[t];
  // defined in terms of <, argument order swap, and boolean negation

  // less
  virtual fun < : t * t -> bool;
  fun lt (x:t,y:t): bool=> x < y;
  fun \lt (x:t,y:t): bool=> x < y;
  fun \lneq (x:t,y:t): bool=> x < y;
  fun \lneqq (x:t,y:t): bool=> x < y;


  axiom trans(x:t, y:t, z:t): x < y and y < z implies x < z;
  axiom antisym(x:t, y:t): x < y or y < x or x == y;
  axiom reflex(x:t, y:t): x < y and y <= x implies x == y;
  axiom totality(x:t, y:t): x <= y or y <= x;


  // greater
  fun >(x:t,y:t):bool => y < x;
  fun gt(x:t,y:t):bool => y < x;
  fun \gt(x:t,y:t):bool => y < x;
  fun \gneq(x:t,y:t):bool => y < x;
  fun \gneqq(x:t,y:t):bool => y < x;

  // less equal
  fun <= (x:t,y:t):bool => not (y < x);
  fun le (x:t,y:t):bool => not (y < x);
  fun \le (x:t,y:t):bool => not (y < x);
  fun \leq (x:t,y:t):bool => not (y < x);
  fun \leqq (x:t,y:t):bool => not (y < x);
  fun \leqslant (x:t,y:t):bool => not (y < x);


  // greater equal
  fun >= (x:t,y:t):bool => not (x < y);
  fun ge (x:t,y:t):bool => not (x < y);
  fun \ge (x:t,y:t):bool => not (x < y);
  fun \geq (x:t,y:t):bool => not (x < y);
  fun \geqq (x:t,y:t):bool => not (x < y);
  fun \geqslant (x:t,y:t):bool => not (x < y);

  // negated, strike-through
  fun \ngtr (x:t,y:t):bool => not (x < y);
  fun \nless (x:t,y:t):bool => not (x < y);

  fun \ngeq (x:t,y:t):bool => x < y;
  fun \ngeqq (x:t,y:t):bool => x < y;
  fun \ngeqslant (x:t,y:t):bool => x < y;

  fun \nleq (x:t,y:t):bool => not (x <= y);
  fun \nleqq (x:t,y:t):bool => not (x <= y);
  fun \nleqslant (x:t,y:t):bool => not (x <= y);


  // maxima and minima
  fun max(x:t,y:t):t=> if x < y then y else x endif;
  fun \vee(x:t,y:t) => max (x,y);

  fun min(x:t,y:t):t => if x < y then x else y endif;
  fun \wedge(x:t,y:t):t => min (x,y);


}
Bounded Total Orders.
//[tord.flx]
class UpperBoundTotalOrder[T] {
  inherit Tord[T];
  virtual fun maxval: 1 -> T = "::std::numeric_limits<?1>::max()";
}
class LowerBoundTotalOrder[T] {
  inherit Tord[T];
  virtual fun minval: 1 -> T = "::std::numeric_limits<?1>::min()";
}
class BoundTotalOrder[T] {
  inherit LowerBoundTotalOrder[T];
  inherit UpperBoundTotalOrder[T];
}
Sequences

Sequences are discrete total orders.

//[sequence.flx]

// Forward iterable
class ForwardSequence[T] {
  inherit Tord[T];
  virtual fun succ: T -> T;
  virtual proc pre_incr: &T;
  virtual proc post_incr: &T;
}

// Bidirectional
class BidirectionalSequence[T] {
  inherit ForwardSequence[T];
  virtual fun pred: T -> T;
  virtual proc pre_decr: &T;
  virtual proc post_decr: &T;
}

// Bounded Random access totally ordered
// int should be any integer type really .. fix later
class RandomSequence[T] {
  inherit BidirectionalSequence[T];
  virtual fun advance : int * T -> T;
}

// Bounded totally ordered forward iterable
class BoundForwardSequence[T] {
  inherit ForwardSequence[T];
  inherit UpperBoundTotalOrder[T];
}

// Bounded totally ordered bidirectional
class BoundBidirectionalSequence[T] {
  inherit BidirectionalSequence[T];
  inherit BoundTotalOrder[T];
}

// Bounded Random access totally ordered
class BoundRandomSequence[T] {
  inherit RandomSequence[T];
  inherit BoundBidirectionalSequence[T];
}
Groupoids.
Approximate Additive Group

An approximate additive group is a type for which there is a symmetric binary addition operator, a zero element, and for which there is an additive inverse or negation operator.

It is basically an additive group without the associativity requirement, and is intended to apply to floating point numbers.

Note we use the inherit statement to include the functions from class Eq.

//[group.flx]
//$ Additive symmetric float-approximate group, symbol +.
//$ Note: associativity is not assumed.
class FloatAddgrp[t] {
  inherit Eq[t];
  virtual fun zero: unit -> t;
  virtual fun + : t * t -> t;
  virtual fun neg : t -> t;
  virtual fun prefix_plus : t -> t = "$1";
  virtual fun - (x:t,y:t):t => x + -y;
  virtual proc += (px:&t,y:t) { px <- *px + y; }
  virtual proc -= (px:&t,y:t) { px <- *px - y; }

  reduce id (x:t): x+zero() => x;
  reduce id (x:t): zero()+x => x;
  reduce inv(x:t): x - x => zero();
  reduce inv(x:t): - (-x) => x;
  axiom sym (x:t,y:t): x+y == y+x;

  fun add(x:t,y:t)=> x + y;
  fun plus(x:t)=> +x;
  fun sub(x:t,y:t)=> x - y;
  proc pluseq(px:&t, y:t) {  += (px,y); }
  proc  minuseq(px:&t, y:t) { -= (px,y); }
}
Additive Group

A proper additive group is derived from FloatAddgrp with associativity added.

//[group.flx]
//$ Additive symmetric group, symbol +.
class Addgrp[t] {
  inherit FloatAddgrp[t];
  axiom assoc (x:t,y:t,z:t): (x + y) + z == x + (y + z);
  reduce inv(x:t,y:t): x + y - y => x;
}
Approximate Multiplicative Semi-Group With Unit.

An approximate multiplicative semigroup is a set with a symmetric binary multiplication operator and a unit.

//[group.flx]
//$ Multiplicative symmetric float-approximate semi group with unit symbol *.
//$ Note: associativity is not assumed.
class FloatMultSemi1[t] {
  inherit Eq[t];
  proc muleq(px:&t, y:t) { *= (px,y); }
  fun mul(x:t, y:t) => x * y;
  fun sqr(x:t) => x * x;
  fun cube(x:t) => x * x * x;
  virtual fun one: unit -> t;
  virtual fun * : t * t -> t;
  virtual proc *= (px:&t, y:t) { px <- *px * y; }
  reduce id (x:t): x*one() => x;
  reduce id (x:t): one()*x => x;
}
Multiplicative Semi-Group With Unit.

A multiplicative semigroup with unit is an approximate multiplicative semigroup with unit and associativity and satisfies the cancellation law.

//[group.flx]
//$ Multiplicative semi group with unit.
class MultSemi1[t] {
  inherit FloatMultSemi1[t];
  axiom assoc (x:t,y:t,z:t): (x * y) * z == x * (y * z);
  reduce cancel (x:t,y:t,z:t): x * z ==  y * z => x == y;
}
Rings
Approximate Unit Ring.

An approximate ring is a set which has addition and multiplication satisfying the rules for approximate additive group and multiplicative semigroup respectively.

//[ring.flx]
//$ Float-approximate ring.
class FloatRing[t] {
  inherit FloatAddgrp[t];
  inherit FloatMultSemi1[t];
}
Ring

A ring is a type which is a both an additive group and multiplicative semigroup with unit, and which in addition satisfies the distributive law.

//[ring.flx]
//$ Ring.
class Ring[t] {
  inherit Addgrp[t];
  inherit MultSemi1[t];
  axiom distrib (x:t,y:t,z:t): x * ( y + z) == x * y + x * z;
}
Approximate Division Ring

An approximate division ring is an approximate ring with unit with a division operator.

//[ring.flx]
//$ Float-approximate division ring.
class FloatDring[t] {
  inherit FloatRing[t];
  virtual fun / : t * t -> t; // pre t != 0
  fun \over (x:t,y:t) => x / y;

  virtual proc /= : &t * t;
  virtual fun % : t * t -> t;
  virtual proc %= : &t * t;

  fun div(x:t, y:t) => x / y;
  fun mod(x:t, y:t) => x % y;
  fun \bmod(x:t, y:t) => x % y;
  fun recip (x:t) => #one / x;

  proc diveq(px:&t, y:t) { /= (px,y); }
  proc modeq(px:&t, y:t) { %= (px,y); }
}
Division Ring
//[ring.flx]
//$ Division ring.
class Dring[t] {
  inherit Ring[t];
  inherit FloatDring[t];
}
Integral.
Bitwise operations
//[bits.flx]

//$ Bitwise operators.
class Bits[t] {
  virtual fun \^ : t * t -> t = "(?1)($1^$2)";
  virtual fun \| : t * t -> t = "$1|$2";
  virtual fun \& : t * t -> t = "$1&$2";
  virtual fun ~: t -> t = "(?1)(~$1)";
  virtual proc ^= : &t * t = "*$1^=$2;";
  virtual proc |= : &t * t = "*$1|=$2;";
  virtual proc &= : &t * t = "*$1&=$2;";

  fun bxor(x:t,y:t)=> x \^ y;
  fun bor(x:t,y:t)=> x \| y;
  fun band(x:t,y:t)=> x \& y;
  fun bnot(x:t)=> ~ x;

}
Integer
//[integer.flx]

//$ Integers.
class Integer[t] {
  inherit Tord[t];
  inherit Dring[t];
  inherit RandomSequence[t];
  virtual fun << : t * t -> t = "$1<<$2";
  virtual fun >> : t * t -> t = "$1>>$2";

  fun shl(x:t,y:t)=> x << y;
  fun shr(x:t,y:t)=> x >> y;
}

//$ Signed Integers.
class Signed_integer[t] {
  inherit Integer[t];
  virtual fun sgn: t -> int;
  virtual fun abs: t -> t;
}

//$ Unsigned Integers.
class Unsigned_integer[t] {
  inherit Integer[t];
  inherit Bits[t];
}
Float kinds
Trigonometric Functions.

Trigonometric functions are shared by real and complex numbers.

//[trig.flx]

//$ Float-approximate trigonometric functions.
class Trig[t] {
  inherit FloatDring[t];

  // NOTE: most of the axioms here WILL FAIL because they require
  // exact equality, but they're only going to succeed with approximate
  // equality, whatever that means. This needs to be fixed!

  // circular
  // ref http://en.wikipedia.org/wiki/Circular_functions

  // core trig
  virtual fun sin: t -> t;
  fun \sin (x:t)=> sin x;

  virtual fun cos: t -> t;
  fun \cos (x:t)=> cos x;

  virtual fun tan (x:t)=> sin x / cos x;
  fun \tan (x:t)=> tan x;

  // reciprocals
  virtual fun sec (x:t)=> recip (cos x);
  fun \sec (x:t)=> sec x;

  virtual fun csc (x:t)=> recip (sin x);
  fun \csc (x:t)=> csc x;

  virtual fun cot (x:t)=> recip (tan x);
  fun \cot (x:t)=> cot x;

  // inverses
  virtual fun asin: t -> t;
  fun \arcsin (x:t) => asin x;

  virtual fun acos: t -> t;
  fun \arccos (x:t) => acos x;

  virtual fun atan: t -> t;
  fun \arctan (x:t) => atan x;

  virtual fun asec (x:t) => acos ( recip x);
  virtual fun acsc (x:t) => asin ( recip x);
  virtual fun acot (x:t) => atan ( recip x);

  // hyperbolic
  // ref http://en.wikipedia.org/wiki/Hyperbolic_functions
  virtual fun sinh: t -> t;
  fun \sinh (x:t) => sinh x;

  virtual fun cosh: t -> t;
  fun \cosh (x:t) => cosh x;

  virtual fun tanh (x:t) => sinh x / cosh x;
  fun \tanh (x:t) => tanh x;

  // reciprocals
  virtual fun sech (x:t) => recip (cosh x);
  fun \sech (x:t) => sech x;

  virtual fun csch (x:t) => recip (sinh x);
  fun \csch (x:t) => csch x;

  virtual fun coth (x:t) => recip (tanh x);
  fun \coth (x:t) => coth x;

  // inverses
  virtual fun asinh: t -> t;

  virtual fun acosh: t -> t;

  virtual fun atanh: t -> t;

  virtual fun asech (x:t) => acosh ( recip x);
  virtual fun acsch (x:t) => asinh ( recip x );
  virtual fun acoth (x:t) => atanh ( recip x );

  // exponential
  virtual fun exp: t -> t;
  fun \exp (x:t) => exp x;

  // log
  virtual fun log: t -> t;
  fun \log (x:t) => log x;
  fun ln (x:t) => log x;
  fun \ln (x:t) => log x;

  // power
  virtual fun pow: t * t -> t;
  virtual fun pow (a:t, b:int) : t => pow (a, C_hack::cast[t] b);
  fun ^ (x:t,y:t) => pow (x,y);
  fun ^ (x:t,y:int) => pow (x,y);


}

//$ Finance and Statistics.
class Special[t] {
  virtual fun erf: t -> t;
  virtual fun erfc: t -> t;
}
Approximate Reals.
//[real.flx]
//$ Float-approximate real numbers.
class Real[t] {
  inherit Tord[t];
  inherit Trig[t];
  inherit Special[t];
  virtual fun embed: int -> t;

  virtual fun log10: t -> t;
  virtual fun abs: t -> t;

  virtual fun sqrt: t -> t;
  fun \sqrt (x:t) => sqrt x;
  virtual fun ceil: t -> t;
    // tex \lceil \rceil defined in grammar

  virtual fun floor: t -> t;
    // tex \lfloor \rfloor defined in grammar

  virtual fun trunc: t -> t;

  // this trig function is included here because it
  // is not available for complex numbers
  virtual fun atan2: t * t -> t;

}
Complex numbers
//[complex.flx]
//$ Float-approximate Complex.
class Complex[t,r] {
  inherit Eq[t];
  inherit Special[t];
  inherit Trig[t];
  virtual fun real: t -> r;
  virtual fun imag: t -> r;
  virtual fun abs: t -> r;
  virtual fun arg: t -> r;
  virtual fun sqrt: t -> r;

  virtual fun + : r * t -> t;
  virtual fun + : t * r -> t;
  virtual fun - : r * t -> t;
  virtual fun - : t * r -> t;
  virtual fun * : t * r -> t;
  virtual fun * : r * t -> t;
  virtual fun / : t * r -> t;
  virtual fun / : r * t -> t;
}
Summation and Product Quantifiers.

To be moved. Folds over streams.

//[group.flx]
open class Quantifiers_add_mul {
  fun \sum[T,C with FloatAddgrp[T], Streamable[C,T]] (a:C):T =
  {
    var init = #zero[T];
    for x in a perform init = init + x;
    return init;
  }

  fun \prod[T,C with FloatMultSemi1[T], Streamable[C,T]] (a:C):T =
  {
    var init = #one[T];
    for x in a perform init = init * x;
    return init;
  }

  fun \sum[T with FloatAddgrp[T]] (f:1->opt[T])  =
  {
    var init = #zero[T];
    for x in f perform init = init + x;
    return init;
  }

  fun \prod[T with FloatMultSemi1[T]] (f:1->opt[T])  =
  {
    var init = #one[T];
    for x in f perform init = init * x;
    return init;
  }

}
Monad
//[monad.flx]

class Monad [M: TYPE->TYPE] {
  virtual fun ret[a]: a -> M a;
  virtual fun bind[a,b]: M a * (a -> M b) -> M b;
  fun join[a] (n: M (M a)): M a => bind (n , (fun (x:M a):M a=>x));
}

Package: src/packages/arrays.fdoc

Arrays

key file
array_class.flx share/lib/std/datatype/array_class.flx
array.flx share/lib/std/datatype/array.flx
varray.flx share/lib/std/datatype/varray.flx
darray.flx share/lib/std/datatype/darray.flx
sarray.flx share/lib/std/datatype/sarray.flx
bsarray.flx share/lib/std/datatype/bsarray.flx
Array Abstactions.

We specify two core array abstractions: arrays as values and arrays as objects.

Array Value.

The ArrayValue class construes an array as a value, that is, a purely functional, immutable data structure characterised by two properties: its length, and a way to fetch a value from the array using a integral index.

Many routines can be written using only these two functions.

Note: an array is not intrinsically a Container because that would require it to also be a Set, which in turn requires a membership operator which would require some standard comparison. Arrays don’t come equipped with a comparison.

//[array_class.flx]
//$ Array as Value (immutable).
class ArrayValue[t,v]
{

The length of the array.

//[array_class.flx]
  //$ Length.
  virtual fun len: t -> size;

Performance routine to fetch the n’th element of an array without any bounds checking.

//[array_class.flx]
  //$ Unchecked common indexing.
  virtual fun unsafe_get: t * size -> v;

//[array_class.flx]
  //$ Checked common indexing.
  fun get[I in ints] (x:t, i:I) = {
    assert i.size < x.len;
    return unsafe_get (x,i.size);
  }

The following methods depend only on the implementation of the core methods. Most are either simple remaps to provide more convenient nottion, or we use virtual function so that the default definitions can be replaced by a more efficient implemention for some particular types. We use the special lookup rules for provided by the apply function so that an application of an integer to an array is translated into a call on the get method:

n a -> get (a,n) a. n -> n a -> get (a,n)

Note that the more usual reverse application using operator dot . is also made available this way.

//[array_class.flx]

  //$  Checked common indexing.
  fun apply [I in ints] (i:I, x:t) => get (x,i.size);

//[array_class.flx]
  //$ Callback based value iterator.
  virtual proc iter (_f:v->void) (x:t) {
    val n = x.len;
    if n > 0uz do
      for var i:size in 0uz upto n - 1uz do
        _f$ unsafe_get(x,i);
      done
    done
  }

//[array_class.flx]
  //$ Callback based index and value iterator.
  //$ Callback f index value.
  virtual proc iiter (_f:size -> v->void) (x:t) {
    val n = x.len;
    if n > 0uz do
      for var i:size in 0uz upto n - 1uz do
        _f i  (x,i).unsafe_get;
      done
    done
  }

Class Streamable provides a set of functions based on a generated named iterator which returns an infinite stream of option values. Loops based on such streams work with any Streamable data type, including ArrayValue.

Such loops operate by providing the loop body with the argument of the Some constructor of the option type obtained by a call to a closure of the iterator generator. When that object finally returns None to signal the end of data, the loop terminates.

//[array_class.flx]
  instance Iterable[t,v] {
    //$ Stream  value iterator.
    gen iterator(xs:t) () : opt[v] =
    {
      if xs.len > 0uz do
        for var j in 0uz upto xs.len - 1uz do
          yield Some (xs,j).unsafe_get;
        done
      done
      return None[v];
    }
  }

  inherit Streamable[t,v];

This HOF folds the values in an array into an accumulator using the supplied function. The scan is left to right.

//[array_class.flx]
  //$ Traditional left fold.
  virtual fun fold_left[u] (_f:u->v->u) (init:u) (x:t): u = {
    var o = init;
    val n = x.len;
    if n > 0uz do
      for var i:size in 0uz upto n - 1uz do
        o = _f o (unsafe_get(x,i));
      done
    done
    return o;
  }

This HOF folds the values in an array into an accumulator using the supplied function. The scan is right to left.

//[array_class.flx]
//$ Traditional right fold.
  virtual fun fold_right[u] (_f:v->u->u) (x:t) (init:u): u = {
    var o = init;
    val n = x.len;
    if n > 0uz do
      for var i:size in n - 1uz downto 0uz do
        o = _f (unsafe_get(x,i)) o;
      done
    done
    return o;
  }

This HOF folds array array into an accumulator using an associative user supplied function. Associative here means that the order in which the fold is done does not matter. This constraint is currently not checked. The default order is a left fold but the function is virtual and may be replaced by another more efficient ordering in an overriding function.

//[array_class.flx]
  virtual fun fold[u] (_f:u->v->u) (init:u) (x:t): u =>
    fold_left _f init x
  ;

This function searches an array for a value that satifies the given predicate and returns a boolean value indicating whether one exists.

//[array_class.flx]
  //$ Membership by predicate.
  virtual fun mem(pred:v->bool) (x:t): bool = {
    val n = x.len;
    if n > 0uz do
      for var i:size in 0uz upto n  - 1uz do
        if pred(unsafe_get(x,i)) do
          return true;
        done
      done
    done
    return false;
  }

This function searches an array for a value i that stands in the specified relation rel to a given value v, where the relation is applied in that order: rel(i,v). The usual relation to use is equality.

//[array_class.flx]
  //$ Membership by relation to given value.
  virtual fun mem[u] (rel:v*u->bool) (x:t) (e:u): bool =>
    mem (fun (i:v) => rel(i, e)) x
  ;

This function uses the default equality operator Eq[v]::== for the array value type t to perform a search.

//[array_class.flx]
  //$ Array as Set:
  //$ Membership by equality of value type.
  instance[with Eq[v]] Set[t,v] {
    fun \in (elt:v, a:t) => mem eq of (v * v) a elt;
  }
  inherit[t,v with Eq[v]] Set[t,v];

Same as our mem function except it returns the located value as an option type.

//[array_class.flx]
  //$ Searching for value satisfying predicate.
  virtual fun find(pred:v->bool) (x:t): opt[v] = {
    val n = x.len;
    if  n > 0uz do
      for var i:size in 0uz upto n - 1uz do
        if pred(unsafe_get(x,i)) do
          return Some$ unsafe_get(x,i);
        done
      done
    done
    return None[v];
  }

Same as our mem function except it returns the located value as an option type.

//[array_class.flx ]
  //$ Searching for value satisfying relation to given value.
  virtual fun find (rel:v*v->bool) (x:t) (e:v): opt[v] = {
    val n = x.len;
    if n > 0uz do
      for var i:size in 0uz upto n - 1uz do
        if rel(unsafe_get (x,i), e) do
          return Some$ unsafe_get (x,i);
        done
      done
    done

    return None[v];
  }

//[array_class.flx]
  fun \sum [with FloatAddgrp[v]] (it:t) =
  {
    var init = #zero[v];
    for v in it do init = init + v; done
    return init;
  }

//[array_class.flx]
  fun \prod[with FloatMultSemi1[v]] (it:t) =
  {
    var init = #one[v];
    for v in it do init = init * v; done
    return init;
  }

Should have a functional update? Find methods should have directions. Search method should really be instances of a class derived from Set. Find functions should have a version that also returns the index.

//[array_class.flx]
}
True Arrays.

This is an attempt to represent arrays in a more precise setting. Ordinary arrays just use integer indexes. But a true array uses a precise type as the index, an it must provide a value for all possible values of the index. As such, bounds checks are not required.

This work is incomplete.

//[array_class.flx]

class TrueArrayValue [t,x,v]
{
   inherit ArrayValue[t,v];
   virtual fun render : x -> size;
   fun true_unsafe_get (a:t, i:x) => unsafe_get (a, render i);
}
Array Object.

The ArrayObject class extends the capabilities of an ArrayValue by allowing mutation. A mutable array is typically abstract and represented by a pointer, so it also uses pass by reference.

//[array_class.flx]
//$ Array as Object (mutable).
class ArrayObject[t,v]
{
  inherit ArrayValue[t,v];

Modify an array object at a given index position by assigning a new value without a bounds check.

//[array_class.flx]
  // Unsafe store value into array by common index.
  virtual proc unsafe_set: t * size * v;

Note this is problematic as it forces a value to addressabe be stored as an object. A bitarray will not satisfy this requirement. Do we need another abstraction?

//[array_class.flx]
  virtual fun unsafe_get_ref : t * size -> &v;

Modify an array object by assigning a new value to the slot at a given index position. Bounds checked.

//[array_class.flx]
  // Checked store value into array by common index.
  proc set[I in ints] (x:t, i:I, a:v) {
    assert i.size < x.len; unsafe_set (x,i.size,a);
  }

//[array_class.flx]
  fun n"&." [I in ints] (x:t, i:I) : &v = {
    assert i.size < x.len;
    return unsafe_get_ref (x,i.size);
  }
}
True Array Object.

Incomplete work for arrays in a more precise setting where the index type is fixed.

//[array_class.flx]
class TrueArrayObject[t,x, v]
{
  inherit TrueArrayValue[t,x,v];
  inherit ArrayObject[t,v];
  proc true_unsafe_set(a:t, i:x, e:v) => unsafe_set (a, render i, e);
}
Contiguous Arrays.

A contiguous array is one for which the store is certain to be contiguous and admits scanning the array directly using a pointer.

Two methods, stl_begin and stl_end provide pointers to the first element and one past the location of the last element, for traditional STL like array operations. These pointers have type +v where v is the element type. The named type carray[v] is an alias for +v.

//[array_class.flx]
//$ Array as Contiguous STL Object.
//$ Provides STL iterators type +v
class ContiguousArrayObject[t,v]
{
  inherit ArrayObject[t,v];

//[array_class.flx]
  //$ Start of array iterator.
  virtual fun stl_begin: t -> +v;

  //$ One past the end of array iterator.
  virtual fun stl_end: t -> +v;

We allow adding an integer to an array object to yield an incrementable pointer to that element.

//[array_class.flx]
  //$ Add integer to iterator.
  fun + [I in ints] (pa:t, i:I) : carray [v] = {
     assert i.size < pa.len;
     return pa.stl_begin + i.size;
  }

In place sort the contents of a contiuous array using STL sort and a supplied comparator, which must be a total order.

//[array_class.flx]
  //$ In place sort using STL sort with Felix comparator.
  proc sort (cmp: v * v -> bool) (a:t) {
    var first = a.stl_begin;
    var last = a.stl_end;
    var z = Sort::stl_comparator (cmp);
    Sort::stl_sort (z,first,last);
  }

Inplace sort using default comparator.

//[array_class.flx]
  //$ In place sort using STL sort with default comparison.
  proc sort[with Tord[v]] (a:t) => sort (< of (v*v)) a;

}
True Contiguous Array Object.

A contiguous array in a more precise setting. Incomplete.

//[array_class.flx]
class TrueContiguousArrayObject[t,x, v]
{
  inherit TrueArrayObject [t,x,v];
  inherit ContiguousArrayObject[t,v];
  fun + (pa:t, i:x) : carray [v] => pa + render i;
}
Array
//[array.flx]

//$ Compile time fix length array.
open class Farray
{
  typedef array[t,n] = t ^ n;

  //ctor[T,N] array[T,N] (x:array[T,N]) => x;

  //$ Array copy.
  fun copy[T,N] (var x:array[T,N]) => x;

  //$ Array of one element.
  ctor[T] array[T,1] (x:T) => x :>> array[T,1];

  //$ Array as value.
  instance[t,n] ArrayValue[array[t,n], t] {
    fun len (x:array[t, n]): size => Typing::arrayindexcount[n];
    fun unsafe_get (var a: array[t, n], j: size): t => a . (j :>> n);
  }

  //$ Pointer to array as value.
  instance[t,n] ArrayValue[&array[t,n], &t] {
    fun len (x:&array[t, n]): size => Typing::arrayindexcount[n];
    fun unsafe_get (var a: &array[t, n],  j: size) : &t  => a.(aproj (j :>> n) of (&(t^n)));
  }

  //$ Pointer to array as value.
  instance[t,n] ArrayValue[&array[t,n], _pclt<array[t,n],t>] {
    fun len (x:&array[t, n]): size => Typing::arrayindexcount[n];
    fun unsafe_get (var a: &array[t, n],  j: size) : _pclt<array[t,n],t>  => a.(aproj (j :>> n) of (&(t^n)));
  }

  //$ Compact Linear Pointer to array as value.
  instance[t,n] ArrayValue[_pclt<array[t,n],t>, _pclt<array[t,n],t>] {
    fun len (x:&array[t, n]): size => Typing::arrayindexcount[n];
    fun unsafe_get (var a: &array[t, n],  j: size) => a.(aproj (j :>> n) of (&(t^n)));
  }

  // this one should
  proc unsafe_set[t,n] (a: &(t^n), i:size, v:t) { a . (i.int) <- v; }

  proc set[t,n, I in ints] (a: &array[t,n], i:I,v:t) {
    assert i.size < (*a).len;
    unsafe_set (a,i.size,v);
  }

  // these cannot work for compact linear arrays
  fun stl_begin[t,n]: &array[t,n] -> +t = "(?1*)($1->data)";
  fun stl_end[t,n] ( x:&array[t,n] ) : +t => stl_begin x + x*.len;

  //$ Array map.
  fun map[V,N,U] (_f:V->U) (x:array[V,N]):array[U,N] = {
    var o : array[U,N];
    val n = x.len;
    if n > 0uz
      for var i: size in 0uz upto n - 1uz
        call set (&o,i, _f x.i)
    ;
    return o;
  }

  // not very efficient!
  fun rev_map[V,N,U] (_f:V->U) (x:array[V,N]):array[U,N] =>
    rev (map _f x)
  ;

  // Note: for many loops below, note we're using unsigned values
  // iterating from 0 to N-1. Subtraction N-1 fails for n == 0
  // so we need a special test.

  //$ Join two arrays (functional).
  fun join[T, N:UNITSUM, M:UNITSUM] (x:array[T, N]) (y:array[T, M]):array[T, N `+ M] = {
    var o : array[T, N `+ M];

    if x.len > 0uz
      for var i in 0uz upto len(x) - 1uz
        call set (&o, i,x.i)
    ;
    i = x.len;
    if y.len > 0uz
      for var k in 0uz upto len(y) - 1uz
        call set(&o,i + k, y.k)
    ;
    return o;
  }

  // this routine SHOULD check FIRST + LEN <= N
  // we can perform that calculation now .. but there's no way yet to assert it
  // we can, actually, add it as a constraint ..
  // but we want the constraint to fail on monomorphisation
  // NOT during overload resolution .. because that would just reject
  // the candidate and lead to a not found error instead of a constraint violation error....
  fun subarray[
    FIRST:UNITSUM,
    LEN:UNITSUM,
    T,
    N:UNITSUM,
    K:UNITSUM=_unitsum_min(LEN, N `- FIRST)
  ]
  (a:T^N) : T ^ K
  =
  {
    var o : T ^ K;
    for i in ..[K] do
      var first = Typing::arrayindexcount[FIRST].int;
      var outix = caseno i;
      var inpix = (first + outix) :>> N; // checked at run time?
      &o.i <- a.inpix;
    done
    return o;
  }


  //$ Append value to end of an array (functional).
  fun join[T, N:UNITSUM] (x:array[T, N]) (y:T):array[T, N `+ 1] = {
    var o : array[T, N `+ 1];

    if x.len > 0uz
      for var i in 0uz upto len(x) - 1uz
        call set (&o, i,x.i)
    ;
    set(&o,x.len, y);
    return o;
  }

  //$ Prepand value to start of an array (functional).
  fun join[T, M:UNITSUM] (x:T) (y:array[T, M]):array[T, 1 `+ M] = {
    var o : array[T, 1 `+ M];

    set (&o, 0, x);
    if y.len > 0uz
      for var k in 0uz upto len(y) - 1uz
        call set(&o,1uz + k, y.k)
    ;
    return o;
  }


  //$ Join two arrays (functional).
  // will probably clash with tuple joining functions if we implement them
  fun + [T, N:UNITSUM, M:UNITSUM] (x:array[T, N], y:array[T, M]):array[T, N `+ M] => join x y;

  //$ Transpose and array.
  //$ Subsumes zip.
  //$ Example: transpose ( (1,2,3), (4,5,6) ) = ( (1,4), (2,5), (3,6) ).
  fun transpose[T,N,M] (y:array[array[T,M],N]) : array[array[T,N],M] = {
    var o : array[array[T,N],M];
    var n = len y;
    var m = len y.0;
    for var i in 0uz upto n - 1uz
      for var j in 0uz upto m - 1uz do
        val pfirst : +array[T,N] = &o.stl_begin;
        val psub: +array[T,N] = pfirst + j;
        val pelt : +T = psub.stl_begin;
        set(pelt,i, y.i.j);
      done
    return o;
  }

  //$ Reverse elements of an array.
  fun rev[T, N] (x:array[T, N]): array[T, N] = {
    var o : array[T, N];
    var n = len x;
    if n > 0uz
      for var i:size in 0uz upto n - 1uz
        call set(&o,n - 1uz - i, x.i)
    ;
    return o;
  }

  fun sort[T,N] (cmp: T * T -> bool) (var x:array[T,N]) : array[T,N] = {
    Sort::stl_sort (Sort::stl_comparator cmp, stl_begin (&x), stl_end (&x));
    return x;
  }

  fun sort[T,N] (var x:array[T,N]) : array[T,N] = {
    Sort::stl_sort (stl_begin (&x), stl_end (&x));
    return x;
  }


  //$ Display: convert to string like (1,2,3).
  instance[T,N with Show[T]] Str[array[T, N]] {
    fun str (xs:array[T,N]) = {
      var o = '(';
      val n = xs.len;
      if n  > 0uz do
        o += repr xs.0;

        for var i:size in 1uz upto n - 1uz
          perform o += ', ' + repr xs.i
        ;
      done
      return o + ')';
    }
  }

  //$ Equality and Inequality.
  instance[T,N with Eq[T]] Eq[array[T, N]] {
    fun == (xs:array[T,N],ys:array[T,N]) = {
      val n = xs.len;
      // assert n == ys.len;
      if n == 0uz do
        return true;
      else
        for var i:size in 0uz upto n - 1uz
          if not (xs.i == ys.i) return false;
      done
      return true;
    }
  }

  //$ Lexicographical total order based on
  //$ total order of elements.
  instance[T,N with Tord[T]] Tord[array[T,N]] {
    fun < (xs:array[T,N],ys:array[T,N]) = {
      val n = xs.len;
      if n == 0uz return false;
      // assert n == ys.len;
      var i:size;
      ph1:for i in 0uz upto n - 1uz
        if not (xs.i < ys.i) break ph1;
      for i in i upto n - 1uz
        if not (xs.i <= ys.i) return false;
      return true;
    }
  }
}

open[T,N] Eq[array[T,N]];
open[T,N] Tord[array[T,N]];
open[T,N with Eq[T]] Set[array[T,N],T];

open[T,N] ArrayValue[array[T,N], T];
open[T,N] ArrayValue[&array[T,N], &T];
Varray
//[varray.flx]

//$ Bounded Variable length arrays, bound set at construction time.
//$ A bound of 0 is allowed, the result is a NULL pointer.

open class Varray
{
  //$ A varray is just a pointer.
  //$ The current length and bound are maintained by the GC.
  _gc_pointer type varray[t] = "?1*";

  //$ An ordinary carray, but owned by the GC.
  ctor[t] carray[t] : varray[t] = "$1";

  //$ Create an empty varray with the given bound.
  ctor[t] varray[t]: size =
    "(?1*)(PTF gcp->collector->create_empty_array(&@?1,$1))"
    requires property "needs_gc"
  ;

  //$ Raw memory initialisation (really, this belongs in C_hack).
  private proc _init[T]: &T * T = "new((void*)$1) ?1($2);";


  //$ Construct a varray filled up with a default value.
  ctor[t] varray[t] (bound:size, default:t) = {
    var o = varray[t] bound;
    if o.maxlen != bound do
      eprintln$ "Constructor failed, wrong bound";
      eprintln$ "input Bound = " + bound.str + ", actual maxlen = " + o.maxlen.str;
    done
    if bound > 0uz do for var i in 0uz upto bound - 1uz do
    if o.len >= o.maxlen do
      eprintln ("ctor1: attempt to push_back on full varray size " + o.maxlen.str);
      eprintln$ "bound = " + bound.str;
      eprintln$ "index = " + i.str;
    done
      push_back(o, default);
    done done
    return o;
  }

  //$ Construct a partially filled varray with a default value computed by a function.
  ctor[t] varray[t] (bound:size, used:size, f:size->t when used <= bound) = {
    var o = varray[t] bound;
    if used > 0uz do for var i in 0uz upto used - 1uz do
    if o.len >= o.maxlen do
      eprintln ("ctor2: attempt to push_back on full varray size " + o.maxlen.str);
    done
      push_back(o, f i);
    done done
    return o;
  }

  //$ Construct a full varray from an array.
  // funny, the N isn't explicitly used.
  ctor[t,N] varray[t] (x:array[t,N]) =>
     varray[t] (len x, len x, (fun (i:size):t =>x.i))
  ;

  //$ Construct a partially full varray from a varray.
  ctor[t] varray[t] (x:varray[t], maxlen:size) =>
    varray[t] (maxlen, min(maxlen,len x), (fun (i:size):t=> x.i))
  ;

  //$ Construct a full varray from a varray (copy constructor).
  ctor[t] varray[t] (x:varray[t]) =>
    varray[t] (len x, len x, (fun (i:size):t=> x.i))
  ;

  // Construct a varray from a list
  ctor[t] varray[t] (x:list[t]) = {
    val n = x.len.size;
    var a = varray[t] n;
    iter (proc (v:t) {
    if a.len >= a.maxlen do
      eprintln ("ctor3: attempt to push_back on full varray size " + a.maxlen.str);
    done
      push_back(a,v);
     }) x;
    return a;
  }

  //$ Construct a varray from a string.
  //$ Include a trailing nul byte.
  ctor varray[char] (var x:string) = {
    var n = x.len;
    var v = varray[char] (n + 1uz);
    var p = &x.stl_begin;
    var q = v.stl_begin;
    Memory::memcpy (q.address, p.address, n);
    set(q,n, char "");
    set_used (v,n + 1uz);
    return v;
  }

  //$ Construct a varray from a string.
  //$ Exclude trailing nul byte.
  fun varray_nonul (var x:string) = {
    var n = x.len;
    var v = varray[char] (n);
    var q = v.stl_begin;
    var p = &x.stl_begin;
    Memory::memcpy (q.address, p.address, n);
    set_used (v,n);
    return v;
  }


  private proc set_used[t]: varray[t] * size =
    "PTF gcp->collector->set_used($1,$2);"
    requires property "needs_gc"
  ;

  //$ Treat a varray as an ArrayValue.
  instance[v] ArrayValue[varray[v],v] {
    //$ Length of a varray (used).
    fun len: varray[v] -> size =
      "PTF gcp->collector->get_used($1)"
      requires property "needs_gc"
    ;
    //$ Unsafe get value at position.
    fun unsafe_get: varray[v] * size -> v = "$1[$2]";
  }

  //$ Treat a varray as an ArrayObject.
  //$ Allows modifications.
  instance[v] ArrayObject[varray[v],v] {
    //$ Store the given value at the given position.
    proc unsafe_set: varray[v] * size * v = "$1[$2]=$3;";
    fun unsafe_get_ref: varray[v] * size -> &v = "$1+$2";
  }

  //$ Treat a varray as a ContiguousArrayObject.
  instance[v] ContiguousArrayObject[varray[v],v] {
    //$ STL iterator to start of array.
    fun stl_begin: varray[v] -> +v = "$1";

    //$ STL iterator to end of array.
    fun stl_end: varray[v] -> +v = "($1+PTF gcp->collector->get_used($1))";
  }

  //$ Get the bound of a varray.
  fun maxlen[t]: varray[t] -> size =
    "PTF gcp->collector->get_count($1)"
    requires property "needs_gc"
  ;

  //$ Append a new element to the end of a varray.
  //$ Aborts if you go past the bound.
  proc += [t] (pa:&varray[t],v:t) {
    if pa*.len >= pa*.maxlen do
      eprintln ("attempt to += on full varray size " + (pa*.maxlen).str);
    done
    push_back (*pa,v);
  }

  //$ Append a new element to the end of a varray.
  //$ Aborts if you go past the bound.
  proc _push_back[t] : varray[t] * t = """
    {
      //?1 * _p = *$1;
      size_t n = PTF gcp->collector->get_used($1);
      PTF gcp->collector->incr_used($1,1L);
      new($1+n) ?1($2);
    }
  """
    requires property "needs_gc"
  ;

  proc push_back[t] (x: varray[t], v: t)
  {
    if x.len >= x.maxlen do
      eprintln ("attempt to push_back on full varray size " + x.maxlen.str);
    done
    _push_back (x,v);
  }
  proc push_back[t] (x:varray[t]) (v:t) => push_back(x,v);

  //$ Pop an element off the end of a varray.
  //$ Aborts if the array is empty.
  proc pop_back[t] : varray[t] = """
    { // pop varray
      ?1 * _p = $1;
      size_t n = PTF gcp->collector->get_used(_p);
      PTF gcp->collector->incr_used(_p,-1L);
      destroy(_p+n-1); // from flx_compiler_support_bodies
    }
  """
    requires property "needs_gc";
  ;

  //$ Erase elements of array between and including first and last.
  //$ Include first and last, intersect with array span.
  //$ Cannot fail.
  proc erase[v] (a:varray[v], first:int, last:int)
  {
    if first > last return;
    var l = a.len.int;
    var b = if first < 0 then 0 else first;
    var e = if last >= l then l - 1 else last;
    var d = e - b + 1;
    if d > 0 do
      for var i in b upto l - d - 1 do
         unsafe_set (a, i.size, unsafe_get (a, size (i + d)));
      done
      var s : carray[v] = a.stl_begin;
      for i in l - d upto l - 1 do
        var p : carray[v] = s + i;
        C_hack::destroy$ -p;
      done
      set_used$ a, (l - d).size;
    done
  }

  proc erase[v] (a:varray[v], i:int) => erase (a,i,i);

  //$ insert (a,i,v) inserts v in a at position i
  //$ that is, inserts before element i.
  //$ If i is negative, position relative to end,
  //$ that is, -1 is last element, so insert (a,-1,v)
  //$ inserts before the last element (not after!)
  //$ If i equals the length, element is appended.
  //$ If the index is out of range, nothing happens.
  proc insert[t] (a:varray[t], i:int, v:t)
  {
    var l = a.len.int;
    var n = a.maxlen.int;
    if l == n return; // fail: no space
    var ix = if i < 0 then  l - i else i;
    if ix < 0 or ix > l return; // fail: bad index
    if ix == l do
    if a.len >= a.maxlen do
      eprintln ("insert: attempt to push_back on full varray size " + a.maxlen.str);
    done
      push_back (a,v);
    else
      assert l > 0;
    if a.len >= a.maxlen do
      eprintln ("insert: attempt to push_back on full varray size " + a.maxlen.str);
    done
      push_back (a, a.(l - 1)); // dups last element
      if l - 2 > ix do
        for var j in l - 2 downto ix do // copy from second last pos
           unsafe_set (a, j.size + 1uz, unsafe_get (a, j.size));
        done
      done
      unsafe_set (a, ix.size, v);
    done
  }

  fun apply[T] (x:slice[int], v:varray[T])  {
    var minr = max (min x,0);
    var maxr = min (max x,v.len.int - 1);
    var out = varray[T] (maxr - minr + 1).size;
    for var i in minr upto maxr perform
      out.push_back v.i;
    return out;
  }

  //$ Traditional map varray to varray.
  fun map[T, U] (_f:T->U) (x:varray[T]): varray[U] = {
    var o = varray[U]$ len(x);

    if len x > 0uz do for var i in 0uz upto len(x) - 1uz do
    if o.len >= o.maxlen do
      eprintln ("insert: attempt to push_back on full varray size " + o.maxlen.str);
    done
      push_back (o, _f x.i);
    done done
    return o;
  }

  //$ R like operations
  fun rop[T] (op:T * T -> T) (x:varray[T], y:varray[T]) : varray[T] =>
    let n = x.len in
    let m = y.len in
    if m == 0uz or n == 0uz then varray[T](0uz) else
    let l = max(n,m) in
    let fun g (i:size): T => op (x.(i%n), y.(i%m)) in
    varray[T] (l,l,g)
  ;

}

instance[T with Show[T]] Str[Varray::varray[T]] {
  //$ Convert a varray[T] to a string.
  //$ Requires Show[T]
  fun str (xs:varray[T]) = {
    var o = 'varray(';

    if len xs > 0uz do
      o += repr xs.0;

      for var i in 1uz upto len xs - 1uz do
        o += ', ' + repr xs.i;
      done
    done

    return o + ')';
  }
}

//$ Treat varray as Set.
instance[T with Eq[T]] Set[varray[T],T] {
  //$ Check is a value is stored in a varray.
  fun \in (x:T, a:varray[T]) : bool = {
    if len a > 0uz do
      for var i in 0uz upto len a - 1uz do
        if a.i == x do return true; done
      done
    done
    return false;
  }
}

open[T] Show[Varray::varray[T]];
open[T] Set[Varray::varray[T],T];
open[T] ArrayValue[varray[T], T];
open[T] ArrayObject[varray[T], T];
open[T] ContiguousArrayObject[varray[T], T];
Darray
//[darray.flx]
<code>darray</code>: an array with dynamic, unbounded length.

A darray is a contiguous store of variable, unbounded length. It is implemented by a pointer to a varray. When the varray becomes full, a new one with a large bound is created, the contents of the old array copied over, and the old array forgotten.

Similarly when the varray is not sufficiently full, a new varray of smaller extent is allocated and the contents of the old array copied over, and the old array is forgotten.

A user specifiable function is used to control the threshholds for and amount of expansion and contraction. The user function defines the amortised performance. With higher expansion factors, O(1) speed is obtained at the cost of a lot of memory wastage.

//[darray.flx]
//$ Unbounded Variable length object array.
open class Darray
{
Representation

We use a control block darray_ctl to store the data required to access a darray, it contains a varray and a resize function. The resize function takes two arguments: the current varray bound and the requested amount of store. It returns a recommended amount of store.

//[darray.flx]
  private struct darray_ctl[T]
  {
    a: varray[T];
    resize: size * size --> size;
  }
Default resize function.

This function increases the bound to 150% of the requested size when the requested size exceeds the current bound.

It decreases the current bound to 150% of the requested size if the requested size is less that 50% of the current bound.

There is a hard minimum of 20 elements except in the special case the array is empty, when the size is set to 0.

 //[darray.flx]
   //$ This is the default array resize function.
   //$ If we run out of space, allocate what we have + 50%.
   //$ If we need less than half the allocated space, return the requested size + 50%.
   //$ Otherwise return the existing allocated space.
   cfun dflt_resize(old_max:size, requested:size):size=
   {
     // GOTCHA: don't forget that division has a higher precedence than multiplication!
     // sensible minimum size of 20, except if zero length
     if requested == 0uz return 0uz;
     if requested < 20uz return 20uz;
     if requested < old_max / 2uz return (3uz * requested) / 2uz;
     if requested > old_max return (requested * 3uz) / 2uz;
     return old_max;
   }

:code:`darray` type.

We define darray as a pointer to a darray control block darray_ctl. This means, in particular, that darray is passed by reference. The definition is abstract, so the client us not able to fiddle with the underlying control block.

//[darray.flx]
  //$ Type of a darray.
  type darray[T] = new &darray_ctl[T];
Force a resize of the bound.

This procedure forcibly resizes a darray to a new bound. The number of use elements is the maximum of the old number of elements and the new bound.

This procedure is analogous to the C++ string reserve function, however it is primarily intended for internal use. If this function is called the new bound will be adjusted on the next size changing operation such as a push_back or pop_back.

//[darray.flx]
  //$ Force a resize.
  //$ Similar to C++ vector reserve function.
  proc do_resize[T] (pd: darray[T], new_size: size)
  {
    var old = (_repr_ pd)*.a;
    (_repr_ pd).a <- varray[T] (new_size, (len old), (fun(i:size)=>old.i));
  }
Constructors.
//[darray.flx]
  //$ Make an empty darray, give it 20 slots for no particular reason.
  ctor[T] darray[T] () =>
    _make_darray[T]$ new darray_ctl[T](varray[T] 20uz , dflt_resize);

  //$ Make a darray from an array
  ctor[T,N] darray[T] (a:array[T,N]) =>
    _make_darray[T]$ new darray_ctl[T]( varray[T] a, dflt_resize);

  //$ Make a darray from a varray
  ctor[T] darray[T] (a:varray[T]) =>
    _make_darray[T]$ new darray_ctl[T]( varray[T] a, dflt_resize);

  //$ Make a darray from a darray (copy)
  ctor[T] darray[T] (a:darray[T]) => darray ((_repr_ a)*.a);


  //$ make a darray of a certain size initialised with some default value
  ctor[T] darray[T] (n:size, default:T) => darray[T] (varray[T](n,default));
As a value.
//[darray.flx]
  //$ Basic array value stuff.
  instance[v] ArrayValue[darray[v],v] {
    fun len (a:darray[v])=> len (_repr_ a)*.a;
    fun unsafe_get (a:darray[v], i:size) => (_repr_ a)*.a.i;
  }
As an object.
//[darray.flx]
  //$ Basic array object stuff.
  instance[v] ArrayObject[darray[v],v] {
    proc unsafe_set (b:darray[v],  n:size, x:v) => unsafe_set ((_repr_ b)*.a,n,x);
    fun unsafe_get_ref (b:darray[v],  n:size) : &v => unsafe_get_ref ((_repr_ b)*.a,n);
  }
As an contiguous array.
//[darray.flx]
  //$ Contrue as contiguous store.
  instance[v] ContiguousArrayObject[darray[v],v] {
    fun stl_begin(b:darray[v]) => stl_begin b._repr_*.a;
    fun stl_end(b:darray[v]) => stl_end b._repr_*.a;
  }
Size changing mutators.

There’s no push_front but there should be. Generally, this class is very incomplete.

//[darray.flx]
  //$ Pop a value from the end.
  //$ Same as pop_back in C++.
  proc pop_back[t](a:darray[t]) {
    pop_back (_repr_ a)*.a;
    newsize := (_repr_ a)*.resize (maxlen (_repr_ a)*.a, len (_repr_ a)*.a);
    if newsize != maxlen (_repr_ a)*.a call do_resize (a,newsize);
  }

  //$ Push a value onto the end.
  //$ Same as push_back in C++.
  proc += [t] (a:&darray[t],v:t) {
    push_back (*a, v);
  }

  //$ Push a value onto the end.
  //$ Same as push_back in C++.
  proc push_back[t] (a:darray[t], v:t) {
    r := _repr_ a;
    newsize := r*.resize (maxlen r*.a, len r*.a + 1uz);
    if newsize != maxlen r*.a call do_resize(a,newsize);
    if r*.a.len >= r*.a.maxlen do
      eprintln ("darray push_back: attempt to push_back on full varray size " + r*.a.maxlen.str);
    done
    push_back (r*.a, v); // hack to workaround compiler error Address non variable
  }

  //$ insert
  proc insert[t] (a:darray[t], i:int, v:t)
  {
    var r = _repr_ a;
    newsize := r*.resize (maxlen r*.a, len r*.a + 1uz);
    if newsize != maxlen r*.a call do_resize(a,newsize);
    r = _repr_ a;
    insert (r*.a,i,v);
  }

  //$ Erase an element, note doesn't resize the varray,
  //$ probably should ..
  proc erase[t] (a:darray[t], i:int) => erase ((_repr_ a)*.a,i);

  //$ Erase multiple elements, note doesn't resize the varray,
  //$ probably should ..
  proc erase[t] (a:darray[t], first:int, last:int) =>
    erase ((_repr_ a)*.a, first,last);
Slice
//[darray.flx]
  fun apply[T] (x:slice[int], v:darray[T])  {
    var minr = max (min x,0);
    var maxr = min (max x,v.len.int - 1);
    var out = varray[T] (maxr - minr + 1).size;
    for var i in minr upto maxr perform
      out.push_back v.i;
    return darray out;
  }
Convert a darray to a string.
//[darray.flx]
  // uses _repr_ so has to be in the module
  instance[T with Show[T]] Str[Darray::darray[T]] {
    //$ Convert an array to a string,
    //$ provided the element type is convertible.
    fun str (x:darray[T])=> str (_repr_ x)*.a;
  }
Enable map on darray objects.
//[darray.flx]
  //$ Traditional map darray to darray.
  fun map[T, U] (_f:T->U) (arr:darray[T]): darray[U] = {
    var o = darray[U]();

    if arr.len > 0uz do
      for var i in 0uz upto arr.len - 1uz do
      push_back (o, _f arr.i);
      done
    done

    return o;
  }
Enable filter on darray objects
//[darray.flx]

  //$ Return a sub list with elements satisfying the given predicate.
  fun filter[T] (P:T -> bool) (arr:darray[T]) : darray[T] =
  {
    var o = darray[T]();

    if arr.len > 0uz do
      for var i in 0uz upto arr.len - 1uz do
        if (P(arr.i)) do
                push_back (o, arr.i);
        done
      done
    done

    return o;
  }


}
As a set

Should be in main class body.

//[darray.flx]
//$ Construe a darray as a Set.
instance[T with Eq[T]] Set[darray[T],T] {
 //$ element membership test.
 fun \in (x:T, a:darray[T]) : bool = {
   for var i in 0uz upto len a -1uz
     if a.i == x return true
   ;
   return false;
 }
}

open[T] Show[Darray::darray[T]];
open[T] Set[Darray::darray[T],T];

open[T] ArrayValue[darray[T], T];
open[T] ArrayObject[darray[T], T];
open[T] ContiguousArrayObject[darray[T], T];
Sarray
//[sarray.flx]

//$ Unbounded sparse psuedo-array sarray.
//$ This data type is not a real array because it has no bounds
//$ and therefore cannot support iteration.
open class Sarray
{
  open Judy;
  private struct sarray_ctl[T] { a: darray[T]; j:JLArray; free:J1Array; dflt:T; };

  //$ Type of a sarray.
  type sarray[T] = new &sarray_ctl[T];

  //$ Construct an infinite sarray with all values set to the given default.
  ctor[T] sarray[T] (dflt:T) => _make_sarray[T]$ new sarray_ctl[T] (darray[T](), JLArray(), J1Array(),dflt);

  //$ Get the value at the given position.
  fun get[T] (a:sarray[T], i:size) : T = {
     var pk: &word;
     var e: JError_t;
     JudyLGet ( (_repr_ a)*.j, i.word, &e, &pk);
     var r = if C_hack::isNULL pk then (_repr_ a)*.dflt else (_repr_ a)*.a.(size(*pk));
     return r;
  }

  //$ Set the given value at the given position.
  proc set[T] (a:sarray[T], i:size, v:T) {
    var pk: &word;
    var e: JError_t;
    JudyLGet ( (_repr_ a)*.j, i.word, &e, &pk);    // see if already in array
    if C_hack::isNULL pk do
      var idx: word = word 0;
      var b: int;
      Judy1First((_repr_ a)*.free,&idx,&e,&b);     // try to find a free slot
      if b == 0 do                                // none?
        idx = word (len (_repr_ a)*.a);
        push_back ((_repr_ a)*.a, v);              // then push onto array end
      else
        Judy1Unset((_repr_ a)*.free,idx,&e,&b);     // remove free slot from free set
        set ((_repr_ a)*.a,size idx,v);            // store value
      done
      JudyLIns ( (_repr_ a)*.j,i.word, &e, &pk);    // add new index to j mapping
      pk <- idx;
    else
      set ((_repr_ a)*.a, size (*pk), v);
    done
  }

  //$ Replace the value at a given position with the default.
  proc del[T] (a:sarray[T], i:size) {
    var pk: &word;
    var e: JError_t;
    JudyLGet ( (_repr_ a)*.j, i.word, &e, &pk);     // see if already in array
    if not C_hack::isNULL pk do                    // if it is
      var b:int;
      Judy1Set ((_repr_ a)*.free, i.word, &e, &b);  // add slot to free set
      set ( (_repr_ a)*.a, pk*.size, (_repr_ a)*.dflt); // replace old value with default
    done
  }

  //$ Pack a sparse array.
  //$ This is an optimisation with no semantics.
  //$ Reorganises the sarray to reduce memory use and optimise lookup.
  //$
  // Make a new varray with max number
  // of elements in the j mapping, then fill it in order
  // of the j mapping, replacing the j value with the new index
  // finally replace the original darray with a new one made
  // from the constructed varray: this is packed and in sequence
  proc pack[T] (a:sarray[T]) {
    r := _repr_ a;
    var e: JError_t;
    var n: word;
    JudyLCount (r*.j, word 0, word (-1ul), &e, &n);
    var x = varray[T] n.size;
    var index = word 0;
    var i = 0ul;         // slot index for new array
    var slot : &word;
    JudyLFirst(r*.j, &index, &e, &slot);
    while not isNULL slot do
      push_back (x, r*.a.((*slot).size));
      slot <- i.word; ++i;
      JudyLNext(r*.j, &index, &e, &slot);
    done
    var m : word;
    Judy1FreeArray(r*.free,&e,&m);
    //println$ m.ulong.str + " bytes freed --> counted "+n.ulong.str;
    r.a <- darray x;
  }
}
Bsarray
//[bsarray.flx]


//$ Bounded sparse array.
//$ Basically a sarray with a given bound.
//$ The bound is ignored for get and set methods.
//$ The bound is used for membership tests and iteration.
include "std/datatype/sarray";
open class Bsarray
{
  private struct bsarray_ctl[T] { a: sarray[T]; n:size; };
  type bsarray[T] = new &bsarray_ctl[T];

  //$ Contruct with default value and bound.
  ctor[T,I in ints] bsarray[T] (dflt:T, bound:I) =>
    _make_bsarray[T]$ new bsarray_ctl[T] (sarray[T](dflt), bound.size)
  ;

  //$ Contrue as array value.
  instance[T] ArrayValue[bsarray[T],T] {
    fun len(b:bsarray[T])=> (_repr_ b)*.n;
    fun unsafe_get(b:bsarray[T], i:size)=> get ((_repr_ b)*.a, i);
  }

  //$ Contrue as array object.
  instance[T] ArrayObject[bsarray[T],T] {
    proc unsafe_set(b:bsarray[T], i:size, v:T)=> set ((_repr_ b)*.a, i, v);
  }

  //$ Contrue as set: membership test.
  instance[T with Eq[T]] Set[bsarray[T],T] {
   // FIX ME: inefficient!
   fun \in (x:T, a:bsarray[T]) : bool = {
     if len a > 0uz
       for var i in 0uz upto len a - 1uz
         if a.i == x return true
     ;
     return false;
   }
  }

  instance[T with Show[T]] Str[Bsarray::bsarray[T]] {
    //$ Convert to string.
    fun str (xs:bsarray[T]) = {
      var o = 'bsarray(';

      if len xs > 0uz do
        o += repr xs.0;

        for var i in 1uz upto len xs - 1uz do
          o += ', ' + repr xs.i;
        done
      done

      return o + ')';
    }
  }
}


open[T] Show[Bsarray::bsarray[T]];
open[T] Set[Bsarray::bsarray[T],T];
open[T] ArrayValue[bsarray[T], T];
open[T] ArrayObject[bsarray[T], T];
open[T] ContiguousArrayObject[bsarray[T], T];

Package: src/packages/char.fdoc

characters

key file
char.flx share/lib/std/scalar/char.flx
Char
//[char.flx]

//$ Standard C operations on C character set.
open class Char
{
  //$ Ordinal value as int.
  fun ord: char -> int = "(int)$1";

  //$ Constructor from any integer type.
  ctor[t in ints] char: t = "(char)$1";

  //$ Convert to upper case.
  fun toupper : char -> char requires C89_headers::ctype_h;

  //$ Convert to lower case.
  fun tolower : char -> char requires C89_headers::ctype_h;

  //$ Test if upper case [A-Z].
  fun isupper : char -> bool  = "!!isupper($1)" requires C89_headers::ctype_h;

  //$ Test if lower case [a-z].
  fun islower : char -> bool  = "!!islower($1)" requires C89_headers::ctype_h;

  //$ Test if alphanumeric [A-Za-z0-9].
  fun isalnum : char -> bool  = "!!isalnum($1)" requires C89_headers::ctype_h;

  //$ Test if alphabetic [A-Za-z]
  fun isalpha : char -> bool  = "!!isalpha($1)" requires C89_headers::ctype_h;

  //$ Test if digit [0-9].
  fun isdigit : char -> bool  = "!!isdigit($1)" requires C89_headers::ctype_h;

  //$ Test if hex digit [0-9A-Fa-f].
  fun isxdigit : char -> bool  = "!!isxdigit($1)" requires C89_headers::ctype_h;

  //$ Test if control character 0x0 - 0x20, 0x7F
  fun iscntrl : char -> bool  = "!!iscntrl($1)" requires C89_headers::ctype_h;

  //$ Test if space x020.
  fun isspace : char -> bool  = "!!isspace($1)" requires C89_headers::ctype_h;

  //$ Test if space 0x20 or tab 0x09
  fun isblank : char -> bool  = "!!isblank($1)" requires C89_headers::ctype_h;

  //$ Test if printable 0x20-0x7e
  fun isprint : char -> bool  = "!!isprint($1)" requires C89_headers::ctype_h;

  //$ Test if punctuation character.
  fun ispunct : char -> bool  = "!!ispunct($1)" requires C89_headers::ctype_h;

  // define some basic character sets
  val upper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  val lower = "abcdefghijklmnopqrstuvwxyz";
  val letters = upper + lower;
  val digits = "0123456789";
  val alphanum = letters + digits;
  val cidstart = letters + "_";
  val cidcont= alphanum+"_";
  val flxidcont= alphanum+"_-'";
  val camlidcont= alphanum+"_'";
  val numeric = digits + ".eEdD_"; // crud hack

  // some character classification functions
  fun isidstart(x:char) => match (find$ letters,x) with | Some _ => true | #None => false endmatch;
  fun iscidstart(x:char) => match find$ cidstart,x with | Some _ => true | #None => false endmatch;
  fun iscidcont(x:char) => match find$ cidcont,x with | Some _ => true | #None => false endmatch;
  fun iscamlidcont(x:char) => match find$ camlidcont,x with | Some _ => true | #None => false endmatch;
  fun isflxidcont(x:char) => match find$ flxidcont,x with | Some _ => true | #None => false endmatch;
  fun isnumeric(x:char) => match find$ numeric,x with | Some _ => true | #None => false endmatch;
  fun isalphanum(x:char) => isidstart x or isdigit x;
  fun isletter (x:char) => match find$ letters, x with | Some _ => true | #None => false endmatch;

  fun issq(x:char) => x == char "'";
  fun isdq(x:char) => x == char '"';
  fun isslosh(x:char) => x == char '\\';
  fun isnull(x:char) => x == char "";
  fun iseol(x:char) => x == char "\n"; // will be CR on Windoze ;(

}

instance[T in chars] Str[T] {
  fun str: T -> string = "::flx::rtl::strutil::str<#1>($1)" requires package "flx_strutil";
}

instance[T in chars] Repr[T] {
  fun repr[with Str[T]] (c:T) : string = {
    val s = str c;
    return
      match s with
      | "'" =>  "\\'"
      | '\t' => '\\t'
      | '\n' => '\\n'
      | '\r' => '\\r'
      | '\f' => '\\f'
      | '\v' => '\\v'
      | _    => s
      endmatch
    ;
  }
}

instance Tord[char]
{
  fun < : char * char -> bool = "$1<$2";
}
open Tord[char];

Package: src/packages/cheaders.fdoc

C Headers

Headers

To use the facilities of C conveniently we first define some classes naming the standard header files.

The class construction provides a namespace.

The contained header specification provides a tag name for a C include line. A use of a type or function lifted from C depending on the inclusion of the header text causes the Felix compiler to emit the header text.

C Standards.

Each newer C Standard adds some header files. The inherit statement is used to include the headers from the previous standard into a more recent one.

C89 Standard.

The original ANSI Standard blessed as an ISO Standard.

// reference: Wikipedia: http://en.wikibooks.org/wiki/C_Programming/Reference_Tables#List_of_Standard_Headers

// ANSI C89 = ISO C90
class C89_headers
{
  header assert_h =   "#include <assert.h>";
  header ctype_h =    "#include <ctype.h>";
  header errno_h =    "#include <errno.h>";
  header float_h =    "#include <float.h>";
  header limits_h =   "#include <limits.h>";
  header locale_h =   "#include <locale.h>";
  header math_h =     "#include <math.h>";
  header setjmp_h =   "#include <setjmp.h>";
  header signal_h =   "#include <signal.h>";
  header stdarg_h =   "#include <stdarg.h>";
  header stddef_h =   "#include <stddef.h>";
  header stdio_h =    "#include <stdio.h>";
  header stdlib_h =   "#include <stdlib.h>";
  header string_h =   "#include <string.h>";
  header time_h =     "#include <time.h>";
}
C95 Amendment

Added support for wide characters.

// ISO C94/95 Amendment 1
class C95_headers
{
  inherit C89_headers;
  header iso646_h =   "#include <iso646.h>";
  header wchar_h =    "#include <wchar.h>";
  header wctype_h =   "#include <wctype.h>";
}
C99 Standard

Added support for complex, exact integer types and bool.

// ISO C99
class C99_headers
{
  inherit C95_headers;
  header complex_h =  "#include <complex.h>";
  header fenv_h =     "#include <fenv.h>";
  header inttypes_h = "#include <inttypes.h>";
  header wctype_h =   "#include <wctype.h>";
  header stdbool_h =  "#include <stdbool.h>";
  header stdint_h =   "#include <stdint.h>";
  header tgmath_h =   "#include <tgmath.h>";
}
C++ Standards.

Each newer C++ Standard adds some header files. The inherit statement is used to include the headers from the previous standard into a more recent one.

C++90 Standard

The original C++ Standard.

class Cxx_headers
{
  header exception = '#include <exception>';
  header limits = '#include <limits>';
  header new = '#include <new>';
  header typeinfo = '#include <typeinfo>';
  header stdexcept = '#include <stdexcept>';
  header utility = '#include <utility>';
  header memory = '#include <memory>';
  header string = '#include <string>';
  header locale = '#include <locale>';

// STL
  header functional = '#include <functional>';
  header algorithm = '#include <algorithm>';
  header bitset = '#include <bitset>';
  header deque = '#include <deque>';
  header iterator = '#include <iterator>';
  header list = '#include <list>';
  header map = '#include <map>';
  header set = '#include <set>';
  header stack = '#include <stack>';
  header vector = '#include <vector>';
  header complex = '#include <complex>';
  header numeric = '#include <numeric>';
  header valarray = '#include <valarray>';

// I/O
  header fstream = '#include <fstream>';
  header iomanip = '#include <iomanip>';
  header ios = '#include <ios>';
  header iosfwd = '#include <iosfwd>';
  header iostream = '#include <iostream>';
  header istream = '#include <istream>';
  header ostream = '#include <ostream>';
  header streambuf = '#include <streambuf>';
  header sstream = '#include <sstream>';

// ISO C wrappers
  header cassert = '#include <cassert>';
  header cctype = '#include <cctype>';
  header cerrno = '#include <cerrno>';
  header cfloat = '#include <cfloat>';
  header ciso646 = '#include <ciso646>';
  header climits = '#include <climits>';
  header clocale = '#include <clocale>';
  header cmath = '#include <cmath>';
  header csetjmp = '#include <csetjmp>';
  header csignal = '#include <csignal>';
  header cstdarg = '#include <cstdarg>';
  header cstdio = '#include <cstdio>';
  header cstdlib = '#include <cstdlib>';
  header cstring = '#include <cstring>';
  header ctime = '#include <ctime>';
  header cwchar = '#include <cwchar>';
  header cwctype = '#include <cwctype>';
}
C++11 Standard.

A more recent standard from 2011. Added a huge number of new features.

class Cxx11_headers  // http://en.cppreference.com/w/cpp/header
{
  inherit Cxx_headers;
  header system_error = '#include <system_error>'; // std=?
  header typeidex = '#include <typeindex>';
  header type_traits = '#include <type_traits>';
  header chrono = '#include <chrono>';
  header initialiser_list = '#include <initialiser_list>';
  header tuple = '#include <tuple>';
  header scope_allocator = '#include <tuple>';
  header cuchar = '#include <cuchar>';
  header array = '#include <array>';
  header forward_list = '#include <forward_list>';
  header unordered_set = '#include <unordered_set>';
  header unordered_map = '#include <unordered_map>';
  header ratio = '#include <ratio>';
  header cfenv= '#include <ratio>';
  header codecvt = '#include <codecvt>';
  header regex = '#include <regex>';
  header random = '#include <random>';
  header atomic = '#include <atomic>';
  header thread = '#include <thread>';
  header mutex = '#include <mutex>';
  header future = '#include <future>';
  header condition_variable = '#include <condition_variable>';
  header ctgmath = '#include <ctgmath>';
  header cstdalign = '#include <cstdalign>';
  header cstdbool = '#include <cstdbool>';
}
Posix

There are multiple Posix standards but we just include headers from the most recent, most final one.

class Posix_headers {
  header aio_h = "#include <aio.h>";
  header arpa_inet_h = "#include <arpa/inet.h>";
  header cpio_h = "#include <cpio.h>";
  header dirent_h = "#include <dirent.h>";
  header dlfcn_h = "#include <dlfcn.h>";
  header fcntl_h = "#include <fcntl.h>";
  header fmtmsg_h = "#include <fmtmsg.h>";
  header fnmatch_h = "#include <fnmatch.h>";
  header ftw_h = "#include <ftw.h>";
  header glob_h = "#include <glob.h>";
  header grp_h = "#include <grp.h>";
  header iconv_h = "#include <iconv.h>";
  header langinfo_h = "#include <langinfo.h>";
  header libgen_h = "#include <libgen.h>";
  header monetary_h = "#include <monetary.h>";
  header mqueue_h = "#include <mqueue.h>";
  header ndbm_h = "#include <ndbm.h>";
  header net_if_h = "#include <net/if.h>";
  header netdb_h = "#include <netdb.h>";
  header netinet_in_h = "#include <netinet/in.h>";
  header netinet_tcp_h = "#include <netinet/tcp.h>";
  header nl_types_h = "#include <nl_types.h>";
  header poll_h = "#include <poll.h>";
  header pthread_h = "#include <pthread.h>";
  header pwd_h = "#include <pwd.h>";
  header regex_h = "#include <regex.h>";
  header sched_h = "#include <sched.h>";
  header search_h = "#include <search.h>";
  header semaphore_h = "#include <semaphore.h>";
  header spawn_h = "#include <spawn.h>";
  header strings_h = "#include <strings.h>";
  header stropts_h = "#include <stropts.h>";
  header sys_ipc_h = "#include <sys/ipc.h>";
  header sys_mman_h = "#include <sys/mman.h>";
  header sys_msg_h = "#include <sys/msg.h>";
  header sys_resource_h = "#include <sys/resource.h>";
  header sys_select_h = "#include <sys/select.h>";
  header sys_sem_h = "#include <sys/sem.h>";
  header sys_shm_h = "#include <sys/shm.h>";
  header sys_socket_h = "#include <sys/socket.h>";
  header sys_stat_h = "#include <sys/stat.h>";
  header sys_statvfs_h = "#include <sys/statvfs.h>";
  header sys_time_h = "#include <sys/time.h>";
  header sys_times_h = "#include <sys/times.h>";
  header sys_types_h = "#include <sys/types.h>";
  header sys_uio_h = "#include <sys/uio.h>";
  header sys_un_h = "#include <sys/un.h>";
  header sys_utsname_h = "#include <sys/utsname.h>";
  header sys_wait_h = "#include <sys/wait.h>";
  header syslog_h = "#include <syslog.h>";
  header tar_h = "#include <tar.h>";
  header termios_h = "#include <termios.h>";
  header trace_h = "#include <trace.h>";
  header ulimit_h = "#include <ulimit.h>";
  header unistd_h = "#include <unistd.h>";
  header utime_h = "#include <utime.h>";
  header utmpx_h = "#include <utmpx.h>";
  header wordexp_h = "#include <wordexp.h>";
}
Windows

The name win32 for the original 32 bit Windows has stuck, even for 64 bit Windows.

class Win32_headers {
  header windows_h = "#include <windows.h>";
  header io_h = "#include <io.h>";
  header direct_h = "#include <direct.h>";
  header sys_timeb_h = "#include <sys/timeb.h>";
  header sys_utime_h = "#include <sys/utime.h>";
  header process_h = "#include <process.h>";
}

Package: src/packages/core_scalar_types.fdoc

key file
__init__.flx share/lib/std/scalar/__init__.flx
scalar.flx share/lib/std/scalar/ctypedefs.flx

Core Scalar Types

Language features.

In these definitions, we introduce basic types into Felix with bindings to C. These are expressed by the type statement, which gives the Felix name of the type, and then the C name in quotes.

Note very particularly each type is distinct, type names such as size_t in C and C++ are merely aliases for some other integer type, in Felix these types are completely distinct.

The adjective pod stands for <em>plain old datatype</em> and tells the system that the type has a trivial destructor and does not require finalisation.

The adjective _gc_pointer tells the system the abstract primitive is in fact a pointer and the garbage collector must follow it.

The requires clause, if specified, tells the system that the named floating insertion must be emitted into the generated C++ code. We will use the names of code fragments specifying header files defined in the <strong>cheaders</strong> package.

Synopsis
//[__init__.flx]

include "std/scalar/ctypedefs";

include "std/scalar/address";
include "std/scalar/memory";
include "std/scalar/bool";
include "std/scalar/int";
include "std/scalar/real";
include "std/scalar/number";
include "std/scalar/char";

include "std/scalar/float_format";
include "std/scalar/float_math";
include "std/scalar/quaternion";

include "std/kind/staticbool";
Character type

A basic 8 bit character type.

//[scalar.flx]
pod type char = "char";
Efficient Integer types

These types correspond to C99 integer types. Note that Felix mandates the existence of the long long types.

Note we also require the C99 intmax_t and uintmax_t types. These will usually be signed and unsigned long long, however they may be an even larger type if the C implementor desires.

We also map C89 size_t and the less useful C99 ssize_t, a signed variant of size_t. These are used for array lengths and in particular can span byte arrays as large as can be addressed.

//[scalar.flx]
pod type tiny = "signed char" requires index TYPE_tiny;
pod type short = "short" requires index TYPE_short;
pod type int = "int" requires index TYPE_int;
pod type long = "long" requires index TYPE_long;
pod type vlong = "long long" requires index TYPE_vlong;
pod type utiny = "unsigned char" requires index TYPE_utiny;
pod type ushort = "unsigned short" requires index TYPE_ushort;
pod type uint = "unsigned int" requires index TYPE_uint;
pod type ulong = "unsigned long" requires index TYPE_ulong;
pod type uvlong = "unsigned long long" requires index TYPE_uvlong;

pod type intmax = "intmax_t" requires C99_headers::stdint_h, index TYPE_intmax;
pod type uintmax = "uintmax_t" requires C99_headers::stdint_h, index TYPE_uintmax;
pod type size = "size_t" requires C89_headers::stddef_h, index TYPE_size;
pod type ssize = "ssize_t" requires C89_headers::stddef_h, index TYPE_ssize;

/* for concordance, required to generated loops */
class PervasiveInts {
  private const zero: int = "0" requires index CONST_zero;
  private fun isneg:  int -> 2 = "$1<0" requires index FUN_isneg;
  private fun isnonneg:  int -> 2= "$1>=0" requires index FUN_isnonneg;
  private proc decr:  &int = "--*$1;" requires index PROC_decr;
}

// Shouldn't really be here!
class PervasiveLogic {
  private fun land: bool * bool -> bool = "$1&&$2" requires index FUN_land;
  private fun lor: bool * bool -> bool = "$1||$2" requires index FUN_lor;
  private fun lnot: bool * bool -> bool = "!$1" requires index FUN_lnot;
}
Exact Integer types

Here are the usual exact integer types. Note that Felix mandates the existence of the stdint.h header file from C99, and that all the exact types are defined. This includes 64 bit signed and unsigned integers, even on a 32 bit machine.

//[scalar.flx]
pod type int8 = "int8_t" requires C99_headers::stdint_h, index TYPE_int8;
pod type int16 = "int16_t" requires C99_headers::stdint_h, index TYPE_int16;
pod type int32 = "int32_t" requires C99_headers::stdint_h, index TYPE_int32;
pod type int64 = "int64_t" requires C99_headers::stdint_h, index TYPE_int64;
pod type uint8 = "uint8_t" requires C99_headers::stdint_h, index TYPE_uint8;
pod type uint16 = "uint16_t" requires C99_headers::stdint_h, index TYPE_uint16;
pod type uint32 = "uint32_t" requires C99_headers::stdint_h, index TYPE_uint32;
pod type uint64 = "uint64_t" requires C99_headers::stdint_h, index TYPE_uint64;
Raw Memory

Raw memory operations provide an uninterpreted byte and two address types.

We also provide a mapping of ptrdiff_t which is a signed type holding the result of subtracting two pointers or addresses of the same type.

Finally, we provide signed and unsigned integers of the same size as addresses and pointers which can be used to perform arbitrary integer operations.

//[scalar.flx]
pod type byte = "unsigned char" requires index TYPE_byte;
type caddress = "void *";
_gc_pointer type address = "void *" requires index TYPE_address;

pod type ptrdiff = "ptrdiff_t" requires C89_headers::stddef_h, index TYPE_ptrdiff;

pod type intptr = "intptr_t" requires C99_headers::stdint_h, index TYPE_intptr;
pod type uintptr = "uintptr_t" requires C99_headers::stdint_h, index TYPE_uintptr;
Integer literal constructors.

In Felix, integer types are lifted from C in the library. Therefore, constructors for these types must also be defined in the library, including literals.

In Felix, internally, all literals are represented opaquely. There are three components to a literal: the Felix type, the string value of the lexeme decoded by the parser, and a string representing the C++ value to be emitted by the compiler back end.

The grammar specification consists of regular definitions used to recognize the literal, and decoding routines written in Scheme used to produce the triple required by the compiler.

Floating types

Note that Felix requires the long double type from C99. Also note that the complex types are taken from C++ and not C!

//[scalar.flx]
pod type float = "float" requires index TYPE_float;
pod type double = "double" requires index TYPE_double;
pod type ldouble = "long double" requires index TYPE_ldouble;
pod type fcomplex = "::std::complex<float>" requires Cxx_headers::complex, index TYPE_fcomplex;
pod type dcomplex = "::std::complex<double>" requires Cxx_headers::complex, index TYPE_dcomplex;
pod type lcomplex = "::std::complex<long double>" requires Cxx_headers::complex, index TYPE_lcomplex;
Groupings of the types.

We can define sets of types so they may be used in in function bindings to avoid a lot of repetition.

The typesetof operator takes a comma separated list of parenthesised type names, and represents a finite set of types.

The \(\cup\) operator, spelled \cup, can be used to find the setwise union of two typesets.

//[scalar.flx]
//$ Types associated with raw address calculations.
typedef addressing = typesetof (
  byte,
  address,
  caddress
);

//$ Character types.
typedef chars = typesetof (char);
Integers
//[scalar.flx]
//$ "natural" sized signed integer types.
//$ These correspond to C/C++ core types.
typedef fast_sints = typesetof (tiny, short, int, long, vlong);

//$ Exact sized signed integer types.
//$ In C these are typedefs.
//$ In Felix they're distinct types.
typedef exact_sints = typesetof(int8,int16,int32,int64);

//$ "natural" sized unsigned integer types.
//$ These correspond to C/C++ core types.
typedef fast_uints = typesetof (utiny, ushort, uint, ulong,uvlong);

//$ Exact sized unsigned integer types.
//$ In C these are typedefs.
//$ In Felix they're distinct types.
typedef exact_uints = typesetof (uint8,uint16,uint32,uint64);

//$ Weirdo signed integers types corresponding to
//$ typedefs in C.
typedef weird_sints = typesetof (ptrdiff, ssize, intmax, intptr);

//$ Weirdo unsigned integers types corresponding to
//$ typedefs in C.
typedef weird_uints = typesetof (size, uintmax, uintptr);

//$ All the signed integers.
typedef sints = fast_sints \cup exact_sints \cup weird_sints;

//$ All the usigned integers.
typedef uints = fast_uints \cup exact_uints \cup weird_uints;

//$ All the fast integers.
typedef fast_ints = fast_sints \cup fast_uints;

//$ All the exact integers.
typedef exact_ints = exact_sints \cup exact_uints;

//$ All the integers.
typedef ints = sints \cup uints;
Floats
//[scalar.flx]
//$ All the core floating point types.
typedef floats = typesetof (float, double, ldouble);

//$ All the core approximations to real types.
typedef reals = ints \cup floats;

//$ All the core approximations to complex types.
typedef complexes = typesetof (fcomplex,dcomplex,lcomplex);

//$ All the core approximations to numbers.
typedef numbers = reals \cup complexes;
All Scalars.
//[scalar.flx]
//$ All the basic scalar types.
typedef basic_types = bool \cup numbers \cup chars \cup addressing;

// we define this now, we will open it later...
instance [t in basic_types] Eq[t] {
  fun == : t * t -> bool = "$1==$2";
}

// we open this now even though we haven't developed
// the instances yet....
open[T in basic_types] Show[T];

Package: src/packages/core_type_constructors.fdoc

Core Type Constructors

key file
option.flx share/lib/std/datatype/option.flx
unitsum.flx share/lib/std/datatype/unitsum.flx
tuple.flx share/lib/std/datatype/tuple.flx
slice.flx share/lib/std/datatype/slice.flx
typing.flx share/lib/std/datatype/typing.flx
special.flx share/lib/std/datatype/special.flx
functional.flx share/lib/std/datatype/functional.flx
Core Type Classes
//[special.flx]

// Core types and type classes

typedef any = any;
Type Functors
//[typing.flx]
open class Typing
{
  typedef fun dom(t:TYPE):TYPE =>
    typematch t with
    | ?a -> _ => a
    endmatch
  ;

  typedef fun cod(t:TYPE):TYPE =>
    typematch t with
    | _ -> ?b => b
    endmatch
  ;

  typedef fun prj1(t:TYPE):TYPE =>
    typematch t with
    | ?a * _ => a
    endmatch
  ;

  typedef fun prj2(t:TYPE):TYPE =>
    typematch t with
    | _ * ?b => b
    endmatch
  ;
/*
  // THESE SHOULD PROBABLY BE FIXED OR DELETED
  typedef fun type_lnot(x:TYPE):TYPE=>
    typematch x with
    | 0 => 1
    | _ => 0
    endmatch
  ;

  typedef fun type_land(x:TYPE, y:TYPE):TYPE =>
    typematch (x,  y) with
    | 0, _ => 0
    | _,0 => 0
    | _,_ => 1
    endmatch
  ;

  typedef fun type_lor(x:TYPE, y:TYPE):TYPE=>
    typematch (x,  y) with
    | 0, 0 => 0
    | _,_ => 1
    endmatch
  ;

  typedef fun type_eq(x:TYPE, y:TYPE):TYPE=>
    typematch x with
    | y => typematch y with | x => 1 | _ => 0 endmatch
    | _ => 0
    endmatch
  ;

  typedef fun type_ne (x:TYPE, y:TYPE):TYPE=> type_lnot (type_eq (x , y));

  typedef fun type_le (x:TYPE, y:TYPE):TYPE=>
    typematch x with
    | y => 1
    | _ => 0
    endmatch
  ;

  typedef fun type_ge (x:TYPE, y:TYPE):TYPE=>
    typematch y with
    | x => 1
    | _ => 0
    endmatch
  ;

  typedef fun type_gt (x:TYPE, y:TYPE):TYPE=> type_le (y, x);
  typedef fun type_lt (x:TYPE, y:TYPE):TYPE=> type_ge (y, x);
*/

  // Polymorphic type comparisons, including subtyping AND subsumption
  typedef fun is_subtype (arg:TYPE, param:TYPE):BOOL =>
    subtypematch arg with
    | param => TRUE
    | _ => FALSE
    endmatch
  ;

  typedef fun is_supertype (param:TYPE, arg:TYPE):BOOL =>
    subtypematch arg with
    | param => TRUE
    | _ => FALSE
    endmatch
  ;

  typedef fun type_eq(a:TYPE, b:TYPE):BOOL =>
    typematch a with
    | b => TRUE
    | _ => FALSE
    endmatch
  ;

  const memcount[t] : size = "#memcount";
  const arrayindexcount[t] : size = "#arrayindexcount";
}
Option
//[option.flx]

// Note: some felix internals expect this to be defined here, not in a class, and
// in this order.  Don't mess with it!
publish "option type"
variant opt[T] =
  | None
  | Some of T
;

open class Option {

  instance[T with Show[T]] Str[opt[T]] {
    fun str (x:opt[T]) =>
      match x with
      | Some x => "Some " + (str x)
      | #None => "None"
      endmatch
    ;
  }

  instance[T with Eq[T]] Eq[opt[T]] {
    fun == : opt[T] * opt[T] -> bool =
    | None, None => true
    | Some x, Some y => x == y
    | _ => false
    ;
  }
  inherit[T] Eq[T];

  // Return the value of the option if it has any, otherwise
  // returns the default value provided
  fun or_else[T] (x:opt[T]) (d:T) : T =>
     match x with
     | Some v => v
     | #None => d
     endmatch
     ;

  // Returns the first option if it has the value, otherwise
  // the second option
  fun or_else[T] (x:opt[T]) (alt:opt[T]) : opt[T] =>
     match x with
     | Some _ => x
     | #None => alt
     endmatch
     ;

  // If the option has a value, call the given procedure on it
  proc iter[T] (_f:T->void) (x:opt[T]) =>
    match x with
    | #None => {}
    | Some v => { _f v; }
    endmatch
    ;

  // Convert an option to a list with either zero or one elements
  ctor[T] list[T] (x:opt[T]) =>
    match x with
    | #None => list[T]()
    | Some v => list[T](v)
    endmatch
  ;

  // True if this option has no value
  pure fun is_empty[T] : opt[T] -> 2 =
    | #None => true
    | _ => false
  ;

  // True if this option has a value
  pure fun is_defined[T] : opt[T] -> 2 =
    | #None => false
    | _ => true
  ;

  // Get the optional value; aborts if no value is available
  fun get[T] : opt[T] -> T =
    | Some v => v
  ;

  // If the option has a value, apply the function to it and return a new Some value.
  // If the option has no value, returns None
  fun map[T,U] (_f:T->U) (x:opt[T]): opt[U] =>
    match x with
    | #None => None[U]
    | Some v => Some(_f v)
    endmatch
  ;

  // Mimics the filter operation on a list.
  // If there is a value and the predicate returns false for that value, return
  // None.  Otherwise return the same option object.
  fun filter[T] (P:T -> bool) (x:opt[T]) : opt[T] =>
    match x with
    | Some v => if P(v) then x else None[T] endif
    | #None => x
    endmatch
  ;

  // Make option types iterable.  Iteration will loop once
  // if there is a value.  It's a handy shortcut for using
  // the value if you don't care about the None case.
  gen iterator[T] (var x:opt[T]) () = {
    yield x;
    return None[T];
  }
}

class DefaultValue[T] {
  virtual fun default[T]: 1->T;

  fun or_default[T]  (x:opt[T]) () =>
               x.or_else #default[T]
       ;

}
Slice
//[slice.flx]

open class Slice {
variant slice[T] =
  | Slice_all
  | Slice_from of T
  | Slice_from_counted of T * int /* second arg is count */
  | Slice_to_incl of T
  | Slice_to_excl of T
  | Slice_range_incl of T * T
  | Slice_range_excl of T * T
  | Slice_one of T
  | Slice_none
;

fun min[T with BoundRandomSequence[T]] (x:slice[T]) => match x with
  | ( Slice_all
    | Slice_to_incl _
    | Slice_to_excl
    ) => #minval[T]
  | (Slice_from i
    | Slice_from_counted (i,_)
    | Slice_range_incl (i,_)
    | Slice_range_excl (i,_)
    | Slice_one i
    ) => i
  | Slice_none => #maxval[T]
;
fun max[T with BoundRandomSequence[T]] (x:slice[T]) => match x with
  | ( Slice_all
    | Slice_from _
    ) => #maxval[T]
  | Slice_from_counted (i,n) => pred (advance (n, i))
  | Slice_to_incl i => i
  | Slice_to_excl i => pred i
  | Slice_range_incl (_,i) => i
  | Slice_range_excl (_,i) => pred i
  | Slice_one i => i
  | Slice_none => #minval
;

fun normalise_to_inclusive_range[T with BoundRandomSequence[T]] (x:slice[T]) =>
  let l = x.min in
  let u = x.max in
  if l <= u then Slice_range_incl (l,u)
  else Slice_none[T]
;

fun \cap[T with BoundRandomSequence[T]] (x:slice[T], y:slice[T]) =>
  let l = max (min x, min y) in
  let u = min (max x, max y) in
  if  l <= u then Slice_range_incl (l,u)
  else Slice_none[T]
;

fun \in[T with BoundRandomSequence[T]] (x:T, s:slice[T]) =>
  match s with
  | #Slice_all => true
  | Slice_from i => x >= i
  | Slice_from_counted (i,n) => x >= i and x < advance (n, i)
  | Slice_to_incl j => x <= j
  | Slice_to_excl j => x < j
  | Slice_range_incl (i,j) => x >= i and x <= j
  | Slice_range_excl (i,j) => x >= i and x < j
  | Slice_one i => i == x
  | Slice_none => false
;


gen iterator[T with BoundRandomSequence[T]] (s:slice[T]) =>
  match s with
  | Slice_one x => { yield Some x; return None[T]; }
  | Slice_range_incl (first, last) => slice_range_incl first last
  | Slice_range_excl (first, last) => slice_range_excl first last
  | Slice_to_incl (last) => slice_range_incl #minval[T] last
  | Slice_to_excl (last) => slice_range_excl #minval[T] last
  | Slice_from (first) => slice_range_incl first #maxval[T]
  | Slice_from_counted (first, count) => slice_from_counted first count
  | #Slice_all => slice_range_incl #minval #maxval
  | #Slice_none => { return None[T]; }
  endmatch
;

// Note: guarrantees no overflow
// handles all cases for all integers correctly
// produces nothing if first > last
gen slice_range_incl[T with BoundRandomSequence[T]] (first:T) (last:T) () = {
  var i = first;
  while i < last do
    yield Some i;
    i = succ i;
  done
  if i == last perform yield Some i;
  return None[T];
}

gen slice_range_excl[T with BoundRandomSequence[T]] (first:T) (limit:T) () = {
  var i = first;
  while i < limit do
    yield Some i;
    i = succ i;
  done
  return None[T];
}


gen slice_from_counted[T with BoundRandomSequence[T]] (first:T) (count:int) () = {
  var k = count;
  while k > 0 do
    yield Some (advance (count - k, first));
    k = k - 1;
  done
  return None[T];
}

// hack so for in f do .. done will work too
gen iterator[t] (f:1->opt[t]) => f;

// slice index calculator

// Given length n, begin b and end e indicies
// normalise so either 0 <= b <= e <= n or m = 0
//
// if m = 0 ignore b,e and use empty slice
// otherwise return a slice starting at b inclusive
// and ending at e exclusive, length m > 0

// Normalised form allows negative indices.
// However out of range indices are trimmed back:
// the calculation is NOT modular.

fun cal_slice (n:int, var b:int, var e:int) = {
  if b<0 do b = b + n; done
  if b<0 do b = 0; done
  if b>=n do b = n; done
  // assert 0 <= b <= n (valid index or one past end)
  if e<0 do  e = e + n; done
  if e<0 do  e = 0; done
  if e>=n do e = n; done
  // assert 0 <= e <= n (valid index or one pas end)
  var m = e - b;
  if m<0 do m = 0; done
  // assert 0 <= m <= n (if m > 0 then b < e else m = 0)
  return b,e,m;
  // assert m = 0 or  0 <= b <= e <= n and 0 < m < n
}

variant gslice[T] =
  | GSlice of slice[T]
  | GSSList of list[gslice[T]]
  | GSIList of list[T]
  | GSIter of 1 -> opt[T]
  | GSMap of (T -> T) * gslice[T]
;

gen gslist_iterator[T with Integer[T]] (ls: list[gslice[T]]) () : opt[T] =
{
  var current = ls;
next:>
  match current with
  | #Empty => return None[T];
  | Cons (gs, tail) =>
    for v in gs do yield Some v; done
    current = tail;
    goto next;
  endmatch;
}

gen gsmap_iterator[T] (f:T->T) (var gs:gslice[T]) () : opt[T] =
{
  for v in gs do yield v.f.Some; done
  return None[T];
}

gen iterator[T with Integer[T]] (gs:gslice[T]) =>
  match gs with
  | GSlice s => iterator s
  | GSSList ls => gslist_iterator ls
  | GSIList ls => iterator ls
  | GSIter it => it
  | GSMap (f,gs) => gsmap_iterator f gs
;

fun +[T with Integer[T]] (x:gslice[T], y:gslice[T]) =>
  GSSList (list (x,y))
;

fun +[T with Integer[T]] (x:gslice[T], y:slice[T]) =>
 x + GSlice y
;

fun +[T with Integer[T]] (x:slice[T], y:gslice[T]) =>
 GSlice x + y
;

fun +[T with Integer[T]] (x:slice[T], y:slice[T]) =>
 GSlice x + GSlice y
;

fun map[T with Integer[T]] (f:T->T) (gs:gslice[T]) =>
  GSMap (f,gs)
;
}
Operations on sums of units

Treated as finite cyclic groups.

//[unitsum.flx]

// -----------------------------------------------------------------------------
typedef void = 0;
typedef unit = 1;

instance Str[void] {
  fun str (x:void) => "void";
}
open Show[void];


instance Str[unit] {
  fun str (x:unit) => "()";
}
open Show[unit];

instance[T:UNITSUM] Eq[T] {
  fun == (x:T,y:T) => caseno x ==caseno y;
}
instance[T:UNITSUM] Tord[T] {
  fun < (x:T,y:T) => caseno x < caseno y;
}
instance[T:UNITSUM] ForwardSequence[T] {
  fun succ (x:T) => (caseno x + 1) :>> T;
}
instance[T:UNITSUM] BidirectionalSequence[T] {
  fun pred (x:T) => (caseno x - 1) :>> T;
}
instance[T:UNITSUM] UpperBoundTotalOrder[T] {
  fun maxval () => (memcount[T].int - 1) :>> T;
}

instance[T:UNITSUM] LowerBoundTotalOrder[T] {
  fun minval () => 0 :>> T;
}

instance[T:UNITSUM] RandomSequence[T] {
  fun advance (amt: int,  pos:T) => (caseno pos + amt) :>> T;
}
open[T:UNITSUM] BoundRandomSequence[T];


typedef fun n"`+" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_add",(x,y),UNITSUM);
typedef fun n"`-" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_diff",(x,y),UNITSUM);
typedef fun n"`*" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_mul",(x,y),UNITSUM);
typedef fun n"`/" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_div",(x,y),UNITSUM);
typedef fun n"`%" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_mod",(x,y),UNITSUM);

typedef fun n"_unitsum_min" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_min",(x,y),UNITSUM);
typedef fun n"_unitsum_max" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_max",(x,y),UNITSUM);
typedef fun n"_unitsum_gcd" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_gcd",(x,y),UNITSUM);
typedef fun n"_unitsum_lcm" (x:UNITSUM,y:UNITSUM):UNITSUM => _typeop ("_unitsum_lcm",(x,y),UNITSUM);

typedef fun n"`<" (x:UNITSUM,y:UNITSUM):BOOL=> _typeop ("_unitsum_lt",(x,y),BOOL);
typedef fun n"`>" (x:UNITSUM,y:UNITSUM):BOOL=> _typeop ("_unitsum_lt",(y,x),BOOL);
typedef fun n"`==" (x:UNITSUM,y:UNITSUM):BOOL=> x `< y and y `< x;

// —————————————————————————–

Category Theoretic Functional Operations
//[functional.flx]

//$ Categorical Operators
open class Functional
{
  // note: in Felix, products are uniquely decomposable, but arrows
  // are not. So we cannot overload based on arrow factorisation.
  // for example, the curry functions can be overloaded but
  // the uncurry functions cannot be

  // Note: Felix is not powerful enough to generalise these
  // operation in user code, i.e. polyadic programming

  //$ change star into arrow (2 components)
  fun curry[u,v,r] (f:u*v->r) : u -> v -> r => fun (x:u) (y:v) => f (x,y);

  //$ change star into arrow (3 components)
  fun curry[u,v,w,r] (f:u*v*w->r) : u -> v -> w -> r => fun (x:u) (y:v) (z:w) => f (x,y,z);

  //$ change arrow into star (arity 2)
  fun uncurry2[u,v,r] (f:u->v->r) : u * v -> r => fun (x:u,y:v) => f x y;

  //$ change arrow into star (arity 3)
  fun uncurry3[u,v,w,r] (f:u->v->w->r) : u * v * w -> r => fun (x:u,y:v,z:w) => f x y z;

  //$ argument order permutation (2 components)
  fun twist[u,v,r] (f:u*v->r) : v * u -> r => fun (x:v,y:u) => f (y,x);

  //$ projection 1 (2 components)
  fun proj1[u1,u2,r1,r2] (f:u1*u2->r1*r2) : u1 * u2 -> r1 =>
    fun (x:u1*u2) => match f x with | a,_ => a endmatch;

  //$ projection 2 (2 components)
  fun proj2[u1,u2,r1,r2] (f:u1*u2->r1*r2) : u1 * u2 -> r2 =>
    fun (x:u1*u2) => match f x with | _,b => b endmatch;

  // aka \delta or diagonal function
  fun dup[T] (x:T) => x,x;

  //$ unique product (of above projections)
  // if f: C-> A and g: C -> B there is a unique function
  // <f,g>: C -> A * B such that f = <f,g> \odot \pi0 and
  // g = <f,g> \odot pi1
  // WHAT IS THE FUNCTION CALLED?

  fun prdx[u1,r1,r2] (f1:u1->r1,f2:u1->r2) : u1 -> r1 * r2 =>
    fun (x1:u1) => f1 x1, f2 x1;

  //$ series composition (2 functions)
  fun compose[u,v,w] (f:v->w, g:u->v) : u -> w =>
    fun (x:u) => f (g x)
  ;

  fun \circ [u,v,w] (f:v->w, g:u->v) : u -> w =>
    fun (x:u) => f (g x)
  ;

  //$ series reverse composition (2 functions)
  fun rev_compose[u,v,w] (f:u->v, g:v->w) : u -> w =>
    fun (x:u) => g (f x)
  ;

  //$ series reverse composition (2 functions)
  fun \odot[u,v,w] (f:u->v, g:v->w) : u -> w =>
    fun (x:u) => g (f x)
  ;

  //$ series reverse composition (2 functions)
  fun \cdot[u,v,w] (f:u->v, g:v->w) : u -> w =>
    fun (x:u) => g (f x)
  ;


}
Tuples
//[tuple.flx]

//------------------------------------------------------------------------------
// Class Str: convert to string

// Tuple class for inner tuple listing
class Tuple[U] {
  virtual fun tuple_str (x:U) => str x;
}

instance[U,V with Str[U], Tuple[V]] Tuple[U ** V] {
  fun tuple_str (x: U ** V) =>
    match x with
    | a ,, b => str a +", " + tuple_str b
    endmatch
  ;
}

instance[U,V with Str[U], Str[V]] Tuple[U * V] {
  fun tuple_str (x: U * V) =>
    match x with
    | a , b => str a +", " + str b
    endmatch
  ;
}

// actual Str class impl.
instance [U, V with Tuple[U ** V]] Str[U ** V] {
  fun str (x: U ** V) => "(" + tuple_str x +")";
}

instance[T,U] Str[T*U] {
   fun str (t:T, u:U) => "("+str t + ", " + str u+")";
}
instance[T] Str[T*T] {
   fun str (t1:T, t2:T) => "("+str t1 + ", " + str t2+")";
}

open[U, V with Tuple[U **V]] Str [U**V];
open[U, V with Str[U], Str[V]] Str [U*V];


//------------------------------------------------------------------------------
// Class Eq: Equality
instance [T,U with Eq[T], Eq[U]] Eq[T ** U] {
  fun == : (T ** U) * (T ** U) -> bool =
  | (ah ,, at) , (bh ,, bt) => ah == bh and at == bt;
  ;
}

instance[t,u with Eq[t],Eq[u]] Eq[t*u] {
  fun == : (t * u) * (t * u) -> bool =
  | (x1,y1),(x2,y2) => x1==x2 and y1 == y2
  ;
}

instance[t with Eq[t]] Eq[t*t] {
  fun == : (t * t) * (t * t) -> bool =
  | (x1,y1),(x2,y2) => x1==x2 and y1 == y2
  ;
}

//------------------------------------------------------------------------------
// Class Tord: Total Order
instance [T,U with Tord[T], Tord[U]] Tord[T ** U] {
  fun < : (T ** U) * (T ** U) -> bool =
  | (ah ,, at) , (bh ,, bt) => ah < bh or ah == bh and at < bt;
  ;
}

instance[t,u with Tord[t],Tord[u]] Tord[t*u] {
  fun < : (t * u) * (t * u) -> bool =
  | (x1,y1),(x2,y2) => x1 < x2 or x1 == x2 and y1 < y2
  ;
}
instance[t with Tord[t]] Tord[t*t] {
  fun < : (t * t) * (t * t) -> bool =
  | (x1,y1),(x2,y2) => x1 < x2 or x1 == x2 and y1 < y2
  ;
}
open [T,U with Tord[T], Tord[U]] Tord[T ** U];
open [T,U with Tord[T], Tord[U]] Tord[T * U];

/* type equality now requires type_eq!
//------------------------------------------------------------------------------
// Generic Field access
fun field[n,t,u where n==0] (a:t,b:u)=>a;
fun field[n,t,u where n==1] (a:t,b:u)=>b;

fun field[n,t,u,v where n==0] (a:t,b:u,c:v)=>a;
fun field[n,t,u,v where n==1] (a:t,b:u,c:v)=>b;
fun field[n,t,u,v where n==2] (a:t,b:u,c:v)=>c;

fun field[n,t,u,v,w where n==0] (a:t,b:u,c:v,d:w)=>a;
fun field[n,t,u,v,w where n==1] (a:t,b:u,c:v,d:w)=>b;
fun field[n,t,u,v,w where n==2] (a:t,b:u,c:v,d:w)=>c;
fun field[n,t,u,v,w where n==3] (a:t,b:u,c:v,d:w)=>d;

fun field[n,t,u,v,w,x where n==0] (a:t,b:u,c:v,d:w,e:x)=>a;
fun field[n,t,u,v,w,x where n==1] (a:t,b:u,c:v,d:w,e:x)=>b;
fun field[n,t,u,v,w,x where n==2] (a:t,b:u,c:v,d:w,e:x)=>c;
fun field[n,t,u,v,w,x where n==3] (a:t,b:u,c:v,d:w,e:x)=>d;
fun field[n,t,u,v,w,x where n==4] (a:t,b:u,c:v,d:w,e:x)=>e;
*/

//------------------------------------------------------------------------------
open class parallel_tuple_comp
{
  //$ parallel composition
  // notation: f \times g
  fun ravel[u1,u2,r1,r2] (f1:u1->r1,f2:u2->r2) : u1 * u2 -> r1 * r2 =>
    fun (x1:u1,x2:u2) => f1 x1, f2 x2;

  fun ravel[u1,u2,u3,r1,r2,r3] (
     f1:u1->r1,
     f2:u2->r2,
     f3:u3->r3
    ) : u1 * u2 * u3 -> r1 * r2 * r3 =>
    fun (x1:u1,x2:u2,x3:u3) => f1 x1, f2 x2, f3 x3;

  fun ravel[u1,u2,u3,u4,r1,r2,r3,r4] (
     f1:u1->r1,
     f2:u2->r2,
     f3:u3->r3,
     f4:u4->r4
    ) : u1 * u2 * u3 * u4 -> r1 * r2 * r3 * r4=>
    fun (x1:u1,x2:u2,x3:u3,x4:u4) => f1 x1, f2 x2, f3 x3, f4 x4;

  fun ravel[u1,u2,u3,u4,u5,r1,r2,r3,r4,r5] (
     f1:u1->r1,
     f2:u2->r2,
     f3:u3->r3,
     f4:u4->r4,
     f5:u5->r5
    ) : u1 * u2 * u3 * u4 * u5 -> r1 * r2 * r3 * r4 * r5 =>
    fun (x1:u1,x2:u2,x3:u3,x4:u4,x5:u5) => f1 x1, f2 x2, f3 x3, f4 x4, f5 x5;

}

Package: src/packages/grammars.fdoc

key file
grammars.flx share/lib/std/strings/grammars.flx

Grammars

Grammar
//[grammars.flx]

class Grammars {

typedef generic_gramentry_t[T] = string * T;
typedef generic_gramlib_t[T] = list[generic_gramentry_t[T]];
typedef generic_grammar_t[T] = string * generic_gramlib_t[T];

fun generic_cls[T]
  (generic_add: list[string] -> T -> list[string])
  (lib:generic_gramlib_t[T])
  (unprocessed: list[string])
  (processed:list[string])
: list[string]
=>
  match unprocessed with
  | Empty => processed
  | Cons (h,tail) =>
    if h in processed then generic_cls generic_add lib tail processed else
    match find lib h with
    | Some p =>
      let unprocessed = generic_add tail p in
      generic_cls generic_add lib unprocessed (Cons (h,processed))
    | None =>
      fun_fail[list[string]] ("MISSING NONTERMINAL " + h)
    endmatch
  endmatch
;

fun generic_closure[T]
  (generic_add: list[string] -> T -> list[string])
  (g:generic_grammar_t[T])
: list[string] =>
  match g with
  | start, lib => generic_cls generic_add lib ([start]) Empty[string]
;

// NOTE: this depends on Recognisers, but Recognisers
// depends on Grammars. BAD BAD.

typedef open_prod_t[T] =
(
  | `Terminal of string * Recognisers::recog_t
  | `Nonterminal of string
  | `Epsilon
  | `Seq of list[T]
  | `Alt of list[T]
)
;

typedef prod_t = open_prod_t[prod_t];

instance[T with Str[T]] Str[open_prod_t[T]]
{
  fun str: open_prod_t[T] -> string =
  | `Terminal (s,r) => '"' + s + '"'
  | `Nonterminal name => name
  | `Epsilon => "Eps"
  | `Seq ss => "(" + catmap " " (str of T) ss + ")"
  | `Alt ss => "[" + catmap " | " (str of T) ss + "]"
  ;
}

typedef open_gramentry_t[T] = string * open_prod_t[T];
typedef open_gramlib_t[T] = list[open_gramentry_t[T]];
typedef open_grammar_t[T] = string * open_gramlib_t[T];


typedef gramentry_t = open_gramentry_t[prod_t];
typedef gramlib_t = open_gramlib_t[prod_t];
typedef grammar_t = open_grammar_t[prod_t];
Grammar Operations
Closure
//[grammars.flx]

fun add_unique (acc:list[string]) (elt:string) : list[string] =>
  if elt in acc then acc else Cons (elt,acc)
;

fun open_add_prod[T]
  (aux: list[string] -> T -> list[string])
  (acc:list[string]) (p: open_prod_t[T])
: list[string] =>
  match p with
  | `Terminal _ => acc
  | `Nonterminal name => Cons (name, acc)
  | `Epsilon => acc
  | `Seq ps => fold_left aux acc ps
  | `Alt ps => fold_left aux acc ps
  endmatch
;

fun add_prod(acc:list[string]) (p:prod_t) : list[string] =>
  fix open_add_prod[prod_t] acc p
;

fun closure (g:grammar_t): list[string] =>
  generic_closure[prod_t] add_prod g
;

fun nullable_prod (lib:gramlib_t) (e:prod_t) (trail:list[string]) =>
  match e with
  | `Terminal _ => false
  | `Seq es => fold_left (fun (acc:bool) (sym:prod_t) =>
      acc and (nullable_prod lib sym trail)) true es

  | `Alt es => fold_left (fun (acc:bool) (sym:prod_t) =>
      acc or (nullable_prod lib sym trail)) false es

  | `Nonterminal nt => nullable_nt lib nt trail
  | `Epsilon => true
;

fun nullable_nt (lib: gramlib_t) (nt:string) (trail:list[string]) : bool =>
  if nt in trail then false else
  match find lib nt with
  | None => false
  | Some e => nullable_prod lib e (nt ! trail)
;

fun is_nullable_prod (lib:gramlib_t) (e:prod_t) =>
  nullable_prod lib e Empty[string]
;

fun is_nullable_nt (lib:gramlib_t) (nt:string) =>
  nullable_nt lib nt Empty[string]
;

fun recursive_prod (lib:gramlib_t) (e:prod_t) (orig:string) (trail:list[string]) =>
  match e with
  | `Terminal _ => false
  | `Seq es => fold_left (fun (acc:bool) (sym:prod_t) =>
      acc or (recursive_prod lib sym orig trail)) false es

  | `Alt es => fold_left (fun (acc:bool) (sym:prod_t) =>
      acc or (recursive_prod lib sym orig trail)) false es

  | `Nonterminal nt => if nt == orig then true else recursive_nt lib nt orig trail
  | `Epsilon => false
;

fun recursive_nt (lib: gramlib_t) (nt:string) (orig:string) (trail:list[string]) : bool =>
  if nt in trail then false else
  match find lib nt with
  | None => false
  | Some e => recursive_prod lib e orig (nt ! trail)
;


fun is_recursive_nt (lib:gramlib_t) (nt:string) =>
  recursive_nt lib nt nt Empty[string]
;

fun left_recursive_prod (lib:gramlib_t) (e:prod_t) (orig:string) (trail:list[string]) =>
  match e with
  | `Terminal _ => false

  | `Seq es =>
    let fun aux (es:list[prod_t]) =>
      match es with
      | Empty => false
      | Cons (head, tail) =>
        if left_recursive_prod lib head orig trail then true
        elif is_nullable_prod lib head then aux tail
        else false
      endmatch
    in
    aux es

  | `Alt es => fold_left (fun (acc:bool) (sym:prod_t) =>
      acc or (left_recursive_prod lib sym orig trail)) false es

  | `Nonterminal nt =>
    if nt == orig then true
    else left_recursive_nt lib nt orig trail

  | `Epsilon => false
;

fun left_recursive_nt (lib: gramlib_t) (nt:string) (orig:string) (trail:list[string]) : bool =>
  if nt in trail then false else
  match find lib nt with
  | None => false
  | Some e => left_recursive_prod lib e orig (nt ! trail)
;


fun is_left_recursive_nt (lib:gramlib_t) (nt:string) =>
  left_recursive_nt lib nt nt Empty[string]
;


fun unpack (fresh:1->string) (head:string, p:prod_t) : gramlib_t =
{
 var out = Empty[gramentry_t];
 match p with
 | `Epsilon => out = ([head,p]);
 | `Terminal _ => out = ([head,(`Seq ([p]) :>> prod_t)]);
 | `Nonterminal s => out= ([head,(`Seq ([p]) :>> prod_t)]);

 | `Seq ps =>
   var newseq = Empty[prod_t];
   for term in ps do
     match term with
     | `Epsilon => ;
     | `Nonterminal _ => newseq = term ! newseq;
     | `Terminal _ => newseq = term ! newseq;
     | _ =>
       var newhead = fresh();
       newseq = (`Nonterminal newhead  :>> prod_t) ! newseq;
       out = unpack fresh (newhead,term);
     endmatch;
   done

   match newseq with
   | Empty => out = (head,(#`Epsilon :>> prod_t)) ! out;
   | _ => out = (head,(`Seq (rev newseq) :>> prod_t)) ! out;
   endmatch;

 | `Alt ps =>
   iter (proc (p:prod_t) { out = unpack fresh (head,p) + out; }) ps;
 endmatch;
 return out;
}

fun normalise_lib (fresh:1->string) (lib:gramlib_t) = {
  var normalised = Empty[gramentry_t];
  for p in lib perform
    normalised = unpack fresh p + normalised;
  return normalised;
}

fun sort_merge (g:gramlib_t) : gramlib_t =>
 let fun enlt (a:gramentry_t, b:gramentry_t) : bool => a.0 < b.0 in
 merge (sort enlt g)
;

fun merge (var p:gramlib_t): gramlib_t =
{
 if p.len == 0uz return p;

 var out: gramlib_t;

 var key: string;
 var alts = Empty[prod_t];
 var cur: gramentry_t;

 proc fetch() {
   match p with
   | Cons (head,tail) => cur = head; p = tail;
   | Empty => assert false;
   endmatch;
 }

 proc dohead() { key = cur.0; alts = Empty[prod_t]; }
 proc dofoot() { out = (key,(`Alt alts :>> prod_t)) ! out;  }
 proc dobreak() { dofoot; dohead; }
 proc check() { if key != cur.0 call dobreak; }

 fetch;
 dohead;
 while p.len > 0uz do
   check;
   alts = cur.1 ! alts;
   fetch;
 done
 check;
 alts = cur.1 ! alts;
 dofoot;
 return out;
}

} // class Grammar

Package: src/packages/lists.fdoc

key file
list.flx share/lib/std/datatype/list.flx
assoc_list.flx share/lib/std/datatype/assoc_list.flx
ralist.flx share/lib/std/datatype/ralist.flx
sexpr.flx share/lib/std/datatype/sexpr.flx
lsexpr.flx share/lib/std/datatype/lsexpr.flx
dlist.flx share/lib/std/datatype/dlist.flx

Functional List

The list type.

The core data type for most functional programming languages.

//[list.flx]
open class List
{
  variant list[T] = | Empty | Snoc of list[T] * T;
  fun _match_ctor_Cons[T] : list[T] -> bool = "!!$1";
  inline fun _ctor_arg_Cons[T]: list[T] -> T * list[T] =
    "reinterpret<#0>(flx::list::snoc2cons<?1>($1))"
    requires snoc2cons_h
  ;
  inline fun Cons[T] (h:T, t:list[T]) => Snoc (t,h);

  header snoc2cons_h = """
    namespace flx { namespace list {
      template<class T> struct snoc { void *mem_0; T mem_1; };
      template<class T> struct cons { T mem_0; void * mem_1; };
      template<class T> cons<T> snoc2cons (void *x) {
        return cons<T> {((snoc<T>*)x)->mem_1, ((snoc<T>*)x)->mem_0};
      }
    }}
  """;
Splice

This is primarily a non-functional helper routine.

//[list.flx]
  //$ The second list is made the tail of the
  //$ list stored at the location pointed at by the first argument.
  //$ If the first list is empty, the variable will point
  //$ at the second list. This operation is DANGEROUS because
  //$ it is a mutator: lists are traditionally purely functional.

  // NOTE: this will fail if the second argument is named "p"!
  // fix as for rev, rev_last!
  proc splice[T] : &list[T] * list[T] =
    """
    { // list splice
      //struct node_t { ?1 elt; void *tail; };
      struct node_t { void *tail; ?1 elt; };
      void **p = $1;
      while(*p) p = &((node_t*)FLX_VNP(*p))->tail;
      *p = $2;
    }
    """
  ;
In-place unsafe reversal.

Another helper routine.

//[list.flx]
  //$ In place list reversal: unsafe!
  // second arg is a dummy to make overload work
  proc rev[T,PLT=&list[T]] : &list[T] = "_rev($1,(?1*)0);" requires _iprev_[T,PLT];

  body _iprev_[T,PLT]=
    """
    static void _rev(?2 plt, ?1*) // second arg is a dummy
    { // in place reversal
      //struct node_t { ?1 elt; void *tail; };
      struct node_t { void *tail; ?1 elt; };
      void *nutail = 0;
      void *cur = *plt;
      while(cur)
      {
        void *oldtail = ((node_t*)FLX_VNP(cur))->tail;   // save old tail in temp
        ((node_t*)FLX_VNP(cur))->tail = nutail;          // overwrite current node tail
        nutail = cur;                                   // set new tail to current
        cur = oldtail;                                  // set current to saved old tail
      }
      *plt = nutail;                                    // overwrite
    }
    """
  ;
In-place reversal.

Another variant of the unsafe reversal.

//[list.flx]
  // in place list reversal, also returns the last element
  // as a list, empty iff the original list is
  // unsafe!
  proc rev_last[T,PLT=&list[T]] : &list[T] * &list[T] = "_rev_last($1,$2,(?1*)0);" requires _rev_last_[T,PLT];

  body _rev_last_[T,PLT]=
    """
    static void _rev_last(?2 p1, ?2 p2, ?1*)
    { // in place reversal returns tail as well
      //struct node_t { ?1 elt; void *tail; };
      struct node_t { void *tail; ?1 elt; };
      void *nutail = (void*)0;                 // new temp tail
      void *cur = *p1;                         // list to reverse
      void *last = cur;                        // save head
      while(cur)
      {
        void *oldtail = ((node_t*)FLX_VNP(cur))->tail;            // set old tail to current's tail
        ((node_t*)FLX_VNP(cur))->tail = nutail;                   // set current's tail to nutail
        nutail = cur;                                            // set nutail to current
        cur = oldtail;                                           // set current to old tail
      }
      *p1 = nutail;                                              // reversed list
      *p2 = last;                                                // original lists tail
    }
    """
  ;
List copy

Make an entirely new copy of a list. Primarily a helper.

//[list.flx]
  //$ Copy a list.
  fun copy[T] (x:list[T]):list[T]= {
    var y = rev x;
    rev (&y);
    return y;
  }
Copy and return last copy_last

Yet another helper.

//[list.flx]
  //$ Copy a list, and return last element as a list,
  //$ empty if original list was empty.
  proc copy_last[T] (inp:list[T], out:&list[T], last:&list[T]) {
    out <- rev inp;
    rev_last (out, last);
  }
Constructors
Named constructor for empty list.
//[list.flx]
  //$ Make an empty list.
  ctor[T] list[T] () => Empty[T];
Construct a singleton list.

Does not work if the argument is an array or option iterator.

//[list.flx]
  //$ Make a list with one element.
  //$ NOTE: list (1,2) is a list of 2 ints.
  //$ To get a list of one pair use list[int*int] (1,2) instead!
  ctor[T] list[T] (x:T) => Snoc(Empty[T],x);
Construct a list from an array.
//[list.flx]
  //$ Make a list from an array.
  ctor[T,N] list[T] (x:array[T, N]) = {
    var o = Empty[T];
    if x.len > 0uz do
      for var i in x.len.int - 1 downto 0 do
        o = Snoc(o,x.i);
      done
    done
    return o;
  }
List comprehension.

Make a list from an option stream. Named variant.

//[list.flx]
  //$ List comprehension:
  //$ Make a list from a stream.
  fun list_comprehension[T] (f: (1->opt[T])) = {
    var ff = f;
    fun aux (l:list[T]) = {
      var x = ff();
      return
        match x with
       | Some elt => aux (Snoc(l,elt))
       | #None => rev l
       endmatch
      ;
    }
    return aux Empty[T];
  }
List comprehension.

Make a list from an option stream. Constructor variant.

//[list.flx]
//$ List comprehension:
  //$ Make a list from a stream.
  ctor[T] list[T](f: (1->opt[T])) => list_comprehension f;
Construe a list as an array value.
//[list.flx]
  //$ Contrue a list as an array value
  instance[T] ArrayValue[list[T],T] {

//[list.flx]
    //$ Return umber of elements in a list.
    pure fun len (x:list[T]) = {
      fun aux (acc:size) (x:list[T]) =>
        match x with
        | #Empty => acc
        | Snoc(t,_) => aux (acc + 1uz) t
        endmatch
      ;
      return aux 0uz x;
    }

//[list.flx]
    //$ get n'th element
    pure fun unsafe_get: list[T] * size -> T =
      | Snoc(_,h), 0uz => h
      | Snoc(t,_), i => unsafe_get (t, i - 1uz)
    ;

//[list.flx]
    //$ Apply a procedure to each element of a list.
    proc iter (_f:T->void) (x:list[T]) {
      match x with
      | #Empty => {}
      | Snoc(t,h) => { _f h; iter _f t; }
      endmatch
      ;
    }

//[list.flx]
    //$ Traditional left fold over list (tail rec).
    fun fold_left[U] (_f:U->T->U) (init:U) (x:list[T]):U =
    {
      fun aux (init:U) (x:list[T]):U =>
        match x with
        | #Empty => init
        | Snoc(t,h) => aux (_f init h) t
        endmatch
      ;
      return aux init x;
    }

//[list.flx]
    //$ Right fold over list (not tail rec!).
    fun fold_right[U] (_f:T->U->U) (x:list[T]) (init:U):U =
    {
      fun aux (x:list[T]) (init:U):U =>
        match x with
        | #Empty => init
        | Snoc(t,h) => _f h (aux t init)
        endmatch
      ;
      return aux x init;
    }

  }
Destructors
Test for empty list is_empty
//[list.flx]
  //$ Test if a list is empty.
  pure fun is_empty[T] : list[T] -> 2 =
    | #Empty => true
    | _ => false
  ;
Tail of a list tail
//[list.flx]
  //$ Tail of a list, abort with match failure if list is empty.
  pure fun tail[T] (x:list[T]) : list[T] = {
    match x with
    | Snoc(t,_) => return t;
    endmatch;
  }
Head of a list head
//[list.flx]
  //$ Head of a list, abort with match failure if list is empty.
  pure fun head[T] (x:list[T]) : T = {
    match x with
    | Snoc(_,h) => return h;
    endmatch;
  }
Maps
Reverse map a list rev_map

Tail recursive.

//[list.flx]
  //$ map a list, return mapped list in reverse order (tail rec).
  fun rev_map[T,U] (_f:T->U) (x:list[T]): list[U] = {
    fun aux (inp:list[T]) (out:list[U]) : list[U] =>
      match inp with
      | #Empty => out
      | Snoc(t,h) => aux t (Snoc(out,_f(h)))
      endmatch
    ;
    return aux x Empty[U];
  }
Map a list map

Tail recursive. Uses rev_map and then inplace revseral. This is safe because we enforce linearity by abstraction.

//[list.flx]
  //$ map a list (tail-rec).
  //  tail rec due to in-place reversal of result.
  fun map[T,U] (_f:T->U) (x:list[T]): list[U] =
  {
    var r = rev_map _f x;
    rev$ &r;
    return r;
  }
Reverse a list rev.

Tail recursive.

//[list.flx]
  //$ reverse a list (tail rec).
  pure fun rev[T] (x:list[T]):list[T]= {
    fun aux (x:list[T]) (y:list[T]) : list[T] =
    {
      return
        match x with
        | #Empty => y
        | Snoc(t,h) => aux t (Snoc(y,h))
        endmatch
      ;
    }
    return aux x Empty[T];
  }

  fun urev[T](x:list[T]) => box (rev x);
  fun urev[T](var x:uniq (list[T])) : uniq (list[T]) {
    var y = unbox x;
    rev &y;
    return box y;
  }
Zip a pair of lists to a list of pairs zip2

Returns a list the length of the shortest argument.

//[list.flx]
  //$ Zip two lists into a list of pairs.
  //$ Zips to length of shortest list.
  fun zip2[T1,T2] (l1: list[T1]) (l2: list[T2]) : list[T1 * T2] =
  {
    fun aux (l1: list[T1]) (l2: list[T2]) (acc: list[T1 * T2]) =>
      match l1, l2 with
      | Snoc(t1,h1), Snoc(t2,h2) => aux t1 t2 (Snoc (acc, (h1, h2)))
      | _ => rev acc
      endmatch
    ;
    return aux l1 l2 Empty[T1 * T2];
  }
Useful lists
A list of integers range.

From low to high exclusive with given step.

//[list.flx]
  //$ Generate an ordered list of ints between low and high with given step.
  //$ Low included, high not included.
  fun range (low:int, high:int, step:int) =
  {
    fun inner(low:int, high:int, step:int, values:list[int]) =
    {
      return
        if high < low
          then values
          else inner(low, high - step, step, Snoc(values,high))
          endif
      ;
    }

    // reverse low and high so we can do negative steps
    lo, hi, s := if low < high
      then low, high, step
      else high, low, -step
      endif;

    // adjust the high to be the actual last value so we don't
    // have to reverse the list
    n := hi - lo - 1;

    return if s <= 0
      then Empty[int]
      else inner(lo, lo + n - (n % s), s, Empty[int])
      endif
    ;
  }
Consecutive integers range
//[list.flx]
  //$ Range with step 1.
  fun range (low:int, high:int) => range(low, high, 1);
Non-negative integers to limit range
//[list.flx]
  //$ Range from 0 to num (excluded).
  fun range (num:int) => range(0, num, 1);
Operators
Concatenate two lists join.
//[list.flx]
  //$ Concatenate two lists.
  fun join[T] (x:list[T]) (y:list[T]):list[T] =
  {
    if is_empty x do
      return y;
    else
      var z: list[T];
      var last: list[T];
      copy_last (x,&z,&last);
      splice (&last, y);
      return z;
    done;
  }

  //$ Concatenate two lists.
  pure fun + [T] (x:list[T], y: list[T]):list[T] => join x y;

  proc += [T] (x:&list[T], y: list[T]) => x <- join (*x) y;
Cons an element onto a list.
//[list.flx]
  //$ Prepend element to head of list.
  pure fun + [T] (x:T, y:list[T]):list[T] => Snoc(y,x);
Append an element onto a list.

O(N) slow.

//[list.flx]
  //$ Append element to tail of list (slow!).
  noinline fun + [T] (x:list[T], y:T):list[T] => rev$ Snoc (rev x,y);

  //$ Append element to tail of list (slow!).
  proc += [T] (x:&list[T], y:T) { x <- *x + y; }

  //$ Prepend element to head of list (fast!).
  proc -= [T] (x:&list[T], y:T) { x <- y ! *x; }
Outer product.

Given a list of lists of T named x and a list of lists of T named y, return a list of lists of T, consisting of every combination xelt + yelt where e in x, f in y.

Note: this is a special case of a second order fold.

//[list.flx]

noinline fun outer_product[T] (x:list[list[T]]) (y:list[list[T]]): list[list[T]] =
{
  var res = Empty[list[T]];

  for xelt in x
  for yelt in y
    perform res = (xelt + yelt) ! res;
  return res;
}
Concatenate a list of lists cat
//[list.flx]
  //$ Concatenate all the lists in a list of lists.
  noinline fun cat[T] (x:list[list[T]]):list[T] =
  {
     return
       match x with
       | #Empty => Empty[T]
       | Snoc(t,h) => fold_left join of (list[T]) h t
       endmatch
     ;
   }
Lists and Strings
Pack list of strings into a string with separator cat
//[list.flx]
  //$ Concatenate all the strings in a list with given separator.
  pure fun cat (sep:string) (x:list[string]):string =
  {
    var n = 0uz;
    for s in x perform n += s.len+1uz;
    var r = "";
    reserve (&r,n);
    match x with
    | #Empty => return r;
    | Snoc (tail, head) =>
      r = head;
      var tl = tail;
  next:>
      match tl with
      | #Empty => return r;
      | Snoc(t,h) =>
        r += sep + h;
        tl = t;
        goto next;
      endmatch;
    endmatch;
    return r;
  }
Map a list to a list of strings and cat with separator catmap
//[list.flx]
  fun catmap[T] (sep:string) (f:T -> string) (ls: list[T]) =>
    cat sep (map f ls)
  ;

  fun strcat[T with Str[T]]  (sep: string) (ls: list[T]) =>
    catmap sep (str of (T)) ls
  ;

  fun strcat[T with Str[T]]  (ls: list[T]) =>
    catmap ", " (str of (T)) ls
  ;
Searching
Value membership
//[list.flx]
  //$ Return true if one value in a list satisfies the predicate.
  fun mem[T] (eq:T -> bool) (xs:list[T]) : bool =>
    match xs with
    | #Empty => false
    | Snoc(t,h) => if eq(h) then true else mem eq t endif
    endmatch
  ;

  //$ Return true if one value in the list satisfies the relation
  //$ in the left slot with
  //$ the given element on the right slot.
  fun mem[T, U] (eq:T * U -> bool) (xs:list[T]) (e:U) : bool =>
    mem (fun (x:T) => eq(x, e)) xs
  ;

  //$ Construe a list as a set, imbuing it with a membership
  //$ test, provided the element type has an equality operator.
  instance[T with Eq[T]] Set[list[T],T] {
    fun \in (x:T, a:list[T]) => mem[T,T] eq of (T * T) a x;
  }
Value Find by relation find

Returns option.

//[list.flx]
  //$ return option of the first element in a list satisfying the predicate.
  fun find[T] (eq:T -> bool) (xs:list[T]) : opt[T] =>
    match xs with
    | #Empty => None[T]
    | Snoc(t,h) => if eq(h) then Some h else find eq t endif
    endmatch
  ;


  //$ Return option the first value in the list satisfies the relation
  //$ in the left slot with
  //$ the given element on the right slot.
  fun find[T, U] (eq:T * U -> bool) (xs:list[T]) (e:U) : opt[T] =>
    find (fun (x:T) => eq(x, e)) xs;
  ;

  //$ Return a sub list with elements satisfying the given predicate.
  noinline fun filter[T] (P:T -> bool) (x:list[T]) : list[T] =
  {
    fun aux (inp:list[T], out: list[T]) =>
      match inp with
      | #Empty => rev out
      | Snoc(t,h) =>
        if P(h) then aux(t,Snoc(out,h))
        else aux (t,out)
        endif
      endmatch
    ;
    return aux (x,Empty[T]);
  }

  //$ Push element onto front of list if there isn't one in the
  //$ list already satisfying the relation.
  fun prepend_unique[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] =>
    if mem eq x e then x else Snoc(x,e) endif
  ;

  //$ Attach element to tail of list if there isn't one in the
  //$ list already satisfying the relation.
  fun insert_unique[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] =>
    if mem eq x e then x else rev$ Snoc (rev x,e) endif
  ;

  //$ Remove all elements from a list satisfying relation.
  fun remove[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] =>
    filter (fun (y:T) => not eq (e,y)) x
  ;

  //$ Attach element to tail of list if there isn't one in the
  //$ list already satisfying the relation (tail-rec).
  noinline fun append_unique[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] = {
    fun aux (inp:list[T], out: list[T]) =>
      match inp with
      | #Empty => rev$ Snoc(out,e)
      | Snoc(t,h) =>
        if not eq (h, e) then aux(t,Snoc(out,h))
        else aux (t,out)
        endif
      endmatch
    ;
    return aux (x,Empty[T]);
  }

  //$ Take the first k elements from a list.
  fun take[T] (k:int) (lst:list[T]) : list[T] =>
    if k <= 0 then
      list[T] ()
    else
      match lst with
        | #Empty => list[T] ()
        | Snoc(xs,x) => join (list[T] x) (take[T] (k - 1) xs)
      endmatch
    endif
  ;

  //$ Drop the first k elements from a list.
  fun drop[T] (k:int) (lst:list[T]) : list[T] =>
    if k <= 0 then
      lst
    else
      match lst with
        | #Empty => list[T] ()
        | Snoc(xs,x) => drop (k - 1) xs
    endif
  ;

  fun scroll1[T] (left: list[T], right: list[T]) =>
    match left with
    | h ! t => t, h ! right
    | _ => left, right
  ;
  fun scroll[T] (lr:list[T] * list[T]) (n:int) =>
    if n <= 0 then lr else
    scroll (scroll1 lr) (n - 1)
  ;

  // return revhead, tail where revhead is first k elements
  // of lst, in reverse order, and tail is what is left over
  // cannot fail: if k is not big enough the tail just ends
  // up empty and the function is equivalent to rev.
  fun revsplit[T] (k:int) (lst:list[T]) : list[T] * list[T] =>
    let fun aux (k:int) (revhead:list[T]) (tail:list[T]) =>
      if k <=0 then revhead,tail
      else match tail with
      | #Empty => revhead, tail
      | h ! t => aux (k - 1) (h!revhead) t
      endmatch
    in aux k Empty[T] lst
  ;

  fun list_eq[T with Eq[T]] (a:list[T], b:list[T]): bool =>
    match a, b with
    | #Empty, #Empty => true
    | #Empty, _ => false
    | _,#Empty => false
    | Snoc(ta,ha), Snoc(tb,hb) =>
      if not (ha == hb) then false
      else list_eq (ta, tb)
      endif
    endmatch
  ;
  instance[T with Eq[T]] Eq[list[T]] {
    fun ==(a:list[T], b:list[T])=> list_eq(a,b);
  }
Sort
//[list.flx]
  //$ Sort a list with given less than operator, which must be
  //$ total order. Uses varray sort (which uses STL sort).
  fun sort[T] (lt:T*T->bool) (x:list[T])=
  {
    val n = len x;
    var a = varray[T]$ n;
    iter (proc (e:T) { a+=e; }) x;
    sort lt a;
    var r = Empty[T];
    if n > 0uz do
      for var i in n - 1uz downto 0uz do r = Snoc(r,a.i); done
    done
    return r;
  }

  //$ Sort a list with default total order.
  //$ Uses varray sort (which uses STL sort).
  fun sort[T with Tord[T]](x:list[T])=> sort lt x;
Streaming list
//[list.flx]
  instance[T] Iterable[list[T],T] {
  //$ Convert a list to a stream.
    gen iterator (var xs:list[T]) () = {
      while true do
        match xs with
        | Snoc(t,h) => xs = t; yield Some h;
        | #Empty => return None[T];
        endmatch;
      done
    }
  }
  inherit[T] Streamable[list[T],T];

  inherit [T with Str[T]] Str[list[T]];
  inherit [T with Eq[T]] Set[list[T],T];
  inherit[T] ArrayValue[list[T],T];

}

open [T with Eq[T]] Eq[List::list[T]];

//open [T with Str[T]] Str[list[T]];
//open [T with Eq[T]] Set[list[T],T];

// display list as string given element type with str operator
// elements are separated by a comma and one space
instance[T with Show[T]] Str[List::list[T]] {
  noinline fun str (xs:List::list[T]) =>
    'list(' +
      match xs with
      | #Empty => ''
      | Snoc(os,o) =>
          List::fold_left (
            fun (a:string) (b:T):string => a + ', ' + (repr b)
          ) (repr o) os
      endmatch
    + ')'
  ;
}
Association List

A list of pairs

//[assoc_list.flx]
open class Assoc_list
{
  typedef assoc_list[A,B] = List::list[A*B];

  // check is the key (left element) of a pair
  // satisfies the predicate
  fun mem[A,B] (eq:A -> bool) (xs:assoc_list[A,B]) : bool =>
    List::mem (fun (a:A, b:B) => eq a) xs;
  ;

  // check is the key (left element) of a pair
  // satisfies the relation to given element
  fun mem[A,B,T] (eq:A * T -> bool) (xs:assoc_list[A,B]) (e:T) : bool =>
    mem (fun (a:A) => eq(a, e)) xs;
  ;

  instance[A,B] Set[assoc_list[A,B], A] {
    fun mem[A,B with Eq[A]] (xs:assoc_list[A,B]) (e:A) : bool =>
      mem eq of (A * A) xs e
    ;
  }

  // find optionally the first value whose associate key satisfies
  // the given predicate
  fun find[A,B] (eq:A -> bool) (xs:assoc_list[A,B]) : opt[B] =>
    match xs with
    | #Empty => None[B]
    | Snoc (t,(a, b)) => if eq(a) then Some b else find eq t endif
    endmatch
  ;

  // find optionally the first value whose associate key (left slot)
  // satisfies the given relation to the given element (right slot)
  fun find[A,B,T] (eq:A * T -> bool) (xs:assoc_list[A,B]) (e:T) : opt[B] =>
    find (fun (a:A) => eq (a, e)) xs;
  ;

  fun find[A,B with Eq[A]] (xs:assoc_list[A,B]) (e:A) : opt[B] =>
    find eq of (A * A) xs e
  ;
}
Purely Functional Random Access List.
//[ralist.flx]
//$ Purely functional Random Access List.
//$ Based on design from Okasaki, Purely Functional Datastructures.
//$ Transcribed from Hongwei Xi's encoding for ATS2 library.
//$
//$ An ralist provides O(log N) indexed access and amortised
//$ O(1) consing. This is roughly the closest thing to
//$ purely functional array available.

class Ralist
{

  //$ Auxilliary data structure.
  variant pt[a] = | N1 of a | N2 of pt[a] * pt[a];

  //$ Type of an ralist.
  variant ralist[a] =
    | RAnil
    | RAevn of ralist[a]
    | RAodd of pt[a] * ralist[a]
  ;

  //$ Length of an ralist.
  fun ralist_length[a] : ralist[a] -> int =
    | #RAnil => 0
    | RAevn xxs => 2 * ralist_length xxs
    | RAodd (_,xxs) => 2 * ralist_length xxs + 1
  ;

  private fun cons[a] // O(1), amortized
    (x0: pt[a], xs: ralist[a]): ralist [a] =>
    match xs with
    | #RAnil => RAodd (x0, RAnil[a])
    | RAevn xxs => RAodd (x0, xxs)
    | RAodd (x1, xxs) =>
        let x0x1 = N2 (x0, x1) in
        RAevn (cons (x0x1, xxs) )
    endmatch  ;

  //$ Cons: new list with extra value at the head.
  fun ralist_cons[a] (x:a, xs: ralist[a]) =>
    cons (N1 x, xs)
  ;

  //$ Check for an empty list.
  fun ralist_empty[a]: ralist[a] -> bool  =
  | #RAnil => true
  | _ => false
  ;

  private proc uncons[a] (xs: ralist[a], phd: &pt[a], ptl: &ralist[a])
  {
    match xs with
    | RAevn xss =>
      var nxx: pt[a];
      var xxs: ralist[a];
      uncons (xss,&nxx, &xxs);
      match nxx with
      | N2(x0,x1) =>
        phd <- x0;
        ptl <- RAodd (x1,xxs);
      endmatch;

    | RAodd (x0,xss) =>
      phd <- x0;
      match xss with
      | #RAnil => ptl <- RAnil[a];
      | _ => ptl <- RAevn xss;
      endmatch;
    endmatch;
  }

  //$ Proedure to split a non-empty ralist
  //$ into a head element and a tail.
  proc ralist_uncons[a] (xs: ralist[a], phd: &a, ptl: &ralist[a])
  {
    var nx: pt[a];
    uncons (xs, &nx, ptl);
    match nx with
    | N1 (x1) => phd <- x1;
    endmatch;
  }

  //$ User define pattern matching support
  fun _match_ctor_Cons[T] (x:ralist[T]) =>not ( ralist_empty x);
  fun _match_ctor_Empty[T] (x:ralist[T]) => ralist_empty x;

  fun _ctor_arg_Cons[T] (x:ralist[T]) : T * ralist[T] =
  {
    var elt : T;
    var tail : ralist[T];
    ralist_uncons (x, &elt, &tail);
    return elt,tail;
  }


  //$ Head element of a non-empty ralist.
  fun ralist_head[a] (xs: ralist[a]) : a =
  {
    var nx: a;
    var xxs: ralist[a];
    ralist_uncons (xs, &nx, &xxs);
    return nx;
  }

  //$ Tail list of a non-empty ralist.
  fun ralist_tail[a] (xs: ralist[a]) : ralist[a] =
  {
    var nx: a;
    var xxs: ralist[a];
    ralist_uncons (xs, &nx, &xxs);
    return xxs;
  }

  private fun lookup[a]
  (
    xs: ralist [a],
    i: int
  ) : pt[a] =>
    match xs with
    | RAevn xxs =>
      let x01 = lookup (xxs, i/2) in
      if i % 2 == 0 then
        let N2 (x0, _) = x01 in x0
      else
        let N2 (_, x1) = x01 in x1
      endif

    | RAodd (x, xxs) =>
      if i == 0 then x else
        let x01 = lookup (xxs, (i - 1)/2) in
        if i % 2 == 0 then
          let N2 (_, x1) = x01 in x1
        else
          let N2 (x0, _) = x01 in x0
        endif
      endif
    endmatch
  ;

  //$ Random access to an ralist. Unchecked.
  fun ralist_lookup[a] (xs:ralist[a],i:int)=>
    let N1 x = lookup (xs,i) in x
  ;

  private fun fupdate[a]
  (
    xs: ralist[a] ,
    i:int,
    f: pt[a] -> pt[a]
  ) : ralist[a] =>
    match xs with
    | RAevn (xxs) => RAevn (fupdate2 (xxs, i, f))
    | RAodd (x, xxs) =>
      if i == 0 then RAodd (f x, xxs)
      else RAodd (x, fupdate2 (xxs, i - 1, f))
      endif
    endmatch
  ;

  private fun fupdate2[a]
  (
    xxs: ralist[a],
    i: int,
    f: pt[a] -> pt[a]
  ) : ralist[a] =>
      if i % 2 == 0 then
      let f1 =
        fun (xx: pt[a]): pt[a] =>
        let N2 (x0, x1) = xx in N2 (f x0, x1)
      in
      fupdate (xxs, i / 2, f1)
    else
      let f1 =
        fun (xx: pt[a]): pt[a] =>
        let N2 (x0, x1) = xx in N2 (x0, f x1)
      in
      fupdate (xxs, i / 2, f1)
  ;

  //$ Return a list with the i'th element replaced by x0.
  //$ Index is unchecked.
  fun ralist_update[a] (xs:ralist[a], i:int, x0:a) =>
    let f = fun (z:pt[a]) : pt[a] => N1 x0 in
    fupdate (xs,i,f)
  ;

  private proc foreach[a]
  (
    xs: ralist[a],
    f: pt[a] -> void
  )
  {
    match xs with
    | RAevn (xxs) => foreach2 (xxs, f);
    | RAodd (x, xxs) =>
      f x;
      match xxs with
      | #RAnil => ;
      | _ => foreach2 (xxs, f);
      endmatch;
    | #RAnil => ;
    endmatch;
  }

  private proc foreach2[a]
  (
    xxs: ralist[a],
    f: pt[a] -> void
  )
  {
    var f1 =
      proc (xx: pt[a]) {
        match xx with
        | N2 (x0, x1) => f (x0); f (x1);
        endmatch;
      }
    ;
    foreach (xxs, f1);
  }

  //$ Callback based iteration.
  //$ Apply procedure to each element of the ralist.
  proc ralist_foreach[a]
  (
    xs: ralist[a],
    f: a -> void
  )
  {
    var f2 =
      proc (x:pt[a]) {
        match x with
        | N1 y => f y;
        endmatch;
      }
    ;
    foreach (xs, f2);
  }

  //$ Convert ralist to a string.
  instance[a with Str[a]] Str[ralist[a]]
  {
    fun str (xx: ralist[a]):string = {
      var xs = xx;
      var x: a;
      var s = "";
      while not ralist_empty xs do
        ralist_uncons (xs,&x,&xs);
        s += (if s != "" then "," else "") + str x;
      done
      return s;
    }
  }

  // TODO: list membership, folds, etc
}
Dlist

A dlist_t is a doubly linked mutable list. It is suitable for use as non-thread-safe queue.

//[dlist.flx]
class DList[T]
{
  typedef dnode_t=
  (
    data: T,
    next: cptr[dnode_t], // possibly NULL
    prev: cptr[dnode_t]  // possibly NULL
  );
  typedef dlist_t = (first:cptr[dnode_t], last:cptr[dnode_t]);
    // invariant: if first is null, so is last!

  ctor dlist_t () => (first=nullptr[dnode_t],last=nullptr[dnode_t]);
Length len
//[dlist.flx]
  fun len (x:dlist_t) = {
    var n = 0;
    var first : cptr[dnode_t] = x.first;
  again:>
    match first do
    | #nullptr => return n;
    | Ptr p => ++n; first = p*.next;
    done
    goto again;
  }
Inspection
//[dlist.flx]
  fun peek_front (dl:dlist_t) : opt[T] =>
    match dl.first with
    | #nullptr => None[T]
    | Ptr p => Some p*.data
    endmatch
  ;

  fun peek_back (dl:dlist_t) : opt[T] =>
    match dl.last with
    | #nullptr => None[T]
    | Ptr p => Some p*.data
    endmatch
  ;
Insertion
//[dlist.flx]
  proc push_front (dl:&dlist_t, v:T) {
    var oldfirst = dl*.first;
    var node = new (data=v, next=oldfirst, prev=nullptr[dnode_t]);
    dl.first <- Ptr node;
    match oldfirst with
    | #nullptr => dl.last
    | Ptr p => p.prev
    endmatch <- Ptr node;
  }

  proc push_back (dl:&dlist_t, v:T) {
    var oldlast = dl*.last;
    var node = new (data=v, next=nullptr[dnode_t], prev=oldlast);
    dl.last <- Ptr node;
    match oldlast with
    | #nullptr => dl.first
    | Ptr p => p.next
    endmatch <- Ptr node;
  }
Deletion
//[dlist.flx]

  gen pop_front (dl:&dlist_t): opt[T] = {
    match dl*.first do
    | #nullptr => return None[T];
    | Ptr p =>
      match p*.next do
      | #nullptr =>
        dl.first <- nullptr[dnode_t];
        dl.last <- nullptr[dnode_t];
      | _ =>
        dl.first <- p*.next;
      done
      return Some p*.data;
    done
  }

  gen pop_back (dl:&dlist_t): opt[T] = {
    match dl*.last do
    | #nullptr => return None[T];
    | Ptr p =>
      match p*.prev do
      | #nullptr =>
        dl.first <- nullptr[dnode_t];
        dl.last <- nullptr[dnode_t];
      | _ =>
        dl.last <- p*.prev;
      done
      return Some p*.data;
    done
  }
Use as a queue

We can implement enqueue and dequeue at either end, we’ll make enqueue push_front and dequeue pop_back for no particular reason.

//[dlist.flx]
  typedef queue_t = dlist_t;
  proc enqueue (q:&queue_t) (v:T) => push_front (q,v);
  gen dequeue (q:&queue_t) :opt[T] => pop_back q;
  ctor queue_t () => dlist_t ();
Queue iterator

Fetch everything from a queue.

//[dlist.flx]
  gen iterator (q:&queue_t) () => dequeue q;
}
S-expressions

A scheme like data structure.

//[sexpr.flx]
class S_expr
{
  variant sexpr[T] = Leaf of T | Tree of list[sexpr[T]];

  fun fold_left[T,U] (_f:U->T->U) (init:U) (x:sexpr[T]):U =>
    match x with
    | Leaf a => _f init a
    | Tree b => List::fold_left (S_expr::fold_left _f) init b
  ;

  proc iter[T] (_f:T->void) (x:sexpr[T]) {
    match x with
    | Leaf a => _f a;
    | Tree b => List::iter (S_expr::iter _f) b;
    endmatch;
  }

  fun map[T,U] (_f:T->U) (x:sexpr[T]):sexpr[U] =>
    match x with
    | Leaf a => Leaf (_f a)
    | Tree b => Tree ( List::map (S_expr::map _f) b )
  ;

  instance[T with Eq[T]] Set[sexpr[T],T] {
    fun \in (elt:T, x:sexpr[T]) =>
      fold_left (fun (acc:bool) (v:T) => acc or v == elt) false x;
  }
  instance[T with Str[T]] Str[sexpr[T]] {
    noinline fun str(x:sexpr[T])=>
      match x with
      | Leaf a => str a
      | Tree b => str b
    ;
  }

}

open[T with Str[T]] Str[S_expr::sexpr[T]];
open[T with Eq[T]] Set[S_expr::sexpr[T],T];
LS-expressions

A scheme like data structure, similar to sexpr, only in this variant the tree nodes also have labels.

//[lsexpr.flx]
class LS_expr
{
  variant lsexpr[T,L] = | Leaf of T | Tree of L * list[lsexpr[T,L]];

  fun fold_left[T,L,U] (_f:U->T->U) (_g:U->L->U) (init:U) (x:lsexpr[T,L]):U =>
    match x with
    | Leaf a => _f init a
    | Tree (a,b) => List::fold_left (LS_expr::fold_left _f _g) (_g init a) b
  ;

  proc iter[T,L] (_f:T->void) (_g:L->void) (x:lsexpr[T,L]) {
    match x with
    | Leaf a => _f a;
    | Tree (a,b) => _g a; List::iter (LS_expr::iter _f _g) b;
    endmatch;
  }

  fun map[T,L,U,V] (_f:T->U) (_g:L->V) (x:lsexpr[T,L]):lsexpr[U,V] =>
    match x with
    | Leaf a => Leaf[U,V] (_f a)
    | Tree (a,b) => Tree ( _g a, List::map (LS_expr::map _f _g) b )
  ;

  instance[T,L with Str[T], Str[L]] Str[lsexpr[T,L]] {
    noinline fun str(x:lsexpr[T,L])=>
      match x with
      | Leaf a => str a
      | Tree (a,b) => str a + "(" + str b  + ")"
    ;
  }

}

open[T,L with Str[T], Str[L]] Str[LS_expr::lsexpr[T,L]];

Package: src/packages/logic.fdoc

Logic

key file
bool.flx share/lib/std/scalar/bool.flx
predicate.flx share/lib/std/algebra/predicate.flx
staticbool.flx share/lib/std/kind/staticbool.flx
Boolean Logic

We have two kinds of boolean, cbool is the binding to C/C++ bool type which is usually a single byte.

The other kind, bool, is a synonym for type 2, which is a compact linear type and will use a a 64 bit word.

We provide the same operations on both, since as values they’re compatible. However the Felix bool is the standard type.

Pointers to these two types are not compatible. Although a sole bool is much bigger than a cbool, 64 bools can fit in a single machine word, as opposed to only 8 cbools.

//[bool.flx]
typedef bool = 2;
type cbool = "bool" requires index TYPE_cbool;

open class Bool
{
  ctor bool:cbool="$1";

  //$ Short cut and via closure
  noinline fun andthen (x: bool, y:1->bool) : bool =>
    if x then #y else false
  ;

  //$ Short cut and via closure
  noinline fun orelse (x: bool, y:1->bool) : bool =>
    if x then true else #y
  ;

   //$ Disjunction: logical and.
  fun land: bool * bool -> bool = "$1&&$2";      // x and y

  //$ Negated and.
  fun nand: bool * bool -> bool = "!($1&&$2)";   // not (x and y)

  //$ Conjunction: logical or.
  fun lor: bool * bool -> bool = "$1||$2";       // x or y

  //$ Negated or.
  fun nor: bool * bool -> bool = "!($1||$2)";    // not (x or y)

  //$ Logical exclusive or.
  fun xor: bool * bool -> bool = "$1!=$2";       // (x or y) and not (x and y)

  //$ Logical negation.
  fun lnot: bool -> bool = "!$1";                // not x

  //$ Logical implication.
  fun implies: bool * bool -> bool = "!$1||$2";  // not x or y

  //$ Mutating or.
  proc |= : &bool * bool = "*$1|=$2;";

  //$ Mutating and.
  proc &= : &bool * bool = "*$1&=$2;";

  // Elide double negations.
  //reduce dneg(x:bool): lnot (lnot x) => x;
  // Elide double negations.
  //reduce dneg(x:bool,y:bool): lnot (nand(x,y)) => land(x,y);
  // Elide double negations.
  //reduce dneg(x:bool,y:bool): lnot (nor(x,y)) => lor(x,y);
}

//$ Standard operations on cboolean type.
open class CBool
{
  ctor cbool:bool="$1";
  const cfalse: cbool="false";
  const ctrue: cbool="true";

  //$ Short cut and via closure
  noinline fun andthen (x: cbool, y:1->cbool) : cbool =>
    if x then #y else cfalse
  ;

  //$ Short cut and via closure
  noinline fun orelse (x: cbool, y:1->cbool) : cbool =>
    if x then ctrue else #y
  ;

  //$ Disjunction: logical and.
  fun land: cbool * cbool -> cbool = "$1&&$2";      // x and y

  //$ Negated and.
  fun nand: cbool * cbool -> cbool = "!($1&&$2)";   // not (x and y)

  //$ Conjunction: logical or.
  fun lor: cbool * cbool -> cbool = "$1||$2";       // x or y

  //$ Negated or.
  fun nor: cbool * cbool -> cbool = "!($1||$2)";    // not (x or y)

  //$ Logical exclusive or.
  fun xor: cbool * cbool -> cbool = "$1!=$2";       // (x or y) and not (x and y)

  //$ Logical negation.
  fun lnot: cbool -> cbool = "!$1";                // not x

  //$ Logical implication.
  fun implies: cbool * cbool -> cbool = "!$1||$2";  // not x or y

  //$ Mutating or.
  proc |= : &cbool * cbool = "*$1|=$2;";

  //$ Mutating and.
  proc &= : &cbool * cbool = "*$1&=$2;";

  // Elide double negations.
  //reduce dneg(x:cbool): lnot (lnot x) => x;
  // Elide double negations.
  //reduce dneg(x:cbool,y:cbool): lnot (nand(x,y)) => land(x,y);
  // Elide double negations.
  //reduce dneg(x:cbool,y:cbool): lnot (nor(x,y)) => lor(x,y);
}


instance FloatAddgrp[bool] {
  fun zero () => 0 :>> bool;
  fun - (x:bool) => (sub (2, caseno x)) :>> bool;
  fun + (x:bool, y:bool) : bool => (add ((caseno x , caseno y)) % 2) :>> bool;
  fun - (x:bool, y:bool) : bool => (add (2, sub(caseno x , caseno y)) % 2) :>> bool;
}

instance Str[bool] {
  //$ Convert bool to string.
  fun str (b:bool) : string => if b then "true" else "false" endif;
}

instance Tord[bool] {
  //$ Total ordering of bools, false < true.
  //$ Note that x < y is equivalent to x implies y.
  fun < : bool * bool -> bool = "$1<$2";
}

open Tord[bool];
open Show[bool];
open Addgrp[bool];

instance Str[cbool] {
  //$ Convert cbool to string.
  fun str (b:cbool) : string => if b then "ctrue" else "cfalse" endif;
}

instance Tord[cbool] {
  //$ Total ordering of cbools, false < true.
  //$ Note that x < y is equivalent to x implies y.
  fun < : cbool * cbool -> cbool = "$1<$2";
}

open Tord[cbool];
open Show[cbool];
Predicate combinators.

A <em>predicate</em> is any function returning a boolean argument. Predicates are also relations by simply providing a tuple argument.

This is a simple class allowing predicates to be combined directly using symbolic operators to form new predicates, using logical conjunction and, disjunction or, implication implies and negation not. The parser maps these operator onto the functions land, lor, implies, and lnot respectively.

//[predicate.flx]

// Some operations on predicates.
// These also automatically apply to relations, but just taking
// the argument as a tuple.

open class Predicate[T]
{
   fun land (f:T->bool,g:T->bool) =>
     fun (x:T) => f x and g x
   ;

   fun lor (f:T->bool,g:T->bool) =>
     fun (x:T) => f x or g x
   ;

   fun implies (f:T->bool,g:T->bool) =>
     fun (x:T) => f x implies g x
   ;

   fun lnot (f:T->bool) =>
     fun (x:T) => not (f x)
   ;

}

Package: src/packages/numbers.fdoc

Operations on numbers.

key file
number.flx share/lib/std/scalar/number.flx
real.flx share/lib/std/scalar/real.flx
float_format.flx share/lib/std/scalar/float_format.flx
float_math.flx share/lib/std/scalar/float_math.flx
int.flx share/lib/std/scalar/int.flx
quaternion.flx share/lib/std/scalar/quaternion.flx
random.flx share/lib/std/random.flx
General Numeric operations.
//[number.flx]

instance[t in numbers] FloatAddgrp[t] {
  fun zero: unit -> t = "(?1)0" ;
  fun + : t * t -> t = "$1+$2" ;
  fun neg : t -> t = "-$1" ;
  fun - : t * t -> t = "$1-$2" ;
  proc += : &t * t = "*$1+=$2;";
  proc -= : &t * t = "*$1-=$2;";
}

instance[t in numbers] FloatMultSemi1[t] {
  fun one: unit -> t = "(?1)1";
  fun * : t * t -> t = "$1*$2";
  proc *= : &t * t = "*$1*=$2;";
}

instance[t in numbers] FloatRing[t] {}
instance[t in ints \cup complexes] FloatDring[t] {
  fun / : t * t -> t = "$1/$2";
  fun % : t * t -> t = "$1%$2";
  proc /= : &t * t = "*$1/=$2;";
  proc %= : &t * t = "*$1%=$2;";
}
instance[t in floats] FloatDring[t] {
  fun / : t * t -> t = "$1/$2";
  fun % : t * t -> t = "fmod($1,$2)";
  proc /= : &t * t = "*$1/=$2;";
  proc %= : &t * t = "*$1=fmod($1,$2);";
}
Floating Numbers.

Operations on Real and Complex numbers.

//[float_math.flx]

// note: has to be called Fcomplex to avoid clash with class Complex

// Note: ideally we'd use constrained polymorphism for the instances..
// saves typing it all out so many times
open class Floatinf
{
   const FINFINITY : float = "INFINITY" requires C99_headers::math_h;
}

open class Doubleinf
{
   const DINFINITY : double = "(double)INFINITY" requires C99_headers::math_h;
}

open class Ldoubleinf
{
   const LINFINITY : ldouble = "(long double)INFINITY" requires C99_headers::math_h;
}

fun isinf[T in reals] : T -> bool = "::std::isinf($1)" requires Cxx_headers::cmath;
fun isfinite[T in reals] : T -> bool = "::std::isfinite($1)" requires Cxx_headers::cmath;
fun isnan[T in reals] : T -> bool = "::std::isnan($1)" requires Cxx_headers::cmath;

ctor[T in ints] float : T = "(float)($1)";
ctor[T in ints] double  : T = "(double)($1)";
ctor[T in ints] ldouble : T = "(long double)($1)";

ctor float : string = "::std::stof($1)";
ctor double  : string = "::std::stod($1)";
ctor ldouble : string = "::std::stold($1)";


open class Fcomplex
{
  ctor[t in reals] fcomplex : t * t = "::std::complex<float>($1,$2)";
  ctor[t in reals] fcomplex : t = "::std::complex<float>($1,0)";
  instance Str[fcomplex] {
    fun str (z:fcomplex) => str(real z) + "+" + str(imag z)+"i";
  }
}

open class Dcomplex
{
  ctor[t in reals] dcomplex : t * t = "::std::complex<double>($1,$2)";
  ctor[t in reals] dcomplex : t = "::std::complex<double>($1,0)";
  instance Str[dcomplex] {
    fun str (z:dcomplex) => str(real z) + "+" + str(imag z)+"i";
  }
}

open class Lcomplex
{
  ctor[t in reals] lcomplex : t * t = "::std::complex<long double>($1,$2)";
  ctor[t in reals] lcomplex : t = "::std::complex<long double>($1,0)";
  instance Str[lcomplex] {
    fun str (z:lcomplex) => str(real z) + "+" + str(imag z)+"i";
  }
}

instance[t in floats] Complex[complex[t],t] {
  fun real : complex[t] -> t = "real($1)";
  fun imag : complex[t] -> t = "imag($1)";
  fun abs: complex[t] -> t = "abs($1)";
  fun arg : complex[t] -> t = "arg($1)";
  fun neg : complex[t] -> complex[t] = "-$1";
  fun + : complex[t] * complex[t] -> complex[t] = "$1+$2";
  fun - : complex[t] * complex[t] -> complex[t] = "$1-$2";
  fun * : complex[t] * complex[t] -> complex[t] = "$1*$2";
  fun / : complex[t] * complex[t] -> complex[t] = "$1/$2";
  fun + : complex[t] * t -> complex[t] = "$1+$2";
  fun - : complex[t] * t -> complex[t] = "$1-$2";
  fun * : complex[t] * t -> complex[t] = "$1*$2";
  fun / : complex[t] * t -> complex[t] = "$1/$2";
  fun + : t * complex[t] -> complex[t] = "$1+$2";
  fun - : t * complex[t] -> complex[t] = "$1-$2";
  fun * : t * complex[t] -> complex[t] = "$1*$2";
  fun / : t * complex[t] -> complex[t] = "$1/$2";
  fun zero: 1 -> complex[t] = "::std::complex<?1>(0.0)";
  fun one: 1 -> complex[t] = "::std::complex<?1>(1.0)";
}

instance[t in (floats  \cup  complexes)] Trig[t] {
  requires Cxx_headers::cmath;
  fun sin: t -> t = "::std::sin($1)";
  fun cos: t -> t = "::std::cos($1)";
  fun tan: t -> t = "::std::tan($1)";
  fun asin: t -> t = "::std::asin($1)";
  fun acos: t -> t = "::std::acos($1)";
  fun atan: t -> t = "::std::atan($1)";
  fun sinh: t -> t = "::std::sinh($1)";
  fun cosh: t -> t = "::std::cosh($1)";
  fun tanh: t -> t = "::std::tanh($1)";
  fun asinh: t -> t = "::std::asinh($1)";
  fun acosh: t -> t = "::std::acosh($1)";
  fun atanh: t -> t = "::std::atanh($1)";
  fun exp: t -> t = "::std::exp($1)";
  fun log: t -> t = "::std::log($1)";
  fun pow: t * t -> t = "::std::pow($1,$2)";
}

instance[t in floats] Real[t] {
  requires Cxx_headers::cmath;
  fun abs: t -> t = "::std::abs($1)";
  fun log10: t -> t = "::std::log10($1)";
  fun sqrt: t -> t = "::std::sqrt($1)";
  fun ceil: t -> t = "::std::ceil($1)";
  fun floor: t -> t = "::std::floor($1)";
  fun trunc: t -> t = "::std::trunc($1)";
  fun embed: int -> t = "(?1)($1)";
  fun atan2: t * t -> t = "::std::atan2($1,$2)";
}

class CartComplex[r] {
  typedef t = complex[r];
  inherit Complex[t,r];
}

typedef complex[t in floats] = typematch t with
  | float => fcomplex
  | double => dcomplex
  | ldouble => lcomplex
  endmatch
;
Complex Constructors.
//[float_math.flx]

ctor complex[float] (x:float, y:float) => fcomplex(x,y);
ctor complex[double] (x:double, y:double) => dcomplex(x,y);
ctor complex[ldouble] (x:ldouble, y:ldouble) => lcomplex(x,y);

ctor complex[float] (x:float) => fcomplex(x,0.0f);
ctor complex[double] (x:double) => dcomplex(x,0.0);
ctor complex[ldouble] (x:ldouble) => lcomplex(x,0.0l);

typedef polar[t in floats] = complex[t];
ctor[t in floats] polar[t] : t * t = "::std::polar($1,$2)";


instance[r in floats] CartComplex[r] {}

open Real[float];
open Real[double];
open Real[ldouble];
open Complex[fcomplex, float];
open Complex[dcomplex, double];
open Complex[lcomplex, ldouble];
open CartComplex[float];
open CartComplex[double];
open CartComplex[ldouble];
Real numbers
//[real.flx]
instance[t in reals] Tord[t] {
  fun < : t * t -> bool = "$1<$2";
}
Floating Formats
//[float_format.flx ]
//$ Functions to format floating point numbers.
open class float_format
{
  //$ Style of formatting.
  //$ default (w,d)    : like C "w.dG" format
  //$ fixed (w,d)      : like C "w.dF" format
  //$ scientific (w,d) : like C "w.dE" format
  variant mode =
    | default of int * int
    | fixed of int * int
    | scientific of int * int
  ;

  //$ Format a real number v with format m.
  fun fmt[t in reals] (v:t, m: mode) =>
    match m with
    | default (w,p) => fmt_default(v,w,p)
    | fixed (w,p) => fmt_fixed(v,w,p)
    | scientific(w,p) => fmt_scientific(v,w,p)
    endmatch
  ;

  //$ Format a complex number v in x + iy form,
  //$ with format m for x and y.
  fun fmt[t,r with Complex[t,r]] (v:t, m: mode) =>
    match m with
    | default (w,p) => fmt_default(real v,w,p) +"+"+fmt_default(imag v,w,p)+"i"
    | fixed (w,p) => fmt_fixed(real v,w,p)+"+"+fmt_fixed(imag v,w,p)+"i"
    | scientific(w,p) => fmt_scientific(real v,w,p)+"+"+fmt_scientific(imag v,w,p)+"i"
    endmatch
  ;

  //$ Format default.
  fun fmt_default[t] : t * int * int -> string="::flx::rtl::strutil::fmt_default($a)" requires package "flx_strutil";

  //$ Format fixed.
  fun fmt_fixed[t] : t * int * int -> string="::flx::rtl::strutil::fmt_fixed($a)" requires package "flx_strutil";

  //$ Format scientfic.
  fun fmt_scientific[t] : t * int * int -> string="::flx::rtl::strutil::fmt_scientific($a)" requires package "flx_strutil";
}

instance Str[float] {
  fun xstr: float -> string = "::flx::rtl::strutil::str<#1>($1)" requires package "flx_strutil";

  //$ Default format float, also supports nan, +inf, -inf.
  noinline fun str(x:float):string =>
    if isnan x then "nan"
    elif isinf x then
      if x > 0.0f then "+inf" else "-inf" endif
    else xstr x
    endif
  ;
}

instance Str[double] {
  fun xstr: double -> string = "::flx::rtl::strutil::str<#1>($1)" requires package "flx_strutil";

  //$ Default format double, also supports nan, +inf, -inf.
  noinline fun str(x:double):string =>
    if isnan x then "nan"
    elif isinf x then
      if x > 0.0 then "+inf" else "-inf" endif
    else xstr x
    endif
  ;
}

instance Str[ldouble] {
  fun xstr: ldouble -> string = "::flx::rtl::strutil::str<#1>($1)" requires package "flx_strutil";

  //$ Default format long double, also supports nan, +inf, -inf.
  noinline fun str(x:ldouble):string =>
    if isnan x then "nan"
    elif isinf x then
      if x > 0.0l then "+inf" else "-inf" endif
    else xstr x
    endif
  ;
}
Conversion operators.
//[int.flx]
open class Tiny
{
  ctor tiny: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] tiny: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Short
{
  ctor short: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] short: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Int
{
  ctor int: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] int: T = "static_cast<#0>($1)/*int.flx: ctor*/";
  ctor int : int = "($1)/*int.flx: ctor int IDENT*/";
  // special hack
  ctor int(x:bool)=> match x with | true => 1 | false => 0 endmatch;
}

open class Long
{
  ctor long: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] long: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Vlong
{
  ctor vlong: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] vlong: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Utiny
{
  ctor utiny: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] utiny: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Ushort
{
  ctor ushort: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] ushort: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uint
{
  ctor uint: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uint: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Ulong
{
  ctor ulong: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] ulong: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uvlong
{
  ctor uvlong: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uvlong: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Int8
{
  ctor int8: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] int8: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Int16
{
  ctor int16: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] int16: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Int32
{
  ctor int32: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] int32: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Int64
{
  ctor int64: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] int64: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uint8
{
  ctor uint8: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uint8: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uint16
{
  ctor uint16: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uint16: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uint32
{
  ctor uint32: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uint32: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uint64
{
  ctor uint64: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uint64: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Size
{
  ctor size: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] size: T = "static_cast<#0>($1)/*int.flx: ctor size from #0*/";
  ctor size: size = "($1)/*int.flx: ctor size IDENT*/";

  // special overrides so s.len - 1 works
  fun - : size * int -> size = "$1-$2";
  fun + : size * int -> size = "$1+$2";
}

open class Ptrdiff
{
  ctor ptrdiff: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] ptrdiff: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Intptr
{
  ctor intptr: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] intptr: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uintptr
{
  ctor uintptr: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uintptr: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Intmax
{
  ctor intmax: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] intmax: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}

open class Uintmax
{
  ctor uintmax: string = "static_cast<#0>(::std::atoi($1.c_str()))" requires Cxx_headers::cstdlib;
  ctor[T in reals] uintmax: T = "static_cast<#0>($1)/*int.flx: ctor*/";
}
Convert to decimal string.
//[int.flx]
instance Str[tiny] {
  fun str: tiny -> string = "::flx::rtl::strutil::str<int>($1)" requires package "flx_strutil";
}

instance Str[utiny] {
  fun str: utiny -> string = "::flx::rtl::strutil::str<unsigned int>($1)" requires package "flx_strutil";
}

instance
[
  T in
    short \cup ushort \cup int \cup uint \cup long \cup ulong \cup vlong \cup uvlong \cup
    exact_ints \cup weird_sints \cup weird_uints
]
Str[T]
{
  fun str: T -> string = "::flx::rtl::strutil::str<#1>($1)" requires package "flx_strutil";
}
Convert to lexical string.
//[int.flx]
instance Repr[tiny]   { fun repr[with Str[tiny]]   (t:tiny)   : string => (str t) + "t";  }
instance Repr[short]  { fun repr[with Str[short]]  (t:short)  : string => (str t) + "s";  }
instance Repr[int]   { fun repr[with Str[int]]   (t:int)   : string => (str t) + "";  }
instance Repr[long]   { fun repr[with Str[long]]   (t:long)   : string => (str t) + "l";  }
instance Repr[vlong]  { fun repr[with Str[vlong]]  (t:vlong)  : string => (str t) + "v";  }
instance Repr[int8]  { fun repr[with Str[int8]]  (t:int8)  : string => (str t) + "i8";  }
instance Repr[int16]  { fun repr[with Str[int16]]  (t:int16)  : string => (str t) + "i16";  }
instance Repr[int32]  { fun repr[with Str[int32]]  (t:int32)  : string => (str t) + "i32";  }
instance Repr[int64]  { fun repr[with Str[int64]]  (t:int64)  : string => (str t) + "i64";  }
instance Repr[intmax]  { fun repr[with Str[intmax]]  (t:intmax)  : string => (str t) + "j";  }
instance Repr[intptr]  { fun repr[with Str[intptr]]  (t:intptr)  : string => (str t) + "p";  }
instance Repr[ptrdiff]  { fun repr[with Str[ptrdiff]]  (t:ptrdiff)  : string => (str t) + "d";  }

instance Repr[utiny]  { fun repr[with Str[utiny]]  (t:utiny)  : string => (str t) + "ut"; }
instance Repr[ushort] { fun repr[with Str[ushort]] (t:ushort) : string => (str t) + "us"; }
instance Repr[uint]   { fun repr[with Str[uint]]   (t:uint)   : string => (str t) + "u";  }
instance Repr[ulong]  { fun repr[with Str[ulong]]  (t:ulong)  : string => (str t) + "ul"; }
instance Repr[uvlong] { fun repr[with Str[uvlong]] (t:uvlong) : string => (str t) + "uv"; }
instance Repr[uint8]  { fun repr[with Str[uint8]]  (t:uint8)  : string => (str t) + "u8";  }
instance Repr[uint16]  { fun repr[with Str[uint16]]  (t:uint16)  : string => (str t) + "u16";  }
instance Repr[uint32]  { fun repr[with Str[uint32]]  (t:uint32)  : string => (str t) + "u32";  }
instance Repr[uint64]  { fun repr[with Str[uint64]]  (t:uint64)  : string => (str t) + "u64";  }
instance Repr[size]  { fun repr[with Str[size]]  (t:size)  : string => (str t) + "uz";  }
instance Repr[uintmax]  { fun repr[with Str[uintmax]]  (t:uintmax)  : string => (str t) + "uj";  }
instance Repr[uintptr]  { fun repr[with Str[uintptr]]  (t:uintptr)  : string => (str t) + "up";  }
Methods of integers
//[int.flx]
instance[t in ints] Addgrp[t] {}
instance[t in ints] Ring[t] {}
instance[t in ints] MultSemi1[t] {}
instance[t in ints] Dring[t] {}

instance [t in uints] Bits [t] {
  fun \^ : t * t -> t = "(?1)($1^$2)";
  fun \| : t * t -> t = "(?1)($1|$2)";
  fun \& : t * t -> t = "(?1)($1&$2)";

  // note: the cast is essential to ensure ~1tu is 254tu
  fun ~ : t -> t = "(?1)~$1";
  proc ^= : &t * t = "*$1^=$2;";
  proc |= : &t * t = "*$1|=$2;";
  proc &= : &t * t = "*$1&=$2;";
}

instance[t in ints] ForwardSequence[t] {
  fun succ: t -> t = "$1+1";
  proc pre_incr: &t = "++*$1;";
  proc post_incr: &t = "(*$1)++;";
}

instance[t in ints] BidirectionalSequence[t] {
  fun pred: t -> t = "$1-1";
  proc pre_decr: &t = "--*$1;";
  proc post_decr: &t = "(*$1)--;";
}
instance[t in ints] RandomSequence[t] {
  fun advance: int * t -> t = "$1+$2";
}
instance[t in ints] UpperBoundTotalOrder[t] {
  fun maxval: 1 -> t = "::std::numeric_limits<?1>::max()";
}
instance[t in ints] LowerBoundTotalOrder[t] {
  fun minval: 1 -> t = "::std::numeric_limits<?1>::min()";
}

instance[t in ints] Integer[t] {
  fun << : t * t -> t = "$1<<$2";
  fun >> : t * t -> t = "$1>>$2";
}
Methods of signed integers
//[int.flx]
instance[t in sints] Signed_integer[t] {
  fun sgn: t -> int = "$1<0??-1:$1>0??1:0";
  fun abs: t -> t = "$1<0??-$1:$1";
}
Methods of unsigned integers
//[int.flx]
instance[t in uints] Unsigned_integer[t] {}
Make functions accessible without qualification
//[int.flx]
//open[T in sints] Signed_integer[T];
open Signed_integer[tiny];
open Signed_integer[short];
open Signed_integer[int];
open Signed_integer[long];
open Signed_integer[vlong];
open Signed_integer[int8];
open Signed_integer[int16];
open Signed_integer[int32];
open Signed_integer[int64];
open Signed_integer[intmax];
open Signed_integer[ptrdiff];
open Signed_integer[intptr];

//open[T in uints] Unsigned_integer[T];
open Unsigned_integer[utiny];
open Unsigned_integer[ushort];
open Unsigned_integer[uint];
open Unsigned_integer[ulong];
open Unsigned_integer[uvlong];
open Unsigned_integer[uint8];
open Unsigned_integer[uint16];
open Unsigned_integer[uint32];
open Unsigned_integer[uint64];
open Unsigned_integer[uintmax];
open Unsigned_integer[size];
open Unsigned_integer[uintptr];
Quaternions
//[quaternion.flx]

class Quaternion
{
  type quaternion = new double ^ 4;
  ctor quaternion (x:double^4) => _make_quaternion x;
  private typedef q = quaternion;
  fun r(x:q)=> (_repr_ x) . 0;
  fun i(x:q)=> (_repr_ x) . 1;
  fun j(x:q)=> (_repr_ x) . 2;
  fun k(x:q)=> (_repr_ x) . 3;

  ctor q (x:double) => quaternion (x,0.0,0.0,0.0);

  fun + (a:q,b:q):q =>
    quaternion (a.r+ b.r, a.i + b.i, a.j + b.j, a.k+b.k)
  ;

  fun * (a:q, b:q):q =>
    quaternion (
      a.r * b.r - a.i * b.i - a.j * b.j - a.k * b.k,
      a.r * b.i + a.i * b.r + a.j * b.k - a.k * b.j,
      a.r * b.j - a.i * b.k + a.j * b.r - a.k * b.i,
      a.r * b.k + a.i * b.j - a.j * b.i + a.k * b.r
    )
  ;

  fun conj (a:q):q => quaternion (a.r, -a.i, -a.j, -a.k);
  fun norm (a:q):double => sqrt (a.r * a.r + a.i * a.i + a.j * a.j +a.k * a.k);

  fun * (a:q, b: double):q => quaternion (a.r * b, a.i * b, a.j * b, a.k * b);
  fun * (a: double, b:q):q => a * b;

  fun reciprocal (a:q):q => let n = norm a in conj a * (1.0/ (n * n));

  // add more later, generalise scalar type
  // Later, GET RID of complex and quaternions
  // by introducing typeclasses for arbitrary R-modules
}
Random number generation
//[random.flx]

class Random {
    private type random_device = "::std::random_device*"
        requires Cxx11_headers::random;
    private type random_engine = "::std::default_random_engine*"
        requires Cxx11_headers::random;
    private ctor random_device: 1 = "new ::std::random_device{}";
    private ctor random_engine: random_device =
        "new ::std::default_random_engine{(*$1)()}";
    private gen generate_canonical: random_engine -> double =
        "::std::generate_canonical<double, ::std::numeric_limits<float>::digits>(*$1)"
        requires Cxx_headers::limits;

    private struct random_ctl {
        rd: random_device;
        e: random_engine;
    }
    type random = new random_ctl;
    ctor random() => let rd = #random_device in
                     _make_random$ random_ctl (rd, rd.random_engine);

    private gen range[I in ints]: random_engine * I * I -> I =
        "::std::uniform_int_distribution<decltype($2)>{$2, $3-1}(*$1)";
    gen range[I in ints](r: random)(start: I, stop: I) =>
        range (r._repr_.e, start, stop);
    gen range[I in ints](r: random)(stop: I): I =>
         r.range (C_hack::cast[I] 0, stop);

    gen randint[I in ints with FloatAddgrp[I]](r: random)(start: I, stop: I) =>
        r.range (start, stop+C_hack::cast[I] 1);

    gen choice[T,S with ArrayValue[S,T]](r: random)(seq: S): T =>
        unsafe_get (seq, r.range seq.len);

    gen randflt(r: random) => r._repr_.e.generate_canonical;

    proc shuffle[T,S with ArrayObject[S,T]](r: random)(seq: S) {
        for var i in 0zu upto seq.len - 2 do
            j := r.randint (0zu, i);
            ei := unsafe_get (seq, i);
            ej := unsafe_get (seq, j);
            unsafe_set (seq, i, ej);
            unsafe_set (seq, j, ei);
        done
    }
}

Package: src/packages/memory.fdoc

Memory Operations

key file
memory.flx share/lib/std/scalar/memory.flx
address.flx share/lib/std/scalar/address.flx
Raw Address
//[address.flx]

//$ Core operations on addresses.
open class Address {
  //$ Construct from Felix object pointer.
  ctor[T] address: &T = "(void*)$1";

  //$ Construct from possibly NULL pointer.
  ctor[T] address: cptr[T] = "(void*)$1"; //@

  //$ Construct from possibly array element pointer.
  ctor[T] address: +T = "(void*)$1";

  //$ Construct from C function
  ctor[D,C] address: D --> C = "(void*)$1";


  //$ Check is an address is NULL.
  fun isNULL: address -> bool = "(0==$1)";

  //$ Define NULL address.
  const NULL : address = "NULL";

  instance Eq[address] {
    fun == : address * address -> bool = "$1==$2";
  }
  instance Tord[address] {
    fun < : address * address -> bool = "::std::less<void*>()($1,$2)";
  }

  const addrstrfmt : +char = '"%" PRIxPTR' requires C99_headers::inttypes_h;
  const addrreprfmt : +char = '"0x%" PRIxPTR' requires C99_headers::inttypes_h;

  instance Str[address] {
    fun str (t:address) : string => vsprintf (addrstrfmt, C_hack::cast[uintptr] t);
  }
  instance Repr[address] {
    fun repr (t:address) : string => vsprintf (addrreprfmt, C_hack::cast[uintptr] t);
  }


  instance Str[byte] {
    fun str (t:byte) : string => vsprintf (c"%02x", C_hack::cast[uint] t);
  }

  instance Repr[byte] {
    fun repr (t:byte) : string => vsprintf (c"0x%02x", t);
  }


  fun + : address * !ints -> address = "(void*)((char*)$1+$2)";
  fun - : address * !ints -> address = "(void*)((char*)$1-$2)";
  fun - : address * address -> ptrdiff = "(char*)$1-(char*)$2";
}

open Eq[byte];
open Tord[address];

//[memory.flx]
class Memory
{
  proc memcpy: address * address * !ints =
    "{if($1 && $2 && $3)::std::memcpy($1,$2,$3);}"
    requires Cxx_headers::cstring
  ;

  proc memmove: address * address * !ints =
    "{if($1 && $2 && $3)::std::memmove($1,$2,$3);}"
    requires Cxx_headers::cstring
  ;

  fun memcmp: address * address * !ints -> int =
    "::std::memcmp($1,$2,$3)"
    requires Cxx_headers::cstring
  ;

  fun memchr: address * byte * !ints -> address =
    "::std::memchr($1,$2,$3)"
    requires Cxx_headers::cstring
  ;


  proc memset: address * !ints * byte =
    "::std::memset($1,$2,$3);"
    requires Cxx_headers::cstring
  ;

  //$ Heap operations
  gen calloc: !ints -> address =
    "::std::calloc($1)"
    requires Cxx_headers::cstdlib
  ;

  proc free: address =
    "::std::free($1);"
    requires Cxx_headers::cstdlib
  ;

  gen realloc: address * !ints -> address =
    "::std::realloc($1,$2)"
    requires Cxx_headers::cstdlib
  ;

  //$ Raw unchecked malloc.
  gen raw_malloc: !ints -> address =
    '::std::malloc($1)'
    requires Cxx_headers::cstdlib
  ;

  //$ Malloc with memory check.
  //$ Throws c"out of memory" if out of memory.
  body checked_malloc = """
    void *checked_malloc(size_t n) {
      void *p = ::std::malloc(n);
      if(p) return p;
      else throw "out of memory";
    }
  """;

  gen malloc: !ints -> address = 'checked_malloc($1)'
    requires Cxx_headers::cstdlib, checked_malloc
  ;

  // Standard C++ Search algorithm,
  // returns address of found string
  // or $2 = pointer past end on fail
  fun search: address ^ 4 -> address =
    """
    (void*)::std::search(
      (::std::uint8_t*)$1,
      (::std::uint8_t*)$2,
      (::std::uint8_t*)$3,
      (::std::uint8_t*)$4)
    """
    requires Cxx_headers::algorithm
  ;
}

Package: src/packages/parsers.fdoc

key file
parsers.flx share/lib/std/strings/parsers.flx
parser_synlib.flx share/lib/std/strings/parser_synlib.flx

Parsing

Chips to providing parsing functions.

//[parsers.flx]
include "std/control/chips";
include "std/strings/recognisers";
include "std/strings/parser_synlib";
class Parsers
{
  open Recognisers;
  open Grammars;

  variant action_t =
  | Reduce of string * int
  | Scroll of int
  | Unscroll of int
  | Pack of int
  | Unpack
  | Drop of int
  | Swap
  | Sequence of list[action_t]
  ;

  instance Str[action_t] {
    fun str: action_t -> string =
    | Reduce (s,n) => "Reduce(" + s + ","+n.str+")"
    | Scroll n => "Scroll " + n.str
    | Unscroll n => "Unscroll " + n.str
    | Pack n => "Pack " + n.str
    | Drop n => "Drop " + n.str
    | Swap => "Swap"
    | Sequence aa =>
      "Seq(" + catmap "," (str of action_t) aa + ")"
    ;
  }

  typedef open_pgram_t[T] =
  (
    | `Action of action_t
    | open_prod_t[T]
  )
  ;

  instance[T with Str[T]] Str[open_pgram_t[T]]
  {
    fun str: open_pgram_t[T] -> string =
    | `Action a => "{" + a.str + "}"
    | open_prod_t[T] :>> r => r.str
    ;
  }


  typedef pgram_t = open_pgram_t[pgram_t];

  typedef open_pgramentry_t[T] = string * open_pgram_t[T];
  typedef open_pgramlib_t[T] = list[open_pgramentry_t[T]];
  typedef open_pgrammar_t[T] = string * open_pgramlib_t[T];

  typedef pgramentry_t = open_pgramentry_t[pgram_t];
  typedef pgramlib_t = open_pgramlib_t[pgram_t];
  typedef pgrammar_t = open_pgrammar_t[pgram_t];

  typedef lexeme = (start:Buffer, finish:Buffer);

  variant stack_node_t =
  | RTerminal of string * lexeme
  | RNonterminal of string * list[stack_node_t]
  ;

  instance Str[stack_node_t] {
    fun str: stack_node_t -> string =
    | RTerminal (s,x) => s+"("+string (x.start,x.finish)+")"
    | RNonterminal (s,xs) =>
      s + "(" + catmap "," (str of stack_node_t) xs + ")"
    ;
  }

  typedef parser_stack_t = list[stack_node_t];

  instance Str[parser_stack_t] {
    fun str (x:parser_stack_t) =>
      catmap "; " (str of stack_node_t) x
    ;
  }

  typedef parser_state_t =
  (
    pos: Buffer,
    stack: parser_stack_t
  );

  instance Str[parser_state_t] {
    fun str (x:parser_state_t) =>
      x.pos.str + ":  " + x.stack.str
    ;
  }

  instance Str[pgramlib_t] {
    fun str (lib: pgramlib_t) : string =
    {
      var s = "";
      match nt,ex in lib do
        s += nt + ":\n";
        s += "  " + ex.str+"\n";
      done
      return s;
    }
  }

  typedef parser_t = BaseChips::iochip_t[parser_state_t,parser_state_t];

  chip ActionShift (label:string) (r: recog_t)
    connector io
      pin inp: %<parser_state_t
      pin out: %>parser_state_t
   {
     // We need to use a secondary chip so that if the recogniser
     // writes no output, this chip will block on it and die
     // without killing off the ActionShift chip.
     chip handler
       connector inner
         pin inp: %<parser_state_t
     {
       var inp = read inner.inp;

       var ri,wi = #mk_ioschannel_pair[Buffer];
       var ro,wo = #mk_ioschannel_pair[Buffer];
       circuit
         wire ri to r.inp
         wire wo to r.out
       endcircuit

       var ipos = inp.pos;
       write (wi, ipos);
       var opos = read ro;
       var entry = RTerminal (label, (start = ipos, finish = opos));
       //println$ "ActionShift " + label + " write " + io.out.address.str;
       write (io.out, (pos = opos, stack = entry ! inp.stack));
     }

     while true do
       var inp = read io.inp;
       var ri,wi = #mk_ioschannel_pair[parser_state_t];
      circuit
         wire wi to handler.inp
       endcircuit
       write (wi, inp);
     done
   }

  chip ActionSecond (label:string) (r1: recog_t) (r2: recog_t)
    connector io
      pin inp: %<parser_state_t
      pin out: %>parser_state_t
   {

     chip handler
       connector inner
         pin inp: %<parser_state_t
     {
       var inp = read inner.inp;

       var ri1,wi1 = #mk_ioschannel_pair[Buffer];
       var ro1,wo1 = #mk_ioschannel_pair[Buffer];
       var ri2,wi2 = #mk_ioschannel_pair[Buffer];
       var ro2,wo2 = #mk_ioschannel_pair[Buffer];
       circuit
         wire ri1 to r1.inp
         wire wo1 to r1.out
         wire ri2 to r2.inp
         wire wo2 to r2.out
       endcircuit

       // whitespace
       var pos1 = inp.pos;
       write (wi1, pos1);
       var pos2 = read ro1;

       // terminal
       write (wi2, pos2);
       var pos3 = read ro2;

       var entry = RTerminal (label, (start = pos2, finish = pos3));
       //println$ "ActionSecond " + label + " write " + io.out.address.str;
       write (io.out, (pos = pos3, stack = entry ! inp.stack));
     }

     while true do
       var inp = read io.inp;
       var ri,wi = #mk_ioschannel_pair[parser_state_t];
       circuit
         wire wi to handler.inp
       endcircuit
       write (wi, inp);
     done
   }

  fun doaction (aux: parser_stack_t,s:parser_stack_t) (a:action_t) =>
    match a with
    | Reduce (label,n) =>
      let revhead,tail = revsplit n s in
      aux,RNonterminal (label,revhead) ! tail

    | Drop n => aux,drop n s

    | Swap => aux,
      match s with
      | e1 ! e2 ! tail => e2 ! e1 ! tail
      | _ => s
      endmatch

    | Scroll n => let s,a = scroll (s,aux) n in a,s
    | Unscroll n => scroll (aux,s) n

    | Pack n =>
      let revhead,tail = revsplit n s in
      aux,RNonterminal ("_Tuple",revhead) ! tail

    | Unpack =>
      match s with
      | RNonterminal (_,ss) ! tail => aux, ss + tail
      | _ => aux,s
      endmatch

    | Sequence actions =>
      fold_left (fun (aux:parser_stack_t,s:parser_stack_t) (a:action_t) =>
        doaction (aux,s) a)
        (aux,s)
        actions

    endmatch
  ;

  fun doaction (s:parser_stack_t) (a:action_t) =>
    let _,s = doaction (Empty[stack_node_t], s) a in
    s
  ;

  chip ActionGeneral (a:action_t)
    connector io
      pin inp: %<parser_state_t
      pin out: %>parser_state_t
  {
    while true do
      var i = read io.inp;
      var pos = i.pos;
      var stack = doaction i.stack a;
      //println$ "ActionGeneral ["+a.str+"] write " + io.out.address.str;
      write (io.out, (pos=pos, stack=stack));
    done
  }

  typedef pntdef_t = string * parser_t;

  fun find (v:varray[pntdef_t]) (nt:string) : size =
  {
    for i in 0uz ..< v.len do
      if v.i.0 == nt return i;
    done
    assert false;
  }

  fun render_pgram
    (lib:pgramlib_t,v:varray[pntdef_t])
    (white:recog_t)
    (p:pgram_t)
  : parser_t =>
    match p with
    | `Terminal (s,r) => ActionSecond s white r
    | `Epsilon => BaseChips::epsilon[parser_state_t]
    | `Seq ps => BaseChips::pipeline_list (
          map (fun (p:pgram_t) => render_pgram (lib,v) white p) ps)
    | `Alt ps =>  BaseChips::tryall_list (
          map (fun (p:pgram_t) => render_pgram (lib,v) white p) ps)
    | `Nonterminal nt =>
         let idx : size = find v nt in
         let pslot : &pntdef_t = -(v.stl_begin + idx) in
         let pchip : &parser_t = pslot . 1 in
         BaseChips::deref_each_read pchip
    | `Action a => ActionGeneral a
  ;

  fun open_add_pgram[T]
    (aux: list[string] -> T -> list[string])
    (acc:list[string]) (p: open_pgram_t[T])
  : list[string] =>
    match p with
    | `Action a => acc
    | open_prod_t[T] :>> r => open_add_prod[T] aux acc r
    endmatch
  ;

  fun add_pgram (acc:list[string]) (p:pgram_t) : list[string] =>
    fix open_add_pgram[pgram_t] acc p
  ;

  fun closure (g:pgrammar_t): list[string] =>
    generic_closure[pgram_t] add_pgram g
  ;

  chip make_parser_from_grammar (white:recog_t)
    connector io
      pin inp: %<pgrammar_t
      pin out: %>parser_t
  {

    while true do
      // read in the grammar
      var start, lib = read io.inp;

      // calculate the transitive closure of nonterminals
      // from the start symbol
      var cl = closure (start,lib);

      // allocate a varray with a slot for each nonterminal
      var n = cl.len;
      var v = varray[string * parser_t] n;

      // populate the varray with the terminal names and a dummy chip
      for nt in cl call // initialise array
        push_back (v,(nt,BaseChips::epsilon[parser_state_t]))
      ;

      // now assign the real recognisers to the array
      var index = 0uz;
      for nt in cl do
        match find lib nt with
        | None => assert false;
        | Some prod =>
          // get wrapped parser
          var entry = render_pgram (lib, v) white prod;

          // address of the slot
          var pentry : &parser_t = (-(v.stl_begin+index)).1;

          // overwrite dummy value
          pentry <- entry;
        endmatch;
        ++index;
      done
      write (io.out, (v.(find v start).1));
    done
  }

  gen make_parser_from_grammar (g:pgrammar_t) (white:recog_t) : parser_t =
  {
    var parsr: parser_t;
    var sched = #fibre_scheduler;
    spawn_fthread sched {
      var gri,gwi = mk_ioschannel_pair[pgrammar_t]();
      var gro,gwo = mk_ioschannel_pair[parser_t]();
      spawn_fthread (make_parser_from_grammar white (inp=gri,out=gwo));
      write (gwi, g);
      parsr = read gro;
    };
    sched.run;
    return parsr;
  }

  gen run_parser_on_string (parsr:parser_t) (s:string) : list[parser_state_t] =
  {
    var results = Empty[parser_state_t];
    var b = Buffer s;
    var ps : parser_state_t = (pos=b, stack=Empty[stack_node_t]);
    var sched = #fibre_scheduler;
    spawn_fthread sched {
      var ri,wi = mk_ioschannel_pair[parser_state_t]();
      var ro,wo = mk_ioschannel_pair[parser_state_t]();
      spawn_fthread (parsr (inp=ri, out=wo));
      write (wi,ps);
      while true do
        var result = read ro;
        results = result ! results;
        //println$ "Test1: End pos (should be 14)=" + result.str;
      done
    };
    sched.run;
    return results;
  }

  // replace internal sub-expressions with fresh nonterminals
  fun unpack (fresh:1->string) (head:string, p:pgram_t) : pgramlib_t =
  {
   var out = Empty[pgramentry_t];
   match p with
   | `Action a => out = ([head,p]);
   | `Epsilon => out = ([head,p]);
   | `Terminal _ => out = ([head,(`Seq ([p]):>>pgram_t)]);
   | `Nonterminal s => out= ([head,(`Seq ([p]):>>pgram_t)]);

   | `Seq ps =>
     var newseq = Empty[pgram_t];
     for term in ps do
       match term with
       | `Action _ => newseq = term ! newseq;
       | `Epsilon => ;
       | `Nonterminal _ => newseq = term ! newseq;
       | `Terminal _ => newseq = term ! newseq;
       | _ =>
         var newhead = fresh();
         newseq = (`Nonterminal newhead :>>pgram_t) ! newseq;
         out = unpack fresh (newhead,term);
       endmatch;
     done

     match newseq with
     | Empty => out = (head,(#`Epsilon:>> pgram_t)) ! out;
     | _ => out = (head,(`Seq(rev newseq):>>pgram_t)) ! out;
     endmatch;

   | `Alt ps =>
     iter (proc (p:pgram_t) { out = unpack fresh (head,p) + out; }) ps;
   endmatch;
   return out;
  }

  // expand internal sub-expressions, return a list of symbol sequences
  // the outer list are the alternatives and the inner ones sequences
  // IN REVERSE ORDER!
  fun expand_aux (p:pgram_t) : list[list[pgram_t]] =
  {
   var out = ([Empty[pgram_t]]);
   match p with
   // add symbol to each alternative
   | `Epsilon => ;
   | `Action a
   | `Terminal _
   | `Nonterminal s =>
     out = map (fun (ss: list[pgram_t]) => Cons (p,ss)) out;

   // A sequence is unpacked by successively unpacking each
   // symbol. The result is then prepended to each alternative.
   | `Seq ps =>
     for term in ps do
       var tmp = expand_aux term;
       var out2 = Empty[list[pgram_t]];
       for left in tmp perform
         for right in out perform
           out2 += left + right;
       out = out2;
     done

   | `Alt ps =>
     var alts = cat (map expand_aux ps);
     out2 = Empty[list[pgram_t]];
     for left in alts perform
       for right in out perform
         out2 += left + right;
     out = out2;

   endmatch;
   return out;
  }

  fun expand (p:pgram_t) : pgram_t =>
    let ps = expand_aux p in
    (`Alt (map (fun (seqs: list[pgram_t]) => `Seq(rev seqs):>>pgram_t) ps)) :>> pgram_t
  ;

  // in p replace nonterminal name with value (where q=name,value)
  fun substitute (q:pgramentry_t) (p:pgram_t)=>
    let name,value = q in
    match p with
    | `Nonterminal s when name == s => value
    | `Seq ls => `Seq (map (substitute q) ls) :>> pgram_t
    | `Alt ls => `Alt (map (substitute q) ls) :>> pgram_t
    | _ => p
  ;

// direct left recursion eliminator
// assumes A = A alpha | beta form
// outputs
// A = beta A'
// A' = alpha A' | Eps
//
// BETTER
//
// A = beta | beta A'
// A' = alpha A' | alpha
//
// since this is Epsilon free

  fun direct_left_recursion_elimination
   (fresh:1->string)
   (lib:pgramlib_t)
  =
  {
   var outgram = Empty[pgramentry_t];
   for ntdef in lib do
     var nt,expr = ntdef;
     var alphas = Empty[list[pgram_t]];
     var betas = Empty[list[pgram_t]];
  // where does Epsilon go??
     match expr with
     | `Alt alts =>
       for alt in alts do
         match alt with
         | (`Seq (Cons ((`Nonterminal $(nt)),tail))) => alphas = tail ! alphas;
         | (`Seq b) => betas = b ! betas;
         | x => betas = ([x]) ! betas;

         //| x => println$ "EDLR, unexpected alternative " + x.str; assert false;
         endmatch;
       done
     | x => betas = ([x]) ! betas;

     //| x => println$ "EDLR, unexpected expr " + x.str; assert false;
     endmatch;
     if alphas.len == 0uz do
       outgram = (nt,expr) ! outgram;
     else
       var newntname = fresh();
       var newnt = `Nonterminal newntname :>> pgram_t;
       var alts = map (fun (b:list[pgram_t]) => `Seq (b + newnt):>>pgram_t) betas;
       outgram =  (nt, (`Alt alts :>>pgram_t)) !  outgram ;
       alts = map (fun (a:list[pgram_t]) => (`Seq (a + newnt):>>pgram_t)) alphas + (#`Epsilon:>>pgram_t);
       outgram = (newntname, (`Alt alts:>>pgram_t)) ! outgram;
     done
   done
   return outgram;
  }

  gen fresh_sym () : string = {
    var n = 1;
  next:>
    yield "_"+n.str;
    ++n;
    goto next;
  }
  // this needs to be global so the algo can be re-applied to the same
  // grammar library
  var fresh = fresh_sym;

  fun direct_left_recursion_elimination (lib:pgramlib_t) =
  {
    return direct_left_recursion_elimination fresh lib;
  }

  fun make_seq (a:pgram_t) (b:list[pgram_t]) =>
    match a with
    | (`Seq a) => `Seq (a + b) :>> pgram_t
    | _ => `Seq (a ! b) :>> pgram_t
  ;

  // requires one entry per non-terminal, sorted for performance
  // must be in form Alt (Seq (nt, ...)) or Seq (nt, ...) or sym
  // right is the original grammar which i scans thru
  // left is the modified grammar for j = 1 to n -1
  // each recursion advances i one step

  fun left_recursion_elimination_step
    (fresh:1->string)
    (var left:pgramlib_t)
    (var right:pgramlib_t)
  =
  {
     match right with
     | Empty => return left;
     | (rnt,rdfn) ! tail => // A_i
println$ "left_recursion_elimination considering nonterminal A_i=" +rnt;
       var rprods =
         match rdfn with
         | `Alt alts => alts
         | _ => ([rdfn])
       ;

       var toremove = Empty[int];
       var toadd = Empty[pgram_t];
       match lnt,ldfn in left do // A_j = 1 to i - 1
println$ "  left_recursion_elimination considering nonterminal A_j=" +lnt;
         var lprods =
           match ldfn with
           | `Alt alts => alts
           | _ => ([ldfn])
         ;
         var counter = -1;
         for rprod in rprods do // A_i = A_j alpha
println$ "    checking if " + rnt + " = " + rprod.str + " has left corner A_j=" + lnt;
           ++counter;
           match rprod with
           | `Seq ((`Nonterminal s) ! alpha) =>
             if s == lnt do
println$ "      YES: replace";
               toremove = counter ! toremove;
               for beta in lprods perform
                 toadd  = make_seq beta alpha ! toadd;
             else // not of form A_i = A_j alpha
println$ "      NO: keep";
             done
           | `Nonterminal s => // alpha = Epsilon
             if s == lnt do
println$ "      YES: replace";
               toremove = counter ! toremove;
               for beta in lprods perform
                 toadd  = beta ! toadd;
             else
println$ "      NO: keep";
             done
           | _ =>
println$ "      NO: keep";
           endmatch;
         done // all A_i of form A_J alpha
       done
       // strip replaced productions out, add the others
       counter = -1;
       for elt in rprods do
         ++counter;
         if not (counter in toremove) perform
           toadd = elt ! toadd;
       done
       var newa_i = direct_left_recursion_elimination fresh ([rnt, (`Alt toadd :>> pgram_t)]);
       return left_recursion_elimination_step fresh (newa_i + left) tail;
     endmatch;
  }

  fun left_recursion_elimination
    (fresh:1->string)
    (var right:pgramlib_t)
  => left_recursion_elimination_step fresh Empty[pgramentry_t] right;

} // class

//[parser_synlib.flx]
include "std/strings/parsers";

class Parser_synlib
{
  open Parsers;
  open Grammars;
  fun NT (s:string) => `Nonterminal  s :>> pgram_t ;
  fun TERM (s:string, r:Recognisers::recog_t) => `Terminal (s,r) :>> pgram_t;
  fun STR (s:string) => (`Terminal (s, (Recognisers::match_string s)));
  fun REDUCE (s:string, n:int) => `Action (Reduce (s,n)) :>> pgram_t;
  fun BINOP(s:string) => `Action (Sequence ([Swap, Drop 1, (Reduce (s,2))])):>>pgram_t;
  fun SWAP () => `Action (Swap) :>> pgram_t;
  fun DROP (n:int) => `Action (Drop n) :>> pgram_t;
  fun ALT (ls: list[pgram_t]) => `Alt ls :>> pgram_t;
  fun SEQ (ls: list[pgram_t]) => `Seq ls :>> pgram_t;
  fun EPS () => (#`Epsilon) :>> pgram_t;
}

Package: src/packages/pointers.fdoc

Pointers and low level address manipulation.

key file
carray.flx share/lib/std/c/carray.flx
cptr.flx share/lib/std/c/cptr.flx
shared_ptr.flx share/lib/std/c/shared_ptr.flx
key file
sort.flx share/lib/std/datatype/sort.flx
posix_mmap.flx share/lib/std/posix/mmap.flx
carray_test.flx test/regress/rt/carray_test.flx
carray_test.expect test/regress/rt/carray_test.expect
C pointer
//[cptr.flx]

// move to separate file later.
open class AbstractPointers
{
  typedef fun rptr (T:TYPE) : TYPE =>  (get: 1 -> T);
  typedef fun wptr (T:TYPE) : TYPE =>  (set : T -> 0);
  typedef fun rwptr (T:TYPE) : TYPE => (get: 1 -> T, set : T -> 0);

  fun mkr[T] (p:&<T) => (get= { *p });
  fun mkw[T] (p:&>T) => (set = proc (v:T) { p<-v; });
  fun mkrw[T] (p:&T) => mkr p + mkw p;

  fun deref[T] (p: rptr T) => p.get ();
  proc storeat[T] (p: wptr T, v: T) { p.set v; }
}

open class MachinePointers
{
  // ordinary pointers
  proc storeat[T] ( p: &>T, v: T) = { _storeat (p,v); }

  //$ Dereference a Felx pointer.
  //lvalue fun deref[T]: &T -> T = "*$1";
  fun _deref[T]: &<T -> T = "*$t";
  fun deref[T] (p:&<T) => _deref p;
}

open class CompactLinearPointers
{
  // concrete compact linear type pointers
  proc storeat[D,C] ( p:_wpclt< D, C >, v: C) = { _storeat (p,v); }

  // deref a pointer to compact linear component
  fun _deref[mach,clv]: _rpclt<mach,clv> -> clv = "::flx::rtl::clt_deref($t)";
  fun deref[mach,clv] (p: _rpclt<mach,clv>) => _deref p;
}


//$ Felix and C pointers.
//$ Felix pointer ptr[T] = &T.
//$ C pointer cptr[T] = &T.
//$ See also carray for incrementable pointers carray[T] = +T.
open class Cptr
{
  //$ Type of a Felix pointer.
  //$ Always points to an object.
  //$ Cannot be NULL.
  //$ Cannot be incremented.
  typedef ptr[T] = &T;

  //$ Type of a C pointer.
  //$ Either pointes to an object or is NULL.
  //$ Cannot be incremented.
  variant cptr[T] = | nullptr | Ptr of &T;

  //$ Demote a Felix pointer to a C pointer. Safe.
  ctor[T] cptr[T]: &T = "$t";

  //$ Promote a C pointer to a Felix pointer.
  //$ Conversion is checked.
  //$ Aborts with match failure if NULL.
  ctor[T] ptr[T](px:cptr[T]) =>
    let Ptr p = px in p
   ; // match failure if null

  //$ Checked dereference of C pointer.
  fun deref[T] (px:cptr[T])=> *(px.ptr);

  //$ Test if a C pointer is NULL.
  fun is_nullptr[T] (px:cptr[T])=> match px with | #nullptr => true | _ => false endmatch;

  instance[T] Eq[cptr[T]] {
    //$ Equality of C pointers.
    fun == : cptr[T] * cptr[T] -> bool = "$1==$2";
  }
  instance[T] Tord[cptr[T]] {
    //$ Total ordering of C pointer.
    //$ NULL is the least element.
    fun < : cptr[T] * cptr[T] -> bool = "$1<$2";
  }

  //$ Allocate unmanaged C++ object on the heap and return pointer.
  //$ Felix does not check the argument type, but C++ does.
  //$ The argument must select a suitable C++ constructor.
  gen cnew[T,A] : A -> &T = "new (?1)($a)";

  //$ Delete unmanaged C++ object from heap
  proc delete[T] : &T = "delete $1;";

  //$ Allocate managed C++ object directly on heap.
  //$ Felix does not check the argument type, but C++ does.
  //$ The argument must select a suitable constructor.
  gen gcnew[T,A] : A -> &T = "new (*PTF gcp, @?1,true) (?1)($a)";

}

open[T] Eq[cptr[T]];
open[T] Tord[cptr[T]];

//$ Special notation @T for  type of a C pointer.
typedef fun n"@" (T:TYPE) : TYPE => cptr[T];
C Arrays

A carray[T], with more suggestive shorthand notation +T, is an incrementable, non-NULL pointer to a contiguous store.

//[carray.flx]


// For some reason this functor must be in global scope
//$ Define prefix + notation.
typedef fun prefix_plus(T:TYPE) : TYPE => Carray::carray[T];

//$ A carray[T] = +T is an incrementable, non-NULL, pointer.
open class Carray
{
  requires Cxx_headers::cstdlib;
  open C_hack;

  //$ The carray type.
  type carray[T] = new &T;
Allocation

These allocators use raw malloc/ calloc/ free and therefore provide store of which the garbage collector is unaware. It is best to reserve such carrays for C datatypes.

//[carray.flx]

  //$ Allocate a C array on the C heap (malloc).
  //$ Unsafe: Not tracked by GC.
  fun array_alloc[T]: !ints -> carray[T] = '(?1*)::std::malloc(sizeof(?1)*$1)';

  //$ Allocate a C array on the C heap with 0 fill (cmalloc).
  //$ Unsafe: Not tracked by GC.
  fun array_calloc[T]: !ints -> carray[T] = '(?1*)::std::calloc(sizeof(?1),$1)';

  //$ Free a C array (free).
  //$ Must point to C heap allocated storage. Unsafe.
  proc free[T]: carray[T] = "::std::free($1);";
Dereference
//[carray.flx]

  //$ Functional get by index.
  fun get[T]: carray[T] * !ints -> T = '$1[$2]';

  //$ Store value in array at index position.
  proc set[T] : carray[T] * !ints * T = "$1[$2]=$3;";

  //$ Get by index using application.
  //$ i x = x . i = get (x,i)
  fun apply [T,I in ints] (i:I, x:carray[T]) => get (x,i);
Lvalue dereferences

Note that lvalue operators are for convenience of those familiar with C notation. Felix does not support the notion of lvalues in general: this is a very special case.

//[carray.flx]
  //$ Lvalue reference to element by index position. Unsafe.
  //lvalue fun subscript[T]: carray[T] * !ints -> T = '$1[$2]';
  fun subscript[T]: carray[T] * !ints -> T = '$1[$2]';

  //$ Lvalue reference to element by pointer.
  //lvalue fun deref[T]: carray[T] -> T = '*$1';
  fun deref[T]: carray[T] -> T = '*$1';
Pointer operators
//[carray.flx]
  //$ Advance carray to next element.
  fun + [T]: carray[T] * !ints -> carray[T]= '$1+$2';

  //$ Backup carray to previous element.
  fun - [T]: carray[T] * !ints -> carray[T] = '$1-$2';

  //$ Calculate the offset in elements between
  //$ two overlapping carrays.
  fun - [T]: carray[T] * carray[T]-> ptrdiff = '$1-$2';
Mutators
//[carray.flx]

  //$ Mutable pre-increment ++p.
  proc pre_incr[T]: &carray[T] = '++*$1;';

  //$ Mutable post-increment p++.
  proc post_incr[T]: &carray[T] = '(*$1)++;';

  //$ Mutable pre-decarement --p.
  proc pre_decr[T]: &carray[T] = '--*$1;';

  //$ Mutable post-decarement p--.
  proc post_decr[T]: &carray[T] = '(*$1)--;';

  //$ Mutable advance by offset amount.
  proc += [T]: &carray[T] * !ints = '*$1+=$2;';

  //$ Mutable backup by offset amount.
  proc -= [T]: &carray[T] * !ints = '*$1-=$2;';
Comparisons
//[carray.flx]

  //$ Pointer equality.
  instance[T] Eq[carray[T]] {
    fun == : carray[T] * carray[T] -> bool = '$1==$2';
    fun != : carray[T] * carray[T] -> bool = '$1!=$2';
  }

  //$ Pointer total ordering.
  instance[T] Tord[carray[T]] {
    fun < : carray[T] * carray[T] -> bool = '$1<$2';
    fun <= : carray[T] * carray[T] -> bool = '$1<=$2';
    fun > : carray[T] * carray[T] -> bool = '$1>$2';
    fun >= : carray[T] * carray[T] -> bool = '$1>=$2';
  }
Conversions
//[carray.flx]
  //$ Get carray of an array.
  fun stl_begin[T,N]: carray[array[T,N]] -> carray[T] = "(?1*)&($1->data)";

  //$ Unsafe conversion of Felix pointer to carray.
  fun prefix_plus [T]:&T -> carray[T] = "$t"; // unsafe

  //$ Demote carray to Felix pointer (safe unless off the end).
  fun neg [T]: carray[T] -> &T = "$t"; // safe (unless we allow +T to be NULL later ..)

  //$ Unsafe conversion of Felix pointer to carray.
  ctor[T] carray[T] : &T = "$t";

  //$ Get a carray from a Felix array object.
  ctor[T,N] carray[T]: &array[T,N] = "($1)->data";


  //$ Convert C array to Felix array.
  fun array_of[T,N]: carray[T] -> &array[T,N] = "*(#0*)(void*)$1";
}

open[T] Eq[carray[T]];
open[T] Tord[carray[T]];

//[carray_test.flx]
// carray test

var a : +int = array_alloc[int] 10;
for var i in 0 upto 9 do
  set(a, i, i * i);
  set(a,i,get(a,i)+1);
done
for i in 0 upto 9 do
  println$  a.[i], *(a+i), a.i;
done
free a;

(1, 1, 1)
(2, 2, 2)
(5, 5, 5)
(10, 10, 10)
(17, 17, 17)
(26, 26, 26)
(37, 37, 37)
(50, 50, 50)
(65, 65, 65)
(82, 82, 82)
Array sort

Sort an array using STL sort.

//[sort.flx]

//$ Utility class to leverage STL sort.
class Sort
{
  //$ STL compliant comparator object built from
  //$ a closure of a Felix function.
  private header stl_comparator_def =
  """
  template<class CT, class FT2, class FFT>
  struct comparator {
    FFT cmp;
    comparator() : cmp(0) {}
    comparator(FFT cmp_a) : cmp(cmp_a) {}
    bool operator ()(CT x, CT y){
      ::std::pair<CT,CT> z(x,y);
      return cmp->apply(*(FT2*)(void*)&z);
    }
  };
  """ requires Cxx_headers::utility;

  private type _comparator[CT,FT2,FFT] = "comparator<?1,?2,?3>" requires stl_comparator_def;
  type stl_comparator[T] = new _comparator[T,T*T,T*T->bool];

  private fun _make_comparator[CT,FT2,FFT]: FFT -> stl_comparator[CT] =
    "comparator<?1,?2,?3>($1)"
  ;

  //$ Make a C++ STL comparator object from a Felix comparison function.
  ctor[T] stl_comparator[T] (cmp:T * T -> bool) =>
    _make_comparator[T, T*T, T*T->bool] (cmp)
  ;

  //$ Invoke stl sort with C++ comparator.
  proc stl_sort[T]: stl_comparator[T] * +T * +T = "::std::sort($2, $3, $1);"
    requires Cxx_headers::algorithm;

  //$ Invoke stl sort with Felix comparison function.
  inline proc stl_sort[T] (cmp: T * T -> bool, b: +T,  e:+T) =>
    stl_sort (stl_comparator cmp, b, e)
  ;

  //$ Invoke stl sort default comparison function.
  inline proc stl_sort[T with Tord[T]] (b:+T, e:+T) => stl_sort ( (< of (T * T)), b, e);

}
Reference counting pointer.
//[shared_ptr.flx]
open class SharedPtr
{
   type shared_ptr[T]
     = "::std::shared_ptr<?1>"
     requires Cxx_headers::memory
   ;

   ctor[T] shared_ptr[T] : 1 = "::std::shared_ptr<?1>()"; // nullptr
   ctor[T] shared_ptr[T] : &T = "::std::shared_ptr<?1>($1)";

   proc reset[T] : &shared_ptr[T] = "$1->reset();";
   proc swap[T] : &shared_ptr[T] * &shared_ptr[T] = "$1->swap(*$2);";
   fun get[T] : shared_ptr[T] -> &T = "$1.get()";
   fun deref[T] : shared_ptr[T] -> T = "*$1";
   fun use_count[T] : shared_ptr[T] -> long = "$1.use_count()";
   fun unique[T] : shared_ptr[T] -> bool = "$1.unique";
   fun is_null[T] : shared_ptr[T] -> bool = "(bool)$1";
}
MMap

Address mapping facility. Note: this is the posix function mmap(). Windows has a similar capability we have not modelled yet.

//[posix_mmap.flx]

class Mmap
{
  requires package "mmap";
  header """
    // MAP_ANON is an older form of MAP_ANONYMOUS, and should be compatible
    #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
    #  define MAP_ANONYMOUS MAP_ANON
    #endif
  """;

  // Offset into file, should be defined elsewhere
  typedef off_t = ulong;

  type mmap_prot = "int";
  instance Eq[mmap_prot]{
     fun == : mmap_prot * mmap_prot -> bool = "$1==$2";
  }
  instance Bits[mmap_prot]{}

  inherit Eq[mmap_prot];
  inherit Bits[mmap_prot];


  type mmap_flags = "int";
  instance Eq[mmap_flags]{
     fun == : mmap_flags * mmap_flags -> bool = "$1==$2";
  }
  instance Bits[mmap_flags]{}

  inherit Eq[mmap_flags];
  inherit Bits[mmap_flags];

  // protection options
  const PROT_NONE  : mmap_prot;  // Posix: inaccessible
  const PROT_EXEC  : mmap_prot;  // Posix: allow exec
  const PROT_READ  : mmap_prot;  // Posix: allow read (and perhaps exec)
  const PROT_WRITE : mmap_prot;  // Posix: allow write (and perhaps write and exec)

  // Linux only
  const MAP_DENYWRITE: mmap_flags; // Linux only

  // flags: mode
  const MAP_FILE: mmap_flags;      // Posix: Default mode: map a file
  const MAP_ANONYMOUS: mmap_flags; // Linux, OSX: Map from VM pool

  // flags: map address
  const MAP_FIXED: mmap_flags;     // Posix: Client tries to fix the mapping address,
                            // must set address argument non-NULL
                            // Implementation dependent
                            // Default: system chooses address is not specified
                            // must set address NULL

  // flags: sharing
  const MAP_SHARED : mmap_flags;   // Posix: write changes to backing store on msync
  const MAP_PRIVATE : mmap_flags;  // Posix: don't write changes ever

  // System dependent:
  const MAP_HASSEMAPHORE: mmap_flags;
  const MAP_NORESERVE: mmap_flags;
  const MAP_LOCKED: mmap_flags;
  const MAP_GROWSDOWN: mmap_flags;
  const MAP_32BIT: mmap_flags;
  const MAP_POPULATE: mmap_flags;
  const MAP_NONBLOCK: mmap_flags;

  // return value of mmap
  const MAP_FAILED : address;

  // size of a page
  const _SC_PAGESIZE : long = "sysconf(_SC_PAGESIZE)";

  // establish a mapping
  fun mmap:
    address * //< start address
    size *    //< bytes to map
    mmap_prot *     //< protection
    mmap_flags *     //< flags
    int *     //< file descriptor
    off_t     //< offset into file, multiple of _SC_PAGESIZE
    -> address; //< start of reserved address space

  // unmap a region
  fun munmap: address * size -> int;

  // save region to backing store (MAP_SHARED only)
  fun msync: address * size * int -> int;
}

Package: src/packages/recognisers.fdoc

key file
recogniser_base.flx share/lib/std/strings/recogniser_base.flx
recognisers.flx share/lib/std/strings/recognisers.flx

String Matching recogniser_base

Recognisers

A recogniser is a component which tries to match the prefix of a string. If it succeeds it returns the position of the first character not matched.

Buffer type

Recognisers work on an array of chars in memory. We use a Google StringPiece to represent it.

//[recogniser_base.flx]
include "std/control/chips";
class RecogniserBase
{
open BaseChips; //needed for pipe symbol to work

struct Buffer
{
  sp: varray[char];
  pos: int;

  fun atend => self.pos >= self.sp.len.int;

  fun get =>
    if self.atend then char ""
    else (self.sp) . (self.pos)
  ;

  proc next {
    if not self*.atend do
      pre_incr self.pos;
    done
  }

  fun advanced =>
    if self.atend then self
    else Buffer (self.sp, self.pos + 1)
  ;

  fun lookahead (i:int) =>
    if self.pos + i > self.sp.len.int then char ""
    elif self.pos + i < 0 then char ""
    else (self.sp) . (self.pos + i)
  ;

  fun stl_end => Buffer (self.sp,self.sp.len.int);

}


ctor Buffer (p:varray[char]) =>
  Buffer (p,0)
;

ctor Buffer (p:string) =>
  Buffer (p.varray_nonul,0)
;

ctor Buffer (p: &string) =>
  Buffer (*p)
;

instance Str[Buffer] {
  fun str (b:Buffer) => "@"+b.pos.str;
}

// hack, ignore underlying data.. FIXME
instance Eq[Buffer] {
  fun == (a:Buffer, b:Buffer) => a.pos == b.pos;
}
instance Tord[Buffer] {
  fun < (a:Buffer, b:Buffer) => a.pos < b.pos;
}

open Eq[Buffer];
open Tord[Buffer];

ctor string (a:Buffer, b:Buffer) =
{
  var x = "";
  for i in a.pos ..< b.pos do
    x += a.sp.i;
  done
  return x;
}

typedef recog_t = BaseChips::iochip_t[Buffer,Buffer];
// rendering lazy terms to actual recognizer
A string matcher.
//[recogniser_base.flx]
chip match_string (s:string)
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
nextmatch:>
  var b = read io.inp;
  //println$ "Match " + s + " at " + b.str;
  for i in 0..< s.len.int do
    if s.[i] != b.get goto nextmatch;
    b&.next;
  done
  //println$ "Matched " + s + " to " + b.str;
  write (io.out, b);
  goto nextmatch;
}
Whitespace matcher.

Note: never fails.

//[recogniser_base.flx]
chip match_white
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
  while true do
    var b = read io.inp;
    while not b.atend and b.get <= char ' ' perform b&.next;
    write (io.out,b);
  done
}
C++ comment matcher

Note: cannot fail.

//[recogniser_base.flx]
chip match_cxx_comment
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
again:>
  var b = read io.inp;
  var b_saved = b;

  if b.get != char "/" goto bad;
  b&.next;

  if b.get != char "/" goto bad;
  b&.next;

  while not b.atend and not (b.get == char "\n")  perform b&.next;
  b&.next; // works fine even if atend
ok:>
  write (io.out,b);
  goto again;
bad:>
  write (io.out,b_saved);
  goto again;
}
Nested C comment matcher

Note: cannot fail.

//[recogniser_base.flx]
chip match_nested_c_comment
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
again:>
  var depth = 0;
  var b = read io.inp;
  var b_saved = b;
  if b.get != char "/" goto bad;
  b&.next;
  if b.get != char "*" goto bad;

nest:>
  b&.next;
  ++depth;

scan:>
  if b.get == "/" do // start nested comment
    b&.next;
    if b.get == "*" goto nest;
    goto scan;
  done

  if b.get == "*" do // end comment group
    b&.next;
    if b.get == "/" goto unnest;
    goto scan;
  done

  b&.next;
  goto scan;

unnest:>
  b&.next;
  --depth;
  if depth > 0 goto scan;
  write (io.out,b);
  goto again;

bad:>
  write (io.out,b_saved);
  goto again;
}
Felix comments

Note: can fail.

//[recogniser_base.flx]

chip match_felix_white
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
  var ri,wi= #mk_ioschannel_pair[Buffer];
  var ro,wo= #mk_ioschannel_pair[Buffer];
  device w = BaseChips::pipeline_list ([match_white, match_nested_c_comment, match_cxx_comment]);
  circuit
     wire ri to w.inp
     wire wo to w.out
  endcircuit

again:>
  var start = read io.inp;
more:>
  write (wi, start);
  var fin = read ro;
  if fin != start do
    start = fin;
    goto more;
  done

  write (io.out, fin);
  goto again;
}
regex matcher.
//[recogniser_base.flx]
chip match_regex (r:RE2)
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
  while true do
    var b = read io.inp;
//println$ "Match regex " + r.str;
    var matched = varray[StringPiece] (1uz,StringPiece());
    var result = Match(r,StringPiece(b.sp),b.pos,ANCHOR_START,matched.stl_begin,1);
//println$ "Match result " + result.str;
    if result do
//println$ "Matched OK, match len = " + matched.0.len.str;
      var b2 = Buffer (b.sp,b.pos+matched.0.len.int);
//println$ "Writing buffer = " + b2.str;
      write(io.out,b2);
    done
  done
}
Identifier matcher.

For C like identifiers.

//[recogniser_base.flx]
device cident_matcher = match_regex (RE2 "[A-Za-z][A-Za-z0-9_]*");
device flxident_matcher = match_regex (RE2 "[A-Za-z_][A-Za-z0-9_']*");
device texident_matcher = match_regex (RE2 "\\\\[A-Za-z]+");

chip flx_n_ident_matcher
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
nextnident:>
  var b = read io.inp;
  if b.get != char "n" goto nextnident;
  b&.next;
  if b.get == char "'" do
    b&.next;
    while not b.atend and b.get != char "'" perform b&.next;
    b&.next;
    write (io.out, b);
  elif b.get == char '"' do
    b&.next;
    while not b.atend and b.get != char '"' perform b&.next;
    b&.next;
    write (io.out, b);
  done
  goto nextnident;
}

chip felix_identifier_matcher
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
  device x = BaseChips::tryall_list
    ([
      flxident_matcher,
      texident_matcher,
      flx_n_ident_matcher
    ])
  ;
  circuit
    wire io.inp to x.inp
    wire io.out to x.out
  endcircuit
}
Integer matcher.

For plain identifiers.

//[recogniser_base.flx]
device decimal_integer_matcher = match_regex (RE2 "[0-9]+");
Felix integer matcher.

With radix prefix, and allows embedded underscores. Will recognise repeated underscores and trailing underscores even though these are not allowed. I mean, what should we do if we find them?

//[recogniser_base.flx]

chip felix_integer_matcher
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
nexttry:>
  var b = read io.inp;
//println$ "Felix integer matcher "+b.str;
  var ch = b.get;
  if ch not in "0123456789" goto bad;

  if ch == char "0" do
    b&.next;
    ch = b.get;
//println$ "felix_integer got leading 0, next char " + ch;
    if ch in "bB" goto nextbinary;
    if ch in "oO" goto nextoctal;
    if ch in "dD0123456789_" goto nextdecimal;
    if ch in "xX" goto nexthex;
//println$ "Bad radix";
    goto bad;
  done
  goto decimal;

nextbinary:>
  b&.next;
binary:>
  ch = b.get;
  if ch in "_01234567" goto nextbinary;
  goto suffix;

nextoctal:>
  b&.next;
octal:>
  ch = b.get;
  if ch in "_01234567" goto nextoctal;
  goto suffix;


nextdecimal:>
  b&.next;
decimal:>
  ch = b.get;
  if ch in "_0123456789" goto nextdecimal;
  goto suffix;

nexthex:>
  b&.next;
hex:>
  ch = b.get;
  if ch in "_0123456789ABCDEFabcdef" goto nexthex;
  goto suffix;

suffix:>
  // 3 char suffix
  if "" + toupper (b.get) + toupper (b.lookahead 1) + toupper (b.lookahead 2) in
    ([
      "I16", "I32","I64",
      "U16", "U32","U64"
    ])
  do
    b&.next;
    b&.next;
    b&.next;

  // 2 char suffix
  elif "" + toupper (b.get) + toupper (b.lookahead 1) in
    ([
      "LL","I8","U8",
      "UT","US","UD","UL","UV","UZ","UJ",
      "TU","SU","DU","LU","VU","ZU","JU"
    ])
  do
    b&.next;
    b&.next;

  // one char suffix
  elif "" + toupper (b.get) in
    ([
      'T', // tiny
      'S', // short
      'I', // int
      'L', // long
      'V', // long long
      "Z", // size
      "J", // intmax
      "P", // intptr
      "D"  // ptrdiff
    ])
  do
    b&.next;
  done
  goto ok;

ok:>
//println$ "Felix integer ok";
  write (io.out,b);
  goto nexttry;

bad:>
//println$ "Felix integer bad";
  goto nexttry;
}
Felix float matcher.

//$ Follows ISO C89, except that we allow underscores; //$ AND we require both leading and trailing digits so that //$ x.0 works for tuple projections and 0.f is a function //$ application

//[recogniser_base.flx]
chip felix_float_literal_matcher
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
nexttry:>
  var b = read io.inp;
  var ch = b.get;
  if ch == char "0" do
    b&.next;
    ch = b.get;
//println$ "felix_integer got leading 0, next char " + ch;
    if ch in "dD0123456789_" goto nextdecimal;
    if ch in "xX" goto nexthex;
//println$ "Bad radix";
    goto bad;
  done
  goto decimal;


nextdecimal:>
  b&.next;
decimal:>
  ch = b.get;
  if ch in "_0123456789" goto nextdecimal;
  if b.get != char "." goto bad;
  b&.next;
  if b.get not in "0123456789" goto bad;
  b&.next;

nextdecimalfrac:>
  b&.next;
decimalfrac:>
  ch = b.get;
  if ch in "_0123456789" goto nexthexfrac;
  if ch not in "Ee" goto ok;
  b&.next;
  if b.get == char "-" perform b&.next;
  if b.get not in "0123456789" goto bad;
nextdecexp:>
  b&.next;
  if b.get not in "0123456789" goto suffix;
  goto nextdecexp;

nexthex:>
  b&.next;
hex:>
  ch = b.get;
  if ch in "_0123456789ABCDEFabcdef" goto nexthex;
  if b.get != char "." goto bad;
  b&.next;
  if b.get not in "0123456789ABCDEFabcdef" goto bad;
  b&.next;

nexthexfrac:>
  b&.next;
hexfrac:>
  ch = b.get;
  if ch in "_0123456789ABCDEFabcdef" goto nexthexfrac;
  if ch not in "Pp" goto ok;
  b&.next;
  if b.get == char "-" perform b&.next;
  if b.get not in "0123456789" goto bad;
nexthexexp:>
  b&.next;
  if b.get not in "0123456789" goto suffix;
  goto nexthexexp;

suffix:>
  if b.get in "fFlL" perform b&.next;

ok:>
//println$ "Felix float ok";
  write (io.out,b);
  goto nexttry;

bad:>
//println$ "Felix integer bad";
  goto nexttry;
}
String Literal matcher.

One shot. Simple, matches single or double quoted string not spanning lines, with no escape codes,

//[recogniser_base.flx]
chip match_string_literal
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
restart:>
  var b = read io.inp;
  if b.atend goto restart; // end of data
  var leadin = b.get;
//println$ "string literal matcher got char " + leadin.str;
  if not (leadin in (char '"', char "'")) goto restart;
//println$ "Got valid string start .. ";
  b&.next;
  if b.atend goto restart;
  var ch = b.get;
  while ch != leadin do
    b&.next;
    if b.atend goto restart;
    ch = b.get;
    if ch == char "\n" goto restart; // end of line
  done
  b&.next;
  io.out `(write) b;
  goto restart;
}

chip match_string_literal_backquote
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
restart:>
  var b = read io.inp;
  if b.atend goto restart; // end of data
  var leadin = b.get;
//println$ "string literal matcher got char " + leadin.str;
  if leadin != char '`' goto restart;
//println$ "Got valid string start .. ";
  b&.next;
  if b.atend goto restart;
  var ch = b.get;
  while ch != leadin do
    b&.next;
    if b.atend goto restart;
    ch = b.get;
    if ch == char "\n" goto restart; // end of line
  done
  b&.next;
  io.out `(write) b;
  goto restart;
}

chip felix_string_literal_matcher
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
restart:>
  var b = read io.inp;
  var triple = false; // single quoted
  var escape = char ""; // no escape

  // r: raw string, f: function, c: C string
  // add others here

  // check for raw prefix r
  if b.get in "r" do
    if b.lookahead 1 != char '"' goto bad;
    b&.next;
    goto strlit;
  done

  // check for other prefixen
  if b.get in "cf" do
    if b.lookahead 1 != char '"' goto bad;
    b&.next;
  done

  // normal escaping on
  escape = char "\\";

strlit:>
  if b.get not in "'\"" goto bad;
  var first_leadin = b.get;
  b&.next;
  if b.get == first_leadin and b.lookahead 1 == first_leadin do
    triple = true;
    b&.next;
    b&.next;
  done

//println$ "Leadin=" + first_leadin + ", triple=" + triple.str + ", escape=" + escape.str;

eatup:>
//println$ "Eatup " + b.get;

  if b.get == escape goto doescape;
  if not triple and b.get == "\n"  goto bad; // newline in string
  if not triple and b.get == first_leadin do
    b&.next;
    goto ok;
  done

  if triple and
    b.get == first_leadin and
    b.lookahead 1 == first_leadin and
    b.lookahead 2 == first_leadin
  do
    b&.next;
    b&.next;
    b&.next;
    goto ok;
  done

  b&.next;
  goto eatup;


doescape:>
//println$ "Escape";
  b&.next;
  b&.next;
  goto eatup;

ok:>
  write (io.out, b);
  goto restart;

bad:>
  goto restart;
}
End of string matcher
//[recogniser_base.flx]
chip eos_matcher
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
  while true do
    var x = read io.inp;
    if x.atend perform write (io.out,x);
  done
}
Longest match
//[recogniser_base.flx]
chip longest_match (a: list[recog_t])
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
  var x = read io.inp;
  var results = None[Buffer];
  proc storemax[T with Tord [T]] (p: &opt[T]) (a:T) {
    match *p with
    | None => p <- Some a;
    | Some v => if a > v perform p <- Some a;
    endmatch;
  }
  for r in a call
    run (x.value |-> r |-> (storemax &results).procedure)
  ;
  match results with
  | None => ;
  | Some answer => write (io.out, answer);
  endmatch;
}
Match to eos

Equivalent to .* but faster.

//[recogniser_base.flx]
chip toeos_matcher
  connector io
    pin inp: %<Buffer
    pin out: %>Buffer
{
  while true do
    var x = read io.inp;
    write (io.out,x.stl_end);
  done
}
}
Lazy Syntactic form
//[recognisers.flx]
// this is a function, so it cannot construct pipeline
// chips, because they actually spawn the components internally
// and functions can't do service calls.
//
// So instead we just return a function 1->recog_t which does the
// job on invocation.
include "std/strings/recogniser_base";
include "std/strings/grammars";

class Recognisers
{
inherit RecogniserBase;
open BaseChips;

open Grammars;

typedef ntdef_t = string * recog_t;

fun find (v:varray[ntdef_t]) (nt:string) : size =
{
  for i in 0uz ..< v.len do
    if v.i.0 == nt return i;
  done
  assert false;
}


fun render_prod
  (lib:gramlib_t,v:varray[ntdef_t])
  (p:prod_t)
: recog_t =>
  match p with
  | `Terminal (s,r) => r
  | `Epsilon =>  epsilon[Buffer]
  | `Seq ps =>  pipeline_list (
      map (fun (p:prod_t) => render_prod (lib,v) p) ps)
  | `Alt ps =>   tryall_list (
      map (fun (p:prod_t) => render_prod (lib,v) p) ps)
  | `Nonterminal nt =>
    let idx = find v nt in
    let pslot = -(v.stl_begin + idx) in
    let pchip = pslot . 1 in
    BaseChips::deref_first_read pchip
  endmatch
;

fun recogniser
  (start:string, lib:gramlib_t) : recog_t =
{
    var cl = closure (start,lib);

    // allocate a varray with a slot for each nonterminal
    var n = cl.len;
    var v = varray[string * recog_t] n;

    // populate the varray with the terminal names and a dummy chip
    for nt in cl call // initialise array
      push_back (v,(nt,BaseChips::epsilon[Buffer]))
    ;

    // now assign the real recogniser_base to the array
    var index = 0uz;
    for nt in cl do
      match find lib nt with
      | None => assert false;
      | Some prod =>
        // get wrapped recogniser
        var entry = render_prod (lib, v) prod;

        // address of the slot
        var pentry : &recog_t = (-(v.stl_begin+index)).1;

        // overwrite dummy value
        pentry <- entry;
      endmatch;
      ++index;
    done
    return v.(find v start).1;
}

fun in (s:string) (g:grammar_t) =
{
  chip false_if_got (pr: &bool)
     connector io
       pin inp: %<Buffer
  {
    C_hack::ignore$ read io.inp;
    pr <- true;
  }
  var r = recogniser g;
  var result = false;
  run (s.Buffer.value |-> r |-> eos_matcher |-> false_if_got &result);
  return result;
}

} // Recognisers

Package: src/packages/strings.fdoc

Strings

key file
__init__.flx share/lib/std/strings/__init__.flx
string.flx share/lib/std/strings/string.flx
String handling
//[__init__.flx]
include "std/strings/string";
include "std/strings/cstring";
include "std/strings/ustr";
Strings

We have three string like things. cstring is just an alias for a NTBS (Null Terminated Byte String). The workhorse string type based on C++ string.

A ustring is a unicode representation using a 32 bit unsigned integer as the character base. This type is deprecated, to be repalced by C++11 unicode string type.

//[string.flx]
typedef cstring = +char;
type string = "::std::basic_string<char>"
  requires Cxx_headers::string,
  header '#include "flx_serialisers.hpp"',
  encoder "::flx::gc::generic::string_encoder",
  decoder "::flx::gc::generic::string_decoder"
;
typedef strings = typesetof (string);

class Str [T] {
  virtual fun str: T -> string;
}

class Repr [T with Str[T]] {
  virtual fun repr (t:T) : string => str t;
}

class Show [T] {
  inherit Str[T];
  inherit Repr[T];
}
Equality and total ordering
//[string.flx]
instance[t in strings] Eq[t] {
  fun == : t * t -> bool = "$1==$2";
}
instance[t in strings] Tord[t] {
  fun < : t * t -> bool = "$1<$2";
}

class String
{
  inherit Eq[string];

  inherit Tord[string];
Equality of string and char
//[string.flx]
  fun == (s:string, c:char) => len s == 1uz and s.[0] == c;
  fun == (c:char, s:string) => len s == 1uz and s.[0] == c;
  fun != (s:string, c:char) => len s != 1uz or s.[0] != c;
  fun != (c:char, s:string) => len s != 1uz or s.[0] != c;
Append to string object
//[string.flx]
  proc  += : &string * string = "$1->append($2:assign);";
  proc  += : &string * +char = "$1->append($2:assign);";
  proc  += : &string * char = "*$1 += $2;";
  proc  += : &string * &string = "$1->append(*$2);";
Length of string
//[string.flx]
  // we need to cast to an int so that c++ won't complain
  fun len: string -> size = "$1.size()";
  fun len: &string -> size = "$1->size()";
String concatenation.
//[string.flx]
  fun + : string * string -> string = "$1+$2";
  fun + : string * carray[char] -> string = "$1+$2";
  fun + : string * char -> string = "$1+$2";
  fun + : char * string -> string = "$1+$2";
  //fun + : string * int -> string = "$1+::flx::rtl::i18n::utf8($2:assign)" is add requires package "flx_i18n";
  fun + ( x:string,  y: int) => x + str y;

  // may be a bit risky!
  // IT WAS: interferes with "hello" + list ("world","blah"):
  // is this a string or a list of strings?
  //fun + [T with Str[T]] (x:string, y:T) => x + str y;
Repetition of string or char
//[string.flx]
  fun * : string * int -> string = "::flx::rtl::strutil::mul($1:assign,$2:assign)" requires package "flx_strutil";
  fun * : char * int -> string = "::std::string($2:assign,$1:assign)";
Application of string to string or int is concatenation
//[string.flx]
  fun apply (x:string, y:string):string => x + y;
  fun apply (x:string, y:int):string => x + y;
Construct a char from first byte of a string.

Returns nul char (code 0) if the string is empty.

//[string.flx]
  ctor char (x:string) => x.[0];
Constructors for string
//[string.flx]
  ctor string (c:char) => ""+c;
  ctor string: +char = "::std::string($1:assign)";
  ctor string: +char  * !ints = "::std::string($1:assign,$2:assign)";
  fun utf8: int -> string = "::flx::rtl::i18n::utf8($1)" requires package "flx_i18n";
Substrings
//[string.flx]
  fun subscript: string * !ints -> char =
    "::flx::rtl::strutil::subscript($1:assign,$2:assign)" requires package "flx_strutil";
  fun copyfrom: string * !ints -> string =
    "::flx::rtl::strutil::substr($1:assign,$2:assign,$1:postfix.size())" requires package "flx_strutil";
  fun copyto: string * !ints -> string =
    "::flx::rtl::strutil::substr($1:assign,0,$2:assign)" requires package "flx_strutil";
  fun substring: string * !ints * !ints -> string =
    "::flx::rtl::strutil::substr($1:assign,$2:assign,$3:assign)" requires package "flx_strutil";

  fun subscript (x:string, s:slice[int]):string =>
    match s with
    | #Slice_all => substring (x, 0, x.len.int)
    | Slice_from (start) => copyfrom (x, start)
    | Slice_to_incl (end) => copyto (x, end + 1)
    | Slice_to_excl (end) => copyto (x, end)
    | Slice_range_incl (start, end) => substring (x, start, end + 1)
    | Slice_range_excl (start, end) => substring (x, start, end)
    | Slice_from_counted (start, count) => substring (x,start, start + count)
    | Slice_one (index) => string x.[index]
    endmatch
  ;
  fun apply (s:slice[int], x:string) => subscript (x,s);

  fun subscript (x:string, gs:gslice[int]):string = {
    var r = "";
    match gs with
    | GSlice s => r = subscript(x,s);
    | GSSList gsl =>
      // this should be faster cause it cats a list of string which
      // is linear in the number of strings
      var sl = Empty[string];
      for gs in gsl perform sl = subscript (x,gs) + sl;
      r = sl.rev.(cat "");
    | _ =>
      for i in gs perform r += x.[i];
    endmatch;
    return r;
  }

  proc store: &string * !ints * char = "(*$1)[$2] = $3;";
Map a string char by char
//[string.flx]
  fun map (f:char->char) (var x:string): string = {
    if len x > 0uz do
      for var i in 0uz upto (len x) - 1uz do
        store(&x, i, f x.[i]);
      done
    done
    return x;
  }
STL string functions

These come in two flavours: the standard C++ operations which return stl_npos on failure, and a more Felix like variant which uses an option type.

//[string.flx]
  const stl_npos: size = "::std::string::npos";

  fun stl_find: string * string -> size = "$1.find($2)" is cast;
  fun stl_find: string * string * size -> size = "$1.find($2,$3)" is cast;
  fun stl_find: string * +char -> size = "$1.find($2)" is cast;
  fun stl_find: string * +char * size -> size = "$1.find($2,$3)" is cast;
  fun stl_find: string * char -> size = "$1.find($2)" is cast;
  fun stl_find: string * char * size -> size = "$1.find($2,$3)" is cast;

  fun find (s:string, e:string) : opt[size] => match stl_find (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find (s:string, e:string, i:size) : opt[size] => match stl_find (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find (s:string, e:+char) : opt[size] => match stl_find (s, e) with | i when i== stl_npos => None[size] | i => Some i endmatch;
  fun find (s:string, e:+char, i:size) : opt[size] => match stl_find (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find (s:string, e:char) : opt[size] => match stl_find (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find (s:string, e:char, i:size) : opt[size] => match stl_find (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;

  fun stl_rfind: string * string -> size = "$1.rfind($2)";
  fun stl_rfind: string * string * size -> size = "$1.rfind($2,$3)";
  fun stl_rfind: string * +char-> size = "$1.rfind($2)";
  fun stl_rfind: string * +char * size -> size = "$1.rfind($2,$3)";
  fun stl_rfind: string * char -> size = "$1.rfind($2)";
  fun stl_rfind: string * char * size -> size = "$1.rfind($2,$3)";

  fun rfind (s:string, e:string) : opt[size] => match stl_rfind (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun rfind (s:string, e:string, i:size) : opt[size] => match stl_rfind (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun rfind (s:string, e:+char) : opt[size] => match stl_rfind (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun rfind (s:string, e:+char, i:size) : opt[size] => match stl_rfind (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun rfind (s:string, e:char) : opt[size] => match stl_rfind (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun rfind (s:string, e:char, i:size) : opt[size] => match stl_rfind (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;

  fun stl_find_first_of: string * string -> size = "$1.find_first_of($2)";
  fun stl_find_first_of: string * string * size -> size = "$1.find_first_of($2,$3)";
  fun stl_find_first_of: string * +char -> size = "$1.find_first_of($2)";
  fun stl_find_first_of: string * +char * size -> size = "$1.find_first_of($2,$3)";
  fun stl_find_first_of: string * char -> size = "$1.find_first_of($2)";
  fun stl_find_first_of: string * char * size -> size = "$1.find_first_of($2,$3)";

  fun find_first_of (s:string, e:string) : opt[size] => match stl_find_first_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_of (s:string, e:string, i:size) : opt[size] => match stl_find_first_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_of (s:string, e:+char) : opt[size] => match stl_find_first_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_of (s:string, e:+char, i:size) : opt[size] => match stl_find_first_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_of (s:string, e:char) : opt[size] => match stl_find_first_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_of (s:string, e:char, i:size) : opt[size] => match stl_find_first_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;

  fun stl_find_first_not_of: string * string -> size = "$1.find_first_not_of($2)";
  fun stl_find_first_not_of: string * string * size -> size = "$1.find_first_not_of($2,$3)";
  fun stl_find_first_not_of: string * +char -> size = "$1.find_first_not_of($2)";
  fun stl_find_first_not_of: string * +char * size -> size = "$1.find_first_not_of($2,$3)";
  fun stl_find_first_not_of: string * char -> size = "$1.find_first_not_of($2)";
  fun stl_find_first_not_of: string * char * size -> size = "$1.find_first_not_of($2,$3)";

  fun find_first_not_of (s:string, e:string) : opt[size] => match stl_find_first_not_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_not_of (s:string, e:string, i:size) : opt[size] => match stl_find_first_not_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_not_of (s:string, e:+char) : opt[size] => match stl_find_first_not_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_not_of (s:string, e:+char, i:size) : opt[size] => match stl_find_first_not_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_not_of (s:string, e:char) : opt[size] => match stl_find_first_not_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_first_not_of (s:string, e:char, i:size) : opt[size] => match stl_find_first_not_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;

  fun stl_find_last_of: string * string -> size = "$1.find_last_of($2)";
  fun stl_find_last_of: string * string * size -> size = "$1.find_last_of($2,$3)";
  fun stl_find_last_of: string * +char -> size = "$1.find_last_of($2)";
  fun stl_find_last_of: string * +char * size -> size = "$1.find_last_of($2,$3)";
  fun stl_find_last_of: string * char -> size = "$1.find_last_of($2)";
  fun stl_find_last_of: string * char * size -> size = "$1.find_last_of($2,$3)";

  fun find_last_of (s:string, e:string) : opt[size] => match stl_find_last_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_of (s:string, e:string, i:size) : opt[size] => match stl_find_last_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_of (s:string, e:+char) : opt[size] => match stl_find_last_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_of (s:string, e:+char, i:size) : opt[size] => match stl_find_last_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_of (s:string, e:char) : opt[size] => match stl_find_last_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_of (s:string, e:char, i:size) : opt[size] => match stl_find_last_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;

  fun stl_find_last_not_of: string * string -> size = "$1.find_last_not_of($2)";
  fun stl_find_last_not_of: string * string * size -> size = "$1.find_last_not_of($2,$3)";
  fun stl_find_last_not_of: string * +char -> size = "$1.find_last_not_of($2)";
  fun stl_find_last_not_of: string * +char * size -> size = "$1.find_last_not_of($2,$3)";
  fun stl_find_last_not_of: string * char -> size = "$1.find_last_not_of($2)";
  fun stl_find_last_not_of: string * char * size -> size = "$1.find_last_not_of($2,$3)";

  fun find_last_not_of (s:string, e:string) : opt[size] => match stl_find_last_not_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_not_of (s:string, e:string, i:size) : opt[size] => match stl_find_last_not_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_not_of (s:string, e:+char) : opt[size] => match stl_find_last_not_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_not_of (s:string, e:+char, i:size) : opt[size] => match stl_find_last_not_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_not_of (s:string, e:char) : opt[size] => match stl_find_last_not_of (s, e) with | i when i == stl_npos => None[size] | i => Some i endmatch;
  fun find_last_not_of (s:string, e:char, i:size) : opt[size] => match stl_find_last_not_of (s, e, i) with | i when i == stl_npos => None[size] | i => Some i endmatch;
Construe string as set of char
//[string.flx]
  instance Set[string,char] {
    fun \in (c:char, s:string) => stl_find (s,c) != stl_npos;
  }
Construe string as stream of char
//[string.flx]
  instance Iterable[string, char] {
    gen iterator(var x:string) () = {
      for var i in 0 upto x.len.int - 1 do yield Some (x.[i]); done
      return None[char];
    }
  }
  inherit Streamable[string,char];
Test if a string has given prefix or suffix
//[string.flx]
  fun prefix(arg:string,key:string)=>
    arg.[to len key]==key
  ;

  fun suffix (arg:string,key:string)=>
    arg.[-key.len to]==key
  ;


  fun startswith (x:string) (e:string) : bool => prefix (x,e);

  // as above: slices are faster
  fun endswith (x:string) (e:string) : bool => suffix (x,e);

  fun startswith (x:string) (e:char) : bool => x.[0] == e;
  fun endswith (x:string) (e:char) : bool => x.[-1] == e;
Trim off specified prefix or suffix or both
//[string.flx]
  fun ltrim (x:string) (e:string) : string =>
    if startswith x e then
      x.[e.len.int to]
    else
      x
    endif
  ;

  fun rtrim (x:string) (e:string) : string =>
    if endswith x e then
      x.[to x.len.int - e.len.int]
    else
      x
    endif
  ;

  fun trim (x:string) (e:string) : string => ltrim (rtrim x e) e;
Strip characters from left, right, or both end of a string.
//[string.flx]
  fun lstrip (x:string, e:string) : string =
  {
    if len x > 0uz do
      for var i in 0uz upto len x - 1uz do
        var found = false;
        for var j in 0uz upto len e - 1uz do
          if x.[i] == e.[j] do
            found = true;
          done
        done

        if not found do
          return x.[i to];
        done
      done;
    done
    return '';
  }

  fun rstrip (x:string, e:string) : string =
  {
    if len x > 0uz do
      for var i in len x - 1uz downto 0uz do
        var found = false;
        for var j in 0uz upto len e - 1uz do
          if x.[i] == e.[j] do
            found = true;
          done
        done

        if not found do
          return x.[to i.int + 1];
        done
      done
    done
    return '';
  }

  fun strip (x:string, e:string) : string => lstrip(rstrip(x, e), e);

  fun lstrip (x:string) : string => lstrip(x, " \t\n\r\f\v");
  fun rstrip (x:string) : string => rstrip(x, " \t\n\r\f\v");
  fun strip (x:string) : string => lstrip$ rstrip x;
Justify string contents
//[string.flx]
  fun ljust(x:string, width:int) : string =>
    if x.len.int >= width
      then x
      else x + (' ' * (width - x.len.int))
    endif
  ;

  fun rjust(x:string, width:int) : string =>
    if x.len.int >= width
      then x
      else (' ' * (width - x.len.int)) + x
    endif
  ;
Split a string into a list on given separator
//[string.flx]
  fun split (x:string, d:char): List::list[string] => List::rev (rev_split (x,d));

  fun rev_split (x:string, d:char): List::list[string] = {
    fun aux (x:string,y:List::list[string]) =>
      match find (x, d) with
      | #None => Cons (x, y)
      | Some n => aux$ x.[n+1uz to], List::Cons (x.[to n],y)
      endmatch
    ;
    return aux$ x, List::Empty[string];
  }

  fun split (x:string, d:string): List::list[string] => List::rev (rev_split (x,d));

  fun rev_split (x:string, d:string): List::list[string] = {
    fun aux (pos:size,y:List::list[string]) =>
      match stl_find_first_of (x, d, pos) with
      | $(stl_npos) => List::Cons (x.[pos to],y)
      | n => aux$ (n+1uz), List::Cons (x.[pos to n],y)
      endmatch
    ;
    return aux$ 0uz, List::Empty[string];
  }

  fun split (x:string, d:+char): List::list[string] => List::rev (rev_split (x,d));

  fun rev_split (x:string, d:+char): List::list[string] = {
    fun aux (x:string,y:List::list[string]) =>
      match find_first_of (x, d) with
      | #None => List::Cons (x, y)
      | Some n => aux$ x.[n+1uz to], List::Cons (x.[to n],y)
      endmatch
    ;
    return aux$ x, List::Empty[string];
  }

  fun split_first (x:string, d:string): opt[string*string] =>
    match find_first_of (x, d) with
    | #None => None[string*string]
    | Some n => Some (x.[to n],substring(x,n+1uz,(len x)))
    endmatch
  ;


  //$ Split a string on whitespace but respecting
  //$ double quotes, single quotes, and slosh escapes.
  // leading and trailing space is removed. Embedded
  // multiple spaces cause a single split.
  class RespectfulParser {
    variant quote_action_t =
      | ignore-quote
      | keep-quote
      | drop-quote
    ;
    variant dquote_action_t =
      | ignore-dquote
      | keep-dquote
      | drop-dquote
    ;
    variant escape_action_t =
      | ignore-escape
      | keep-escape
      | drop-escape
    ;
    typedef action_t = (quote:quote_action_t, dquote:dquote_action_t, escape:escape_action_t);

    variant mode_t = | copying | skipping | quote | dquote | escape-copying | escape-quote | escape-dquote;
    typedef state_t = (mode:mode_t, current:string, parsed: list[string] );

    noinline fun respectful_parse (action:action_t) (var state:state_t) (var s:string) : state_t =
    {
      var mode = state.mode;
      var current = state.current;
      var result = Empty[string];

      noinline proc handlecopying(ch:char) {
        if ch == char "'" do
          match action.quote with
          | #ignore-quote =>
            current += ch;
          | #keep-quote =>
            current += ch;
            mode = quote;
          | #drop-quote =>
            mode = quote;
          endmatch;
        elif ch == char '"' do
          match action.dquote with
          | #ignore-dquote =>
            current += ch;
          | #keep-dquote =>
            current += ch;
            mode = dquote;
          | #drop-dquote =>
            mode = dquote;
          endmatch;
        elif ch == char '\\' do
          match action.escape with
          | #ignore-escape =>
            current += ch;
          | #keep-escape =>
            current += ch;
            mode = escape-copying;
          | #drop-escape =>
            mode = escape-copying;
          endmatch;
        elif ord ch <= ' '.char.ord  do // can't happen if called from skipping
          result += current;
          current = "";
          mode = skipping;
        else
          current += ch;
          mode = copying;
        done
      }

      for ch in s do
        match mode with
        | #copying => handlecopying ch;
        | #quote =>
          if ch == char "'" do
            match action.quote with
            | #ignore-quote =>
              assert false;
              //current += ch;
            | #keep-quote =>
              current += ch;
              mode = copying;
            | #drop-quote =>
              mode = copying;
            endmatch;
          elif ch == char "\\" do
            match action.escape with
            | #ignore-escape =>
              current += ch;
            | #keep-escape =>
              current += ch;
              mode = escape-quote;
            | #drop-escape =>
              mode = escape-quote;
            endmatch;
          else
            current += ch;
          done

        | #dquote =>
          if ch == char '"' do
            match action.dquote with
            | #ignore-dquote =>
              assert false;
              //current += ch;
            | #keep-dquote =>
              current += ch;
              mode = copying;
            | #drop-dquote =>
              mode = copying;
            endmatch;
          elif ch == char "\\" do
            match action.escape with
            | #ignore-escape =>
              current += ch;
            | #keep-escape =>
              current += ch;
              mode = escape-dquote;
            | #drop-escape =>
              mode = escape-dquote;
            endmatch;
          else
            current += ch;
          done

        | #escape-copying =>
           current += ch;
           mode = copying;

        | #escape-quote =>
           current += ch;
           mode = quote;

        | #escape-dquote =>
           current += ch;
           mode = dquote;

        | #skipping =>
          if ord ch > ' '.char.ord  do
            handlecopying ch;
          done
        endmatch;
      done
      return (mode=mode, current=current, parsed=state.parsed + result);
    }
  }

  // simplified one shot parser.
  // ignores mismatched quotes and backslashes.
  fun respectful_split (action:RespectfulParser::action_t) (s:string) : list[string] =
  {
    var state = RespectfulParser::respectful_parse
      action
      (
        mode=RespectfulParser::skipping,
        current="",
        parsed=Empty[string]
      )
      s
    ;
    // ignore mismatched quotes and backslashes.
    match state.mode with
    | #skipping => ;
    | _ => &state.parsed <- state.parsed + state.current;
    endmatch;
    return state.parsed;

  }

  fun respectful_split (s:string) : list[string] =>
    respectful_split (
      quote=RespectfulParser::keep-quote,
      dquote=RespectfulParser::keep-dquote,
      escape=RespectfulParser::keep-escape
    )
    s
  ;

  // OO version of the parser.
  object respectfulParser (action:RespectfulParser::action_t) = {
    var state = (mode=RespectfulParser::skipping, current="", parsed=Empty[string]);
    method proc parse (s:string) {
      state = RespectfulParser::respectful_parse action state s;
    }
    method fun get_parsed () => state.parsed;
  }
erase, insert or replace substrings
//[string.flx]
  // Note: pos, length!
  //$ mutators
  proc erase: &string * size * size = "$1->erase($2,$3);";
  proc insert: &string * size * string = "$1->insert($2,$3);";
  proc replace: &string * size * size * string = "$1->replace($2,$3,$4);";

  //$ functional
  fun erase: string * size * size -> string = "::std::string($1).erase($2,$3)";
  fun insert: string * size * string -> string = "::std::string($1).insert($2,$3)";
  fun replace: string * size * size * string -> string = "::std::string($1).replace($2,$3,$4)";
search and replace

Search and replace by string.

//[string.flx]
  fun search_and_replace (x:string, var spos:size, s:string, r:string) : string =
  {
    val m = s.len;
    var o = x.[to spos];
    var n = (x,s,spos).stl_find;
    while n != stl_npos do
      o+=x.[spos to n]+r;
      spos = n+m;
      n = (x,s,spos).stl_find.size;
    done
    o+=x.[spos to];
    return o;
  }
  fun search_and_replace (x:string, s:string, r:string) : string => search_and_replace (x,0uz,s,r);

  fun search_and_replace (vs:list[string * string]) (var v:string) = {
    match k,b in vs do
      v = search_and_replace (v,k,b);
    done
    return v;
  }
Regexp search and replace

Uses Google RE2 engine.

//[string.flx]
  // Replace \0 \1 \2 etc in s with text from v
  fun subst(s:string, v:varray[StringPiece]): string =
  {
  //println$ "Subst " + s +" with " + str v;
     enum mode_t {cp, ins};
     var b = "";
     var mode=cp;
     var j = 0;
     var count = 0;
     for var i in 0 upto s.len.int - 1 do
       match mode with
       | #cp =>
         if s.[i] == char "\\" do
           mode = ins;
           j=0; count = 0;
         else
          b += s.[i];
         done
       | #ins =>
         if s.[i] in "0123456789" do
           j = j * 10 + ord(s.[i]) - ord (char "0");
           ++count;
         else
           if count == 0 do
             b += "\\";
           elif j < v.len.int do
             b+= str v.stl_begin.j;
           done
           // adjacent insertion?
           if s.[i] == char "\\" do
             j=0; count=0;
           else
             mode = cp;
             b += s.[i];
           done
         done
       endmatch;
     done
     // run off end
     match mode with
     | #cp => ;
     | #ins =>
       if count == 0 do
         b += "\\";
       elif j < v.len.int do
         b+= str v.j;
       done
     endmatch;
     return b;
  }
  // Search for regex, replace by r with \0 \1 \2 etc replace by match groups.
  fun search_and_replace (x:string, var spos: size, re:Re2::RE2, r:string) : string =
  {
    var ngroups = re.NumberOfCapturingGroups + 1;
    var v = varray[StringPiece]$ (ngroups+1).size, StringPiece "";
    var o = x.[to spos];             // initial substring
    var sp = StringPiece(x);
    var base : +char = sp.data;      // base pointer of char array
    while Re2::Match(re, sp, spos.int, UNANCHORED, v.stl_begin, v.len.int) do
      var mpos = size(v.0.data - base);  // start of match
      o+= x.[spos to mpos];          // copy upto start of match
      o+= subst(r,v);                // copy replacement
      spos = mpos + v.0.len;       // advance over match
    done
    o+=x.[spos to];                  // rest of string
    return o;
  }
Parse string to numeric type
//[string.flx]
  fun atoi: string -> int = "::std::atoi($1:postfix.c_str())"  requires Cxx_headers::cstdlib;
  fun atol: string -> long = "::std::atol($1:postfix.c_str())"  requires Cxx_headers::cstdlib;
  fun atoll: string -> long = "::std::atoll($1:postfix.c_str())"  requires Cxx_headers::cstdlib;
  fun atof: string -> double = "::std::atof($1:postfix.c_str())"  requires Cxx_headers::cstdlib;
Reserve store
//[string.flx]
  proc reserve: &string * !ints = "$1->reserve($2);";
Fetch underlying cstring.
//[string.flx]
  // safely returns a malloc()'d copy, not garbage collected
  fun _unsafe_cstr: string -> +char = "::flx::rtl::strutil::flx_cstr($1)" is atom;

  // partially unsafe because the string could be modified.
  fun stl_begin: &string -> +char = "((char*)$1->c_str())" is atom;
  fun stl_end: &string -> +char = "((char*)($1->c_str()+$1->size()))" is atom;

  // this operation returns a char pointer to GC managed storage
  fun cstr (var s:string) => s.varray[char].stl_begin;
Polymorphic vsprintf hack
//[string.flx]
  fun vsprintf[t]: +char  * t -> string =
    "::flx::rtl::strutil::flx_asprintf($1,$2)" requires package "flx_strutil"
  ;

  fun vsprintf[t]: string * t -> string =
    "::flx::rtl::strutil::flx_asprintf(const_cast<char*>($1.c_str()),$2)" requires package "flx_strutil"
  ;
Case translation
//[string.flx]
  // Convert all characters to upper case
  fun toupper(s:string):string => map (toupper of char) s;
  // Convert all characters to lower case
  fun tolower(s:string):string => map (tolower of char) s;
}
Transation to string
//[string.flx]

instance Str[string] {
  fun str (s:string) : string => s;
}

instance Str[+char] {
  fun str: +char -> string = '::flx::rtl::strutil::atostr($1)' requires package "flx_strutil";
}

instance Repr[string] {
  fun repr (x:string) : string = {
    var o = "'";
    if len x > 0uz do
      for var i in 0uz upto (String::len x) - 1uz do
        o += repr x.[i];
      done
    done
    return o + "'";
  }
}

open[T in strings] Show[T];
open Set[string,char];

Package: src/packages/trees.fdoc

Tree and graph data types

key file
heap.flx share/lib/std/datatype/heap.flx
avl.flx share/lib/std/datatype/avl.flx
graph.flx share/lib/std/datatype/graph.flx
partition.flx share/lib/std/datatype/partition.flx
judy.flx share/lib/std/datatype/judy.flx
strdict.flx share/lib/std/datatype/strdict.flx
binary_search_tree.flx share/lib/std/datatype/binary_search_tree.flx
Array backed Heap

We provide a min-heap using a darray for storage.

//[heap.flx]
class MinHeap[T with Tord[T]]
{
  fun left_child (p:int)  => 2*p + 1;
  fun right_child (p:int) => 2*p + 2;
  fun parent (c:int) => if c == 0 then 0 else (c - 1)/2;

  axiom family (i:int): i == i.left_child.parent and i == i.right_child.parent;
  typedef minheap_t = darray[T];
  ctor minheap_t () => darray[T] ();
  axiom left_heap (m:minheap_t, i:int):
    i.left_child < m.len.int or m.i < m.(i.left_child)
  ;

  proc heap_swap (h:minheap_t,i:int,j:int) {
    var tmp = h.i;
    set(h,i,h.j);
    set(h,j,tmp);
  }

  proc bubble_up(h:minheap_t, j:int)
  {
     var p = parent j; // parent of root is itself
     if h.p > h.j do // and so can't satisfy this condition
        heap_swap(h,p,j);
        bubble_up(h,p);
     done
  }
  proc heap_insert (h:minheap_t) (elt:T) {
    push_back (h,elt);
    bubble_up (h,h.len.int - 1);
  }

  // this procedure does nothing if the index p
  // is greater than or equal to the limit - 2,
  // since the last used slot is lim - 1,
  // and that node cannot have any children.
  proc bubble_down_lim (h:minheap_t, p:int, lim:int) {
    var min_index = p;
    var left = p.left_child;
    if left < lim do
      if h.min_index > h.left perform min_index = left;
      var right = left + 1;
      if right < lim
        if h.min_index > h.right perform min_index = right;
    done
    if min_index != p do
      heap_swap (h, p, min_index);
      bubble_down_lim (h, min_index, lim);
    done
  }

  proc bubble_down (h:minheap_t,p:int) =>
    bubble_down_lim (h, p, h.len.int)
  ;

  gen extract_min (h:minheap_t) : opt[T] =  {
    if h.len.int == 0 return None[T];
      var min = h.0;
      set(h,0,h.(h.len.int - 1));
      h.pop_back;
      bubble_down (h,0);
      return Some min;
  }

  // sorts largest to smallest!!
  // based on extract_min, except the minimum element
  // is moved to the position at the end of the heap
  // which would otherwise be deleted.
  proc heap_sort (h:minheap_t) {
    var tosort = h.len.int;
    while tosort > 1 do
      --tosort;
      heap_swap(h,0,tosort);
      bubble_down_lim (h,0, tosort);
    done
  }

  proc heapify (h:minheap_t) {
    var index = h.len.int - 2;
    while index >= 0 do
      bubble_down (h, index); --index;
    done
  }

}
AVL tree
//[avl.flx]

class Avl
{
  variant avl[T] =
    | Nil
    | Tree of int * T * avl[T] * avl[T] // (Height,Object,Left,Right)
  ;

  //==============================

  fun _ctor_avl[T] () => Nil[T];

  fun _ctor_avl[T] (x : T, left : avl[T], right : avl[T]) =>
    Tree (max(height(left), height(right)) + 1, x, left, right)
  ;

  //==============================

  private fun height[T] : avl[T]->int =
    | #Nil => 0
    | Tree(h, _, _, _) => h
  ;

  private fun slope[T] : avl[T]->int =
    | #Nil => 0
    | Tree(_, _, left, right) => height(left) - height(right)
  ;

  private fun rot_l[T](tree : avl[T]) =>
    match tree with
      | Tree(_, x, leftL, Tree(_, y, rightL, rightR)) =>
        avl(y, avl(x, leftL, rightL), rightR)
      | x => x
    endmatch
  ;

  private fun shift_l[T](tree : avl[T]) =>
    match tree with
      | Tree(_, x, left, right) =>
        if (slope(right) == 1) then
          rot_l(avl(x, left, rot_r(right)))
        else
          rot_l(tree)
        endif
      | x => x
    endmatch
  ;

  private fun rot_r[T](tree : avl[T]) =>
    match tree with
      | Tree(_, x, Tree(_, y, leftL, leftR), rightR) =>
        avl(y, leftL, avl(x, leftR, rightR))
      | x => x
    endmatch
  ;

  private fun shift_r[T](tree : avl[T]) =>
    match tree with
      | Tree(_, x, left, right) =>
        if (slope(right) == -1) then
          rot_r(avl(x, rot_r(left), right))
        else
          rot_r(tree)
        endif
      | x => x
    endmatch
  ;

  private fun balance[T](tree : avl[T]) =>
    match slope(tree) with
      | x when x == -2 => shift_l(tree)
      | 2 => shift_r(tree)
      | _ => tree
    endmatch
  ;

  //==============================

  fun insert[T] (tree : avl[T], y : T, cmp : T*T->int) =>
    match tree with
      | #Nil =>
        Tree(1, y, Nil[T], Nil[T])
      | Tree(h, x, left, right) =>
        if cmp(x, y) > 0 then
          balance(avl(x, (insert(left, y, cmp)), right))
        elif cmp(x, y) < 0 then
          balance(avl(x, left, insert(right, y, cmp)))
        else
          Tree(h, x, left, right)
        endif
    endmatch
  ;

  fun insert[T] (y : T, cmp : T*T->int) =>
    insert(Nil[T], y, cmp)
  ;

  //=================================

  fun find[T] (tree : avl[T], y : T, cmp : T*T->int) : opt[T] =>
      match tree with
        | #Nil => None[T]
        | Tree(_, x, left, right) =>
          if cmp(x, y) > 0 then
            find(left, y, cmp)
          elif cmp(x, y) < 0 then
            find(right, y, cmp)
          else
            Some x
          endif
      endmatch
    ;

  //=================================

  fun last[T] : avl[T]->T =
    | Tree(_, x, _, #Nil) => x
    | Tree(_, _, _, right) => last(right)
  ;

  fun all_but_last[T] : avl[T]->avl[T] =
    | Tree(_, _, left, #Nil) => left
    | Tree(_, x, left, right) => balance(avl(x, left, all_but_last(right)))
  ;

  //=================================

  fun first[T] : avl[T]->T =
    | Tree(_, x, #Nil, _) => x
    | Tree(_, _, left, _) => first(left)
  ;

  fun all_but_first[T] : avl[T]->avl[T] =
    | Tree(_, _, #Nil, right) => right
    | Tree(_, x, left, right) => balance(avl(x, all_but_first(left), right))
  ;

  //=================================

  fun join[T] (A : avl[T], B : avl[T]) =>
    match A with
      | #Nil => B
      | x => balance(avl(last(A), all_but_last(A), B))
    endmatch
  ;

  fun remove[T] (tree : avl[T], y : T, cmp : T*T->int) =>
    match tree with
      | #Nil => Nil[T]
      | Tree(_, x, left, right) =>
        if cmp(x, y) == 1 then
          balance(avl(x, remove(left, y, cmp), right))
        elif cmp(x, y) == -1 then
          balance(avl(x, left, remove(right, y, cmp)))
        else
          join(left, right)
        endif
    endmatch
  ;

  //==============================

  fun fold_left[T, U] (f:U->T->U) (accumulated:U) (tree:avl[T]):U =>
    match tree with
      | #Nil => accumulated
      | Tree (_, x, left, right) =>
        fold_left f  (f (fold_left f accumulated left)  x) right
    endmatch
  ;

  fun fold_right[T, U] (f:T->U->U) (tree:avl[T]) (accumulated:U) =>
    match tree with
      | #Nil => accumulated
      | Tree (_, x, left, right) =>
        fold_right f left (f x (fold_right f right accumulated))
    endmatch
  ;

  //==============================

  proc iter[T] (f:T->void, tree:avl[T])
  {
    match tree with
      | #Nil => {}
      | Tree (_, x, left, right) => {
        iter(f, left);
        f(x);
        iter(f, right);
      }
    endmatch;
  }

  proc iter[T] (f:int*T->void, tree:avl[T])
  {
    proc aux (depth:int, f:int*T->void, tree:avl[T]) {
      match tree with
        | #Nil => {}
        | Tree (_, x, left, right) => {
          aux(depth + 1, f, left);
          f(depth, x);
          aux(depth + 1, f, right);
        }
      endmatch;
    }
    aux(0, f, tree);
  }
}
Directed Graph
//[graph.flx]
// Directed Cyclic graph

include "std/datatype/dlist";
include "std/datatype/partition";

class DiGraph[V,E with Str[V], Str[E]] // V,E labels for graph parts
{
  // vertices are stored in an array, so they're identified
  // by their slot number 0 origin
  typedef digraph_t = (vertices: darray[vertex_t], nedges: int);
  ctor digraph_t () => (vertices= #darray[vertex_t], nedges=0);

  // x index implicit, the edge source
  // y index is the edge destination
  typedef edge_t = (elabel:E, x:int,y:int, weight:double);
  typedef vertex_t = (vlabel:V, outedges: list[edge_t]);

  fun len (d:digraph_t) => d.vertices.len;

  virtual fun default_vlabel: 1 -> V;
  virtual fun default_elabel: 1 -> E;
  fun default_vertex () => (vlabel = #default_vlabel, outedges = Empty[edge_t]);

  // Add an isolated vertex
  // If the vertex is already in the graph,
  // this routine just replaces the label
  // this allows adding out of order vertices
  // and adding vertices implicitly by adding edges
  proc add_vertex (d:&digraph_t, v:V, x:int)
  {
    while x >= d*.vertices.len.int call push_back (d*.vertices, #default_vertex);
    var pv: &V = (d*.vertices,x.size).unsafe_get_ref.vlabel;
    pv <- v;
  }

  proc add_weighted_edge (d:&digraph_t, x:int, y:int, elab:E, weight:double)
  {
    while x >= d*.vertices.len.int call add_vertex (d,#default_vlabel,d*.vertices.len.int);
    while y >= d*.vertices.len.int call add_vertex (d,#default_vlabel,d*.vertices.len.int);
    var pedges : &list[edge_t] = (d*.vertices,x.size).unsafe_get_ref.outedges;
    pedges <- (elabel=elab,x=x,y=y,weight=weight) ! *pedges;
    d.nedges.pre_incr;
  }

  proc add_edge (d:&digraph_t, x:int, y:int, elab:E) =>
    add_weighted_edge (d,x,y,elab,1.0)
  ;

  // add and edge and its reverse edge, distinct labels
  proc add_weighted_edge_pair (d:&digraph_t, x:int, y:int, felab:E, relab:E, weight:double)
  {
    add_weighted_edge(d,x,y,felab, weight);
    add_weighted_edge(d,y,x,relab, weight);
  }

  proc add_edge_pair (d:&digraph_t, x:int, y:int, felab:E, relab:E) =>
    add_weighted_edge_pair (d,x,y,felab,relab,1.0)
  ;

  // add and edge and its reverse edge, same label
  // use for undirected graph
  proc add_edge_pair (d:&digraph_t, x:int, y:int, elab:E)
  {
    add_edge(d,x,y,elab);
    add_edge(d,y,x,elab);
  }


  fun dump_digraph (d:digraph_t) : string =
  {
    var out = "";
    reserve (&out,10000);
    var x = 0;
    for vertex in d.vertices do
      out += x.str + " " + vertex.vlabel.str + "\n";
      for edge in vertex.outedges do
        out += "  " + edge.x.str + "->" + edge.y.str + " " +
          edge.elabel.str +
          if edge.weight != 1.0 then " "+edge.weight.str else "" endif +
          "\n"
        ;
      done
    ++x;
    done
    return out;
  }

  variant Vstate = Undiscovered | Discovered | Processed;

  typedef digraph_visitor_processing_t =
  (
    process_vertex_early: digraph_t -> int -> 0,
    process_vertex_late: digraph_t -> int -> 0,
    process_edge: digraph_t -> int * int -> 0
  );

  proc dflt_pve (g:digraph_t) (x:int) {};
  proc dflt_pvl (g:digraph_t) (x:int) {};
  proc dflt_pe (g:digraph_t) (x:int, y:int) {};

  // default visitor does nothing
  ctor digraph_visitor_processing_t () => (
    process_vertex_early= dflt_pve,
    process_vertex_late= dflt_pvl,
    process_edge= dflt_pe
  );

  interface mutable_collection_t[T] {
     add: T -> 0;
     remove: 1 -> opt[T];
  }

  gen iterator[T] (x:mutable_collection_t[T]) () : opt[T] => x.remove ();

  object gstack_t[T] () implements mutable_collection_t[T] = {
    open DList[T];
    var d = dlist_t();
    method proc add (x:T) => push_back (&d,x);
    method gen remove () => pop_back (&d);
  }

  object gqueue_t[T] () implements mutable_collection_t[T] = {
    open DList[T];
    var d = dlist_t();
    method proc add (x:T) => push_back (&d,x);
    method gen remove () => pop_front (&d);
  }

  proc iter
    (var pending:mutable_collection_t[int])
    (d:digraph_t) (startv:int)
    (p:digraph_visitor_processing_t)
  {
    var state = varray[Vstate] (bound=d.len,default=Undiscovered);
    pending.add startv;
    set (state,startv,Discovered);
    //var parent = -1;
    for v in pending do // all vertex indices in queue
      p.process_vertex_early d v;
      set (state,v,Processed);
      for edge in d.vertices.v.outedges do
        var y = edge.y;
        p.process_edge d (v, y);
        match state.y do
        | #Undiscovered =>
          pending.add y;
          set (state,y,Discovered);
          //parent = v;
        | _ => ;
        done
      done
      p.process_vertex_late d v;
    done // vertices
  }

  proc breadth_first_iter (d:digraph_t) (startv:int) (p:digraph_visitor_processing_t) =>
    iter #gqueue_t[int] d startv p
  ;

  proc depth_first_iter (d:digraph_t) (startv:int) (p:digraph_visitor_processing_t) =>
    iter #gstack_t[int] d startv p
  ;

  // This routine returns a list of vertices from startv to fin, inclusive ..
  // not a list of edges.
  gen find_shortest_unweighted_path (d:digraph_t) (startv:int, fin:int) : opt[list[int]] =
  {
    if startv == fin return Some (list(startv));

    open DList[int];
    var state = varray[Vstate] (bound=d.len,default=Undiscovered);
    var parents = varray[int] (bound=d.len,default= -1);
    var q = queue_t();
    enqueue &q startv;
    set (state,startv,Discovered);
    set(parents,startv,-1);
    for v in &q // all vertex indices in queue
      for edge in d.vertices.v.outedges do
        var y = edge.y;
        if y == fin do
          var path = Empty[int];
          set(parents,y,v);
          while y != startv do
            path = Cons (y,path);
            y = parents.y;
          done
          path = Cons (y,path);
          return Some path;
        else
          match state.y do
          | #Undiscovered =>
            enqueue &q y;
            set (state,y,Discovered);
            set(parents,y,v);
          | _ => ;
          done
        done
      done
    return None[list[int]];
  }

  // find minimum spanning tree
  // Prim's algorithm, enhanced as in Skiena
  // only returns list of vertices from starting point
  gen prim (d:digraph_t) (startv:int) : list[int * int] =
  {
    var INF=DINFINITY;
    var intree = varray[bool] (bound=d.len, default=false);
    var distance = varray[double] (bound=d.len, default=INF);
    var fromv = varray[int] (bound=d.len, default= -1);
    var span = Empty[int * int];
    var src = -1;
    var v = startv;
    while not intree.v do
      set(intree,v,true);
      for edge in d.vertices.v.outedges do
        var w = edge.y;
        var weight = edge.weight;
        if distance.w > weight and not intree.w do
          set(distance,w,weight);
          set(fromv,w,v);
        done
      done

      // find closest out of tree vertex
      var dist = INF;
      src = -1;
      for var i in 0 upto intree.len.int - 1 do
        if not intree.i and dist > distance.i do
          dist = distance.i;
          v = i;
          src = fromv.i;
        done // not in tree
      done // each vertex i
      // v is set to closest out of tree vertex and
      // src to the vertex it comes from
      // if there is one, otherwise v is unchanged and so remains in tree
      // and src stays at -1
      if src != -1 do span = Cons ( (src,v), span); done
    done // each v not in tree
    return rev span;
  }

}

instance DiGraph[string, string]
{
  fun default_vlabel () => "Unlabelled Vertex";
  fun default_elabel () => "Unlabelled Edge";
}
Partition with Union-Find

Partition range of integers 0 through n-1. Features classic union-find data structure.

//[partition.flx]
class Partition
{
  // internal array based union find
  typedef partition_t = (
    parents: varray[int],
    sizes : varray[int],
    n: int
  );

  ctor partition_t (nelts:int) => (
    n=nelts,
    parents=varray[int] (bound=nelts.size,used=nelts.size,f=(fun (i:size)=>i.int)),
    sizes=varray[int] (bound=nelts.size,default=1)
  );

  // find canonical representative of partition containing element
  // can't fail, returns -1 if the input i is out of range of the partition
  fun find (s:&partition_t, i:int) =>
    if i < 0 or i>= s*.n then -1 else
      let val p = s*.parents.i in
      if p == i then i
      else find (s,p)
      endif
    endif
  ;

  // merge classes , keeping tree balanced
  // can't fail, does nothing if either s1 or s2 is out of range of the partition
  proc merge (s: &partition_t, s1:int, s2:int) {
    var r1 = find (s,s1);
    if r1 == -1 return;
    var r2 = find (s,s2);
    if r2 == -1 return;
    if r1 != r2 do
      var m = s*.sizes.r1 + s*.sizes.r2;
      if s*.sizes.r1 >= s*.sizes.r2 do
        set (s*.sizes,r1,m);
        set (s*.parents,r2,r1);
      else
        set (s*.sizes,r2,m);
        set (s*.parents,r1,r2);
      done
    done
  }

  // partition 0:n-1 with equivalence relation
  gen partition (n:int, equiv:int * int -> bool) =
  {
    var p = partition_t n;
    for var i in 0 upto  n - 1
      for var j in i + 1 upto n - 1
        if equiv (i,j) call merge (&p,i,j)
    ;
    return p;
  }

  // return an equivalence relation from a partition
  gen equiv (s:&partition_t) : int * int -> bool =>
    fun (x:int, y:int) => find (s,x) == find (s,y)
  ;

  // create a partition from an equivalence relation
  // constructor syntax
  ctor partition_t (n:int, equiv: int * int -> bool) => partition (n,equiv);

  // create an equivalence relation from a property
  // assuming the property return type has equality
  fun mk_equiv[T with Eq[T]] (f:int -> T) =>
    fun (x:int, y:int) => f x == f y
  ;
}
Binary Search Tree
Description.

A mutable binary tree with a label and parent uplink satisfying the property that for any node, all elements in the left subtree are less than the node label, and all elements in the right subtree are greater than or equal to the node label.

Implementation.

This version requires and uses the default total order on the label.

//[binary_search_tree.flx]
class BinarySearchTree[T with Tord[T]]
{
Type.
//[binary_search_tree.flx]
  typedef bstree_node_t =
    (
      elt: T,
      parent:bstree_t,
      left:bstree_t,
      right:bstree_t
    )
  ;
  variant bstree_t =
    | #Empty
    | Node of &bstree_node_t
  ;
Quick Checks.
//[binary_search_tree.flx]

  fun leaf: bstree_t -> bool =
    | #Empty => false
    | Node p =>
      match p*.left, p*.right with
      | #Empty, Empty => true
      | _ => false
  ;

  fun leaf_or_empty : bstree_t -> bool =
    | #Empty => true
    | x => leaf x
  ;
String representation
//[binary_search_tree.flx]
  instance Str[bstree_t] {
    fun str : bstree_t -> string =
      | #Empty => "()"
      | Node p =>
        p*.elt.str + "(" + p*.left.str + ") (" + p*.right.str + ")"
    ;
  }
Find.

Find the subtree with top node equal to the given value, or Empty if not found.

//[binary_search_tree.flx]
  // Skiena p78
  fun find (tree:bstree_t) (elt:T) : bstree_t =>
    // saves passing invariant elt
    let fun aux (tree:bstree_t) : bstree_t =>
      match tree with
      | #Empty => tree
      | Node p =>
         if p*.elt == elt then tree
         elif elt < p*.elt then aux p*.left
         else aux p*.right
      endmatch
    in aux tree
  ;
min.

Find the minimum subtree in the tree which is the left most bottom leaf.

//[binary_search_tree.flx]
  fun min (x:bstree_t) =>
    match x with
    | #Empty => x
    | Node p =>
      let fun aux (p:&bstree_node_t) =>
        match *p.left with
        | #Empty => Node p
        | Node p => aux p
      in aux p
   ;
iter.

Procedural preorder iteration visits values in ascending order.

//[binary_search_tree.flx]
   proc iter (f: T -> 0) (x:bstree_t) =
   {
      proc aux (x:bstree_t) = {
        match x with
        | #Empty => ;
        | Node p =>
          aux p*.left;
          f p*.elt;
          aux p*.right;
        endmatch;
      }
     aux x;
   }
Fold.

Easily defined given iter, this should be generalised elsewhere!

//[binary_search_tree.flx]
  fun fold_left[U] (_f:U->T->U) (init:U) (x:bstree_t): U = {
    var sum = init;
    iter proc (elt:T) { sum = _f sum elt; } x;
    return sum;
  }
Map.

Easily defined given iter. Note the tree structure is NOT preserved.

//[binary_search_tree.flx]
  fun map[U] (_f:T->U) (x:bstree_t): BinarySearchTree[U]::bstree_t = {
    var res = BinarySearchTree::Empty[U];
    iter proc (elt:T) { BinarySearchTree[U]::insert &res elt._f; } x;
    return res;
  }
Constructors.
//[binary_search_tree.flx ]
  ctor bstree_t () => Empty;
  ctor bstree_node_t (x:T) => (parent=Empty,elt=x,left=Empty,right=Empty);
  ctor bstree_node_t (x:T, p:bstree_t) => (parent=p,elt=x,left=Empty,right=Empty);

  ctor bstree_t (x:T) => Node (new (bstree_node_t x));
  ctor bstree_t (x:T, p:bstree_t) => Node (new (bstree_node_t (x,p)));
Insert routine
//[binary_search_tree.flx]
  // Note: this routine disallows duplicates.
  proc insert_with_parent (p:&bstree_t) (parent:bstree_t) (elt:T)
  {
    proc aux (p:&bstree_t) (parent:bstree_t) {
      match *p with
      | #Empty => p <- bstree_t (elt,parent);
      | Node q =>
        if elt < q*.elt do
          aux q.left (*p);
        elif elt > q*.elt do
          aux q.right (*p);
        done //otherwise it's already in there
      endmatch;
    }
    aux p parent;
  }
  proc insert (p:&bstree_t) (elt:T) => insert_with_parent p Empty elt;
Comprehension.

Make a tree from an option stream.

//[binary_search_tree.flx]
  ctor bstree_t  (f:1->opt[T]) = {
    var x = Empty;
    var ff = f;
    proc aux () {
      match #ff with
      | Some y => insert &x y; aux();
      | #None => ;
      endmatch;
    }
    aux();
    return x;
  }
Iterator.

Ab interesting routine, related to iter.

//[binary_search_tree.flx]
  gen iterator (x:bstree_t) () : opt[T] =
  {
    match x with
    | #Empty => return None[T];
    | Node p =>
      var ff = iterator p*.left; // closure for generator
    left:>
      var elt_opt = #ff;
      match elt_opt with
      | #None => ;
      | Some v =>
        yield elt_opt;
        goto left;
      endmatch;

      yield Some (p*.elt);

      ff = iterator p*.right;
    right:>
      elt_opt = #ff;
      match elt_opt with
      | #None => return None[T];
      | Some _ =>
        yield elt_opt;
        goto right;
      endmatch;
    endmatch;
  }
As a set.
//[binary_search_tree.flx]
  instance Set[bstree_t,T] {
    fun \in (elt:T, container:bstree_t) =>
      match find container elt with
      | #Empty => false
      | _ => true
      endmatch
    ;
  }
  inherit Set[bstree_t,T];
As a container.
//[binary_search_tree.flx]
  instance Container[bstree_t, T] {
    // not tail rec
    fun len (x:bstree_t) =>
      let fun aux (x:bstree_t) (sum:size) =>
        match x with
        | #Empty => sum
        | Node p =>
          aux p*.left (aux p*.right (sum+1uz))
        endmatch
      in aux x 0uz
    ;

    // faster than counting then comparing to 0
    fun empty: bstree_t -> bool =
      | #Empty => true
      | _ => false
    ;

  }
  inherit Container[bstree_t,T];
Delete by value.

Ensures the tree doesn’t contain the specified value.

//[binary_search_tree.flx ]
  // deletes the first copy of the element found
  proc delete_element (p:&bstree_t) (elt:T)
  {
    proc aux (p:&bstree_t) {
      match *p with
      | #Empty => ; // not found, nothing to do
      | Node q =>
        if elt == q*.elt do // found it
          var par = q*.parent;
          match q*.left, q*.right with
          // no kids
          | #Empty, Empty => p <- Empty;

          // right kid only
          | #Empty, Node child =>
            p <- q*.right;
            child.parent <-par;

          // left kid only
          | Node (child) , Empty =>
            p <- q*.left;
            child.parent <- par;

          // two kids
          // overwrite elt with min elt of right kid
          // then delete that elt's original node
          // which is the leftmost descendant of the right kid

          | _, Node child =>
            match min q*.right with
            | #Empty => assert false;
            | Node k =>
              var m = k*.elt;
              q.elt <- m;
              delete_element q.right m;
                // this looks nasty and is poor syle but
                // it's not recursive because the element
                // is a leaf and has no children
            endmatch;
          endmatch;
        elif elt < q*.elt do
          aux q.left;
        else
          aux q.right;
        done
      endmatch;
    }
    aux p;
  }

} // class
Judy Arrays
//[judy.flx]

// NOTES: The Felix type 'address' is the correct type for Judy Word
// However it is also an unsigned integer type (int or long depending
// on platform)
//
// But Felix doesn't support automatic int/address conversions
//
// So we will (later) use a typeset to fix this!
class Judy
{
  requires package "judy";
  requires header "#include <Judy.h>";
  open C_hack;

  type word = "Word_t";
  ctor word: !ints = "(Word_t)$1";
  ctor word: address = "(Word_t)$1";
  ctor int: word = "(int)$1";
  ctor uint: word = "(int)$1";
  ctor ulong: word = "(unsigned long)$1";
  ctor size: word = "(size_t)$1";
  ctor address: word = "(void*)$1";
  fun isNULL: word -> bool = "$1==0";
  fun isNULL: &word -> bool = "$1==0";

  type JError_t = "JError_t";

  private body mkjudy =
    """
      static void **_mkjudy(FLX_APAR_DECL ::flx::gc::generic::gc_shape_t *jptr_map){
        typedef void *voidp; // syntax
        void **m = new (*PTF gcp, *jptr_map, false) voidp;
        *m=0;
        return m;
      }
    """
  ;

  // the "value" of a judy array is just a void*
  // to mutate it though, we need it to be on the heap
  // and use the pointer to that object as the array,
  // so that it can be copied about
  private body j1free =
    """
      static void _j1free(::flx::gc::generic::collector_t*,void *p) {
        //printf("Free J1Array %p\\n",p);
        JError_t je;
        Judy1FreeArray((void**)p, &je);
      }
    """
  ;
  private type J1Array_ = "void*"
    requires
      scanner "::flx::gc::generic::Judy1_scanner",
      header '#include "flx_judy_scanner.hpp"',
      finaliser '_j1free',
      j1free
  ;
  _gc_pointer _gc_type J1Array_ type J1Array = "void**" requires property "needs_gc";

  gen _ctor_J1Array: 1 -> J1Array = "_mkjudy(FLX_POINTER_TO_THREAD_FRAME, &@0)"
    requires
      mkjudy,
      property "needs_gc"
  ;

  proc free: J1Array = "_j1free(NULL,$1);" requires j1free;

  proc Judy1Set: J1Array * word * &JError_t * &int =
    "*$4=Judy1Set($1,$2,$3);";

  proc Judy1Unset: J1Array * word * &JError_t * &int =
    "*$4=Judy1Unset($1,$2,$3);";

  proc Judy1Test: J1Array * word * &JError_t * &int =
    "*$4=Judy1Test(*$1,$2,$3);";

  instance Set[J1Array,word] {
    fun \in (x:word, a:J1Array) : bool = {
      var e:JError_t;
      var r:int;
      Judy1Test(a,x,&e,&r);
      return r == 1;
    }
  }
  proc Judy1Count: J1Array * word * word* &JError_t * &word =
    "*$5=Judy1Count(*$1,$2,$3,$4);";

  proc Judy1ByCount: J1Array * word * &word * &JError_t * &word =
    "*$5=Judy1ByCount(*$1,$2,$3,$4);";

  proc Judy1FreeArray: J1Array * &JError_t * &word =
    "*$3=Judy1FreeArray($1,$2);";

  proc Judy1MemUsed: J1Array * &word = "*$2=Judy1MemUsed(*$1);";

  proc Judy1First: J1Array * &word * &JError_t * &int =
    "*$4=Judy1First(*$1,$2,$3);";

  proc Judy1Next: J1Array * &word * &JError_t * &int =
    "*$4=Judy1Next(*$1,$2,$3);";

  proc Judy1Last: J1Array * &word * &JError_t * &int =
    "*$4=Judy1Last(*$1,$2,$3);";

  proc Judy1Prev: J1Array * &word * &JError_t * &int =
    "*$4=Judy1Prev(*$1,$2,$3);";

  proc Judy1FirstEmpty: J1Array * &word * &JError_t * &int =
    "*$4=Judy1FirstEmpty(*$1,$2,$3);";

  proc Judy1NextEmpty: J1Array * &word * &JError_t * &int =
    "*$4=Judy1NextEmpty(*$1,$2,$3);";

  proc Judy1LastEmpty: J1Array * &word * &JError_t * &int =
    "*$4=Judy1LastEmpty(*$1,$2,$3);";

  proc Judy1PrevEmpty: J1Array * &word * &JError_t * &int =
    "*$4=Judy1PrevEmpty(*$1,$2,$3);";

///////////////////////////////////////
  private body jLfree =
    """
      static void _jLfree(::flx::gc::generic::collector_t*,void *p) {
        //printf("Free JLArray %p\\n",p);
        JError_t je;
        JudyLFreeArray((void**)p, &je);
      }
    """
  ;
  private type JLArray_ = "void*"
    requires
      scanner "::flx::gc::generic::JudyL_scanner",
      header '#include "flx_judy_scanner.hpp"',
      finaliser '_jLfree',
      jLfree
  ;
  _gc_pointer _gc_type JLArray_ type JLArray = "void**" requires property "needs_gc";

  gen _ctor_JLArray: 1 -> JLArray = "_mkjudy(FLX_POINTER_TO_THREAD_FRAME, &@0)"
    requires
      mkjudy,
      property "needs_gc"
  ;

  proc free: JLArray = "_jLfree(NULL,$1);" requires jLfree;


  proc JudyLIns: JLArray * word * &JError_t * &&word =
    "*(Word_t**)$4=(Word_t*)JudyLIns($1,$2,$3);";

  proc JudyLDel: JLArray * word * &JError_t * &int =
    "*$4=JudyLDel($1,$2,$3);";

  proc JudyLGet: JLArray * word * &JError_t * &&word =
    "*$4=(Word_t*)JudyLGet(*$1,$2,$3);";

  proc JudyLCount: JLArray * word * word * &JError_t * &word =
    "*$5=JudyLCount(*$1,$2,$3,$4);";

  proc JudyLByCount: JLArray * word * &word * &JError_t * &&word =
    "*$5=JudyLCount(*$1,$2,$3,$4);";

  proc JudyLFreeArray: JLArray * &JError_t * &word =
    "*$3=JudyLFree($1,$2);";

  proc JudyLMemUsed: JLArray * &word =
    "*$2=JudyLMemUsed(*$1);";

  proc JudyLFirst: JLArray * &word * &JError_t * &&word =
    "*(Word_t**)$4=(Word_t*)JudyLFirst(*$1,$2,$3);";

  proc JudyLNext: JLArray * &word * &JError_t * &&word =
    "*(Word_t**)$4=(Word_t*)JudyLNext(*$1,$2,$3);";

  proc JudyLLast: JLArray * &word * &JError_t * &&word =
    "*(Word_t**)$4=(Word_t*)JudyLLast(*$1,$2,$3);";

  proc JudyLPrev: JLArray * &word * &JError_t * &&word =
    "*(Word_t**)$4=(Word_t*)JudyLPrev(*$1,$2,$3);";

  proc JudyLFirstEmpty: JLArray * &word * &JError_t * &word =
    "*$4=JudyLFirstEmpty(*$1,$2,$3);";

  proc JudyLNextEmpty: JLArray * &word * &JError_t * &word =
    "*$4=JudyLNextEmpty(*$1,$2,$3);";

  proc JudyLLastEmpty: JLArray * &word * &JError_t * &word =
    "*$4=JudyLLastEmpty(*$1,$2,$3);";

  proc JudyLPrevEmpty: JLArray * &word * &JError_t * &word =
    "*$4=JudyLPrevEmpty(*$1,$2,$3);";

///////////////////////////////////////
// We should improve the safety here, unbounded string
// lengths .. yuck. char *buffer for results .. overruns possible!

  body JudySL_maxlen = "#define JUDY_SL_MAXLEN 10000";
  body jSLfree =
    """
      static void _jSLfree(::flx::gc::generic::collector_t*,void *p) {
        //printf("Free JSLArray %p\\n",p);
        JError_t je;
        JudySLFreeArray((void**)p, &je);
      }
    """
  ;
  private type JSLArray_ = "void*"
    requires
      scanner "::flx::gc::generic::JudySL_scanner",
      header '#include "flx_judy_scanner.hpp"',
      finaliser '_jSLfree',
      jSLfree, JudySL_maxlen
  ;
  _gc_pointer _gc_type JSLArray_ type JSLArray = "void**" requires property "needs_gc";

  gen _ctor_JSLArray: 1 -> JSLArray = "_mkjudy(FLX_POINTER_TO_THREAD_FRAME, &@0)"
    requires
      mkjudy ,
      property "needs_gc"
  ;

  proc free: JSLArray = "_jSLfree(NULL,$1);" requires jSLfree;

  const JUDY_SL_MAXLEN : int = "JUDY_SL_MAXLEN";

  proc JudySLIns: JSLArray * +char * &JError_t * &&word =
    """
      if (::std::strlen($2) >= JUDY_SL_MAXLEN) throw "JudySLIns strlen>10000";
      *(Word_t**)$4=(Word_t*)JudySLIns($1,(unsigned char*)$2,$3);
    """ requires Cxx_headers::cstring;

  proc JudySLDel: JSLArray * +char * &JError_t * &int =
    "*$4=JudySLDel($1,(unsigned char*)$2,$3);";

  proc JudySLGet: JSLArray * +char * &JError_t * &&word =
    "*$4=(Word_t*)JudySLGet(*$1,(unsigned char*)$2,$3);";

  proc JudySLFirst: JSLArray * +char * &JError_t * &&word =
    "*(Word_t**)$4=(Word_t*)JudySLFirst(*$1,(unsigned char*)$2,$3);";

  proc JudySLNext: JSLArray * +char * &JError_t * &&word =
    "*(Word_t**)$4=(Word_t*)JudySLNext(*$1,(unsigned char*)$2,$3);";

  proc JudySLLast: JSLArray * +char * &JError_t * &&word =
    "*$4=JudySLLast(*$1,(unsigned char*)$2,$3);";

  proc JudySLPrev: JSLArray * +char * &JError_t * &&word =
    "*$4=JudySLPrev(*$1,(unsigned char*)$2,$3);";

///////////////////////////////////////

/* JUDYHS is not supported because there's no way to iterate
   which is required for the GC to work

  type JHSArray = "void**";
  gen _ctor_JHSArray: 1 -> JHSArray = "_mkjudy()" requires mkjudy;

  proc free: JHSArray = "_jHSfree($1);" requires body
    """
      void _jHSfree(void **p) { JudyHSFreeArray(p); free(p); }
    """;

  proc JudyHSIns: JHSArray * address * word * &JError_t * &&word =
    "*$5=(Word_t*)JudyHSIns($1,$2,$3,$4);";

  proc JudyHSDel: JHSArray * address * word * &JError_t * &int =
    "*$5=JudyHSDel($1,$2,$3,$4);";

  proc JudyHSGet: JHSArray * address * word * &JError_t * &&word =
    "*$5=(Word_t*)JudyHSGet(*$1,$2,$3);";
*/

}

open Set[Judy::J1Array,Judy::word];
String Dictionary.
//[strdict.flx]

//$ A strdict is dictionary keyed by strings.
//$ The strings must not contain nul bytes.
//$
//$ This is an ultra high performance data structure
//$ implemented using a JudySLArray.
//$ Typically about the same speed as a hashtable on exact key retrieval,
//$ but with the ability to perform linear key seeking as well.
//$ Linear seeking means searching for a key satisfying one of the total
//$ ordering relations to a given key, including ordered iteration.
//$
//$ Scales to terabytes.
//$ No other data structure can do this.

class StrDict[T] {
   open Judy;

   //$ Type of a strdict.
   type strdict = new JSLArray;

   //$ Construct and empty dictionary.
   ctor strdict() => _make_strdict$ JSLArray ();

   proc add (x:strdict) (var key:string) (value: T) {
     var err: JError_t;
     var slot : && T;
     JudySLIns (_repr_ x, &key.stl_begin, &err, C_hack::cast[&&word] (&slot));
     slot <- new value;
   }

   //$ Construct a dictionary from a list of pairs.
   ctor strdict ( kv: list[string * T] ) = {
     var x = strdict ();
     match k,v in kv do add x k v; done
     return x;
   }


   //$ Fetch a value optionally using the given key.
   fun get (x:strdict) (var key: string) : opt[T] = {
     var err: JError_t;
     var slot : && T;
     JudySLGet (_repr_ x, &key.stl_begin, &err, C_hack::cast[&&word] (&slot));
     return if C_hack::isNULL slot then None[T] else Some (**slot);
   }

   //$ Check if value is in the dictionary.
   fun haskey (x:strdict) (var key: string) : bool =
   {
     var err: JError_t;
     var slot : && T;
     JudySLGet (_repr_ x, &key.stl_begin, &err, C_hack::cast[&&word] (&slot));
     return slot.C_hack::isNULL.lnot;
   }


   //$ Fetch a value using the given key.
   //$ If there is no value in the dictionary with that key,
   //$ then return a default value.
  fun get_dflt (x:strdict) (key:string, dflt:T) =>
    match get x key with
    | Some v => v
    | #None => dflt
    endmatch
  ;

  //$ Remove a key/value pair from the dictionary if it exists.
  //$ Return a boolean value signalling if it existed.
  gen del (x:strdict) (key: string) : bool = {
     var err: JError_t;
     var found : int;
     JudySLDel (_repr_ x, key.cstr, &err, &found);
     return found == 1;
   }

   //$ Get an optional value with key greater than or equal to
   //$ the supplied NTBS (unsafe!)
   gen charp_get_ge (x:strdict) (var key: +char) : opt[T]= {
     var err: JError_t;
     var slot : && T;
     JudySLFirst (_repr_ x, key, &err, C_hack::cast[&&word] (&slot));
     if C_hack::isNULL slot do
       return None[T];
     else
       return Some (**slot);
     done
   }

   //$ Get an optional value with key greater than or equal to
   //$ the supplied string. Safer than the NTBS version but slower.
   //$ Fails if the string contains a nul byte.
   fun get_ge (x:strdict) (var key: string)= {
     var err: JError_t;
     var slot : && T;
     var k = array_alloc[char]$ JUDY_SL_MAXLEN+1;
     CString::strncpy (k,key.cstr, JUDY_SL_MAXLEN);
     var result = charp_get_ge x k;
     match result with
     | Some v =>
       key = k.string;
       free k;
       return Some (key,v);
     | #None=>
       free k;
       return None[string * T];
     endmatch ;
   }

     //$ Get an optional value with key greater than  (>)
     //$ the supplied NTBS (unsafe!)
     gen charp_get_gt (x:strdict) (var key: +char)= {
     var err: JError_t;
     var slot : && T;
     JudySLNext(_repr_ x, key, &err, C_hack::cast[&&word] (&slot));
     if C_hack::isNULL slot do
       return None[T];
     else
       return Some (**slot);
     done
   }

   //$ Get an optional value with key greater than (>)
   //$ the supplied string. Safer than the NTBS version but slower.
   //$ Fails if the string contains a nul byte.
   fun get_gt (x:strdict) (var key: string)= {
     var err: JError_t;
     var slot : && T;
     var k = array_alloc[char]$ JUDY_SL_MAXLEN+1;
     CString::strncpy (k,key.cstr, JUDY_SL_MAXLEN);
     var result = charp_get_gt x k;
     match result with
     | Some v =>
       key = k.string;
       free k;
       return Some (key,v);
     | #None=>
       free k;
       return None[string * T];
     endmatch ;
   }

   //$ Get an optional value with key less than or equal to (<=)
   //$ the supplied NTBS (unsafe!)
   gen charp_get_le (x:strdict) (var key: +char)= {
     var err: JError_t;
     var slot : && T;
     JudySLLast(_repr_ x, key, &err, C_hack::cast[&&word] (&slot));
     if C_hack::isNULL slot do
       return None[T];
     else
       return Some (**slot);
     done
   }

   //$ Get an optional value with key less than or equal to (<=)
   //$ the supplied string. Safer than the NTBS version but slower.
   //$ Fails if the string contains a nul byte.
   fun get_le (x:strdict) (var key: string)= {
     var err: JError_t;
     var slot : && T;
     var k = array_alloc[char]$ JUDY_SL_MAXLEN+1;
     CString::strncpy (k,key.cstr, JUDY_SL_MAXLEN);
     var result = charp_get_le x k;
     match result with
     | Some v =>
       key = k.string;
       free k;
       return Some (key,v);
     | #None=>
       free k;
       return None[string * T];
     endmatch ;
   }

   //$ Get an optional value with key less than (<)
   //$ the supplied NTBS (unsafe!)
   gen charp_get_lt (x:strdict) (var key: +char)= {
     var err: JError_t;
     var slot : && T;
     JudySLPrev (_repr_ x, key, &err, C_hack::cast[&&word] (&slot));
     if C_hack::isNULL slot do
       return None[T];
     else
       return Some (**slot);
     done
   }

   //$ Get an optional value with key less than (<)
   //$ the supplied string. Safer than the NTBS version but slower.
   //$ Fails if the string contains a nul byte.
   fun get_lt (x:strdict) (var key: string)= {
     var err: JError_t;
     var slot : && T;
     var k = array_alloc[char]$ JUDY_SL_MAXLEN+1;
     CString::strncpy (k,key.cstr, JUDY_SL_MAXLEN);
     var result = charp_get_lt x k;
     match result with
     | Some v =>
       key = k.string;
       free k;
       return Some (key,v);
     | #None=>
       free k;
       return None[string * T];
     endmatch ;
   }

   //$ Get the optional first key in the dictionary into
   //$ the supplied NTBS (unsafe!)
   gen charp_first (x:strdict) (buffer:+char) = {
     set(buffer,0,char "");
     return x.charp_get_ge buffer;
   }

   //$ Get the optional first key in the dictionary.
   fun first (x:strdict) : opt[string * T] => x.get_ge("");

   instance Iterable[strdict, string * T] {
     //$ Stream iterator scanning through all key value pairs
     //$ in the dictionary, in key order.
     gen iterator (x:strdict) () : opt[string * T]  = {
       var buffer : +char = array_alloc[char](JUDY_SL_MAXLEN+1);
       var v = charp_first x buffer;
       while true do
         match v with
         | Some vv => yield Some (string buffer, vv);
         | #None => free buffer; return None[string * T];
         endmatch;
         v = charp_get_gt x buffer;
       done
     }
  }
  inherit Streamable[strdict, string * T];

  instance[with Str[T]] Str[strdict]
  {
    fun str(var x:strdict) : string =
    {
      var s = "{";
      match key,value in x.iterator do
        var entry = key +"=" + str value;
        if s == "{" do s+= entry; else s+= ", "+ entry; done
      done
      s+="}";
      return s;
    }
  }
  inherit Str[strdict];

  instance Set[strdict,string] {
    fun \in (key:string, dict:strdict) => haskey dict key;
  }
  inherit Set[strdict,string];

}

open[T] StrDict[T];

// map from string to list of strings
open class Str2StrList
{
  typedef str2strlist = strdict[list[string]];
  ctor str2strlist () => strdict[list[string]] ();

  // transitive closure of a list of dependencies
  fun trcls (x:str2strlist) (inp: list[string]) (out:list[string]) =>
    match inp with
    | Empty => out
    | head ! tail =>
      if not (head in out) then
        trcls x (tail + x.get_dflt (head, Empty[string])) (head ! out)
      else
        trcls x tail out
      endif
    endmatch
  ;

  // mutates the dictionary so each key maps to
  // the transitive closure of its original value set
  // the resulting value lists are unique lists even if
  // the original list contained duplicates
  proc transitive_closure (x:str2strlist) = {
    match file,deps in x.iterator do
      x.add file (trcls x deps Empty[string]);
    done
  }

}

Package: src/packages/ucstring.fdoc

Unique Strings

Traditional C Strings
key file
cstring.flx share/lib/std/strings/cstring.flx

Primitive operations on C strings, distinct from corresponding byte operations in that they depend on or involve the null terminator.

//[cstring.flx]
// Primitives
class CString
{
  //$ C strcpy.
  proc strcpy: +char * +char = "(void)::std::strcpy($1,$2);"
    requires Cxx_headers::cstring
  ;

  //$ C strncpy.
  proc strncpy: +char * +char * !ints = "(void)::std::strncpy($1,$2,$3);"
    requires Cxx_headers::cstring
  ;

  //$ C strlen: NTBS length.
  fun strlen: +char -> size = "::std::strlen($1)"
    requires Cxx_headers::cstring
  ;

  fun len (s:+char) => strlen s;

  //$ Traditional NTBS strdup.
  gen strdup: +char -> +char = "::flx::rtl::strutil::flx_strdup($1)"
    requires package "flx_strutil"
  ;

}
Unique C Strings
key file
ucstr.flx share/lib/std/strings/ucstr.flx
ucstr_prim_01.flx src/test/regress/rt/ucstr_prim_01.flx
ucstr_prim_01.expect src/test/regress/rt/ucstr_prim_01.expect

A safer way to handle NTBS, using uniq typing to transfer owenership. Doesn’t require GC.

Synopsis:

ctor : string -> ucstr ctor : +char -> ucstr (unsafe) proc delete : ucstr fun len : ucstr -> size fun set : ucstr * int * char -> ucstr fun reserve : ucstr * size -> ucstr fun append : ucstr * ucstr -> ucstr fun append : ucstr * &ucstr -> ucstr doesn’t consume second arg fun + : ucstr * ucstr -> ucstr fun + : ucstr * &ucstr -> ucstr doesn’t consume second arg proc += : &ucstr * &ucstr -> ucstr modifies first arg, doesn’t consume second fun erase : ucstr -> slice[int] -> ucstr fun insert : ucstr -> int * ucstr -> ucstr inserts second arg into first at pos fun dup : ucstr -> ucstr * ucstr destructive dup fun dup : &ucstr -> ucstr * ucstr nondestructive dup

This one is private:

fun strmov : ucstr -> int * int -> ucstr

strmov u (f,l) returns a the original string with the tail starting at position l moved left to position f. Right moves will fail, possibly causing corruption, so we require f <= l. f and l are clipped up to zero if negative and down to the string length if they exceed it.

//[ucstr.flx]
open class UniqueCStrings
{
  open CString;
  open Memory;

  private var debug = Env::issetenv "FLX_TRACE_UCSTR";

  // abstract representation
  private type _ucstr = new +char;

  // make it uniq
  typedef ucstr = uniq _ucstr;

  // privatise access to representation
  private fun unpack (var p: ucstr) : +char => p.unbox._repr_;
  private fun pack (p: +char) => p._make__ucstr.box;

  // Constructors
  ctor ucstr (var s:string) = {
     var p =  s._unsafe_cstr; // malloc'd copy of string contents
     if debug perform
       println$ "Creating " + p.repr + " @" + p.address.repr;
     return pack p;
  }

  ctor ucstr (s:+char) => s.strdup.pack;

  // duplicate value, destructive
  fun dup (var s:ucstr) : ucstr * ucstr = {
    var p = unpack s;
    var q = strdup p;
    if debug perform
      println$ "Creating " + q.repr + " @" + q.address.repr;
    return p.pack,q.pack;
  }

  // duplicate variable, non destructive
  fun dup (s:&<ucstr) : ucstr = {
    var p = s.peek._repr_.strdup;
    if debug perform
      println$ "Creating " + p.repr + " @" + p.address.repr;
    return p.pack;
  }

  // deletes the store
  proc delete (var p:ucstr) {
    var q = unpack p;
    if debug perform
      println$ "Deleting " + q.address.repr;
    free q;
  }

  inherit Str[_ucstr];
  inherit Repr[_ucstr];
  instance Str[_ucstr] { fun str(p:_ucstr)=>p._repr_.str; }
  instance Repr[_ucstr] { fun repr(p:_ucstr)=>p._repr_.repr; }

  // length
  fun len(var s:&<ucstr) : size => s.peek._repr_.strlen;

  // modify one char
  fun set (var s:ucstr, i:int, c:char) : ucstr =  {
    var cs = unpack s;
    Carray::set (cs, i, c);
    return cs.pack;
  }

  private gen realloc : +char * !ints -> +char =
    "(char*)::std::realloc($1,$2)"
    requires Cxx_headers::cstdlib
  ;

  // reserve storage
  fun reserve (var s:ucstr, n:size) : ucstr =>
    pack (realloc (unpack s,n))
  ;

  // append: consumes y
  fun append (var x:ucstr, var y:ucstr): ucstr = {
    var cx = unpack x;
    var cy = unpack y;
    var lx = cx.len;
    var ly = cy.len;
    var r = realloc (cx, lx+ly+1);
    strncpy (r+lx,cy,ly+1);
    if debug do
      println$ "Realloc @" + cx.address.repr + " -> " + r.address.repr;
      println$ "Free @" + cy.address.repr;
    done
    free cy;
    return pack r;
  }

  // append: doesnt consume y
  noinline fun append (var x:ucstr, var py:&ucstr): ucstr = {
    var cx = unpack x;
    var cy = py.peek._repr_;
    var lx = cx.len;
    var ly = cy.len;
    var r = realloc (cx, lx+ly+1);
    if debug perform
      println$ "Realloc @" + cx.address.repr + " -> " + r.address.repr;
    strncpy (r+lx,cy,ly+1);
    return pack r;
  }

  // nicer appends
  fun + (var x:ucstr, var y:ucstr) => append (x,y);
  fun + (var x:ucstr, var py:&ucstr) => append (x,py);

  proc += (var lhs: &ucstr, var rhs: ucstr) =>
    lhs <- append (*lhs,rhs)
  ;
  proc += (var lhs: &ucstr, var rhs: &ucstr) =>
    lhs <- append (*lhs,rhs)
  ;

  private fun strmov (var x:ucstr) (var f:int, var l:int) : ucstr = {
    var p = x.unpack;
    var n = p.strlen.int;
    if f < 0 perform f = 0;
    if f > n perform f = n;
    if l < 0 perform l = f;
    if l > n perform l = n;
    if f != l perform strcpy (p+f, p+l);
    return pack p;
  }

  fun erase (var x:ucstr) (sl:slice[int]) : ucstr =>
    match sl with
    | Slice_all => set (x,0,char "")
    | Slice_from idx => set (x,idx, char "")
    | Slice_from_counted (first,len) => strmov x (first,first+len)
    | Slice_to_incl incl => strmov x (0,incl)
    | Slice_to_excl excl => strmov x (0, excl - 1)
    | Slice_range_incl (first, last) => strmov x (first, last+1)
    | Slice_range_excl (first, last) => strmov x (first, last)
    | Slice_one pos => strmov x (pos, pos+1)
  ;

  fun insert (var x:ucstr) (var pos: int, var y:ucstr) : ucstr =
  {
    var px = unpack x;
    var py = unpack y;
    var n = px.strlen.int;
    var m = py.strlen.int;
    if pos < 0 perform pos = pos + n;
    if pos > n perform pos = n;
    if pos < 0 perform pos = 0;
    px = realloc (px, m + n + 1);
    memmove (px.address + pos, px.address + pos + m, m);
    free py;
    return pack px;
  }

  fun search (var s: &<ucstr, var pat: &<ucstr) : size =
  {
    var p = s*.unpack;
    var q = pat*.unpack;
    var n = strlen p;
    var m = strlen q;
    var pr = Memory::search (p.address,(p+n).address,q.address,(q+m).address);
    val r = (pr - p.address).size;
    return r;
  }

}
ucstr_prim_01.flx
//[ucstr_prim_01.flx]
proc test() {
  var s = ucstr "hello";
  println$ &s;
  s = set (s, 0, char "e");
  println$ &s;
  delete s;
}
test();

hello
eello
Unique Counted Strings
key file
ustr.flx share/lib/std/strings/ustr.flx
ustr_prim_01.flx src/test/regress/rt/ustr_prim_01.flx
ustr_prim_01.expect src/test/regress/rt/ustr_prim_01.flx

A safer way to handle counted strings using uniq typing to transfer owenership. Doesn’t require GC.

Synopsis:

ctor : string -> ustr ctor : +char -> ustr (unsafe) proc delete : ustr fun len : ustr -> size fun set : ustr * int * char -> ustr fun reserve : ustr * size -> ustr fun append : ustr * ustr -> ustr fun append : ustr * &ustr -> ustr doesn’t consume second arg fun + : ustr * ustr -> ustr fun + : ustr * &ustr -> ustr doesn’t consume second arg proc += : &ustr * &ustr -> ustr modifies first arg, doesn’t consume second fun erase : ustr -> slice[int] -> ustr fun insert : ustr -> int * ustr -> ustr inserts second arg into first at pos fun dup : ustr -> ustr * ustr destructive dup fun dup : &ustr -> ustr * ustr nondestructive dup

This one is private:

fun strmov : ustr -> int * int -> ustr

strmov u (f,l) returns a the original string with the tail starting at position l moved left to position f. Right moves will fail, possibly causing corruption, so we require f <= l. f and l are clipped up to zero if negative and down to the string length if they exceed it.

//[ustr.flx]
open class UniqueCountedStrings
{
  open CString;
  open Memory;

  private var debug = Env::issetenv "FLX_TRACE_UCSTR";

  // abstract representation
  private type _ustr = new +char;

  // make it uniq
  typedef ustr = uniq _ustr;

  // privatise access to representation
  private fun unpack (var p: ustr) : +char => p.unbox._repr_;
  private fun pack (p: +char) => p._make__ustr.box;

  // Constructors
  ctor ustr (var s:string) = {
     var p =  s._unsafe_cstr; // malloc'd copy of string contents
     if debug perform
       println$ "Creating " + p.repr + " @" + p.address.repr;
     return pack p;
  }

  ctor ustr (s:+char) => s.strdup.pack;

  // duplicate value, destructive
  fun dup (var s:ustr) : ustr * ustr = {
    var p = unpack s;
    var q = strdup p;
    if debug perform
      println$ "Creating " + q.repr + " @" + q.address.repr;
    return p.pack,q.pack;
  }

  // duplicate variable, non destructive
  fun dup (s:&<ustr) : ustr = {
    var p = s.peek._repr_.strdup;
    if debug perform
      println$ "Creating " + p.repr + " @" + p.address.repr;
    return p.pack;
  }

  // deletes the store
  proc delete (var p:ustr) {
    var q = unpack p;
    if debug perform
      println$ "Deleting " + q.address.repr;
    free q;
  }

  inherit Str[_ustr];
  inherit Repr[_ustr];
  instance Str[_ustr] { fun str(p:_ustr)=>p._repr_.str; }
  instance Repr[_ustr] { fun repr(p:_ustr)=>p._repr_.repr; }

  // length
  fun len(var s:&<ustr) : size => s.peek._repr_.strlen;

  // modify one char
  fun set (var s:ustr, i:int, c:char) : ustr =  {
    var cs = unpack s;
    Carray::set (cs, i, c);
    return cs.pack;
  }

  private gen realloc : +char * !ints -> +char =
    "(char*)::std::realloc($1,$2)"
    requires Cxx_headers::cstdlib
  ;

  // reserve storage
  fun reserve (var s:ustr, n:size) : ustr =>
    pack (realloc (unpack s,n))
  ;

  // append: consumes y
  fun append (var x:ustr, var y:ustr): ustr = {
    var cx = unpack x;
    var cy = unpack y;
    var lx = cx.len;
    var ly = cy.len;
    var r = realloc (cx, lx+ly+1);
    strncpy (r+lx,cy,ly+1);
    if debug do
      println$ "Realloc @" + cx.address.repr + " -> " + r.address.repr;
      println$ "Free @" + cy.address.repr;
    done
    free cy;
    return pack r;
  }

  // append: doesnt consume y
  noinline fun append (var x:ustr, var py:&ustr): ustr = {
    var cx = unpack x;
    var cy = py.peek._repr_;
    var lx = cx.len;
    var ly = cy.len;
    var r = realloc (cx, lx+ly+1);
    if debug perform
      println$ "Realloc @" + cx.address.repr + " -> " + r.address.repr;
    strncpy (r+lx,cy,ly+1);
    return pack r;
  }

  // nicer appends
  fun + (var x:ustr, var y:ustr) => append (x,y);
  fun + (var x:ustr, var py:&ustr) => append (x,py);

  proc += (var lhs: &ustr, var rhs: ustr) =>
    lhs <- append (*lhs,rhs)
  ;
  proc += (var lhs: &ustr, var rhs: &ustr) =>
    lhs <- append (*lhs,rhs)
  ;

  private fun strmov (var x:ustr) (var f:int, var l:int) : ustr = {
    var p = x.unpack;
    var n = p.strlen.int;
    if f < 0 perform f = 0;
    if f > n perform f = n;
    if l < 0 perform l = f;
    if l > n perform l = n;
    if f != l perform strcpy (p+f, p+l);
    return pack p;
  }

  fun erase (var x:ustr) (sl:slice[int]) : ustr =>
    match sl with
    | Slice_all => set (x,0,char "")
    | Slice_from idx => set (x,idx, char "")
    | Slice_from_counted (first,len) => strmov x (first,first+len)
    | Slice_to_incl incl => strmov x (0,incl)
    | Slice_to_excl excl => strmov x (0, excl - 1)
    | Slice_range_incl (first, last) => strmov x (first, last+1)
    | Slice_range_excl (first, last) => strmov x (first, last)
    | Slice_one pos => strmov x (pos, pos+1)
  ;

  fun insert (var x:ustr) (var pos: int, var y:ustr) : ustr =
  {
    var px = unpack x;
    var py = unpack y;
    var n = px.strlen.int;
    var m = py.strlen.int;
    if pos < 0 perform pos = pos + n;
    if pos > n perform pos = n;
    if pos < 0 perform pos = 0;
    px = realloc (px, m + n + 1);
    memmove (px.address + pos, px.address + pos + m, m);
    free py;
    return pack px;
  }

  fun search (var s: &<ustr, var pat: &<ustr) : size =
  {
    var p = s*.unpack;
    var q = pat*.unpack;
    var n = strlen p;
    var m = strlen q;
    var pr = Memory::search (p.address,(p+n).address,q.address,(q+m).address);
    val r = (pr - p.address).size;
    return r;
  }

}
ustr_prim_01.flx
//[ustr_prim_01.flx]
proc test() {
  var s = ustr "hello";
  println$ &s;
  s = set (s, 0, char "e");
  println$ &s;
  delete s;
}
test();

hello
eello

Package: src/packages/uint256_t.fdoc

Jason Lee’s uint256_t library

key file
unix_uint256_t.fpc $PWD/src/config/unix/flx_uint256_t.fpc
win_uint256_t.fpc $PWD/src/config/win/flx_uint256_t.fpc
flx_uint256_t.py $PWD/buildsystem/flx_uint256_t.py

Main code

The code is in src/uint256_t.

Config

//[unix_uint256_t.fpc]
Name: uint256_t
Description: Jason Lee's uint256_t library
provides_dlib: -lflx_uint256_t_dynamic
provides_slib: -lflx_uint256_t_static
includes: '"uint256_t.h"'
library: flx_uint256_t
srcdir: src/uint256_t
headers: (uint256_t.h|uint128_t.h|uint128_t.include|uint256_t.include|uint256_t_config.include)
src: uint128_t.cpp uint256_t.cpp
build_includes: src/uint256_t

//[win_uint256_t.fpc]
Name: uint256_t
Description: Jason Lee's uint256_t library
provides_dlib: /DEFAULTLIB:flx_uint256_t_dynamic
provides_slib: /DEFAULTLIB:flx_uint256_t_static
includes: '"uint256_t.h"'
library: flx_uint256_t
srcdir: src\uint256_t
headers: (uint256_t.h|uint128_t.h|uint128_t.include|uint256_t.include|uint256_t_config.include)
src: uint128_t.cpp uint256_t.cpp
build_includes: src\uint256_t

#[flx_uint256_t.py]
import fbuild
from fbuild.path import Path
from fbuild.record import Record
from fbuild.builders.file import copy

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    print('[fbuild] [rtl] build uint256_t')
    path = Path(phase.ctx.buildroot/'share'/'src'/'uint256_t')

    buildsystem.copy_to(phase.ctx, phase.ctx.buildroot/'share'/'lib'/'rtl',[
      path/"uint128_t.h", path/"uint128_t.include",
      path/"uint256_t.h", path/"uint256_t.include",
      path/"uint256_t_config.include"
      ])

    srcs = [path/'uint128_t.cpp',path/'uint256_t.cpp']

    dst = 'host/lib/rtl/flx_uint256_t'

    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs)
        )

Package: src/packages/unique.fdoc

General Unique Facilities

key file
unique.flx share/lib/std/control/unique.flx
General Facilities
//[unique.flx]
open class Unique
{
  // box up a value as a unique thing
  fun box[T] : T -> _uniq T = "($t)";

  // unsafely unpack the unique box
  fun unbox[T] : _uniq T -> T = "($t)";

  // kill a live unique value
  proc kill[T] : uniq T = ";";

  // functor for typing
  typedef fun uniq (T:TYPE):TYPE => _uniq T;

  // peek inside the box without changing livenes state
  fun peek[T] : &<(uniq T) -> T = "*($t)";

  // string representions
  instance[T] Repr[uniq T] {
    fun repr(var x:uniq T) => "uniq " + (C_hack::cast[T] x).str;
  }

  instance[T] Str[uniq T] {
    fun str(var x:uniq T) => "uniq " + (C_hack::cast[T] x).str;
  }

  instance[T with Repr[T]] Repr[&<(uniq T)] {
    fun repr(var x:&<(uniq T)) => "uniq " + x.peek.repr;
  }

  instance[T with Str[T]] Str[&<(uniq T)] {
    fun str(var x:&<(uniq T)) => x.peek.str;
  }
}

Control Flow

Contents:

Package: src/packages/chips.fdoc

key file
chips.flx share/lib/std/control/chips.flx

Chips.

Standard components
Write block.

Blocks reader.

//[chips.flx]
open class BaseChips
{

chip writeblock[T]
  connector io
    pin inp : %<T
{
}
Read block.

Blocks writer.

//[chips.flx]
chip readblock[T]
  connector io
    pin inp: %>T
{
}
Universal sink

Reads input forever.

//[chips.flx]
chip sink[T]
  connector io
    pin inp : %<T
{
  while true do
    var x = read (io.inp);
    C_hack::ignore (x);
  done
}
Constant Source.

Write fixed value forever.

//[chips.flx]
chip source[T] (a:T)
  connector io
    pin out: %>T
{
  while true do
    write (io.out, a);
  done
}
One shot source
//[chips.flx]
chip value[T] (a:T)
  connector io
    pin out: %>T
{
  write (io.out, a);
}
Source from generator
//[chips.flx]
chip generator[T] (g: 1->T)
  connector io
    pin out: %>T
  {
    repeat perform write (io.out, g());
  }
Source from iterator
//[chips.flx]
chip iterate[T] (g: 1->opt[T])
  connector io
    pin out: %>T
  {
    again:>
      var x = g();
      match x with
      | Some v =>
        write (io.out, v);
        goto again;
      | None => ;
      endmatch;
  }
Source from list
//[chips.flx]
chip source_from_list[T] (a:list[T])
  connector io
    pin out: %>T
{
  for y in a perform write (io.out,y);
}

chip bound_source_from_list[T] (a:list[T])
  connector io
    pin out: %>opt[T]
{
  for y in a perform write (io.out,Some y);
  while true perform write (io.out,None[T]);
}
Function adaptor.

Converts function to chip.

//[chips.flx]
chip function[D,C] (f:D->C)
  connector io
    pin inp: %<D
    pin out: %>C
{
  while true do
    var x = read io.inp;
    var y = f x;
    write (io.out, y);
  done
}
Procedure adaptor.

Converts a procedure to a sink.

//[chips.flx]
chip procedure[D] (p:D->0)
  connector io
    pin inp: %<D
{
  while true do
    var x = read io.inp;
    p x;
  done
}
Filter

Convert a predicate and function to a transducer.

//[chips.flx]
chip filter[D,C] (c:D->bool) (f:D->C)
  connector io
    pin inp: %<D
    pin out: %>C
{
  while true do
    var x = read io.inp;
    if c x do
       write (io.out, f x);
    done
  done
}

chip filter[D,C] (f:D->opt[C])
  connector io
    pin inp: %<D
    pin out: %>C
{
  while true do
    var x = read io.inp;
    match f x with
    | Some y => write (io.out, y);
    | None => ;
    endmatch;
  done
}
Sink to list
//[chips.flx]
chip sink_to_list[T] (p: &list[T])
  connector io
    pin inp : %<T
{
  while true do
    var x = read (io.inp);
    p <- Cons (x,*p);
  done
}
Sink to unique list
//[chips.flx]
chip sink_to_unique_list[T with Eq[T]] (p: &list[T])
  connector io
    pin inp : %<T
{
  while true do
    var x = read (io.inp);
    if not (x in *p) perform
      p <- Cons (x,*p)
    ;
  done
}
Buffer.

One step buffer. Same as a function adaptor passed identity.

//[chips.flx]
chip buffer [T]
  connector io
    pin inp: %<T
    pin out: %>T
{
  while true do
    var x = read io.inp;
    write (io.out, x);
  done
}

chip dup [T]
  connector io
    pin inp: %<T
    pin out1: %>T
    pin out2: %>T
{
  while true do
    var x = read io.inp;
    write (io.out1, x);
    write (io.out2, x);
  done
}
Connector symbol

The syntax |-> is parsed to pipe (a,b). We add overloads for chips with pins named io.inp, io.out.

//[chips.flx]
// two transducers
chip pipe[T,U,V] (a:iochip_t[T,U],b:iochip_t[U,V])
 connector io
   pin inp: %<T
   pin out: %>V
{
  circuit
    connect a.out,b.inp
    wire io.inp to a.inp
    wire io.out to b.out
  endcircuit
}

// source to transducer
chip pipe[T,U] (a:ochip_t[T],b:iochip_t[T,U])
 connector io
   pin out: %>U
{
  circuit
    connect a.out,b.inp
    wire io.out to b.out
  endcircuit
}

// transducer to sink
chip pipe[T,U] (a:iochip_t[T,U],b:ichip_t[U])
 connector io
   pin inp: %<T
{
  circuit
    connect a.out,b.inp
    wire io.inp to a.inp
  endcircuit
}

// source to sink
proc pipe[T] (a:ochip_t[T],b:ichip_t[T])  ()
{
  circuit
    connect a.out,b.inp
  endcircuit
}
Debug Buffer.
//[chips.flx]
chip debug_buffer [T with Str[T]] (tag:string)
  connector io
    pin inp: %<T
    pin out: %>T
{
  while true do
    println$ "Debug buffer [" + tag + "] READ";
    var x = read io.inp;
    println$ "Debug buffer [" + tag + "] read " + x.str;
    write (io.out, x);
    println$ "Debug buffer [" + tag + "] written " + x.str;
  done
}
One Shot.

A one shot buffer.

//[chips.flx]
chip oneshot [T]
  connector io
    pin inp: %<T
    pin out: %>T
{
  var x = read io.inp;
  write (io.out, x);
}
Store

Stores read values in a variable.

//[chips.flx]
chip store[T] (p:&T)
  connector io
    pin inp: %<T
{
  while true do
    var x = read io.inp;
    p <- x;
  done
}
Fetch

Writes current value of a variable.

//[chips.flx]
chip fetch[T] (p:&T)
  connector io
    pin out: %>T
{
  while true do
    write (io.out, *p);
  done
}
Printer

Writes input to console.

//[chips.flx]
chip debug_sink [T with Str[T]] (s:string)
  connector io
    pin inp: %<T
{
  while true do
    var x = read io.inp;
    println$ "Debug sink ["+s+"] "+x.str;
  done
}
Asynchronous Latch.

Satisfied all reads with the last value written. Blocks readers until at least one value is written.

//[chips.flx]
chip latch[T]
  connector io
    pin inp: %<T
    pin out: %>T
{
   var x = read io.inp;
   device w = fetch &x;
   device r = store &x;
   circuit
     wire io.inp to r.inp
     wire io.out to w.out
   endcircuit
}
Serialise.

Read values in sequence from a sequence of channels, write each one out on a single channel. Repeat. The input channels are fixed by supplying them as an argument.

//[chips.flx]
chip serialise_chan_list[T] (a: list[%<T])
 connector io
   pin out: %>T
{
  while true do
    var current = a;
next:>
    match current with
    | Cons (h,t) =>
      var x = read h;
      write (io.out, x);
      current = t;
      goto next;
    | Empty => ;
    endmatch;
  done
}

typedef iopair_t[D,C] = (inp: %<D, out: %>C);

// transducer
typedef iochip_t[D,C] = iopair_t[D,C] -> 1 -> 0;

// sink
typedef ichip_t[T] = (inp: %<T) -> 1 -> 0;

// source
typedef ochip_t[T] = (out: %>T) -> 1 -> 0;

chip pipeline_list[T] (a: list[iochip_t[T,T]])
  connector io
    pin inp: %<T
    pin out: %>T
{
  proc aux (lst:list[iochip_t[T,T]]) (inp: %<T) {
    match lst with
    | h1 ! h2 ! tail =>
      var inchan,outchan = mk_ioschannel_pair[T]();
      spawn_fthread$  h1 (inp=inp, out=outchan);
      aux (h2!tail) inchan;
    | h1 ! _ =>
      spawn_fthread$  h1 (inp=inp, out=io.out);
    | Empty =>
      spawn_fthread$ buffer (inp=io.inp, out=io.out);
    endmatch;
  }
  aux a io.inp;
}

// This loops, but only by repeatedly spawning
// the alternative set. The alternatives are restricted
// to a single read on each iteration. The chips are
// respawned because they might be locked up, in which
// case the whole thing locks up.
//
// NOTE: if one of the alternatives starts, and does not
// read the input, everything locks up. This is because
// the implementation ACTUALLY progresses serially.
//
// this COULD be fixed by adding a buffer to the front of
// each. Actually better, add a one shot source based
// on the input.
chip tryall_list[D,C with Str[D]] (a: list[iochip_t[D,C]])
  connector io
    pin inp: %<D
    pin out: %>C
{
  while true do
    var x = read io.inp;
    //println$ "Tryall read " + a.len.str + " alternatives: " + x.str;
    //var counter = 1;
    for h in a do
      //println$ "Trying alternative #" + counter.str + "/"+a.len.str;
      var lin,lout = mk_ioschannel_pair[D]();
      spawn_fthread (h (inp=lin, out=io.out));
      //println$ "Tryall_list write " + lout.address.str;
      write (lout,x);
    done
  done
}
Deref

This version spawns a clone of p for each input. In particular it delays the spawn until there is an input.

//[chips.flx]
chip deref_each_read[D,C] (p:&iochip_t[D,C])
  connector io
    pin inp: %<D
    pin out: %>C
{
  while true do
    var x = read io.inp;
    var rinp,rout = mk_ioschannel_pair[D]();
    spawn_fthread ((*p) (inp=rinp, out=io.out));
    // println$ "Deref_each_read: write " + io.out.address.str;
    write (rout,x);
  done
}

chip deref_first_read[D,C] (p:&iochip_t[D,C])
  connector io
    pin inp: %<D
    pin out: %>C
{
  var x = read io.inp;
  var rinp,rout = mk_ioschannel_pair[D]();
  spawn_fthread ((*p) (inp=rinp, out=io.out));
  write (rout,x);
  while true do
    x = read io.inp;
    write (rout,x);
  done
}
Epsilon

Identity chip.

//[chips.flx]
chip epsilon[T]
  connector io
   pin inp: %<T
   pin out: %>T
{
  while true do
    var x = read io.inp;
    //println$ "Epsilon: write " + io.out.address.str;
    write (io.out, x);
  done
}
Optional matcher.

Matches given matcher if possible and epsilon. Note the epsilon match is ALWAYS output!

//[chips.flx]
chip optional[T] (p:iochip_t[T,T])
  connector io
    pin inp: %<T
    pin out: %>T
{
  device both = tryall_list ([
    p,
    epsilon[T]
  ]);
  circuit
    wire io.inp to both.inp
    wire io.out to both.out
  endcircuit
}
One or more matcher
//[chips.flx]

chip oneormore_matcher[T] (A:iochip_t[T,T])
connector chans
  pin inp: %<T
  pin out: %>T
{
 device As = oneormore_matcher A;
 device As2 = pipeline_list (A,As).list;
 device Ass = tryall_list (A, As2).list;
 circuit
   wire chans.inp to Ass.inp
   wire chans.out to Ass.out
 endcircuit
}
Zero or more matcher
//[chips.flx]

chip zeroormore_matcher[T] (A:iochip_t[T,T])
connector chans
  pin inp: %<T
  pin out: %>T
{
 device As = oneormore_matcher A;
 device Ass = tryall_list (epsilon[T], As).list;
 circuit
   wire chans.inp to Ass.inp
   wire chans.out to Ass.out
 endcircuit
}

//[chips.flx]
} // end class BaseChips

Package: src/packages/fibres.fdoc

Synchronous threads

key file
fibres.flx share/lib/std/control/fibres.flx
schannels.flx share/lib/std/control/schannels.flx
mux.flx share/lib/std/control/mux.flx
spipes.flx share/lib/std/control/spipes.flx
Fibres (fthreads)
//[fibres.flx]

//$ Low level management of Felix fthreads (fibres).
open class Fibres
{
  private gen _start[t]: (t->0)*t->cont = "$1->clone()->call(0,$2)";

  //$ Function to start a continution with argument type t.
  gen start[t] (p:t->0) (x:t) = { return _start (p,x); }

  private fun _start0: (1->0)->cont = "$1->clone()->call(0)";

  //$ Function to start a contiuation without an argument.
  gen start (p:1->0) = { return _start0 (p); }

  //$ Function to make a fibre out of a continuation.
  gen mk_thread: cont->fthread = "new(*PTF gcp,::flx::rtl::_fthread_ptr_map,false) ::flx::rtl::fthread_t($1)";

  // Spawn a fibre on this fibres scheduler.
  // uses a supervisor call so can't be used in a function
  proc spawn_fthread(p:1->0)
  {
      var con = start p;              // get continuation of p
      var fthr = mk_thread con;
      svc$ svc_spawn_fthread fthr;
  }

  proc schedule_fthread(p:1->0)
  {
      var con = start p;              // get continuation of p
      var fthr = mk_thread con;
      svc$ svc_schedule_fthread fthr;
  }

  proc suicide: 1 = "throw (con_t*)NULL;";

  proc chain : cont = "return $1;" requires property "heap_closure";

  // *********************************************************
  // NESTED SYNC SCHEDULER
  // NOTE: deprecated in favour of async scheduler below
  // *********************************************************
  //$ The type of a fibre scheduler.
  type fibre_scheduler = "::flx::run::sync_sched*" requires header '#include "flx_sync.hpp"';

  //$ Construct a fibre scheduler.
  //$  NOTE: NOW GARBAGE COLLECTED!
  ctor fibre_scheduler: bool = """
    new(*PTF gcp,::flx::run::sync_sched_ptr_map,false)
      ::flx::run::sync_sched
      (
        $1,
        PTF gcp,
        new(*PTF gcp, ::flx::run::fthread_list_ptr_map, false) ::flx::run::fthread_list(PTF gcp)
      )
    """
  ;
  ctor fibre_scheduler () =>
    fibre_scheduler (Env::getenv "FLX_DEBUG_DRIVER" != "")
  ;


  //$ Spawn a fibre on a given scheduler with a given continuation.
  //$ Note: does NOT run it!
  //$ FIXME: no mutex guard!!
  proc spawn_fibre: fibre_scheduler * fthread = """
    $1->active->push_back($2);
  """;

  proc frun: (1->0) = "::flx::rtl::executil::frun (PTF gcp, $1);"
    requires header '#include "flx_executil.hpp"'
  ;

  proc run: fibre_scheduler = "$1->frun();";

  proc run (p: 1 -> 0) {
    var s = fibre_scheduler();
    spawn_fthread s p;
    s.run;
  }


  //$ The type of the stop state of the fibre scheduler.
  //$ terminated: the scheduler is terminated.
  //$ blocked: the scheduler is out of threads to run.
  //$ delegated: the scheduler has been issued a service
  //$  request by a thread which it cannot satisfy.
  //$  The scheduler is put in delegated state and awaits
  //$  for another service to satisfy the request and put
  //$  it back in operation.
  //$
  //$ Note: there is no "operating" state because the
  //$ stop state can only be queried by the schedulers caller
  //$ when the scheduler returns control to it.
  enum fibre_scheduler_state {
    terminated,
    blocked,
    delegated
  };
  fun get_state : fibre_scheduler -> fibre_scheduler_state = "$1->fs";


  //$ Core user procedure for launching a fibre.
  proc spawn_fthread (fs:fibre_scheduler) (p:1->0) { spawn_fibre (fs,p.start.mk_thread); }

  // *********************************************************
  // ASYNC SCHEDULER
  // *********************************************************
  // FIXME: it is leaked .. to be fixed shortly

  // async scheduler type
  type async_scheduler = "::flx::run::async_sched*"
    requires header '#include "flx_async.hpp"',
    package "flx_arun"
  ;

  // async scheduler constructor
  ctor async_scheduler: bool = """
    new
    ::flx::run::async_sched
        (
          PTF world, // world object
          $1, // debug driver flag
          PTF gcp,  // GC profile object
          new(*PTF gcp, ::flx::run::fthread_list_ptr_map, false) ::flx::run::fthread_list(PTF gcp),
          ::flx::run::async_sched::mainline // temporary hack! thread kind (should be inherited)
        )
      """
    ;

  // async scheduler constructor wrapper
  ctor async_scheduler () =>
    async_scheduler (Env::getenv "FLX_DEBUG_DRIVER" != "")
  ;

  // spawn fibre on async scheduler from fthread object
  proc spawn_fibre: async_scheduler * fthread = """
      $1->ss->active->push_back($2);
  """;

  // spawn fibre on async scheduler from procedure
  proc spawn_fthread (fs:async_scheduler) (p:1->0) { spawn_fibre (fs,p.start.mk_thread); }

  proc prun: async_scheduler = "$1->prun();";


  proc async_run (p: 1 -> 0) {
    var s = async_scheduler();
    spawn_fthread s p;
    s.prun;
  }

// *********************************************************
// MISC STUFF THAT MAY NOT BE USED, CONSIDER DELETING IT
// UNRELIABLE ANYHOW .. CHECK PLUGINS ...
// *********************************************************


  //$ Execute a single step of a fibre.
  gen step: cont -> cont = "$1->resume()";

  //$ Schedule death of a fibre.
  proc kill: fthread = "$1->cc = 0;";

  //$ Run a continuation until it terminates.
  //$ Do not use this proc if the underlying
  //$ procedure attempts to read messages.
  //$ This is a low level primitive, bypassing fthreads.
  proc run: cont = "::flx::rtl::executil::run($1);" requires package "flx_executil";

  private proc _send[t]: &cont * t =
  """
  {
    using namespace ::flx::rtl;
    con_t *tmp = *(con_t**)$1.get_data();
    // run target until it reaches a service request (or death)
    while(tmp && (!tmp->p_svc || tmp->p_svc->variant == svc_yield)) {
      try { tmp=tmp->resume(); }
      catch (con_t *x) { tmp = x; }
    }
    // check it is alive and making the expected service request
    if (!tmp)
      throw flx_exec_failure_t (__FILE__,"send","Send to terminated procedure");
    if (!tmp->p_svc)
      throw flx_exec_failure_t (__FILE__,"send","Send to unready Procedure");
    if (tmp->p_svc->variant != svc_read)
      throw flx_exec_failure_t (__FILE__,"send","Send to Procedure which is not trying to read");
    // store the message
    **(?1**)tmp->p_svc->data= $2;
    // clear the service request
    tmp->p_svc = 0;
    // run the target until the next service request (or death)
    while(tmp && (!tmp->p_svc || tmp->p_svc->variant == svc_yield)) {
      try { tmp=tmp->resume(); }
      catch (con_t *x) { tmp = x; }
    }
    // save the new continuation
    *(con_t**)$1.get_data() = tmp;

  }
  """;

  //$ Send a message to a continuation.
  //$ There is no type checking on the message type.
  //$ The procedure is executed until
  //$ the next wait_state, then the message is stored.
  //$ Low level primitive, bypassing fthreads.
  proc send[t] (p:&cont) (x:t)
  {
    _send (p,x);
  }

}
Synchronous Channels
//[schannels.flx]

//$ Sychronous Channels.
//$ Used to exchange control and possibly data
//$ between Felix f-threads (aka fibres).

open class Schannel
{
  //$ The type of a bidirectional synchronous channel.
  _gc_pointer type schannel[t] = "::flx::rtl::schannel_t*";

  //$ The type of an input synchronous channel.
  _gc_pointer type ischannel[t] = "::flx::rtl::schannel_t*";

  //$ The type of an output synchronous channel.
  _gc_pointer type oschannel[t] = "::flx::rtl::schannel_t*";

  gen mk_untyped_schannel: 1 -> address =
    "new(*PTF gcp,::flx::rtl::schannel_ptr_map,false) ::flx::rtl::schannel_t()"
    requires property "needs_gc"
  ;
  //$ Create a bidirectional synchronous channel.
  gen mk_schannel[t]():schannel[t] =>
    C_hack::cast[schannel[t]] #mk_untyped_schannel
  ;

  //$ Model a NULL pointer as an schannel.
  //$ Necessary for killing off schannels,
  //$ so as to make them unreachable, so the gc can reap them.
  //$ Note: null_schannels are safe.
  gen mk_null_schannel[t]: 1->schannel[t] = "NULL";

  //$ Model a NULL pointer as an ischannel.
  //$ Necessary for killing off schannels,
  //$ so as to make them unreachable, so the gc can reap them.
  gen mk_null_ischannel[t]: 1->ischannel[t] = "NULL";

  //$ Model a NULL pointer as an oschannel.
  //$ Necessary for killing off schannels,
  //$ so as to make them unreachable, so the gc can reap them.
  gen mk_null_oschannel[t]: 1->oschannel[t] = "NULL";

  ctor[T] address: oschannel[T] = "$1";
  ctor[T] address: ischannel[T] = "$1";

  //$ Check if an schannel is NULL.
  fun isNULL[T] :schannel[T] -> bool = "NULL==$1";

  //$ Check if an ischannel is NULL.
  fun isNULL[T] :ischannel[T] -> bool = "NULL==$1";

  //$ Check if an oschannel is NULL.
  fun isNULL[T] :oschannel[T] -> bool = "NULL==$1";

  //$ Safe cast from bidirectional to ouput synchronous channel.
  ctor[t] oschannel[t](x:schannel[t]) => C_hack::cast[oschannel[t]] x;

  //$ Safe cast from bidirectional to input synchronous channel.
  ctor[t] ischannel[t](x:schannel[t]) => C_hack::cast[ischannel[t]] x;

  //$ Make an input and an output channel out of a bidirectional channel.
  gen mk_ioschannel_pair[t](var ch:schannel[t]) =>
    ischannel[t] ch, oschannel[t] ch
  ;

  //$ Construct a connected input and output channel pair.
  gen mk_ioschannel_pair[t]() =>
    mk_ioschannel_pair[t]$ mk_schannel[t] ()
  ;

  // pass in address of location to put the pointer to the T data
  proc read[T] (chan:schannel[T], loc: &&T) {
    svc$ svc_sread$ C_hack::cast[_schannel] chan, C_hack::reinterpret[&root::address] (loc);
  }

  // pass in address of location to put the T data
  proc read[T] (chan:schannel[T], p: &T) {
    var loc: &T;
    read (chan, &loc);
    p <- *loc;
  }

  //$ Read an item from a bidirectional channel.
  inline gen read[T] (chan:schannel[T]) = {
    var loc: &T;
    read (chan, &loc);
    return *loc;
  }
  proc read[T] (chan:ischannel[T], loc: &&T) { read (C_hack::cast[schannel[T]] chan, loc); }
  proc read[T] (chan:ischannel[T], p: &T) { read (C_hack::cast[schannel[T]] chan, p); }

  //$ Read an item from an input channel.
  inline gen read[T] (chan:ischannel[T]) => read$ C_hack::cast[schannel[T]] chan;

  //$ Test if channel is read for a read.
  inline gen ready[T] :ischannel[T] -> bool = "$1->top!=nullptr && !(uintptr_t)$1->top &1u)";
  inline gen ready[T] : schannel[T] -> bool = "$1->top!=nullptr && (uintptr_t)$1->top &1u)";

  //$ Return Some value if ready, otherwise None
  inline gen maybe_read[T] (chan:ischannel[T]) =>
    if chan.ready then Some chan.read else None[T]
  ;

  inline gen maybe_read[T] (chan:schannel[T]) =>
    if chan.ready then Some chan.read else None[T]
  ;

  //$ Write an item to a bidirectional channel.
  proc write[T] (chan:schannel[T], v:T) {
    var ps = C_hack::cast[root::address]$ new v;
    svc$ svc_swrite$ C_hack::cast[_schannel] chan, &ps;
  }

  proc write[T] (chan:oschannel[T], v:T) {
    write (C_hack::cast[schannel[T]] chan, v);
  }

  //$ Multi Write an item to a bidirectional channel.
  proc broadcast[T] (chan:schannel[T], v:T) {
    var ps = C_hack::cast[root::address]$ new v;
    svc$ svc_multi_swrite$ C_hack::cast[_schannel] chan, &ps;
  }

  //$ Multi Write an item to an output channel.
  proc broadcast[T] (chan:oschannel[T], v:T) {
    broadcast (C_hack::cast[schannel[T]] chan, v);
  }

  // Very high power though not very efficient conversion
  // from ischannel to iterator.
  // Given i: ischannel[T] you can just write
  // for j in i do .. done
  gen iterator[T] (i:ischannel[T]) () : opt[T] = {
  next:>
    var y = None[T];
    frun { var x = read i; y = Some x; };
    match y do
    | Some _ => yield y; goto next;
    | None => return y;
    done
  }

  // Here is a subroutine call, assuming the
  // fibre is already created
  inline gen subcall[r,w] (chout:%>w, chin:%<r) (arg:w):r =
  {
    write (chout,arg);
    return read chin;
  }

  // Now, we can use the channels AS a function:
  inline fun apply[r,w] (ch:(%>w * %<r), arg:w):r =>
    subcall ch arg
  ;

}
Synchronous multiplexor

The following device acts like a select, that is, the reader get all the input data, but the order is indeterminate.

[Not clear how this is useful .. ]

//[mux.flx]

//$ Schannel multiplexor.
//$ Read multiple input schannels, write to an output schannel.
open class Multiplexor
{
  //$ Schannel copy.
  noinline proc copy[T] (i:ischannel[T],o:oschannel[T]) ()
  {
    while true do
      var x = read i;
      write (o,x);
    done
  }

  //$ Schannel multiplexor based on iterator argument.
  //$ Accepts stream of input schannels.
  //$ Writes to output schannel.
  proc mux[T] (inp:1->opt[ischannel[T]], out:oschannel[T]) ()
  {
    for i in inp do
      spawn_fthread$ copy(i,out);
    done
  }


  //$ Schannel multiplexor based on streamable data structure.
  //$ Creates stream of input schannels.
  //$ Writes to output schannel.
  fun mux[C,T with Streamable[C,ischannel[T]]] (a:C, out:oschannel[T]) =>
    mux (iterator a, out)
  ;
}
Schannel and Pipe syntax

Special syntax for both pipes and also abbreviation for schannel types.

//[schannels.flx]

open class DuplexSchannels
{
_gc_pointer type duplex_schannel[r,w] = "::flx::rtl::schannel_t*";

inline gen read[r,w] (chan:duplex_schannel[r,w]) : r =>
  read (C_hack::cast[ischannel[r]] chan)
;

inline proc write[r,w] (chan:duplex_schannel[r,w], v:w)  =>
  write (C_hack::cast[oschannel[w]] chan, v)
;

ctor[r,w] duplex_schannel[r,w] () =>
  C_hack::cast[duplex_schannel[r,w]] #mk_untyped_schannel
;

// NOTE: assuming the mainline want to read an r
// after passing a w to the subroutine, it must
// use the second channel of the pair to do so.
// passing the first one to the subroutine.
gen mk_duplex_schannel_pair[r,w] () =>
  let c = #mk_untyped_schannel in
  C_hack::cast[duplex_schannel[w,r]] c,
  C_hack::cast[duplex_schannel[r,w]] c
;

// Here is our subroutine call, assuming the
// fibre is already created
inline gen subcall[r,w] (ch:duplex_schannel[r,w]) (arg:w):r =
{
  write (ch,arg);
  return read ch;
}

// Now, we can use the duplex channel AS a function:
inline fun apply[r,w] (ch:duplex_schannel[r,w], arg:w):r =>
  subcall ch arg
;

// Here is a self contained subcall that spawns the fibre
// and creates the channel too. This model is for a one shot.
inline gen subcall[r,w]
  (fib: duplex_schannel[w,r] -> 1 -> 0)
  (arg: w)
: r =
{
  var wr,rw = mk_duplex_schannel_pair[r,w]();
  spawn_fthread$ fib wr;
  write (rw,arg);
  return read rw;
}

inline gen apply[r,w] (
  fib: duplex_schannel[w,r] -> 1 -> 0,
  arg: w)
: r =>
  subcall fib arg
;

} // class DuplexSchannels

Let’s now rewrite our example:

//[subrout-02.flx]
proc int_to_string (ch: %<int%>string)  ()
{
  var x = read ch;
  var r = x.str;
  write(ch, r);
}
var wr, rw = mk_duplex_schannel_pair[string,int]();
spawn_fthread$ int_to_string wr;
println$ rw 42;

42

Even more compactly:

//[subrout-03.flx]
proc int_to_string (ch: %<int%>string)  ()
{
  var x = read ch;
  var r = x.str;
  write(ch, r);
}
println$ int_to_string 42;

42

Package: src/packages/pthreads.fdoc

Preemptive Threading Support

key file
__init__.flx share/lib/std/pthread/__init__.flx
pthread.flx share/lib/std/pthread/pthread.flx
pchannels.flx share/lib/std/pthread/pchannels.flx
ppipe.flx share/lib/std/pthread/ppipe.flx
forkjoin.flx share/lib/std/pthread/forkjoin.flx
mutex.flx share/lib/std/pthread/mutex.flx
semaphore.flx share/lib/std/pthread/semaphore.flx
condition_variable.flx share/lib/std/pthread/condition_variable.flx
ts_bound_queue.flx share/lib/std/pthread/ts_bound_queue.flx
atomic.flx share/lib/std/pthread/atomic.flx
threadpool.flx share/lib/std/pthread/threadpool.flx
threadpoolex1.flx share/demo/threadpoolex1.flx
Pthread Synopsis
//[__init__.flx]

// pthreads (portable)
include "std/pthread/pthread";
//include "std/pthread/pchannels";
include "std/pthread/mutex";
//include "std/pthread/ts_bound_queue";
//include "std/pthread/semaphore";
//include "std/pthread/condition_variable";
//include "std/pthread/ppipe";
//include "std/pthread/forkjoin";
//include "std/pthread/atomic";
//include "std/pthread/threadpool";
Pthreads.

General support for pre-emptive threading, aka shared memory concurrency. The core routines are based on Posix C interface. Emulations are provided for Windows.

The core support routines are written in C++. Adaption to the local platform operating system is done in C++ using configuration data provided by Felix configuration scripts.

Felix pthreads are always detached. It is not possible to directly wait on a pthread, kill a pthread, or join to a pthread. Pchannels or other devices such as mutex locks, semaphores or conditiona variables must be used for synchronisation instead.

//[pthread.flx]

header pthread_hxx = '#include "pthread_thread.hpp"';
header mutex_hxx = '#include "pthread_mutex.hpp"';
header condv_hxx = '#include "pthread_condv.hpp"';
header semaphore_hxx = '#include "pthread_semaphore.hpp"';
header monitor_hxx = '#include "pthread_monitor.hpp"';
header work_fifo_hxx = '#include "pthread_work_fifo.hpp"';

//$ This class provides access to the operating system's native
//$ threading routines. On systems with multiple cpus, this may
//$ increase performance as the operating system may schedule
//$ threads on different processors.
open class Pthread
{
  requires package "flx_pthread";

  //$ spawn a detached pthread.
  proc spawn_pthread(p:1->0)
  {
      var con = start p;              // get continuation of p
      var fthr = mk_thread con;
      svc$ svc_spawn_pthread fthr;
  }
  //$ spawn a detached pthread sharing active list with spawner
  proc spawn_process(p:1->0)
  {
      var con = start p;              // get continuation of p
      var fthr = mk_thread con;
      svc$ svc_spawn_process fthr;
  }
  proc thread_yield : 1 = "PTF gcp->collector->get_thread_control()->yield();";
}
Pchannels.

A <em>pchannel</em> is a <em>monitor</em> object, which is used to synchronise pthreads by use of read and write procedures which transfer a pointer to a heap allocated object. Ownership is transfered from the writer to the reader.

After initial synchronisation the read gains control and takes possession of the data. The reader then signals that the writer may proceed. The control interlock ensures that the reader is able to capture the data from the writer without the writer interfering. This may be necessary if the value needs to be deep copied, for example. The monitor data exchange protocol is designed to permit transfer of data on the writer’s machine stack, or data which the writer may modify after regaining control. However the read/write operations on pchannels automatically copy the data onto the heap and perform the synchronisation.

Pchannels should be used carefully because they block the whole pthread, that is, all fibres. Unlike fibres, if a deadlock occurs it cannot be resolved and should generally be considered a programming error.

//[pchannels.flx]

//$ Pchannels are unbuffered synchronisation points
//$ for pre-emptive threads.
//$
//$ Similarly to schannels, paired reader-writer pthreads
//$ cannot proceed until both parties agree data exchange is complete.
//$ Unlike schannels, both reader and writer can subsequently
//$ continue concurrently after the exchange.
open class Pchannel
{
  requires package "flx_pthread";

  //$ Pre-emptive thread channels (monitor).
  type pchannel[t] = "flx::pthread::monitor_t*" requires monitor_hxx;
  //$ Pre-emptive thread input channel.
  type ipchannel[t] = "flx::pthread::monitor_t*" requires monitor_hxx;
  //$ Pre-emptive thread output channel.
  type opchannel[t] = "flx::pthread::monitor_t*" requires monitor_hxx;

  //$ Make bidirectional pchannel.
  fun mk_pchannel[t]: 1->pchannel[t] = "new flx::pthread::monitor_t(PTF gcp->collector->get_thread_control())";

  //$ Safe cast from bidirectional to output pchannel.
  ctor[t] opchannel[t](x:pchannel[t]) => C_hack::cast[opchannel[t]] x;
  //$ Safe cast from bidirectional to input pchannel.
  ctor[t] ipchannel[t](x:pchannel[t]) => C_hack::cast[ipchannel[t]] x;

  //$ Make an input and an output pchannel out of a bidirectional channel.
  fun mk_iopchannel_pair[t](var ch:pchannel[t]) =>
    ipchannel[t] ch, opchannel[t] ch
  ;

  //$ Construct a connected input and output pchannel pair.
  fun mk_iopchannel_pair[t]() =>
    mk_iopchannel_pair[t]$ mk_pchannel[t] ()
  ;


  // NOTE: read/write on pchannels uses suspend/resume
  // to tell any pending collector it is safe to proceed
  // whilst it is doing the I/O (which may block),
  // to block returning from the I/O during a collection
  // AND, if the I/O completed before the collection got
  // going, to yield at this point.

  //$ Read from a pchannel.
  proc _read[t]: pchannel[t] * &&t = """
    {
    //fprintf(stderr,"READ:DQ\\n");
    *$2 = (?1*)($1->dequeue());
    PTF gcp->collector->remove_root(*$2);
    //fprintf(stderr,"DONE READ:DQ\\n");
    }
  """ requires property "needs_ptf";

  //$ Write to a pchannel.
  noinline gen read[t] (chan:pchannel[t]) = {
    var p : &t;
    _read (chan,  &p);
    return *p;
  }
  gen read[t] (chan:ipchannel[t]) => read$ C_hack::cast[pchannel[t]] chan;

  proc _write[t]: pchannel[t] * &t = """
    {
    //fprintf(stderr,"WRITE:NQ\\n");
    PTF gcp->collector->add_root($2);
    $1->enqueue((void*)$2);
    //fprintf(stderr,"DONE WRITE:NQ\\n");
    }
  """ requires property "needs_ptf";

  noinline proc write[t](chan:pchannel[t], v:t) {
    var ps = new v;
    _write (chan,ps);
  }
  proc write[t] (chan:opchannel[t], v:t) { write$ C_hack::cast[pchannel[t]] chan,v; }
}
Ppipes.
//[ppipe.flx]

//$ Asynchronous Synchronous Pipe.
//$ Used to link pthreads.
open class Ppipe {

  //$ Send an stream down a channel.
  proc psource[T] (var it:1 -> T) (out:opchannel[T])
  {
    while true do write (out,#it); done
  }

  //$ isrc converts a streamable data structure
  //$ such as an array into a source.
  proc pisrc[V,T with Streamable[T,V]] (dat:T) (out:opchannel[opt[V]])
  {
    psource[opt[V]] (dat.iterator) out;
  }


  //$ Wire a source component to a sink.
  //$ Return coupled fibre ready to run.
  fun pipe[T]
    (w: opchannel[T] -> 0,
    r: ipchannel[T] -> 0)
  :
    1 -> 0
  =>
    {
      var chi,cho = mk_iopchannel_pair[T] ();
      spawn_pthread { (w cho); };
      spawn_pthread { (r chi); };
    }
  ;

  //$ Wire a source component to a transducer.
  //$ Return source.
  fun pipe[T,U]
    (w: opchannel[T] -> 0,
    t: ipchannel[T] * opchannel[U] -> 0)
  :
    opchannel[U] -> 0
  =>
    proc (out:opchannel[U])
    {
      var chi,cho = mk_iopchannel_pair[T] ();
      spawn_pthread { (w cho); };
      spawn_pthread { (t (chi, out)); };
    }
  ;

  //$ xpipe connects a streamable data structure
  //$ such as an array directly into a transducer.
  fun xpipe[V,T,U with Streamable[T,V]]
    (
      a:T,
      t: ipchannel[opt[V]] * opchannel[U] -> 0
    )
    : opchannel[U] -> 0 =>
    pipe (a.pisrc[V],t)
  ;


  //$ Wire a transducer into a transducer.
  //$ Return another transducer.
  fun pipe[T,U,V]
    (a: ipchannel[T] * opchannel[U] -> 0,
    b: ipchannel[U] * opchannel[V] -> 0)
  :
    ipchannel[T] * opchannel[V] -> 0
  =>
    proc (inp:ipchannel[T], out:opchannel[V])
    {
      var chi,cho = mk_iopchannel_pair[U] ();
      spawn_pthread { a (inp, cho); };
      spawn_pthread { b (chi, out); };
    }
  ;

  //$ Wire a transducer into a sink.
  //$ Return a sink.
  fun pipe[T,U]
    (a: ipchannel[T] * opchannel[U] -> 0,
    b: ipchannel[U] -> 0)
  :
    ipchannel[T]  -> 0
  =>
    proc (inp:ipchannel[T])
    {
      var chi,cho = mk_iopchannel_pair[U] ();
      spawn_pthread { a (inp, cho); };
      spawn_pthread { b (chi); };
    }
  ;


  //$ Stream sort using intermediate darray.
  //$ Requires stream of option type.
  proc sort[T with Tord[T]] (r: ipchannel[opt[T]], w: opchannel[opt[T]])
  {
     var x = darray[T]();
     acquire:while true do
       match read r with
       | Some v => x+=v;
       | #None => break acquire;
       endmatch;
     done
     x.sort;
     for v in x do
       write (w, Some v);
     done
     write (w,None[T]);
  }
}
Fork/Join.
//[forkjoin.flx]
include "std/pthread/pchannels";

//$ Implement fork/join protocol.
open class ForkJoin
{
  //$ Launch a set of pthreads and wait
  //$ until all of them are finished.
  proc concurrently_by_iterator (var it:1 -> opt[1->0])
  {
     // Make a channel to signal termination.
     var iterm,oterm = mk_iopchannel_pair[int](); // should be unit but that bugs out at the moment
     noinline proc manager (var p: 1->0) () { p(); write (oterm, 1); }
     // Count the number of pthreads.
     var count = 0;
   again:>
     match #it with
     | Some p =>
       ++count;
       spawn_pthread$ manager p;
      goto again;

     | #None =>
       while count > 0 do
         C_hack::ignore (read iterm);
         --count;
       done
     endmatch;
  }

  proc concurrently[T with Streamable[T,1->0]] (d:T) => concurrently_by_iterator d.iterator;

}
Mutual Exclusion Lock (Mutex)

Mutex may be used to protect some region of memomry associated with that mutex conceptually, by locking the mutex for a short period of time. The region may then be modified atomically.

A Felix mutex is created on the heap and must be destroyed after use manually, they’re not garbage collected.

//[mutex.flx]

open class Mutex
{
  requires package "flx_pthread";
  // this needs to be fixed to work with gc but at the
  // moment the uglier solution will suffice
  type mutex = "::flx::pthread::flx_mutex_t*" requires mutex_hxx;
  ctor mutex: unit = "new ::flx::pthread::flx_mutex_t";
  proc lock: mutex = "$1->lock();";
  proc unlock: mutex = "$1->unlock();";
  proc destroy: mutex = "delete $1;";
}
Semaphores.

A semaphore is a counted lock. The sem_post procedure increments the counter, and the sem_wait procedure decrements it. However, the counter may not become negative so instead, if it were to become negative, the sem_wait procedure blocks the current pthread, and the pthread joins a set of pthreads waiting on the semaphore. When the counter is finally incremented by a call from some pthread to sem_post one of the pthreads waiting with sem_wait is allowed to proceed, again decrementing the counter to zero so the remaining pthreads waiting continue to do so.

The procedure sem_trywait instead returns a flag indicating whether it succeeded in decrementing the counter or not.

The term <em>post</em> is derived from the idea of posting a flag.

The counting feature of a semaphore is analogous to shoppers in a store. The sem_post function puts products on the shelf, whilst the the sem_wait function represents an order on which the customer is waiting due to unavailable stock .. and sem_trywait is the customer that, seeing there is no available stock, decides to go elsewhere!

//[semaphore.flx]

open class Semaphore
{
  // FIXME: does not comply with GC friendly blocking protocol!

  requires package "pthread";
  type semaphore = "::flx::pthread::flx_semaphore_t*" requires semaphore_hxx;
  ctor semaphore = "new ::flx_pthread::flx_semaphore_t";
  ctor semaphore * int = "new ::flx_pthread::flx_semaphore_t($1)";
  proc destroy : semaphore = "delete $1;";
  proc post: semaphore = "$1->post();";
  proc wait: semaphore = "$1->wait();";
  gen trywait: semaphore -> int = "$1->trywait()";
  int get: semaphore = "$1->get();";
}
Condition Variables.
//[condition_variable.flx]

//$ Condition Variable for pthread synchronisation.
open class Condition_Variable
{
  requires package "flx_pthread";

  //$ The type of a condition variable.
  type condition_variable = "::flx::pthread::flx_condv_t*" requires condv_hxx;

  //$ Condition variable constructor taking unit argument.
  ctor condition_variable: 1 = "new ::flx::pthread::flx_condv_t(PTF gcp->collector->get_thread_control())";

  //$ Function to release a condition variable.
  proc destroy: condition_variable = "delete $1;";

  //$ lock/unlock associated mutex
  proc lock : condition_variable = "$1->lock();";
  proc unlock : condition_variable = "$1->unlock();";

  //$ Function to wait until a signal is raised on
  //$ the condition variable by another thread.
  proc wait: condition_variable = "$1->wait();";

  //$ Function to raise a signal on a condition
  //$ variable which will allow at most one thread
  //$ waiting on it to proceed.
  proc signal: condition_variable = "$1->signal();";

  //$ Function to broadcast a signal releasing all
  //$ threads waiting on a conditiona variable.
  proc broadcast: condition_variable = "$1->broadcast();";

  //$ Timed wait for signal on condition variable.
  //$ Time in seconds. Resolution nanoseconds.
  gen timedwait: condition_variable * double -> int = "$1->timedwait($3)";
}
Thread Safe Bound Queue.
//[ts_bound_queue.flx]

open class TS_Bound_Queue
{
  private uncopyable type bQ_ = "::flx::pthread::bound_queue_t";
  _gc_pointer _gc_type bQ_ type ts_bound_queue_t[T] = "::flx::pthread::bound_queue_t*"
    requires
     package "flx_bound_queue",
     scanner "::flx::pthread::bound_queue_scanner"
  ;
  ctor[T] ts_bound_queue_t[T]: !ints =
    """
      new (*PTF gcp, @0, false) ::flx::pthread::bound_queue_t(
      PTF gcp->collector->get_thread_control(), (size_t)$1)
    """ requires property "needs_ptf";

  // NOTE: enqueue/dequeue on queues uses suspend/resume
  // to tell any pending collector it is safe to proceed
  // whilst it is doing the operations (which may block),
  // to block returning from the I/O during a collection
  // AND, if the I/O completed before the collection got
  // going, to yield at this point.


  private proc _enqueue[T]: ts_bound_queue_t[T] * &T = """
    FLX_SAVE_REGS;
//fprintf(stderr,"enqueue to ts_bound_queue q=%p starts, item=%p\\n", $1, $2);
    //PTF gcp->collector->get_thread_control()->suspend();
    $1->enqueue((void*)$2);
//fprintf(stderr,"enqueue to ts_bound_queue q=%p done, item=%p\\n", $1, $2);
    //PTF gcp->collector->get_thread_control()->resume();
  """;


  // Duh .. what happens if $2 storage location is set by
  // the dequeue in the middle of a collection?
  // it might be NULL when scanned, but by the time the queue
  // is scanned the value will be lost from the queue and
  // in the variable instead!
  // The RACE is on!
  private proc _dequeue[T]: ts_bound_queue_t[T] * &&T = """
    FLX_SAVE_REGS;
//fprintf(stderr,"dequeue from ts_bound_queue %p starts\\n", $1);
    //PTF gcp->collector->get_thread_control()->suspend();
    *$2=(?1*)$1->dequeue();
//fprintf(stderr,"dequeue from ts_bound_queue done q=%p item=%p\\n",$1,*$2);
    //PTF gcp->collector->get_thread_control()->resume();
  """;

  proc enqueue[T] (Q:ts_bound_queue_t[T])  (elt:T) {
     _enqueue(Q, new elt);
  }

  gen dequeue[T] (Q:ts_bound_queue_t[T]): T = {
    var x:&T;
    _dequeue (Q,&x);
    return *x;
  }


  proc wait[T]: ts_bound_queue_t[T] = """
    FLX_SAVE_REGS;
    //PTF gcp->collector->get_thread_control()->suspend();
    $1->wait_until_empty();
    //PTF gcp->collector->get_thread_control()->resume();
  """;

  proc resize[T]: ts_bound_queue_t[T] * !ints = "$1->resize((size_t)$2);";

}
Atomic operations
//[atomic.flx]
open class Atomic
{
  // note: only works for some types: constraints need to be added.
  // We have to use a pointer because atomics aren't copyable

  type atomic[T]="::std::atomic<?1>*" requires Cxx11_headers::atomic;

  // FIXME: not managed by GC yet!
  // constructor
  ctor[T] atomic[T]: T = "(new ::std::atomic<?1>($1))";

  proc delete[T] : atomic[T] = "delete $1;";

  // note: only works for even less types! Constraints needed.
  proc pre_incr[T] : &atomic[T] = "++**$1;";
  proc pre_decr[T] : &atomic[T] = "--**$1;";
  gen load[T] : atomic[T] -> T = "$1->load()";
  proc store[T] : atomic[T] * T = "$1->store($2);";
  proc store[T] (a:atomic[T]) (v:T) { store (a,v); }

  instance[T] Str[atomic[T]] {
    fun str (var x:atomic[T]) => x.load.str;
  }
  inherit[T] Str[atomic[T]];
}
Thread Pool

A thread pool is a global object containing set of running threads and a queue. Instead of spawning a new thread, the client just queues the job instead. Each thread grabs a job from the queue and runs it, on completion it grabs another job.

The primary advantage of a global thread pool is it prevent oversaturation of the set of processors and thus excess context switching. The main downside is monitoring the completed state of jobs.

Do not use the threadpool for quick jobs, there is a significant overhead posting a job.

//[threadpool.flx]

include "std/pthread/ts_bound_queue";
include "std/pthread/atomic";
include "std/io/faio";
include "std/pthread/condition_variable";
include "std/pthread/pchannels";

class ThreadPool
{
  typedef job_t = 1 -> 0;
  private const ThreadStop : job_t = "NULL";
  private fun isStop : job_t -> bool = "$1==NULL";
  private var clock = #Faio::mk_alarm_clock;
  private var jobqueue = ts_bound_queue_t[job_t] 1024; // queue up to 1K jobs
  private var nthreads = 8; // great default for quad core i7 ?

  // number of threads actually running
  private var running = atomic 0;

  // number of threads blocked waiting on a barrier
  private var waiting = atomic 0;

  // barrier lock
  private var block = #condition_variable;

  fun get_nthreads () => nthreads;

  // This is a flag used to protect against nested pfor loops.
  // If there is a nested pfor loop, it will just execute serially
  // in the calling thread.
  private var pforrunning = atomic 0;

  proc barrier() {
//println$ "Barrier";
    block.lock;
    ++waiting;
    if waiting.load == nthreads do
      waiting.store 0;
      block.broadcast;
    else
    again:>
      block.wait;
      if waiting.load != 0 goto again;
    done
    block.unlock;
  }

  proc start () {
//println$ "Thread pool start()";
     for i in 1..nthreads call spawn_pthread jobhandler;
//println$ "Threads spawned";
  }

  proc start (n:int) {
     nthreads = n;
     #start;
  }

  private proc jobhandler () {
//println$ "Job handler thread #"+running.str+" started";
     var id = running;
     ++running;
     rpt:while true do
//println$ "Trying to dequeue a job id=" + id.str;
       var job = dequeue jobqueue;
//println$ "Job dequeued id="+id.str;
       if isStop job break rpt;
       job;
       thread_yield();
     done
     --running;
  }

  proc queue_job (job:job_t) {
//println$ "Queuing job";
    if running.load == 0 call start ();
    if nthreads > 0 do
      call enqueue jobqueue job;
    else
      call job;
    done
  }

  proc stop () {
    for i in 1..nthreads
      call enqueue jobqueue ThreadStop;
    while running.load != 0
      call Faio::sleep(clock,0.001);
  }

  proc post_barrier() {
    if nthreads > 0
      for i in 1..nthreads call queue_job barrier;
  }

  proc notify (chan:opchannel[int]) () {
    write (chan,1);
  }

  proc join () {
    if nthreads > 0 do
      post_barrier;
      var ip,op = #mk_iopchannel_pair[int];
      queue_job$ notify op;
      var x = read ip;
      C_hack::ignore(x);
    done
  }

  proc pfor_segment (first:int, last:int) (lbody: int * int -> 1 -> 0)
  {
//println$ "Pfor segment " + first.str + "," last.str;
    var N = last - first + 1;
    var nt = nthreads + 1;
    if pforrunning.load == 0 and N >= nthreads and nthreads > 0 do
      pforrunning.store 1;
      for var counter in 0 upto nt - 2 do
        var sfirst = first + (N * counter) / nt;
        var slast = first + (N * (counter + 1)) / nt - 1;
//println$ "QUEUE JOB: Counter = " + counter.str + ", sfirst=" + sfirst.str + ", slast=" + slast.str;
        ThreadPool::queue_job$ lbody (sfirst, slast);
      done
      sfirst = first + (N * (nt - 1)) / nt;
      slast = last;
//println$ "UNQUEUED JOB: Counter = " + counter.str + ", sfirst=" + sfirst.str + ", slast=" + slast.str;
      lbody (sfirst, slast) ();
      join;
      pforrunning.store 0;
    else
      // Run serially
      lbody (first, last) ();
    done
  }

  noinline proc forloop (lbody: int -> 0) (first:int, last:int) ()
  {
//println$ "forloop " + first.str + "," + last.str;
    for var i in first upto last call lbody i;
  }
  noinline proc pforloop (first: int) (last:int) (lbody: int -> 0)
  {
//println$ "Pfor segment " + first.str + "," last.str;
    pfor_segment (first, last)  (forloop lbody);
  }
  inline proc tpfor (first:int, last:int, lbody: int-> 0)
  {
     pforloop first last lbody;
  }

}
Thread Pool Demo
//[threadpoolex1.flx]
include "std/pthread/threadpool";
open ThreadPool;

// Matrix multiply
macro val N = 1000;
typedef N = 1000;

typedef vec_t = array[double, N];
typedef mx_t = array[vec_t,N];
var a : mx_t;
var b : mx_t;
var r : mx_t;
var s : mx_t;

proc clear (mx:&mx_t) {
  for i in 0..<N
  for j in 0..<N
    perform mx . i . j <- 0.0;
}

proc rinit (mx:&mx_t) {
  for i in 0..<N
  for j in 0..<N
    perform mx . i . j <- #rand.double / RAND_MAX.double;
}

fun check() = {
//println$ "Verification check";
  for i in 0..<N
  for j in 0..<N
    if r.i.j != s.i.j return false;
  return true;
}

proc verify() {
//println$ "Running verify";
  if #check do
    println$ "Verified";
  else
    println "Wrong!";
  done
//println$ "Verify ran";
}

clear &r;
clear &s;
rinit &a;
rinit &b;

fun inner_product (pr: &vec_t, pc: &vec_t) =
{
  var sum = 0.0;
  for (var k=0; k<N; ++k;)
    perform sum = sum + *(pr.k) * *(pc.k);
  return sum;
}

// naive multiply
var start = #time;
begin
  for i in 0..<N
  for (var j=0; j<N; ++j;)
    perform &r . i . j <- inner_product (&a.i, &b.j);
  s = r;
end
var fin = #time;
println$ "Naive mul elapsed " + (fin - start).str + " seconds";

//println$ "Starting thread pool";
ThreadPool::start 8;
//println$ "Thread pool started";

// naive parallel multiply
noinline proc inner_products_proc (var i:int)
{
  for (var j=0; j<N; ++j;)
    perform &r . i . j <- inner_product (&a.i, &b.j);
}

noinline proc inner_products_job (var i:int) () {
  for (var j=0; j<N; ++j;)
    perform &r . i . j <- inner_product (&a.i, &b.j);
}

clear &r;
start = #time;
begin
  for i in 0..<N
    call ThreadPool::queue_job$ inner_products_job (i);
  ThreadPool::join;
end
fin = #time;
println$ "Naive Parallel mul elapsed " + (fin - start).str + " seconds";
verify;

// smart parallel multiply
clear &r;
start = #time;
begin
println$ "Using thread pool's pforloop";
  ThreadPool::pforloop 0 (N - 1) inner_products_proc;
end
fin = #time;
println$ "Smart Parallel mul elapsed " + (fin - start).str + " seconds";
verify;

// smart parallel multiply with syntax
clear &r;
start = #time;
begin
  pfor i in 0 upto (N - 1) do
  for (var j=0; j<N; ++j;)
    perform &r . i . j <- inner_product (&a.i, &b.j);
  done
end
fin = #time;
println$ "pfor mul elapsed " + (fin - start).str + " seconds";
verify;


ThreadPool::stop;

Package: src/packages/streams.fdoc

key file
iterator.flx share/lib/std/control/iterator.flx
stream.flx share/lib/std/datatype/stream.flx

Streamable data types and iterators

Iterators
//[iterator.flx]
//$ Class of data structures supporting streaming.
//$ The container type just needs an iterator method.
//$ The iterator method returns a generator which
//$ yields the values stored in the container.
class Iterable [C1, V] {
  virtual fun iterator : C1 -> 1 -> opt[V];
}

class Streamable[C1, V] {
  inherit Iterable[C1,V];

  // check if a streamable x is a subset of a set y.
  virtual fun \subseteq[C2 with Set[C2,V]] (x:C1, y:C2) =
  {
    for v in x do
      if not (v \in y) goto bad;
    done
    return true;
bad:>
    return false;
  }

  // subset or equal: variant equality bar
  fun \subseteqq [C2 with Set[C2,V], Streamable[C2,V]]
    (x:C1, y:C2) => x \subseteq y
  ;

  // congruence (equality as sets)
  virtual fun \cong[C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => x \subseteq y and y \subseteq x
  ;

  // negated congruence
  fun \ncong[C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => not (x \cong y)
  ;

  // proper subset
  virtual fun \subset [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => x \subseteq y and x \ncong y
  ;

  // variant proper relations with strke-through on equality bar
  fun \subsetneq [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => x \subset y
  ;
  fun \subsetneqq [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => x \subset y
  ;

  // reversed relations, super set
  fun \supset [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => y \subset x
  ;

  fun \supseteq [C2 with Set[C2,V], Streamable[C2,V]]
    (x:C1, y:C2) => y \subseteq x
  ;

  fun \supseteqq [C2 with Set[C2,V], Streamable[C2,V]]
    (x:C1, y:C2) => y \subseteq x
  ;
  // variant proper relations with strke-through on equality bar
  fun \supsetneq [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => x \supset y
  ;
  fun \supsetneqq [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => x \supset y
  ;


  // negated operators, strike-through
  fun \nsubseteq [C2 with Set[C2,V], Streamable[C2,V]]
    (x:C1, y:C2) => not (x \subseteq y)
  ;

  fun \nsubseteqq [C2 with Set[C2,V], Streamable[C2,V]]
    (x:C1, y:C2) => not (x \subseteq y)
  ;

  // negated reversed operators, strike-through
  fun \nsupseteq [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => not (x \supseteq y)
  ;

  fun \nsupseteqq [C2 with Set[C2,V], Streamable[C2,V], Set[C1,V]]
    (x:C1, y:C2) => not (x \supseteq y)
  ;

}
Streams

A functional stream is a coinductive data type dual to a list: it is a function

uncons: S -> T * S.

First here is the class based definition of a stream. It has some problems as do all such definitions:

//[stream.flx]
class Fstream[T,S] {
  virtual fun uncons: S -> T * S;
};

And now, we have a stream example. It is suprising? An integer is a stream.

//[stream.flx]
instance Fstream [int,int] {
  fun uncons(x:int) => x, x + 1;
}

An obvious problem: the stream is ascending. A descending stream is obvious: fun uncons(x:int) => x, x - 1 and clearly there are rather a LOT of streams that can be defined on an integer.

A stream is the dual of a list, some say it is an infinite list. Here is a stream of optional ints built from a list of ints.

//[stream.flx]
instance Fstream [opt[int], list[int]] {
  fun uncons: list[int] -> opt[int] * list[int] =
  | Cons (h,t) => Some h, t
  | #Empty => None[int], Empty[int]
  ;
}

The option type is a good way to provide a trailing infinite sequence of values mandated by the definition of a stream.

This function converts an arbitrary stream into a generator. This hides the state type and state value from clients, however the forward iterator we previously had is now degraded to an input iterator (where I use iterator in the C++ sense)

//[stream.flx]
class Stream
{
fun make_generator [T,S with Fstream[T,S]]
  (var state:S)
=>
  gen () : T = {
    var v,s = uncons state;
    state = s;
    return v;
  }
;

Felix already has an interesting construction called an iterator, it is a generator function of type

1 -> opt[T]

We build such iterator out of a stream of optional values

//[stream.flx]
fun make_iterator [T,S with Fstream[opt[T],S]]
  (var state:S)
=>
  make_generator[opt[T],S] state
;

Our definition is bad, because so far there is only ONE kind of fstream for every type.

What we really want is that, given some uncons function, we can make a fstream object out of it.

here’s our stream object: it has an uncons function and an initial state value. The uncons function is called uncons_f to avoid ambiguities

//[stream.flx]
typedef stream[T,S] = ( state:S, uncons_f: S -> T * S );

Now, instantiate it. The critical thing we’re doing is translating the internal uncons_f function, to one that returns a stream object

//[stream.flx]
instance[T,S] Fstream[T, stream[T,S]] {
  fun uncons (x:stream[T,S]) : T * stream[T,S] =>
    let head,tail = x.uncons_f x.state in
    head, (state=tail, uncons_f = x.uncons_f)
  ;
}
inherit [T,S] Fstream[T,stream[T,S]];
}
open Stream;

Environment Management

Contents:

Package: src/packages/codecs.fdoc

Codecs

key file
__init__.flx share/lib/std/codec/__init__.flx
base64.flx share/lib/std/codec/base64.flx
csv.flx share/lib/std/codec/csv.flx
uri_codec.flx share/lib/std/codec/uri_codec.flx
Synopsis
//[__init__.flx]

include "std/codec/csv";
include "std/codec/base64";
include "std/codec/uri_codec";
Base64
//[base64.flx]

//$ Base64 encode/decode functions.
//$ http://en.wikipedia.org/wiki/Base64

class Base64 {
  val b64_chars = ('A','B','C','D','E','F','G','H','I','J','K','L','M',
                   'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
                   'a','b','c','d','e','f','g','h','i','j','k','l','m',
                   'n','o','p','q','r','s','t','u','v','w','x','y','z',
                   '0','1','2','3','4','5','6','7','8','9','+','/');

  val b64_string = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

  gen make_string: size*char->string = "::std::string ($1, $2)";

  instance Bits[char] {
    fun \& : char * char -> char = "$1&$2";
    fun \| : char * char -> char = "$1|$2";
  }

  open Bits[char];
  private fun >> : char * int -> char = "$1>>$2";
  private fun << : char * int -> char = "$1<<$2";
  private fun utiny_of: char -> utiny = "(unsigned char)$1:cast" is cast;

  // Encode function derived from encode function
  // http://www.source-code.biz/base64coder/java/Base64Coder.java.txt
  // by Christian d'Heureuse, Inventec Informatik AG, Zurich, Switzerland
  //$ Returns base 64 encoding of supplied string inp.
  fun encode (inp:string) => encode(inp,0,inp.len.int);

  fun encode (inp:string, iOff:int, iLen:int) : string = {
    val oDataLen = (iLen*4+2)/3;       // output length without padding
    val oLen = ((iLen+2)/3)*4;         // output length including padding
    // if using darray would use this
    //var out = darray[char]( size oLen,char(0));
    var out:string = "";//make_string(size oLen,char(0));
    var ip = iOff;
    var iEnd = iOff + iLen;
    var op = 0;
    while (ip < iEnd) do
      val i0 = inp.[ip] \& char(0xff);ip++;
      val i1 = if ip < iEnd then inp.[ip] \& char(0xff) else char(0) endif;if ip < iEnd do ip++; done
      val i2 = if ip < iEnd then inp.[ip] \& char(0xff) else char(0) endif;if ip < iEnd do ip++; done
      val o0 = i0 >> 2;
      val o1 = ((i0 \&   char(3)) << 4) \| (i1 >> 4);
      val o2 = ((i1 \& char(0xf)) << 2) \| (i2 >> 6);
      val o3 = i2 \& char(0x3F);
      out  += char (b64_chars.(utiny_of(o0)));op++;
      out  += char (b64_chars.(utiny_of(o1)));op++;
      out  += if op < oDataLen then char (b64_chars.(utiny_of(o2))) else char('=') endif;
      // if usaing darray then would use this
      //out.[op] = char (b64_chars.[utiny_of(o0)]);op++;
      //out.[op] = char (b64_chars.[utiny_of(o1)]);op++;
      //out.[op] = if op < oDataLen then char (b64_chars.[utiny_of(o2)]) else char('=') endif;
      op++;
        out += if op < oDataLen then  char(b64_chars.(utiny_of(o3))) else char('=') endif;
        //if using darray would do this
        //out.[op] = if op < oDataLen then  char(b64_chars.[utiny_of(o3)]) else char('=') endif;
      op++;
   done
   return out;
  }


  //$ Wraps encoded string after ll chars, no newline on last line.
  fun wrap (b64_str:string,ll:uint) : string = {
    var ret = "";
    val n = b64_str.len.uint;
    val whole = n/ll;
    val rmd = n%ll;
    reserve (&ret, n+whole+1u);
    for var i in 0ui upto whole - 2u do
      ret += b64_str.[i*ll to (i + 1u)*ll]+"\n";
    done
    ret += b64_str.[(whole - 1u)*ll to (whole)*ll];
    if rmd > 0u do
      ret+= "\n" + b64_str.[whole*ll to whole*ll+rmd];
    done
    return ret;
  }

  //$ Decodes supplied base 64 encoded string.
  fun decode(enc_str:string) = {
    var in_len:uint = enc_str.len.uint;
    var i:int = 0;
    var j:int = 0;
    var in_ = 0;
    var char_array_4:char^4;
    var char_array_3:char^3;
    var ret:string;

    while in_len > 0ui and ( enc_str.[in_] != char('=')) do
      //(and is_base64(enc_str[in_]))
      in_len--;
      &char_array_4.i <- enc_str.[in_]; i++; in_++;
      if (i == 4) do
        for var ip in  0 upto 3 do
          set(&char_array_4,ip, ( match find(b64_string,char_array_4.(ip)) with
            |Some v => char(v)
            |_ => char(0)
          endmatch));
        done
        set(&char_array_3,0,(char_array_4.(0) << 2) \| ((char_array_4.(1) \& char(0x30)) >> 4));
        set(&char_array_3,1,((char_array_4.(1) \& char(0xf)) << 4) \| ((char_array_4.(2) \& char(0x3c)) >> 2));
        set(&char_array_3,2,((char_array_4.(2) \& char(0x3)) << 6) \| char_array_4.(3));
        for var l in  0 upto 2 do
          ret = ret + char_array_3.(l);
        done
        i = 0;
      done
    done
  if (i > 0 ) do
    set(&char_array_4,i, char_array_3.(1));
    for var m in i upto 3 do
      set(&char_array_4,i, char(0));
    done
    for var k in 0 upto 3 do
      set(&char_array_4,k,( match find(b64_string,char_array_4.(k)) with
            |Some v => char(v)
            |_ => char(0)
          endmatch));
    done
    set(&char_array_3,0, (char_array_4.(0) << 2) \| ((char_array_4.(1) \& char(0x30)) >> 4));
    set(&char_array_3,1, ((char_array_4.(1) \& char(0xf)) << 4) \| ((char_array_4.(2) \& char(0x3c)) >> 2));
    set(&char_array_3,2, ((char_array_4.(2) \& char(0x3)) << 6) \| char_array_4.(3));

    for var n in  0 upto  (i - 2) do
       ret += char_array_3.(n);
    done
  done
  return ret;
  }

}
Csv
//[csv.flx]

//$ Comma Separated Values (CSV) reader
//$ Splits a string like 1,2,"hell" up into three strings.
class Csv {
  open List;

  //$ Fetch a value string res from position i of string s.
  //$ Update i past the comma ready to fetch another value.
  proc get_csv_value(s:string, i:&int,res:&string) {
    var r = "";
    proc add(j:int) { r += s.[j]; }
    n := s.len.int;
    enum state_t = skip,collect,quote;
    fun eq(a:state_t, b:state_t)=> caseno a == caseno b;

    var state = skip;
    ech:for var j in *i upto n - 1 do
      ch := s.[j];
      if ch == char "," do
        match state with
        | #quote => add j;
        | _ => break ech;
        endmatch;
      elif ch == char " " do
        match state with
        | #skip => continue ech;
        | #quote => add j;
        | #collect => state = skip;
        endmatch;
      elif ch == char '"' do
        match state with
        | #quote => state = skip;
        | _ => state = quote;
        endmatch;
      else
        add j;
      done;
    done;
    i <- j+1;
    res <- r;
  }

  //$ Fetch all the values in a CSV string
  //$ and return them as list.
  fun get_csv_values(s:string): list[string] = {
    var v: list[string] = Empty[string];
    var res = "";
    var pos = 0;
    n := s.len.int;
    while pos < n do
      get_csv_value (s, &pos, &res);
      if res.len.int >0 do v += res; done;
    done;
    return v;
  }
}
URI Codec
//[uri_codec.flx]

publish """
Encoder Decoders for URIs, Translates characters not allowed in URIs
to %HEX equivalants

Usage example:
open URICodec;
var s = "THis is a & test < or a url \n encoder \r\r Hello >";
var enc = uri_encode(s);
var dec = uri_decode(enc);
println("S:"+s);
println("ENC:"+enc);
println("DECX:"+dec);
"""

class URICodec {

  header """
  /* Code from http://www.zedwood.com/article/111/cpp-urlencode-function */
  std::string char2hex( char dec )
  {
    char dig1 = (dec&0xF0)>>4;
    char dig2 = (dec&0x0F);
    if ( 0<= dig1 && dig1<= 9) dig1+=48;    //0,48inascii
    if (10<= dig1 && dig1<=15) dig1+=97-10; //a,97inascii
    if ( 0<= dig2 && dig2<= 9) dig2+=48;
    if (10<= dig2 && dig2<=15) dig2+=97-10;

    std::string r;
    r.append( &dig1, 1);
    r.append( &dig2, 1);
    return r;
  }

  std::string urlencode(const std::string &c)
  {
    std::string escaped="";
    int max = c.length();
    for(int i=0; i<max; i++)
    {
      if ( (48 <= c[i] && c[i] <= 57) ||//0-9
           (65 <= c[i] && c[i] <= 90) ||//abc...xyz
           (97 <= c[i] && c[i] <= 122) || //ABC...XYZ
           (c[i]=='~' || c[i]=='!' || c[i]=='*' || c[i]=='(' || c[i]==')' || c[i]=='\\''))
        {
          escaped.append( &c[i], 1);
        }
        else
        {
          escaped.append("%");
          escaped.append( char2hex(c[i]) );//converts char 255 to string "ff"
        }
    }
    return escaped;
  }

""" requires Cxx_headers::iostream;

  gen uri_encode: string -> string = "urlencode($1)";

  private fun isxdigit_c: char -> int = "isxdigit((int)$1)" requires C89_headers::ctype_h;

  private fun isxdigit (c:char):bool => if isxdigit_c(c) == 0 then false else true endif;

  private gen strtoul: string->ulong = "strtoul ((const char *)$1.c_str(),NULL,0)";

  fun uri_decode(encoded:string):string = {
    enum decode_state { SEARCH, CONVERT };
    var state = SEARCH;
    var decoded = "";
    for var i in 0 upto (int(len(encoded)) - 1) do
      match state with
        | #SEARCH => { if encoded.[i] != char('%') do

                         decoded = decoded +
                           if encoded.[i] == char('+') then char(' ') else encoded.[i] endif;
                       else
                         state = CONVERT;
                       done
                     }
        | #CONVERT => { var temp = encoded.[i to (i+2)];
                       var both = true;
                       for var j in 0 upto 1 do
                         if not isxdigit(temp.[j]) do
                           both = false;
                         done
                       done
                       if both do
                         decoded = decoded + char(strtoul("0x"+temp));
                         i++;
                       done
                       state = SEARCH;
                      }
      endmatch;
    done
    return decoded;
  }


}

Package: src/packages/filesystem.fdoc

File System

key file
filename.flx share/lib/std/io/filename.flx
key file
filestat.flx share/lib/std/io/filestat.flx
posix_filestat.flx share/lib/std/posix/filestat.flx
win32_filestat.flx share/lib/std/win32/filestat.flx
key file
filesystem.flx share/lib/std/io/filesystem.flx
posix_filesystem.flx share/lib/std/posix/filesystem.flx
win32_filesystem.flx share/lib/std/win32/filesystem.flx
key file
directory.flx share/lib/std/io/directory.flx
posix_directory.flx share/lib/std/posix/directory.flx
win32_directory.flx share/lib/std/win32/directory.flx
Filename
//[filename.flx]

//$ Operations on filenames.
class Filename_class[os] {

  //$ The path separator.
  virtual fun sep: 1 -> string;
  virtual fun is_absolute_filename : string -> bool;
  virtual fun root_subdir : string -> string;

  virtual fun executable_extension : 1 -> string;
  virtual fun static_object_extension: 1 -> string;
  virtual fun dynamic_object_extension: 1 -> string;
  virtual fun static_library_extension: 1 -> string;
  virtual fun dynamic_library_extension: 1 -> string;



  //$ split1 returns a pair consisting of a directory name and basename
  //$ with the separator between them lost except in the special case
  //$ "/x" where the "/" is kept as the directory name.
  //$ If there is no separator, the path is the basename and
  //$ the directory name is the empty string (NOT . !!!)

  fun split1(s:string)=> match find_last_of(s,#sep) with
    | Some pos =>
      if pos==0uz then #sep else s.[to pos] endif,
      s.[pos+#sep.len to]
    | #None => "",s
    endmatch
  ;

  private fun split(s:string, acc:List::list[string]):List::list[string]=>
    let d,b = split1 s in
    if d == "" then List::Cons(b,acc)
    elif d == #sep then List::Cons(d, List::Cons(b,acc))
    else split (d, List::Cons (b, acc))
    endif
  ;

  //$ split a filename into a list of components.
  fun split(s:string)=> split (s, List::Empty[string]);

  //$ Join two pathnames into a single pathname.
  //$ split and join are logical inverses, however join is not
  //$ not associative: join("x", join("","y")) = "x/y"
  //$ whereas join(join("x",""),"y") = "x//y"
  //$ since split pulls components off from the RHS we have to
  //$ fold them back from the left

  fun join(p:string, b:string)=>
    if p == "" then b
    elif p == #sep then p+b
    elif p.[-1] == #sep.[0] then p+b
    else p+#sep+b
    endif
  ;

  //$ Get the basename of a path (last component).
  fun basename(s:string)=> match split1(s) with | _,b => b endmatch;

  //$ Get the directory name of a path (all but the last component).
  fun dirname(s:string)=> match split1(s) with | d,_ => d endmatch;

  //$ Return a list of all the directory names in a path.
  //$ For example a/b/c gives "a", "a/b"
  fun directories (s:string) : list[string] =>
     let d,b = split1 s in
     if d == "" then Empty[string]
     elif d == #sep then Empty[string]
     else directories d + d
  ;

  //$ Join 3 and 4 strings into a pathname.
  fun join(a:string, b:string, c:string)=> join(join(a,b),c);
  fun join(a:string, b:string, c:string,d:string)=> join(join(join(a,b),c),d);

  //$ Join 2 strings into a pathname (curried form).
  fun join(x:string) (y:string) => join(x,y);

  //$ Join all the strings in a list into a pathname.
  fun join(ps: List::list[string])=> List::fold_left Filename::join of (string) "" ps;

  //$ Split off extension. Includes the dot.
  //$ Invariant: input = basename + extension.
  //$ Works backwards until it hits a dot, path separator,
  //$ or end of data. If a dot, strip it and the tail of the string,
  //$ otherwise return the original string.
  fun split_extension (s:string): string * string = {
     var n = s.len;
     if n > 0uz do
       for var i in s.len - 1uz downto 0uz do
         var ch = s.[i];
         if ch == char "." return s.[to i],s.[i to];
         if ch == char #sep return s,"";
       done
     done
     return s,"";
  }

  //$ Remove an extension from a filename if there is one.
  fun strip_extension (s:string) => s.split_extension.0;

  //$ Get extension if there is one. Includes the dot.
  fun get_extension (s:string) => s.split_extension.1;

}

//$ Windows Filenames
class Win32Filename
{
  inherit Filename_class[Win32];
  instance Filename_class[Win32] {
    fun sep() => "\\";
    fun executable_extension ()=> ".exe";
    fun static_object_extension() => ".obj";
    fun dynamic_object_extension() => ".obj";
    fun static_library_extension() => ".lib";
    fun dynamic_library_extension() => ".dll";
    fun is_absolute_filename (f:string) =>
      f.[0] == "\\".char or // no drive letter
      f.[1] == ":".char and f.[2] == "\\".char // with drive letter
    ;
   fun root_subdir (s:string) => "C:\\"+s;

  }
}

//$ OSX Filenames
class OsxFilename
{
  inherit Filename_class[Osx];
  instance Filename_class[Osx] {
    fun sep() => "/";
    fun executable_extension ()=> "";
    fun static_object_extension() => ".o";
    fun dynamic_object_extension() => ".os";
    fun static_library_extension() => ".a";
    fun dynamic_library_extension() => ".dylib";
    fun is_absolute_filename (f:string) => f.[0] == "/";
    fun root_subdir (s:string) => "/"+s;

  }
}

//$ Posix Filenames
class PosixFilename
{
  inherit Filename_class[Posix];
  instance Filename_class[Posix] {
    fun sep() => "/";
    fun executable_extension ()=> "";
    fun static_object_extension() => ".o";
    fun dynamic_object_extension() => ".os";
    fun static_library_extension() => ".a";
    fun dynamic_library_extension() => ".so";
    fun is_absolute_filename (f:string) => f.[0] == "/";
    fun root_subdir (s:string) => "/"+s;
  }
}

//$ Host Filenames.
class Filename
{
if PLAT_WIN32 do
  inherit Win32Filename;
elif PLAT_MACOSX do
  inherit OsxFilename;
else
  inherit PosixFilename;
done
}
Filestat
//[filestat.flx]

//$ Filesystem file kind query functions parametrised
//$ by operating system, status type and mode type.
class FileStat_class[OS,stat_t, mode_t]
{
  //$ Get information about a file into a status buffer.
  //$ Sets error code at argument 3 pointer.
  virtual proc stat: string * &stat_t * &int;

  //$ set access and modification time of a file.
  //$ Sets error code at argument 4 pointer.
  //$ Times are in seconds, nominally from Epoch (Jan 1 1970).
  virtual proc utime: string * double * double * &int;

  //$ Change read,write permissions for group, owner etc.
  //$ Return 0 on success.
  //$ On Windows this function may silently fail to obey
  //$ unsupported operations.
  virtual gen chmod: string * mode_t -> int;

  //$ set mask for subsequent permissions.
  //$ On Windows this function may silently fail to obey
  //$ unsupported operations.
  virtual gen umask: mode_t -> mode_t;

  //$ Abstracted platform independent file type taxonomy.
  variant file_type_t =
    | PIPE
    | STREAM
    | DIRECTORY
    | BLOCK
    | REGULAR
    | SYMLINK
    | SOCKET
    | INDETERMINATE
    | NONEXISTANT
    | NOPERMISSION
  ;

  //$ Get the file type from a file stat buffer.
  virtual fun file_type: &stat_t -> file_type_t;

  //$ Fill a stat buffer with information about a file.
  gen stat(file: string, statbuf:&stat_t) = {
    var res: int;
    stat(file, statbuf, &res);
    return res == 0;
  }

  //$ Get a file last modification time from a stat buffer.
  //$ Time is in seconds.
  fun mtime: &stat_t -> double = "(double)($1->st_mtime)";

  //$ Get a file creation time from a stat buffer.
  //$ Note: not available on Unix.
  //$ Time is in seconds.
  fun ctime: &stat_t -> double = "(double)($1->st_ctime)";

  //$ Get modification time of a file by name.
  //$ Time is in seconds.
  fun filetime(f:string):double =
  {
    var b: stat_t;
    var err:int;
    stat(f,&b,&err);
    return if err == 0 then mtime (&b) else 0.0 endif;
  }

  //$ Set the last access and modification time of a file by name.
  gen utime(f:string, a:double, m:double): bool = {
    var r:int;
    utime(f,a,m,&r);
    return r == 0;
  }

  //$ Set the last access and modification time of a file by name,
  //$ where the two times are given by a single argument.
  gen utime(f:string, t:double) => utime(f,t,t);

  //$ Check if a file exists.
  fun fileexists(f:string):bool=> filetime f != 0.0;

  //$ Find the type of a file.
  fun filetype(f:string):file_type_t =
  {
    var b:stat_t;
    var err:int;
    stat(f,&b,&err);
    return
      if err == 0 then file_type (&b)
      elif errno == EACCES then NOPERMISSION
      elif errno == ENOENT then NONEXISTANT
      else INDETERMINATE
      endif
    ;
  }

  fun past_time () => -1.0;
  fun future_time () => double(ulong(-1)); // a hacky way to get a big number

  fun strfiletime0 (x:double) = {
    return
      if x == #past_time then "BIG BANG"
      elif x == #future_time then "BIG CRUNCH"
      else fmt (x, fixed (0,3))
      endif
    ;
  }

  fun strfiletime (x:double) = {
    assert x != 0.0;
    return strfiletime0 x;
  }

  fun dfiletime(var f:string, dflt:double)=
  {
    var x = FileStat::filetime (f);
    x = if x == 0.0 then dflt else x endif;
    //debugln$ "Time of file '" + f + "' is " + strfiletime x;
    return x;
  }


}

//$ Platform dependent operations for host file system.
class FileStat {
if PLAT_WIN32 do
  inherit Win32FileStat;
else
  inherit PosixFileStat;
done
}
Posix FileStat
//[posix_filestat.flx]

class PosixFileStat
{
  pod type stat_t = "struct stat" requires Posix_headers::sys_stat_h;

  pod type mode_t = "mode_t" requires Posix_headers::sys_types_h;
  instance Bits[mode_t] {} // defaults to C operators
  instance Eq[mode_t] { fun == : mode_t * mode_t -> bool = "$1==$2"; }
  open Eq[mode_t];
  open Bits[mode_t];

  //------------------------------------------------------------
  // file mode: type and permissions
  //------------------------------------------------------------
  // file types
  const S_IFMT  : mode_t; // file type mask
  const S_IFIFO : mode_t;
  const S_IFCHR : mode_t;
  const S_IFDIR : mode_t;
  const S_IFBLK : mode_t;
  const S_IFREG : mode_t;
  const S_IFLNK : mode_t;
  const S_IFSOCK: mode_t;

  // permissions
  const S_IRWXU : mode_t; // RWX mask: owner
  const S_IRUSR : mode_t;
  const S_IWUSR : mode_t;
  const S_IXUSR : mode_t;

  const S_IRWXG : mode_t; // RWX mask: group
  const S_IRGRP : mode_t;
  const S_IWGRP : mode_t;
  const S_IXGRP : mode_t;

  const S_IRWXO : mode_t; // RWX mask: other
  const S_IROTH : mode_t;
  const S_IWOTH : mode_t;
  const S_IXOTH : mode_t;

  const S_ISUID : mode_t; // set user id on execute
  const S_ISGID : mode_t; // set group id on execute
  const S_ISVXT : mode_t; // sticky bit
  val access_mask = S_IXOTH \| S_IXGRP \| S_IXUSR;


  fun raw_mode: &stat_t -> mode_t = "$1->st_mode";
  fun file_type(m:mode_t)=>m \& S_IFMT;
  fun file_perm(m:mode_t)=>m \& ~S_IFMT;

  ctor uint: mode_t = "(unsigned int)$1";



  inherit FileStat_class[Posix, stat_t, mode_t];
  instance FileStat_class[Posix, stat_t, mode_t]
  {
    proc stat: string * &stat_t * &int = "*$3=stat($1.c_str(),$2);";

    proc utime: string * double * double * &int =
    """
      {
      utimbuf u;
      u.actime=(time_t)$2;
      u.modtime=(time_t)$3;
      *$4 = utime($1.c_str(),&u);
      }
    """

    requires Posix_headers::utime_h;

    gen chmod: string * mode_t -> int = "chmod($1.c_str(),$2)" requires Posix_headers::sys_stat_h;
    gen umask: mode_t -> mode_t = "umask($1)";

    fun file_type (s:&stat_t): file_type_t =>
      let m = file_type$ raw_mode s in
      if m == S_IFIFO then PIPE
      elif m == S_IFCHR then STREAM
      elif m == S_IFDIR then DIRECTORY
      elif m == S_IFBLK then BLOCK
      elif m == S_IFREG then REGULAR
      elif m == S_IFLNK then SYMLINK
      elif m == S_IFSOCK then SOCKET
      else INDETERMINATE
      endif
    ;

  } // instance
}
Win32 FileStat
//[win32_filestat.flx]

class Win32FileStat
{
  //2 things:
  //
  // (1) AFAICT, Windows doesn't define mode_t and uses unsigned int.
  // (2) We still pull in sys/types.h because sys/stat.h uses it (and
  //     it must come first).
  //
  //(source http://msdn.microsoft.com/en-US/library/14h5k7ff(v=vs.80)).

  //pod type mode_t = "mode_t" requires Posix_headers::sys_types_h;

  pod type mode_t = "int";
  pod type stat_t = "struct __stat64" requires Posix_headers::sys_stat_h;

  instance Bits[mode_t] {} // defaults to C operators
  instance Eq[mode_t] { fun == : mode_t * mode_t -> bool = "$1==$2"; }
  open Eq[mode_t];
  open Bits[mode_t];

  // file types
  const _S_IFMT  : mode_t; // file type mask
  const _S_IFDIR : mode_t;
  const _S_IFREG : mode_t;

  // permissions
  const _S_IWRITE: mode_t; // RWX mask: owner
  const _S_IREAD  : mode_t;
  val access_mask = _S_IREAD \| _S_IWRITE;


  fun raw_mode: &stat_t -> mode_t = "$1->st_mode";
  fun file_type(m:mode_t)=>m \& _S_IFMT;
  fun file_perm(m:mode_t)=>m \& ~_S_IFMT;

  ctor uint: mode_t = "(unsigned int)$1";


  inherit FileStat_class[Win32, stat_t, mode_t];

  instance FileStat_class[Win32, stat_t, mode_t]
  {
    proc stat: string * &stat_t * &int = "*$3=_stat64($1.c_str(),$2);";
    // set access and modification time of a file
    proc utime: string * double * double * &int =
    """
      {
      __utimbuf64 u;
      u.actime=(time_t)$2;
      u.modtime=(time_t)$3;
      *$4 = _utime64($1.c_str(),&u);
      }
    """

    requires Win32_headers::sys_utime_h;

    gen chmod: string * mode_t -> int = "_chmod($1.c_str(),$2)" requires Win32_headers::io_h;
    gen umask: mode_t -> mode_t = "_umask($1)";

    fun file_type (s:&stat_t): file_type_t =>
      let m = file_type$ raw_mode s in
      if m == _S_IFDIR then DIRECTORY
      elif m == _S_IFREG then REGULAR
      else INDETERMINATE
      endif
    ;

  } // instance
}
File Syetem
//[filesystem.flx]

//$ Filesystem operations parametrised by operating system.
//$ YET TO BE DONE.
class FileSystem_class[os]
{
}

//$ Platform dependent filesystem operations for host file system.
class FileSystem {
if PLAT_WIN32 do
  inherit Win32FileSystem;
else
  inherit PosixFileSystem;
done

  proc unlink(f:string)
  {
    proc aux (d:string) (b:string)
    {
      if b == "." or b == ".." return;
      var f = if d == "" then b else Filename::join (d,b);
      match FileStat::filetype f with
      | #PIPE => ;
      | #STREAM => ;
      | #DIRECTORY =>
        match Directory::filesin f with
        | #None => ;
        | Some files =>
          for file in files do
            aux f file;
          done
          C_hack::ignore$ Directory::unlink_empty_dir f;
        endmatch;
      | #BLOCK => ;
      | #REGULAR => C_hack::ignore$ unlink_file f;
      | #SYMLINK => C_hack::ignore$ unlink_file f;
      | #SOCKET => ;
      | #INDETERMINATE => ;
      | #NONEXISTANT => ;
      | #NOPERMISSION => ;
      endmatch;
    }
    aux "" f;
  }

  proc rm (f:string) => unlink f;

  //$ Find a file in a list of directories.
  fun find_in_path(x:string, path:list[string]):opt[string]=>
    match path with
    | #Empty => None[string]
    | Cons (d,t) =>
      let p =  Filename::join(d,x) in
      match FileStat::fileexists p with
      | true => Some p
      | false => find_in_path (x,t)
      endmatch
    endmatch
  ;

  //$ Find all the files matching an RE2-regular expression
  //$ in a given directory.
  //$ NOTE: this search finds files in descendant directories too.
  //$ The search is recursive, but the whole pathname within
  //$ the specified directory must match the regexp.
  //$ For example to find all *.flx files in src use:
  //$   regfilesin("src", ".*[.]flx")
  //$ To find the files only in the given directory, on Unix use instead
  //$   regfilesin("src", "[^/]*[.]flx")
  //$ to exclude files in child directories.
  fun regfilesin(dname:string, re:string): list[string] => regfilesin(dname, Re2::RE2 re);

  //$ Find all the files matching a compiled RE2-regular expression.
  fun regfilesin(dname:string, re:RE2): list[string] = {
    //eprintln$ "regfilesin " + dname+ " with some kind of regexp .. ";

    var foundfiles = Empty[string];
    proc rfi(dname2: string) {

      //eprintln$ "rf() : dname2=" +dname2;

      if dname2 == "." or dname2 == ".." return;

      var newpath = if dname2 == "" then dname else Filename::join (dname,dname2);

      //eprintln$ "newpath = "+newpath ;

      var newfiles = Directory::filesin(newpath);

      //eprintln$ "returned from filesin" ;

      match newfiles with
      | #None => return;
      | Some files =>
        //eprintln$ "got files in " + newpath;
        for f in files do
          if f == "." or f == ".." do ;
          else
            //eprintln$ "Processing file " + f;
            var d = Filename::join (dname2,f);
            //eprintln$ "Relpath " + d;
            var fullpath = Filename::join (dname,d);
            //eprintln$ "fullpath " + fullpath;
            var t = FileStat::filetype fullpath;
            match t with
              | #REGULAR =>
                //eprintln ("Regular file " + d);
                var result = d in re;
                if result do
                      //eprintln$ d + " Matches";
                            foundfiles = Cons (d, foundfiles);
                done
              | #DIRECTORY =>
                //eprintln ("found directory " + d);
                rfi (d);
              | _ => ;
            endmatch;
          done
        done
      endmatch;
    }
    rfi ("");
    return rev foundfiles;
  }

}
Posix File Syetem
//[posix_filesystem.flx]

class PosixFileSystem
{
  //------------------------------------------------------------
  // File access and create modes
  //------------------------------------------------------------
  pod type file_perm_t = "int" requires Posix_headers::fcntl_h;
  const O_RDONLY     : file_perm_t;
  const O_WRONLY     : file_perm_t;
  const O_RDWR       : file_perm_t;
  const O_NONBLOCK   : file_perm_t;
  const O_APPEND     : file_perm_t;
  const O_CREAT      : file_perm_t;
  const O_TRUNC      : file_perm_t;
  const O_EXCL       : file_perm_t;
  const O_SHLOCK     : file_perm_t;
  const O_EXLOCK     : file_perm_t;
  const O_NOFOLLOW   : file_perm_t;
  const O_SYMLINK    : file_perm_t;
  const O_EVTONLY    : file_perm_t;
  fun \& : file_perm_t * file_perm_t -> file_perm_t = "$1&$2";
  fun \|  : file_perm_t * file_perm_t -> file_perm_t = "$1|$2";

  //------------------------------------------------------------
  // File I/O functions
  //------------------------------------------------------------
  pod type posix_file = "int" requires Posix_headers::unistd_h;
  fun valid: posix_file -> bool = "$1 != -1";
  ctor int : posix_file = "$1";
  const fd0 : posix_file = "0";
  const fd1 : posix_file = "1";
  const fd2 : posix_file = "2";

  gen open: string * file_perm_t * PosixFileStat::mode_t -> posix_file = "open($1.c_str(), $2, $3)";
  gen open: string * file_perm_t -> posix_file = "open($1.c_str(), $2)";

  gen ropen: string -> posix_file = 'open($1.c_str(), O_RDONLY,0)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
  gen wopen: string -> posix_file = 'open($1.c_str(), O_WRONLY | O_CREAT | O_TRUNC, S_IRUSR | S_IWUSR)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
  gen rwopen: string -> posix_file = 'open($1.c_str(), O_RDWR,0)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
  gen creat: string * PosixFileStat::mode_t-> posix_file = 'open($1.c_str(), O_WRONLY | O_CREAT | O_TRUNC, $2)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;

  gen close: posix_file -> int = "close($1)";
  gen read: posix_file * &char * size -> size = "read($1, $2, $3)";
  gen write: posix_file * &char * size -> size = "write($1, $2, $3)";

  gen dup: posix_file -> posix_file = "dup($1)" requires Posix_headers::unistd_h;
  gen dup2: posix_file * posix_file -> posix_file = "dup2($1,$2)" requires Posix_headers::unistd_h;
  header piper_def = """
    struct _piper_hack { int i; int o; };
  """;
  body piper_def = """
    _piper_hack _piper() {
      _piper_hack p;
      pipe((int*)(void*)&p);
      return p;
    }
  """ requires Posix_headers::unistd_h;
  private cstruct _piper_hack { i:posix_file; o:posix_file; };
  private gen _piper: 1 -> _piper_hack requires piper_def;
  private fun _mkpair (x: _piper_hack) => x.i, x.o;
  gen pipe () => _mkpair #_piper;

  gen fdopen_input: posix_file ->  ifile = 'fdopen($1,"r")';
  gen fdopen_output: posix_file ->  ofile = 'fdopen($1,"w")';

  //------------------------------------------------------------
  // delete (unlink) a file
  //------------------------------------------------------------
  gen unlink_file: string -> int = "::unlink($1.c_str())"
    requires Posix_headers::unistd_h;

  //------------------------------------------------------------
  // rename a file
  //------------------------------------------------------------
  gen rename_file: string * string -> int = "::rename($1.c_str(),$2.c_str())"
    requires Posix_headers::unistd_h;

  //------------------------------------------------------------
  // copy a file, preserving last access and modification times
  // owner, group, and permissions
  //------------------------------------------------------------
  gen filecopy(src: string, dst: string) :  bool =
  {
    if Env::getenv ("FLX_REPORT_FILECOPY") != "" do
      eprintln$ "[PosixFileSystem::filecopy] '" + src + "' -> '" + dst+ "'";
    done
    val now = Time::time(); // seconds
    var stat_buf: PosixFileStat::stat_t;
    if not PosixFileStat::stat (src, &stat_buf) do
      eprintln$ "[PosixFileSystem::filecopy] Can't stat source file " + src;
      return false;
    done;
    val permissions = PosixFileStat::file_perm$ PosixFileStat::raw_mode (&stat_buf);
    val last_modification = PosixFileStat::filetime(src);
    var fsrc = open (src,O_RDONLY );
    if not valid fsrc do
      eprintln$ "[PosixFileSystem::filecopy] Bad src file in Filesystem::filecopy " + src;
      return false;
    done
    var fdst = open (dst,O_WRONLY \| O_CREAT \| O_TRUNC, permissions);
    if not valid fdst do
      eprintln$ "[PosixFileSystem::filecopy] Bad dst file in Filesystem::filecopy " + dst + ", Error: " + str errno + "=" + #strerror;
      return false;
    done
    bsiz := size (4096 * 1024); // 4 Meg
    var buffer = C_hack::cast[&char] (Memory::malloc(bsiz)); // 4 MEG
    var bread = read (fsrc, buffer, bsiz);
    while bread > size 0 do
      var bwrite = write (fdst,buffer,bread);
      if bread != bwrite do
        if bwrite.int == -1 do
          eprintln$
            "[PosixFileSystem::filecopy] Dest des = " + str fdst.int+ " "+
            "Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
            " failed with errno = " + str errno + ": " + strerror()
          ;
        else
          eprintln$
            "[PosixFileSystem::filecopy] Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
            " failed with " +  str bwrite + " only copied!"
          ;
        done
      done
      bread = read (fsrc, buffer, bsiz);
    done
    var res = close fsrc;
    if res != 0 do
      eprintln$ "[PosixFileSystem::filecopy] close on src " + src + " failed: " + str errno + "=" + #strerror;
    done
    res = close fdst;
    if res != 0 do
      eprintln$ "[PosixFileSystem::filecopy] close on dst " + dst + " failed: " + str errno + "=" + #strerror;
    done
    C_hack::ignore(PosixFileStat::utime(dst,now,last_modification));
    Memory::free(C_hack::cast[address] buffer);
    return true;
  }

  //------------------------------------------------------------
  // generate temporary file name
  //------------------------------------------------------------
  body tmpnam = """
    std::string flx_tmpnam() {
      char tmpn[] = "/tmp/flx_XXXXXX";
      close(mkstemp(tmpn));
      return std::string(tmpn);
     }
  """ requires header '#include <unistd.h>';

  gen tmp_filename: 1 -> string = "flx_tmpnam()" requires tmpnam;

}
Win32 File Syetem
//[win32_filesystem.flx]

class Win32FileSystem
{
  //------------------------------------------------------------
  // File access and create modes
  //------------------------------------------------------------
  pod type file_perm_t = "int" requires Posix_headers::fcntl_h;
  const _O_BINARY     : file_perm_t;
  const _O_RDONLY     : file_perm_t;
  const _O_WRONLY     : file_perm_t;
  const _O_RDWR       : file_perm_t;
  const _O_NONBLOCK   : file_perm_t;
  const _O_APPEND     : file_perm_t;
  const _O_CREAT      : file_perm_t;
  const _O_TRUNC      : file_perm_t;
  const _O_EXCL       : file_perm_t;
  const _O_SHLOCK     : file_perm_t;
  const _O_EXLOCK     : file_perm_t;
  const _O_NOFOLLOW   : file_perm_t;
  const _O_SYMLINK    : file_perm_t;
  const _O_EVTONLY    : file_perm_t;
  fun \& : file_perm_t * file_perm_t -> file_perm_t = "$1&$2";
  fun \|  : file_perm_t * file_perm_t -> file_perm_t = "$1|$2";

  //------------------------------------------------------------
  // File I/O functions
  //------------------------------------------------------------
  pod type posix_file = "int" requires Win32_headers::io_h;
  fun valid: posix_file -> bool = "$1 != -1";
  ctor int : posix_file = "$1";
  const fd0 : posix_file = "0";
  const fd1 : posix_file = "1";
  const fd2 : posix_file = "2";

  gen open: string * file_perm_t * Win32FileStat::mode_t -> posix_file = "_open($1.c_str(), $2, $3)";
  gen open: string * file_perm_t -> posix_file = "_open($1.c_str(), $2)";

  gen ropen: string -> posix_file = 'open($1.c_str(), _O_RDONLY | _O_BINARY,0)' requires Posix_headers::fcntl_h, Posix_headers::sys_stat_h;
  gen wopen: string -> posix_file = 'open($1.c_str(), _O_WRONLY  | _O_BINARY | _O_CREAT | _O_TRUNC, S_IRUSR | S_IWUSR)' requires Win32_headers::io_h, Posix_headers::sys_stat_h;
  gen rwopen: string -> posix_file = 'open($1.c_str(), _O_RDWR | _O_BINARY,0)' requires Win32_headers::io_h, Posix_headers::sys_stat_h;
  gen creat: string * Win32FileStat::mode_t-> posix_file = 'open($1.c_str(), _O_WRONLY | _O_BINARY | _O_CREAT | _O_TRUNC, $2)' requires Win32_headers::io_h, Posix_headers::sys_stat_h;

  gen close: posix_file -> int = "_close($1)";
  gen read: posix_file * &char * size -> size = "read($1, $2, $3)";
  gen write: posix_file * &char * size -> size = "write($1, $2, $3)";

  gen dup: posix_file -> posix_file = "dup($1)" requires Win32_headers::io_h;
  gen dup2: posix_file * posix_file -> posix_file = "dup2($1,$2)" requires Win32_headers::io_h;
  header piper_def = """
    struct _piper_hack { int i; int o; };
  """;
  body piper_def = """
    _piper_hack _piper() {
      _piper_hack p;
      pipe((int*)(void*)&p);
      return p;
    }
  """ requires Posix_headers::unistd_h;
  private cstruct _piper_hack { i:posix_file; o:posix_file; };
  private gen _piper: 1 -> _piper_hack requires piper_def;
  private fun _mkpair (x: _piper_hack) => x.i, x.o;
  gen pipe () => _mkpair #_piper;

  gen fdopen_input: posix_file ->  ifile = 'fdopen($1,"r")';
  gen fdopen_output: posix_file ->  ofile = 'fdopen($1,"w")';

  //------------------------------------------------------------
  // delete (unlink) a file
  //------------------------------------------------------------
  gen unlink_file: string -> int = "unlink($1.c_str())";

  //------------------------------------------------------------
  // rename a file
  //------------------------------------------------------------
  gen rename_file: string * string -> int = "rename($1.c_str(),$2.c_str())";

  //------------------------------------------------------------
  // copy a file, preserving last access and modification times
  // owner, group, and permissions
  //------------------------------------------------------------
  gen filecopy(src: string, dst: string) :  bool =
  {
    //eprintln$ "Copy " + src + " -> " + dst;
    if Env::getenv ("FLX_REPORT_FILECOPY") != "" do
      eprintln$ "[Win32FileSystem::filecopy] '" + src + "' -> '" + dst+ "'";
    done

    val now = Time::time(); // seconds
    var stat_buf: Win32FileStat::stat_t;
    if not Win32FileStat::stat (src, &stat_buf) do
      eprintln$ "Can't stat source file " + src;
      return false;
    done;
    val permissions = Win32FileStat::file_perm$ Win32FileStat::raw_mode (&stat_buf);
    val last_modification = Win32FileStat::filetime(src);
    var fsrc = open (src,_O_RDONLY \| _O_BINARY);
    if not valid fsrc do
      eprintln$ " Bad src file in Filesystem::filecopy " + src;
      return false;
    done
    var fdst = open (dst,_O_WRONLY \| _O_BINARY \| _O_CREAT \| _O_TRUNC, permissions);
    if not valid fdst do
      eprintln$ " Bad dst file in Filesystem::filecopy " + dst + ", Error: " + str errno + "=" + #strerror;
      return false;
    done
    bsiz := size (4096 * 1024); // 4 Meg
    var buffer = C_hack::cast[&char] (Memory::malloc(bsiz)); // 4 MEG
    var bread = read (fsrc, buffer, bsiz);
    while bread > size 0 do
      var bwrite = write (fdst,buffer,bread);
      if bread != bwrite do
        if bwrite.int == -1 do
          eprintln$
            "Dest des = " + str fdst.int+ " "+
            "Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
            " failed with errno = " + str errno + ": " + strerror()
          ;
        else
          eprintln$
            "Attempt to copy " + str bread + " bytes from " + src + " to " + dst +
            " failed with " +  str bwrite + " only copied!"
          ;
        done
      done
      bread = read (fsrc, buffer, bsiz);
    done
    var res = close fsrc;
    if res != 0 do
      eprintln$ "In filesystem::filecopy close on src " + src + " failed: " + str errno + "=" + #strerror;
    done
    res = close fdst;
    if res != 0 do
      eprintln$ "In filesystem::filecopy close on dst " + dst + " failed: " + str errno + "=" + #strerror;
    done
    C_hack::ignore(Win32FileStat::utime(dst,now,last_modification));
    Memory::free(C_hack::cast[address] buffer);
    return true;
  }


  //------------------------------------------------------------
  // generate temporary file name
  //------------------------------------------------------------
  body tmpnam = """
    std::string flx_tmpnam() {
      char tmpn[] = "/tmp/flx_XXXXXX";
      close(mkstemp(tmpn));
      return std::string(tmpn);
     }
  """ requires header '#include <unistd.h>';

  gen tmp_filename: 1 -> string = "flx_tmpnam()" requires tmpnam;

}
Directory
//[directory.flx]

//$ File system directory services,
//$ Parametrised  by operating system and mode type.
class Directory_class[os,mode_t]
{
  //$ Create a directory with specified mode.
  //$ Returns 0 if successful.
  virtual gen mkdir: string * mode_t -> int;

  //$ Create a directory with default mode.
  //$ Returns 0 if successful.
  virtual gen mkdir: string -> int;

  //$ Try to ensure all the directories in a path exist.
  //$ Does not return any error indication.
  virtual proc mkdirs: string;

  virtual gen unlink_empty_dir: string -> int;

  //$ Return an option list of all the regular files in a given directory.
  //$ Returns None if the directory does not exist or isn't accessible.
  //$ Returns Some files if the directory exists and is accessible.
  //$ If the directory has no regular files, the list is Empty.
  virtual fun filesin:string -> opt[List::list[string]];

  //$ Get the absolute pathname of the current working directory.
  virtual fun getcwd: 1 -> string;

  //$ Convert a relative filename to an absolute pathname.
  virtual fun mk_absolute_filename: string -> string;
}

//$ Host file system directory services.
//$ Platform dependent.
class Directory {
if PLAT_WIN32 do
  inherit Win32Directory;
else
  inherit PosixDirectory;
done
}
Posix Directory Services
//[posix_directory.flx]

class PosixDirectory
{
  // Posix specific stuff.
  type dirent_t = "struct dirent*" requires Posix_headers::dirent_h;
  type DIR_t = "DIR*" requires Posix_headers::dirent_h;
  proc opendir: string * &DIR_t = "*$2=opendir($1.c_str());";
  fun isNULL: DIR_t -> bool = "$1==0";
  fun isNULL: dirent_t -> bool = "$1==0";
  proc readdir: DIR_t * dirent_t * &dirent_t * &int = "*$4=readdir_r($1, $2, $3);";
  proc closedir: DIR_t = "closedir($1);";
  fun filename: dirent_t -> string = "std::string($1->d_name)";
  private fun getcwd: +char * size -> +char = "getcwd($1,$2)" requires Posix_headers::unistd_h;

  // inherit generic stuff
  inherit Directory_class[Posix, PosixFileStat::mode_t];

  // instantiate generic stuff
  instance Directory_class[Posix, PosixFileStat::mode_t] {
    gen mkdir: string * PosixFileStat::mode_t -> int = "mkdir($1.c_str(), $2)" requires Posix_headers::sys_stat_h;
    gen mkdir: string  -> int = "mkdir($1.c_str(), 0777)" requires Posix_headers::sys_stat_h;
    proc mkdirs (s:string)
    {
      if s == "" or s == "." or s == ".." or s == "/" do
         return;
      done
      mkdirs$ Filename::dirname s;
      C_hack::ignore$ mkdir s;
    }

    // Delete an empty directory.
    gen unlink_empty_dir : string -> int = "rmdir ($1.c_str())" requires Posix_headers::unistd_h;


    fun getcwd():string = {
      var b: array[char,1024];
      var p = getcwd((&b).stl_begin,size 1024);
      return if C_hack::isNULL p then "" else string p endif;
    }
    fun mk_absolute_filename(s:string) =>
       if PosixFilename::is_absolute_filename s then s else
       #getcwd + "/" + s
    ;
    fun filesin(dname:string): opt[List::list[string]] = {
      //println$ "filesin " + dname;
      var d:DIR_t;
      var e: dirent_t = C_hack::cast[dirent_t]$ Memory::malloc 5000;
      var eret = e;
      var err:int = 0;
      var files = List::Empty[string];
      opendir(dname,&d);
      if isNULL d do
        println "Error opening dir";
        Memory::free$ C_hack::cast[address] e;
        return None[List::list[string]];
      else
      //println$ "Opened dir " + dname;
  next:>
        readdir(d,e,&eret, &err);
        if err != 0 do
          println "Error reading dir"; fflush;
          closedir d;
          Memory::free$ C_hack::cast[address] e;
          return None[List::list[string]];
        elif isNULL eret do
          //println "End of dir";
          closedir d;
          Memory::free$ C_hack::cast[address] e;
          return Some files;
        else
          //println "Think we got a file?";
          assert err == 0;
          //println$ "Found a file " + filename e;
          files += filename e;
          goto next;
        done
      done
    }
  }
}
Win32 Directory Services
//[win32_directory.flx]

class Win32Directory
{
  //Win32 specific stuff.

  type DIR_t = "intptr_t" requires Win32_headers::io_h ;
  type FINDDATA_t = "struct _finddata_t" requires Win32_headers::io_h ;

  proc findfirst: string * &FINDDATA_t * &DIR_t = "*$3=_findfirst($1.c_str(), $2);" ;
  proc findnext: DIR_t * &FINDDATA_t * &int = "*$3=_findnext($1, $2);" ;
  proc findclose : DIR_t = "_findclose($1);" ;

  fun findfailed : DIR_t -> bool = "int($1) == -1" ;
  fun filename : FINDDATA_t -> string = "std::string($1.name)" ;

  private fun getcwd: +char * size -> +char = "_getcwd($1,(int)$2)" requires Win32_headers::direct_h;

  // Generic stuff.

  inherit Directory_class[Win32, Win32FileStat::mode_t];

  // Instantiate generics.

  instance Directory_class[Win32, Win32FileStat::mode_t]
  {
    //Make a directory.

    // warning: ignores the mode!
    gen mkdir: string * Win32FileStat::mode_t -> int = "_mkdir($1.c_str())" requires Win32_headers::direct_h;
    gen mkdir: string  -> int = "_mkdir($1.c_str())" requires Win32_headers::direct_h;
    proc mkdirs (s:string)
    {
      if s == "" or s == "." or s == ".." or s.[-1] == char "\\" do
         return;
      done
      mkdirs$ Win32Filename::dirname s;
      C_hack::ignore$ mkdir s;
    }

    gen unlink_empty_dir: string->int=  "(int)RemoveDirectory($1.c_str())" requires Win32_headers::windows_h;


    //Get the current working directory.

    fun getcwd():string =
    {
      var b: array[char,1024];
      var p = getcwd((&b).stl_begin,size 1024);
      return if C_hack::isNULL p then "" else string p endif;
    }

    //Is the given path absolute?

    // this is wrong, because D:filename will have the
    // current directory prepended instead of the
    // current directory for drive D, so it could end up
    // referring to drive C instead ..
    // also none of this works with network names
    fun mk_absolute_filename(s:string) =>
       if Win32Filename::is_absolute_filename s then s else
       #getcwd + "\\" + s
    ;

    //List the files in a directory.

    fun filesin(dname:string): opt[list[string]] =
    {
      //eprintln$ "hi in filesin dname=\""+dname+"\"" ;

      var d : DIR_t ;
      var fileinfo : FINDDATA_t ;
      var files = Empty[string];

      //eprintln$ "calling findfirst with expression = " + dname+"*";
      findfirst (dname+"\\*", &fileinfo, &d) ;
      //eprintln$ "returned from findfirst" ;

      if findfailed d  do
        if errno == ENOENT or errno == EINVAL do
          //eprintln$ "findfirst() failed with ENOENT or EINVAL" ;
          return None[list[string]] ;
        done
        eprintln$ "findfirst() failed unexpectedly" ;
        assert false ;
      done

      var stat : int ;

    harvestnext:>

      var f : string  = filename fileinfo ;
      if f != ".." and f != "." do
        //println$ "Adding file" + (filename fileinfo) ;
        files += filename fileinfo ;
      done

      findnext(d, &fileinfo, &stat) ;
      if stat == 0 goto harvestnext ;

      if stat == -1 do
        if errno == ENOENT goto harvestexit ;
        assert false ;
      else
        println "Error reading dir"; fflush;
        findclose d ;
        return None[list[string]] ;
      done

    harvestexit:>

      //eprintln$ "Leaving normally with some files" ;

      findclose d ;
      return Some files ;
    }
  }
}

Package: src/packages/io.fdoc

I/O

key file
flx_ioutil.hpp share/lib/rtl/flx_ioutil.hpp
flx_ioutil.cpp share/src/rtl/flx_ioutil.cpp
flx_ioutil.fpc $PWD/src/config/flx_ioutil.fpc
key file
__init__.flx share/lib/std/io/__init__.flx
ansi_terminal.flx share/lib/std/io/ansi_terminal.flx
textio.flx share/lib/std/io/textio.flx
iostream.flx share/lib/std/io/iostream.flx
socket.flx share/lib/std/io/socket.flx
demux.flx share/lib/std/io/demux.flx
faio.flx share/lib/std/io/faio.flx
posix_faio.flx share/lib/std/posix/faio_posix.flx
win32_faio.flx share/lib/std/win32/faio_win32.flx
Core RTL support

Basic routines built on C FILE* and C++ iostreams. Provides portability, and some conveniences regarding line handling and string handling.

These routines all use binary I/O but are designed specifically for basic text I/O. Error handling is minimal, these are mainly for simple jobs and debugging.

//[flx_ioutil.hpp]
#ifndef FLX_IOUTIL
#define FLX_IOUTIL
#include <string>
#include <cstdio>
#include "flx_rtl_config.hpp"

namespace flx { namespace rtl { namespace ioutil {
  RTL_EXTERN ::std::string load_file (::std::string);
  RTL_EXTERN ::std::string load_text_file (::std::string);

  RTL_EXTERN ::std::string load_file (::std::FILE *);
  RTL_EXTERN int flx_fileno(::std::FILE*);
  RTL_EXTERN bool flx_isatty(::std::FILE*);
  RTL_EXTERN bool flx_isstdin(::std::FILE*);
  RTL_EXTERN bool flx_isconsole(::std::FILE*);
  RTL_EXTERN ::std::string raw_readln(::std::FILE*);
  RTL_EXTERN ::std::string raw_read(::std::FILE*, ::std::size_t);
  RTL_EXTERN ::std::string echo_readln(::std::FILE*);
  RTL_EXTERN ::std::string readln(::std::FILE*);
  RTL_EXTERN void write (::std::FILE *, ::std::string);
  RTL_EXTERN void writeln (::std::FILE *, ::std::string);

  RTL_EXTERN ::std::string load_file (::std::istream*);
  RTL_EXTERN ::std::string readln(::std::istream*);
  RTL_EXTERN void write (::std::ostream*, ::std::string);
  RTL_EXTERN void writeln (::std::ostream*, ::std::string);
}}}
#endif

//[flx_ioutil.cpp]

#include <cstdio>
#include <cstring>
#include <string>
#include <iostream>
#include <cassert>
#include "flx_ioutil.hpp"

#if FLX_WIN32
#include <io.h>
#else
#include <unistd.h>
#endif

namespace flx { namespace rtl { namespace ioutil {
  using namespace std;


#if FLX_WIN32
  int flx_fileno (FILE *f) { return _fileno (f); }
  bool flx_isatty(int fd) { return 1 == _isatty (fd); }
#else
  int flx_fileno (FILE *f) { return fileno (f); }
  bool flx_isatty(int fd) { return 1 == isatty (fd); }
#endif

  bool flx_isatty (FILE *f)
  {
    return 1 == flx_isatty (flx_fileno (f));
  }

  bool flx_isstdin (FILE *f)
  {
    return flx_fileno (f) == 0;
  }

  bool flx_isconsole (FILE *f)
  {
    return flx_isstdin (f) && flx_isatty(f);
  }


/* small buffer for testing, should be much large in production version */
#define MYBUFSIZ 51200

  string load_file (string f)
  {
    char const *fname = f.c_str();

    FILE *fi = fopen(fname,"rb"); // note: binary mode!

    if (fi)
    {
      string x = "";
      char buffer[MYBUFSIZ];
      while (!feof(fi)) {
        ::std::size_t n = fread(buffer,1,MYBUFSIZ,fi);
        if(n>0) x += string(buffer,n);
        else break;
      }
      fclose(fi);
      return x;
    }
    else return "";
  }

  string load_text_file (string f)
  {
    char const *fname = f.c_str();

    FILE *fi = fopen(fname,"rt"); // note: text mode

    if (fi)
    {
      string x = "";
      char buffer[MYBUFSIZ];
      while (!feof(fi)) {
        ::std::size_t n = fread(buffer,1,MYBUFSIZ,fi);
        if(n>0) x += string(buffer,n);
        else break;
      }
      fclose(fi);
      return x;
    }
    else return "";
  }


// C FILE IO

  string load_file (FILE *fi) // note does NOT close file! (would screw up popen)
  {
    if (fi)
    {
      string x = "";
      char buffer[MYBUFSIZ];
      while (!feof(fi)) {
        ::std::size_t n = fread(buffer,1,MYBUFSIZ,fi);
        if(n>0) x = x + string(buffer,n);
        else break;
      }
      return x;
    }
    else return "";
  }

  // includes newline if present
  // null string indicates end of file
  string raw_readln (FILE *fi)
  {
    if(fi)
    {
      string x = "";
      char buffer[MYBUFSIZ+1];
      buffer[MYBUFSIZ]='\0';
next:
      bool eof = fgets(buffer, MYBUFSIZ, fi) == 0;
      if(eof) return x;
      x += string(buffer);
      if(x[x.size()-1]=='\n') return x;
      goto next;
    }
    else return "";
  }

  // read up to n bytes
  string raw_read (FILE *fi, ::std::size_t n)
  {
    void *buffer = std::malloc(n);
    ::std::size_t m = fread (buffer, 1, n, fi);
    string s((char const*)buffer,m);
    free(buffer);
    return s;
  }

  string echo_readln (FILE *f)
  {
    string result = raw_readln (f);
    printf ("%s",result.c_str());
    return result;
  }

  string readln (FILE *f) {
    bool doecho = flx_isstdin(f) && !flx_isatty (f);
    if (doecho)
       return echo_readln(f);
    else
       return raw_readln (f);
  }

  void write (FILE *fi, string s)
  {
    fwrite(s.data(),s.size(),1,fi);
  }

  static const char eol[] = { '\n' };

  void writeln (FILE *fi, string s)
  {
    fwrite(s.data(),s.size(),1,fi);
    fwrite(eol,sizeof(eol),1,fi);
  }

// C++ file IO

  string load_file (istream *fi) // note does NOT close file! (would screw up popen)
  {
    if (fi)
    {
      string x = "";
      char buffer[MYBUFSIZ];
more:
      fi->read(buffer,MYBUFSIZ);
      int n = fi->gcount();
      if(n>0) x = x + string(buffer,n);
      if (n == MYBUFSIZ)goto more;
      return x;
    }
    else return "";
  }

  // includes newline if present
  // null string indicates end of file
  string readln (istream *fi)
  {
    if(fi)
    {
      ::std::string x = "";
      ::std::getline(*fi,x);
      if (fi->fail()) return x;
      else return x+"\n";
    }
    else return "";
  }

  void write (ostream *fi, string s)
  {
    fi->write(s.data(),s.size());
  }

  void writeln (ostream *fi, string s)
  {
    fi->write(s.data(),s.size());
    fi->write(eol,sizeof(eol));
  }
}}}

//[flx_ioutil.fpc]
Name: flx_ioutil
Description: I/O support
includes: '"flx_ioutil.hpp"'
Requires: flx
Standard Library Synopsis
//[__init__.flx]

include "std/io/textio";
include "std/io/demux";
include "std/io/faio";
include "std/io/socket";
include "std/io/iostream";
include "std/io/ansi_terminal";
include "std/io/filename";
include "std/io/filestat";
include "std/io/directory";
include "std/io/filesystem";
Simple Text I/O
//[textio.flx]

//$ These classes provide simple I/O for text, primarily intended for
//$ naive use, debugging etc. This is because there is no error
//$ handling. This simplifies usage at the expense of correctness,
//$ and so these routines should not be used in production code.

//$ Abstract input file.
class Input_file[input_file]
{
  //$ Open file for reading.
  virtual gen raw_fopen_input: string -> input_file;
  virtual gen raw_fopen_input_text: string -> input_file;

  gen fopen_input_text (f:string) : input_file =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[Open_input_text] " + f
    ;
    return raw_fopen_input_text f;
  }

  gen fopen_input (f:string) : input_file =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[Open_input] " + f
    ;
    return raw_fopen_input f;
  }

  //$ Check if the file was opened correctly.
  virtual gen valid : input_file -> bool;

  //$ Close file.
  virtual proc fclose: input_file;

  //$ Load the rest of an open file.
  virtual gen load: input_file -> string;

  //$ Read one line with the trailing end-line mark included.
  //$ Empty string indicates end of file.
  virtual gen readln: input_file -> string;

  // read up to n bytes from file
  virtual gen read: input_file * size -> string;

  //$ Read line excluding end of line marks.
  virtual gen iterator(f:input_file) (): opt[string] =>
    match readln f with
    | "" => None[string]
    | text => text.rstrip.Some
    endmatch
  ;

  /*
  instance Iterable[input_file, string] {
     gen iterator (f:input_file) () => Input_file[input_file]::iterator f ();
  }
  */

  //$ Check for end of file.
  virtual gen feof : input_file -> bool;
}

//$ Abstract output file.
class Output_file[output_file]
{
  //$ Open file for writing.
  virtual gen raw_fopen_output: string -> output_file;
  virtual gen raw_fopen_output_text: string -> output_file;

  //$ Open file for writing in append-only mode.
  virtual gen raw_fopen_append: string -> output_file;
  virtual gen raw_fopen_append_text: string -> output_file;

  gen fopen_output(f:string) : output_file =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[Open_output] " + f
    ;
    return raw_fopen_output f;
  }

  gen fopen_output_text(f:string) : output_file =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[Open_output_text] " + f
    ;
    return raw_fopen_output_text f;
  }

  gen fopen_append(f:string) : output_file =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[Open_append] " + f
    ;
    return raw_fopen_append f;
  }

  gen fopen_output_append_text(f:string) : output_file =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[Open_output_append_text] " + f
    ;
    return raw_fopen_append_text f;
  }

  //$ Check if the file was opened correctly.
  virtual gen valid : output_file -> bool;

  //$ Close file.
  virtual proc fclose: output_file;

  //$ Write one line adding the trailing end line mark.
  virtual proc writeln : output_file * string;

  //$ Write a string.
  virtual proc write : output_file * string;

  //$ Write a byte.
  virtual proc write : output_file * utiny;

  //$ Write a char.
  virtual proc write : output_file * char;

  //$ Flush the buffers.
  virtual proc fflush: output_file;

  //$ Save string to file
  proc save (fn:string, d:string)
  {
    var f = fopen_output fn;
    write$ f,d;
    fclose f;
  }

  // save list of strings to file
  // adds a newline to each string in list
  proc save (fn:string, lines:list[string])
  {
    var f = fopen_output fn;
    iter (proc (s:string) { writeln$ f,s; }) lines;
    fclose f;
  }

  //$ Write a space.
  proc space (s:output_file) { write (s, " "); };

  //$ Write end of line mark.
  proc endl (s:output_file) { write (s, "\n"); };

  //$ Write data with conversion using Str::str.
  proc fprint[T with Str[T]] (s:output_file, x:T) { write (s, str x); };

  //$ Write data with conversion using Str::str and end line mark.
  proc fprintln[T with Str[T]] (s:output_file, x:T) { write (s, str x+"\n"); };
}

//$ C standard IO with FILE*.
open class Cstdio {

  //$ C file type.
  type FILE = "FILE*" requires C89_headers::stdio_h;

  pod type ifile = "FILE*" requires C89_headers::stdio_h;
  pod type ofile = "FILE*" requires C89_headers::stdio_h;

  //$ Load file from filename.
  //$ Note: loaded in binary mode not text mode!
  fun raw_load: string -> string = "::flx::rtl::ioutil::load_file($1)"
    requires package "flx_ioutil";

  fun raw_load_text: string -> string = "::flx::rtl::ioutil::load_text_file($1)"
    requires package "flx_ioutil";

  fun load(f:string) : string =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[load] " + f
    ;
    return raw_load f;
  }

  fun load_text(f:string) : string =
  {
    if Env::getenv "FLX_FILE_MONITOR" != "" call
      eprintln$ "[load_text] " + f
    ;
    return raw_load_text f;
  }



  //$ Standard input, can be redirected by flx_run.
  const stdin: ifile = "PTF flx_stdin" requires property "needs_ptf";

  //$ Standard output, can be redirected by flx_run.
  const stdout: ofile = "PTF flx_stdout" requires property "needs_ptf";

  //$ Standard error, can be redirected by flx_run.
  const stderr: ofile = "PTF flx_stderr" requires property "needs_ptf";

  //$ Standard input, redirected by shell.
  const cstdin: ifile = "stdin";

  //$ Standard output, redirected by shell.
  const cstdout: ofile = "stdout";

  //$ Standard error, redirected by shell.
  const cstderr: ofile = "stderr";

  //$ C standard IO as instance of Input_file.
  instance Input_file[ifile] {
    requires package "flx_ioutil";
    gen raw_fopen_input: string -> ifile = 'fopen($1.c_str(),"rb")';
    gen raw_fopen_input_text: string -> ifile = 'fopen($1.c_str(),"r")';
    gen valid : ifile -> bool = "$1!=(FILE*)0";
    proc fclose: ifile = '(void)fclose($1);';
    gen load: ifile -> string = "::flx::rtl::ioutil::load_file($1)";
    gen readln: ifile -> string ="::flx::rtl::ioutil::readln($1)";
    gen read: ifile *size -> string = "::flx::rtl::ioutil::raw_read($1,$2)";
    gen feof : ifile -> bool = "feof($1)";
  }

  //$ C standard IO as instance of Output_file.
  instance Output_file[ofile] {
    requires package "flx_ioutil";
    gen raw_fopen_output: string -> ofile = 'fopen($1.c_str(),"wb")';
    gen raw_fopen_output_text: string -> ofile = 'fopen($1.c_str(),"w")';
    gen raw_fopen_append: string -> ofile = 'fopen($1.c_str(),"ab")';
    gen raw_fopen_append_text: string -> ofile = 'fopen($1.c_str(),"a")';
    gen valid : ofile -> bool = "$1!=(FILE*)0";
    proc fclose: ofile = '(void)fclose($1);';
    proc writeln : ofile * string ="::flx::rtl::ioutil::writeln($1,$2);";
    proc write : ofile * string ="::flx::rtl::ioutil::write($1,$2);";
    proc write : ofile * utiny ="fwrite($2,1,1,$1);";
    proc write : ofile * char ="fwrite($2,1,1,$1);";
    proc fflush: ofile = "fflush($1);";
  }
}

open Input_file[Cstdio::ifile];
// note we cannot open Iterable here because it would cause
// a conflict ;(

open Output_file[Cstdio::ofile];
//$ DEBUG OUTPUT UTIITIES!
//$ DO NOT REQUIRE THREAD FRAME.
//$ NOT REDIRECTABLE BY DRIVER.
//$ (can be redirected by OS if OS can do it)

//$ Write string to output.
proc print  [T with Str[T]] (x:T) { fprint (cstdout, x); };

//$ Write string to output with end of line. Also does a flush
//$ to improve synchronisation with cstderr.
proc println[T with Str[T]] (x:T) { fprintln (cstdout, x); fflush cstdout; };

//$ Write end of line on output.
proc endl() { endl cstdout; }

//$ Write space on cout.
proc space() { space cstdout; }

//$ flush buffers of cout.
proc fflush() { fflush cstdout; }

//$ Write string to cerr.
proc eprint  [T with Str[T]] (x:T) { fprint (cstderr, x); };

//$ Write string to cerr with end of line.
proc eprintln[T with Str[T]] (x:T) { fprintln (cstderr, x); fflush cstderr; };

//$ Write end of line on cerr.
proc eendl() { endl cstderr; }

//$ Write space on cerr.
proc espace() { space cstderr; }
Ansi Terminal
//[ansi_terminal.flx]

// Author Mike Maul
//$ #### Color output formatting for Ansi Terminals.
class AnsiTerminal
{
  const cc:char = "(char)27";

  // No colour
  fun  NC_ () => cc + '[0m';
  fun  NC_(s:string) => NC_() + s;
  proc NC()     { print$ NC_(""); }
  proc NC(s:string)     { print$ NC_(s); }

  // Blue
  fun blue_() => cc + '[1;34m';
  fun blue_(s:string) => blue_() + s + NC_();
  proc blue()   { print$ blue_(); }
  proc blue(s:string)   { print$ blue_(s); }
  fun BLUE_() => cc + '[1;34;1m';
  fun BLUE_(s:string) => BLUE_() + s + NC_();
  proc BLUE()   { print$ BLUE_(); }
  proc BLUE(s:string)   { print$ BLUE_(s); }

  // Cyan
  fun cyan_() => cc + '[0;36m';
  fun cyan_(s:string) => cyan_()+ s + NC_();
  proc cyan()   { print$ cyan_(); }
  proc cyan(s:string)   { print$ cyan_(s); }
  fun CYAN_() => cc + '[1;36;1m';
  fun CYAN_(s:string) => CYAN_() + s + NC_();
  proc CYAN()   { print$ CYAN_(); }
  proc CYAN(s:string)   { print$ CYAN_(s); }

  // Green
  fun green_() => cc + '[0;32m';
  fun green_(s:string) => green_() + s + NC_();
  proc green()  { print$ green_(); }
  proc green(s:string)   { print$ green_(s); }
  fun GREEN_() => cc + '[1;32;1m';
  fun GREEN_(s:string) => GREEN_() + s + NC_();
  proc GREEN()  { print$ GREEN_(); }
  proc GREEN(s:string)   { println$ GREEN_(s); }

  // Red
  fun red_() => cc + '[0;31m';
  fun red_(s:string) => red_()+ s + NC_();
  proc red()   { print$ red_(); }
  proc red(s:string)   { print$ red_(s); }
  fun RED_() => cc + '[0;31;1m';
  fun RED_(s:string) => red_()+ s + NC_();
  proc RED()   { print$ red_(); }
  proc RED(s:string)   { print$ red_(s); }

  // Yellow
  fun yellow_() => cc + '[0;33m';
  fun yellow_(s:string) => yellow_() + s + NC_();
  proc yellow() { print$ yellow_(); }
  proc yellow(s:string)   { print$ yellow_(s); }
  fun YELLOW_() => cc + '[1;33;1m';
  fun YELLOW_(s:string) => YELLOW_() + s + NC_();
  proc YELLOW() { print$ YELLOW_(); }
  proc YELLOW(s:string)   { print$ YELLOW_(s); }
}
Stream I/O
//[iostream.flx]

class IOStream {
  requires package "demux";
  requires package "faio";

  open Faio;

  if PLAT_POSIX do
    open Faio_posix;
    typedef fd_t = FileSystem::posix_file;
  else
    open Faio_win32;
    typedef fd_t = Faio_win32::fd_t;
  done

  // ---------------------------------------------------------------------------

  publish "The interface for a readable stream of bytes."
  class IByteStream[T] {
    publish "Read N bytes from the stream into the address."
    virtual proc read: T * &int * address * &bool;
  }

  publish "The interface for a writable stream of bytes."
  class OByteStream[T] {
    publish "Write N bytes from the address into the stream."
    virtual proc write: T * &int * address * &bool;
  }

  publish "The interface for a readable and writable stream of bytes."
  class IOByteStream[T] {
    inherit IByteStream[T];
    inherit OByteStream[T];
  }

  publish "A readable stream that can have it's read channel closed."
  class TerminalIByteStream[T] {
    inherit IByteStream[T];

    publish "Close the input stream."
    virtual proc iclose: T;
  }

  publish "A writable stream that can have it's write channel closed."
  class TerminalOByteStream[T] {
    inherit OByteStream[T];

    publish "Close the output stream."
    virtual proc oclose: T;
  }

  publish "A writable stream that can have it's channels closed."
  class TerminalIOByteStream[T] {
    inherit TerminalIByteStream[T];
    inherit TerminalOByteStream[T];

    publish "Close the stream."
    virtual proc ioclose: T;
  }

  // ---------------------------------------------------------------------------

  variant devnull_t = DEVNULL;

  publish "devnull_t"
  instance IByteStream[devnull_t]
  {
    proc read(strm: devnull_t, len: &int, buf: address, eof: &bool) {
      len <- 0;
      eof <- true;
    }
  }

  instance OByteStream[devnull_t]
  {
    proc write(strm: devnull_t, len: &int, buf: address, eof: &bool) {
      eof <- false;
    }
  }

  instance IOByteStream[devnull_t] {}
  instance TerminalIByteStream[devnull_t] { proc iclose (x:devnull_t) {} }
  instance TerminalOByteStream[devnull_t] { proc oclose (x:devnull_t) {} }
  instance TerminalIOByteStream[devnull_t] { proc ioclose (x:devnull_t) {} }

  // ---------------------------------------------------------------------------

  publish "fd_t -- native file handle (disk file)"
  instance IByteStream[fd_t]
  {
    if PLAT_POSIX do
      gen cread: fd_t * int * address -> int = "read($1,$2,$3)";
      proc read(fd: fd_t, len: &int, buf: address, eof: &bool) {
        var oldlen = *len;
        len <- cread(fd, *len, buf);
        eof <- oldlen < *len;
      }
    else
      // int32 = DWORD
      gen ReadFile: fd_t * address * int32 * &int32 -> bool =
        "ReadFile($1,$2,$3,$4,NULL)"
      ;
      proc read(fd: fd_t, len: &int, buf: address, eof: &bool) {
        var oldlen = *len;
        var readin: int32;
        var res = ReadFile(fd, buf, len*.int32, &readin);
        len <- readin.int;
        eof <- res or (oldlen < *len);
      }
    done
  }

  instance OByteStream[fd_t]
  {
    if PLAT_POSIX do
      gen cwrite: fd_t * int * address -> int = "write($1,$2,$3)";
      proc write(fd: fd_t, len: &int, buf: address, eof: &bool) {
        var oldlen = *len;
        len <- cwrite(fd, *len, buf);
        eof <- oldlen < *len;
      }
    else
      // int32 = DWORD
      gen WriteFile: fd_t * address * int32 * &int32 -> bool =
        "WriteFile($1,$2,$3,$4,NULL)"
      ;
      proc write(fd: fd_t, len: &int, buf: address, eof: &bool) {
        var oldlen = *len;
        var written: int32;
        var res = WriteFile(fd, buf, len*.int32, &written);
        len <- written.int;
        eof <- res or (oldlen < *len);
      }
    done
  }

  instance IOByteStream[fd_t] {}

  instance TerminalIByteStream[fd_t]
  {
    proc iclose (fd: fd_t) {
      if PLAT_POSIX do
        C_hack::ignore(FileSystem::close fd);
      else
        CloseFile fd;
      done
    }
  }

  instance TerminalOByteStream[fd_t]
  {
    proc oclose (fd: fd_t) {
      if PLAT_POSIX do
        C_hack::ignore(FileSystem::close fd);
      else
        CloseFile fd;
      done
    }
  }

  instance TerminalIOByteStream[fd_t]
  {
    proc ioclose (fd: fd_t) {
      if PLAT_POSIX do
        C_hack::ignore(FileSystem::close fd);
      else
        CloseFile fd;
      done
    }
  }

  // ---------------------------------------------------------------------------

  publish "Read the input stream to the output stream."
  proc cat[istr,ostr with IByteStream[istr], OByteStream[ostr]] (
    istream: istr,
    ostream: ostr,
    buf: address,
    bufsize: int)
  {
    var reof = false;
    var weof = false;
    var len: int;

    // if we finish input, stop. if output eofs, don't keep hammering on it!
    while not reof and not weof do
      len = bufsize;
      read (istream, &len, buf, &reof);
      write(ostream, &len, buf, &weof);
    done
  }

  publish "Read the input stream to the output stream."
  proc cat[istr,ostr with IByteStream[istr], OByteStream[ostr]] (
    istream: istr,
    ostream: ostr)
  {
    val BUFSIZE = 100000;
    var buf = Memory::malloc(BUFSIZE);

    // that's some nice error checking
    cat (istream, ostream, buf, BUFSIZE);

    Memory::free (buf);
  }

  publish "Read all the input streams to the output stream."
  proc cat[istr,ostr with IByteStream[istr], OByteStream[ostr]] (
    istreams: list[istr],
    ostream: ostr,
    buf: address,
    bufsize: int)
  {
    List::iter (proc (istream:istr) {
      cat (istream, ostream, buf, bufsize);
    }) istreams;
  }

  publish "Compare the results of two streams."
  proc stream_cmp[istr1,istr2 with IByteStream[istr1], IByteStream[istr2]] (
    stream1: istr1,
    stream2: istr2,
    buf1: address,
    buf2: address,
    bufsize: int,
    sign: &int)
  {
    var eof1 = false;
    var eof2 = false;
    var len1: int;
    var len2: int;
    var terminated = false;
    var cmp = 0;

    while cmp == 0 and not terminated do
      len1 = bufsize; read(stream1, &len1, buf1, &eof1);
      len2 = bufsize; read(stream2, &len2, buf2, &eof2);

      len := min(len1, len2);

      // It's very unfortunate that memcmp doesn't return the position of the
      // first non-equality
      cmp = Memory::memcmp(buf1, buf2, size len);

      if cmp == 0 do
        cmp = len1 - len2;
        if cmp == 0 do
          terminated = eof1 and eof2;
          cmp =
            // ugg: false = case 0, true = case 1
            match eof1, eof2 with
            | case 1, case 1 => 0
            | case 0, case 0 => 0
            | case 0, case 1 => 1
            | case 1, case 0 => -1
            endmatch
          ;
        done
      done
    done

    sign <- cmp;
  }


  publish "Compare the results of two streams."
  proc cmp[istr1, istr2 with IByteStream[istr1], IByteStream[istr2]] (
    istream1: istr1,
    istream2: istr2,
    res: &int)
  {
    val BUFSIZE = 100000;
    var buf1 = Memory::malloc(BUFSIZE);
    var buf2 = Memory::malloc(BUFSIZE);
    stream_cmp(istream1, istream2, buf1, buf2, BUFSIZE, res);
    Memory::free(buf1);
    Memory::free(buf2);
  }

  publish "Read the results of a stream back into it's stream."
  proc echo[iostr with IOByteStream[iostr]] (
    iostream: iostr,
    buf: address,
    bufsize: int)
  {
    // echo a = cat a a. that's deep, man.
    cat(iostream, iostream, buf, bufsize);
  }

  publish "Read in from a stream and write to two streams."
  proc tee[istr,ostr with IByteStream[istr], OByteStream[ostr]] (
    istream: istr,
    ostream1: ostr,
    ostream2: ostr)
  {
    var reof  = false;
    var weof1 = false;
    var weof2 = false;
    var len: int;

    val BUFSIZE = 10*1024;
    var buf = Memory::malloc(BUFSIZE);

    // don't hammer!
    while not reof and not weof1 and not weof2 do
      len = BUFSIZE;
      read  (istream,  &len, buf, &reof);
      write (ostream1, &len, buf, &weof1);
      write (ostream2, &len, buf, &weof2);
    done

    Memory::free buf;
  }

  // highly inefficient!
  noinline proc get_line[istr with IByteStream[istr]] (
    istream: istr,
    s: &string)
  {
//println$ "get_line starts";
    var c: char;
    val ac = address (&c);
    var st: string="";
    var finished = false;

    while not finished do
      var len = 1;
      var eof: bool;

//println$ "read 1 byte";
      read(istream, &len, ac, &eof);
//println$ if eof then "EOF" else "not EOF" endif;
//println$ "Char = " + str(ord c) + "='"+str c+"'";
      if eof or c == char '\n' do
        finished = true;
      else
        st += c;
      done
    done
    s <- st;  // pass back result
  }

  proc write_string[ostr with OByteStream[ostr]] (
    ostream: ostr,
    var s: string,
    eof: &bool)
  {
    var slen = s.len.int;
    var a = C_hack::cast[address]$ cstr s;
    write(ostream, &slen, a, eof);
  }
} // class Stream
TCP/IP Sockets

These sockets are ONLY for TCP/IP.

//[socket.flx]

class Socket_class[socket_t] {
  requires package "demux";

  virtual proc mk_listener: &socket_t * &int * int;
  virtual proc accept: socket_t * &socket_t;
  virtual proc shutdown: socket_t * int;
  virtual proc connect: &socket_t * +char * int * &int;

  inherit IOStream::IByteStream[socket_t];
  inherit IOStream::OByteStream[socket_t];
  inherit IOStream::IOByteStream[socket_t];
  inherit IOStream::TerminalIByteStream[socket_t];
  inherit IOStream::TerminalOByteStream[socket_t];
  inherit IOStream::TerminalIOByteStream[socket_t];
}
Posix sockets
//[socket.flx]
class PosixSocket
{
  requires package "demux";
  typedef socket_t = Faio_posix::socket_t;
  inherit Socket_class[socket_t];
  instance Socket_class[socket_t]
  {
    proc mk_listener (l:&socket_t, port: &int, qlen:int) =>
      Faio_posix::mk_listener(l, port, qlen)
    ;

    proc accept (l:socket_t, s:&socket_t) =>
      Faio_posix::accept(s, l)  // success or not? error checking
    ;

    proc shutdown(s: socket_t, how: int) =>
      Faio_posix::shutdown(s, how)
    ;

    proc connect(s: &socket_t, addr: +char, port: int, err: &int) =>
        Faio_posix::connect(s, addr, port, err)
    ;

  }

  //
  // socket_t
  //
  instance IOStream::IByteStream[socket_t]
  {
    proc read(s: socket_t, len: &int, buf: address, eof: &bool)
      { Faio_posix::async_read(s, len, buf, eof); }
  }

  instance IOStream::OByteStream[socket_t]
  {
    proc write(s: socket_t, len: &int, buf: address, eof: &bool)
      {
        //println$ "faio/socket.flx: Stream::OByteStream[socket_t]: write(s,"+str (*len)+",buf,"+str(*eof)+") calling async_write ..";
        Faio_posix::async_write(s, len, buf, eof);
        //println$ "faio/socket.flx: Stream::OByteStream[socket_t]: write(s,"+str (*len)+",buf,"+str(*eof)+") called async_write ..";
      }
  }

  instance IOStream::IOByteStream[socket_t] {}

  instance IOStream::TerminalIByteStream[socket_t]
  {
    proc iclose (s:socket_t)
      { Faio_posix::shutdown (s,0); Faio_posix::close s; }
  }

  instance IOStream::TerminalOByteStream[socket_t]
  {
    proc oclose (s:socket_t)
      { Faio_posix::shutdown (s,1); Faio_posix::close s; }
  }

  instance IOStream::TerminalIOByteStream[socket_t]
  {
    proc ioclose (s:socket_t)
      {
        // RF: just close, I don't think any of this stuff is necessary.
        // I think this is an application level problem.
        //fprint (cstderr,q"STREAM:Closing socket $s\n");
        //Faio_posix::shutdown(s,2);
        //Faio::sleep (Faio::sys_clock,5.0);
        /*
        var len = 1; var eof = false; var buf = Memory::malloc(1);
        Faio_posix::async_read(s, &len, buf, &eof);
        fprint (cstderr,q"STREAM:socket $s, eof=$eof\n");
        Faio_posix::shutdown(s,0);
        */
        Faio_posix::close s;
      }
  }

}
Windows sockets
//[socket.flx]
class Win32Socket
{
  requires package "demux";
  typedef socket_t = Faio_win32::socket_t;
  inherit Socket_class[socket_t];
  instance Socket_class[socket_t]
  {
    proc mk_listener (l:&socket_t, port: &int, qlen:int) =>
      Faio_win32::mk_listener(l, port, qlen)
    ;
    proc accept (var l:socket_t, s:&socket_t)
    {
      var success: bool;
      Faio_win32::mk_socket(s);  // error check?
      Faio_win32::Accept(&success, l, *s);
      if not success do
        fprint (cstdout, "Accept failed! num?\n");
      done
    }

    proc shutdown(s: socket_t, how: int) =>
      Faio_win32::shutdown(s, how)
    ;

    proc connect(s: &socket_t, addr: +char, port: int, err: &int) =>
      Faio_win32::Connect(s, addr, port, err)
    ;

  }

  //
  // socket_t
  //
  instance IOStream::IByteStream[socket_t]
  {
    proc read(s: socket_t, len: &int, buf: address, eof: &bool) =>
      Faio_win32::WSARecv(s, len, buf, eof)
    ;
  }

  instance IOStream::OByteStream[socket_t]
  {
    proc write(s: socket_t, len: &int, buf: address, eof: &bool) =>
      Faio_win32::WSASend(s, len, buf, eof)
    ;
  }

  instance IOStream::IOByteStream[socket_t] {}

  instance IOStream::TerminalIByteStream[socket_t]
  {
    proc iclose (s:socket_t) =>
      Faio_win32::closesocket s
    ;
  }

  instance IOStream::TerminalOByteStream[socket_t]
  {
    proc oclose (s:socket_t) =>
      Faio_win32::closesocket s
    ;
  }

  instance IOStream::TerminalIOByteStream[socket_t]
  {
    proc ioclose (s:socket_t) =>
      Faio_win32::closesocket s
    ;
  }
}
Host sockets
//[socket.flx]

class Socket
{
  if PLAT_WIN32 do
    inherit Win32Socket;
  elif PLAT_POSIX do
     inherit PosixSocket;
  else
     ERROR;
  done
}
Demux: Felix Event notification service
//[demux.flx]

class Demux
{
  type demuxer = "::flx::demux::flx_demuxer_t*"
    requires package "demux"
  ;
  gen mk_sys_demux: 1->demuxer = "::flx::demux::make_std_demuxer()";
  var sys_demux =  mk_sys_demux();
}
Faio: Felix Asynchronous I/O service
//[faio.flx]

class Faio {
  requires package "demux";
  requires package "faio";

  open C_hack;

  proc faio_req[t](preq: &t ) { // FIXME: HACK! It has to be driver request base
    var p = C_hack::cast[driver_request_base]preq;
    svc (svc_general p);
  }

// this svc call doesn't exist now
/*
  proc get_thread(thread: &fthread) {
      svc (svc_get_fthread thread );
  }
*/

  type sel_param = "flx::demux::sel_param";
  type sel_param_ptr = "flx::demux::sel_param*";

  fun get_bytes_done : sel_param_ptr -> int = '$1->bytes_written';
  proc init_pb : sel_param*address*int
  = '{$1.buffer=(char*)$2;$1.buffer_size=$3;$1.bytes_written=0;}';

  proc calc_eof(pb: sel_param_ptr, len: &int, eof: &bool)
  {
      //println "Calc_eof ..";
      var bytes_done = pb.get_bytes_done;
      //println$ "Bytes done = "+ str bytes_done;
      //println$ "Req len= "+ str (*len);
      eof <- (bytes_done != *len);
      //println$ "Eof = " + str (*eof);
      len <- bytes_done;
      //println$ "Reset len to bytes done ..";
  }

  type sleep_request_t = 'flx::faio::sleep_request' requires package "timer";
  type alarm_clock_t = 'flx::demux::timer_queue*' requires package "timer";

  fun mk_alarm_clock: 1 -> alarm_clock_t = '::flx::demux::mk_timer_queue()';
  fun mk_sleep_request: alarm_clock_t * double -> sleep_request_t = '::flx::faio::sleep_request($1,$2)';

  proc sleep(clock: alarm_clock_t, delta: double)
  {
    var sr = mk_sleep_request$ clock,delta;
    faio_req$ &sr;
  }

  // this should be deleted if not used!
  var clock = mk_alarm_clock();
  proc sleep (delta:double) { sleep (clock,delta); }

} // class faio
Posix Faio
//[posix_faio.flx]

class Faio_posix  {
header faio_posixio_hpp = '#include "faio_posixio.hpp"';
requires package "demux";
requires package "faio";
open C_hack;        // cast, address
open Faio;
open Pthread;
open Demux;
open Posix_headers;

header sockety_h = '#include "demux_sockety.hpp"';  // my socket utils
header '#include "faio_posixio.hpp"';

// ------------ core file and socket definitions ----------------
typedef fd_t = PosixFileSystem::posix_file;

// type of a socket
type socket_t = "int";

// a size type for use in some socket functions
// stupid confused Unix standard!
type socklen_t="socklen_t" requires sockety_h;
ctor socklen_t : int = "$1";
ctor int : socklen_t = "$1";

// A socket address consists of
// 1. a port number
// 2. an address family indicator
// 3. the encoded address, dependent on the family
//
// We deal only with Internet addresses IPv4 and IPv6,
// indicator AF_INET and AF_INET6
//
// type of socket address protocol family
type sa_family_t = "sa_family_t" requires sys_socket_h;
fun ==: sa_family_t * sa_family_t -> bool = "$1==$2";

type in_port_t = "in_port_t" requires netinet_in_h;

const AF_INET : sa_family_t;
const AF_INET6 : sa_family_t;

// type to allocate on stack to hold any socket address for any protocol
// required for stack allocations
type sockaddr_storage_t = "struct sockaddr_storage" requires sockety_h;
fun ss_family : &sockaddr_storage_t -> sa_family_t = "$1->ss_family";

// type of a socket address
type sockaddr_t = "struct sockaddr" requires sockety_h;
fun sa_family : &sockaddr_t -> sa_family_t = "$1->sa_family";

// cast socket address storage object pointer to socket address pointer
fun sockaddr_p : &sockaddr_storage_t -> &sockaddr_t = "(struct sockaddr*)$1";
axiom inet_family(ss: &sockaddr_storage_t) : ss_family ss == sa_family (sockaddr_p ss);

// --------------------------------------------------------------
// IPv4
// type containing IPv4 internet address
type in_addr_t = "in_addr_t" requires netinet_in_h; // an integer
type struct_in_addr = "struct in_addr";
fun s_addr: struct_in_addr -> in_addr_t = "$1.s_addr";

// type containing encoded port and IPv4 address
type sockaddr_in_t = "struct sockaddr_in" requires sockety_h;
fun sin_family: sockaddr_in_t -> sa_family_t= "$1.sin_family";
fun sin_port : sockaddr_in_t -> in_port_t= "$1.sin_port";
fun sin_addr : sockaddr_in_t -> struct_in_addr = "$1.sin_addr";
fun sin_addr : &sockaddr_in_t -> &struct_in_addr = "&($1->sin_addr)";


// --------------------------------------------------------------
// IPv6
// type containing IPv6 internet address
type struct_in6_addr = "struct in6_addr";
typedef ipv6_addr = uint8^16;
fun s6_addr: struct_in6_addr -> &ipv6_addr = "$1.s6_addr";

// type containing encoded socket address for IPv6
type sockaddr_in6_t = "struct sockaddr_in6" requires sockety_h;
fun sin6_family: sockaddr_in6_t -> sa_family_t= "$1.sin6_family";
fun sin6_port : sockaddr_in6_t -> in_port_t = "$1.sin6_port";
fun sin6_addr : sockaddr_in6_t -> struct_in6_addr = "$1.sin6_addr";
fun sin6_addr : &sockaddr_in6_t -> &struct_in6_addr = "&($1->sin6_addr)";


// convert Internet address to display format.
// $1: Address family
// $2: pointer to the address
// $3: pointer to output buffer
// $4: length of output buffer
fun inet_ntop: sa_family_t * address * +char * socklen_t -> +char requires arpa_inet_h;;
const INET_ADDRSTRLEN : socklen_t requires arpa_inet_h;
const INET6_ADDRSTRLEN : socklen_t requires arpa_inet_h;

// --------------------------------------------------------------

instance Str[FileSystem::posix_file] {
  fun str: FileSystem::posix_file -> string = "::flx::rtl::strutil::str<int>($1)" requires package "flx_strutil";
}

instance Str[socket_t] {
  fun str: socket_t -> string = "::flx::rtl::strutil::str<int>($1)" requires package "flx_strutil";
}

fun getpeername: socket_t * &sockaddr_t * &socklen_t -> int;

fun getpeername (s: socket_t) : string =
{
  // store for encoded IP address
  var sa:sockaddr_storage_t;
  var paddr : &sockaddr_t = sockaddr_p &sa; // cast

  // length of encoded IP address
  var nsa = C_hack::cast[socklen_t] sizeof[sockaddr_storage_t];

  // get encoded peer address
  var res = getpeername (s,  paddr, &nsa);
  if res == -1 return "";

  var p = C_hack::cast[+char] null[char];
  var ips = "";
  var family = ss_family &sa;
  match family with
  | $(AF_INET) =>
    begin
      var buffer = C_hack::cast[+char] (Memory::malloc INET_ADDRSTRLEN.int);
      // cast to IPv4 socket address
      var inet_sockaddr = C_hack::cast[&sockaddr_in_t] paddr;
      // extract pointer to IPv4 internet address
      var p_ipnumber : &struct_in_addr = inet_sockaddr.sin_addr;
      p = inet_ntop
        (
          family,
          C_hack::cast[address] p_ipnumber,
          buffer,
          INET_ADDRSTRLEN
        )
      ;
      if not p.isNULL do ips = str p; done
      Memory::free (C_hack::cast[address] buffer);
    end

  | $(AF_INET6) =>
    begin
      var buffer = C_hack::cast[+char] (Memory::malloc INET6_ADDRSTRLEN.int);
      // cast to IPv6 socket address
      var inet6_sockaddr = C_hack::cast[&sockaddr_in6_t] paddr;
      // extract IPv6 internet address (address of a byte array)
      var p_ip6number : &struct_in6_addr = inet6_sockaddr.sin6_addr;
      p = inet_ntop
        (
          family,
          C_hack::cast[address] p_ip6number,
          buffer,
          INET6_ADDRSTRLEN
        )
      ;
      if not p.isNULL do ips = str p; done
      Memory::free (C_hack::cast[address] buffer);
    end

  | _ => ;
  endmatch
  ;
  return ips;

}

proc close: socket_t = 'close($1);' requires Posix_headers::unistd_h;
proc shutdown: socket_t*int = 'shutdown($a);' requires Posix_headers::sys_socket_h;
fun bad_socket : socket_t -> bool = "$1 == -1";


// socketio_request should be renamed to be async_fd_request
type socketio_request = "::flx::faio::socketio_request";

gen mk_socketio_request: demuxer * socket_t*address*int*bool -> socketio_request
    = '::flx::faio::socketio_request($1, $2, (char*)$3, $4, $5)';

fun get_pb: socketio_request -> sel_param_ptr = '&$1.sv.pb';

// read & write differ only by a flag
proc async_rw(fd: socket_t, len: &int, buf: address, eof: &bool, read_flag: bool)
{
    //println$ "faio/flx_faoi_posix.flx: async_rw (s,"+str (*len)+",buf,"+str(*eof)+", "+str read_flag+") calling mk_socketio_req ..";
    var asyncb = mk_socketio_request(sys_demux,fd, buf, *len, read_flag);
    faio_req$ &asyncb;
    //println$ "faio/flx_faoi_posix.flx: async_rw ("+ str fd+", "+str (*len)+",buf,"+str(*eof)+", "+str read_flag+") calculating eof ..";

    calc_eof(asyncb.get_pb, len, eof);
    //println$ "faio/flx_faoi_posix.flx: async_rw (s,"+str (*len)+",buf,"+str(*eof)+", "+str read_flag+") called mk_socketio_req ..";
}

proc async_read(fd: socket_t, len: &int, buf: address,
    eof: &bool)
{
    async_rw(fd, len, buf, eof, true);      // read
}

proc async_write(fd: socket_t, len: &int, buf: address, eof: &bool)
{
    //println$ "faio/flx_faoi_posix.flx: async_write(s,"+str (*len)+",buf,"+str(*eof)+" calling async_rw ..";
    async_rw(fd, len, buf, eof, false);     // write
    //println$ "faio/flx_faoi_posix.flx: async_write(s,"+str (*len)+",buf,"+str(*eof)+" call async_rw ..";
}

// connect!
type async_connect = '::flx::faio::connect_request';

fun mk_async_connect: demuxer * +char *int-> async_connect = '::flx::faio::connect_request($a)';
fun get_socket: async_connect -> socket_t = '$1.s';
fun get_err: async_connect -> int = '$1.socket_err';

// could do multi connects for capable drivers
proc connect(s: &socket_t, addr: +char, port: int, err: &int)
{
    var ac = mk_async_connect(sys_demux,addr, port);
    faio_req$ &ac;
    err <- ac.get_err;
    s <- ac.get_socket;
}

type accept_request = "::flx::faio::accept_request";

fun mk_accept: demuxer * socket_t -> accept_request = '::flx::faio::accept_request($1,$2)';
fun get_socket: accept_request -> socket_t = '$1.accepted';

// arg1 = returned socket, arg2 is port, pass 0 to have one assigned
proc mk_listener: &socket_t* &int *int
    = '*$1 = ::flx::demux::create_async_listener($2, $3);' requires sockety_h;

proc accept(s: &socket_t, listener: socket_t)
{
    var acc = mk_accept$ sys_demux,listener;
    faio_req$ &acc;
    s <- acc.get_socket;
}

} // class faio_posix
Win32 Faio
//[win32_faio.flx]


module Faio_win32 {
requires package "demux";
requires package "faio";
// contains windows overlapped/iocp io & copipes. no stream wrapper yet.
open C_hack;
open Faio;
open Demux;

header '#include "faio_winio.hpp"'; // this has everything (includes asyncio.h)

// ------------ core file and socket definitions ----------------
// I could just use HANDLEs everywhere, but I want to see how this goes
type WFILE = 'HANDLE';
typedef fd_t = WFILE;

const INVALID_HANDLE_VALUE: WFILE = 'INVALID_HANDLE_VALUE';
fun == : WFILE*WFILE -> bool = '($1 == $2)';

type SOCKET = "SOCKET";
typedef socket_t = SOCKET;

instance Str[socket_t] {
   fun str: socket_t -> string = "::flx::rtl::strutil::str<int>($1)" requires package "flx_strutil";
}

// --------------------------------------------------------------

// useful windows function
fun GetLastError: 1 -> int = 'GetLastError()';

// maybe don't use this - let the socket be passed in already associated
// with an IOCP. do I have to make this explicitly overlapped? If we
// want async io I think I'll need to associate this with the iocp.
fun cmk_socket : unit -> SOCKET = '::socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)';

// well that didn't help.
//fun cmk_socket : unit -> SOCKET = 'WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED)';
// must associate with iocp to do overlapped io with s (WSASend/Recv)
proc mk_socket(s: &SOCKET)
{
    s <- cmk_socket();
    associate_with_iocp(*s);                // associate with iocp (errors?).
}


type wasync_accept = "flx::faio::wasync_accept";

fun mk_accept: demuxer *  SOCKET*SOCKET -> wasync_accept = 'flx::faio::wasync_accept($a)';
// make this a parameterised type
fun get_success[t]: t -> bool = '$1.success';

// this feels silly
const INVALID_SOCKET: SOCKET = 'INVALID_SOCKET';
// oops, no good if we can't check against it
fun eq : SOCKET*SOCKET -> bool = '($1 == $2)';

// windows style accept. accepted is an already created socket, unbound
proc Accept(success: &bool, listener: SOCKET, accepted: SOCKET)
{
    var acc = mk_accept(sys_demux,listener, accepted);
    faio_req$ &acc;    // causes AcceptEx to be called
    success <- get_success(acc);
}

type connect_ex="flx::faio::connect_ex";
fun mk_connect_ex: demuxer * SOCKET*+char*int -> connect_ex = 'flx::faio::connect_ex($a)';

// for use on sockets you make yourself, who knows, maybe you want to
// reuse them
proc Connect(s: SOCKET, addr: +char, port: int, err: &int)
{
    var con = mk_connect_ex(sys_demux,s, addr, port);
    faio_req$ &con;    // causes ConnectEx to be called
    var success = get_success(con);
    err <- if success then 0 else -1 endif;
}

proc Connect(s: &SOCKET, addr: +char, port: int, err: &int)
{
    mk_socket s;            // error handling?
    Connect(*s, addr, port, err);
}

// listens on all interfaces, I guess
proc cmk_listener: &SOCKET*&int*int
    = '*$1 = flx::demux::create_listener_socket($2, $3);';

proc mk_listener(listener: &SOCKET, port: &int, backlog: int)
{
    cmk_listener(listener,port, backlog);
    associate_with_iocp(*listener);
}

// ignores return value
proc closesocket: SOCKET = 'closesocket($1);';

const SD_RECEIVE:int = 'SD_RECEIVE';
const SD_SEND:int = 'SD_SEND';
const SD_BOTH:int = 'SD_BOTH';

proc shutdown: SOCKET*int = 'shutdown($1, $2);';

type wasync_transmit_file = "flx::faio::wasync_transmit_file";

// hacked for ro atm. the 0 means exclusive (not good, but I haven't deciphered
// the flags yet. NULL for non inheritable security attributes.
// OPEN_EXISTING is to make sure it doesn't create the file
// Geez, FILE_ATTRIBUTE_NORMAL? not hidden, not temp, etc.
// final NULL is for template file. not sure what it does, but I don't want it.
// notice that it's opened for SHARED reading
gen OpenFile: string -> WFILE =
  '''CreateFile($1.c_str(), FILE_READ_DATA, FILE_SHARE_READ, NULL,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OVERLAPPED, NULL)''';

// basically for windows named pipes
gen OpenFileDuplex: string -> WFILE =
  '''CreateFile($1.c_str(), FILE_READ_DATA | FILE_WRITE_DATA,
     FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
     FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OVERLAPPED, NULL)''';

proc CloseFile: WFILE = '''if(!CloseHandle($1))
  fprintf(stderr, "CloseHandle(WFILE) failed: %i\\n", GetLastError());''';

// error handling?
// proc CloseFile: WFILE = 'CloseHandle($1);';

fun mk_transmit_file : demuxer * SOCKET*WFILE -> wasync_transmit_file
    = 'flx::faio::wasync_transmit_file($a)';

// toylike interface for now, but still fun
proc TransmitFile(s: SOCKET, f: WFILE)
{
    var tf = mk_transmit_file(sys_demux,s, f);
    faio_req$ &tf;
}

// by passing special flags to TransmitFile we can transform a connected
// socket into a socket ready for use with AcceptEx. DisconnectEx explicitly
// does this and without the warning that accept-style & connect-style sockets
// cannot be reused as the other type (which isn't a problem for my use)
// however I already have TransmitFile code in place.
fun mk_reuse_socket : demuxer * SOCKET -> wasync_transmit_file
    = 'flx::faio::wasync_transmit_file($a)';

proc ReuseSocket(s: SOCKET)
{
    var tf = mk_reuse_socket(sys_demux,s);
    faio_req$ &tf;
}

type wsa_socketio = "flx::faio::wsa_socketio";
gen mk_wsa_socketio: demuxer * SOCKET*sel_param_ptr*bool->wsa_socketio = 'flx::faio::wsa_socketio($a)';

private fun to_ptr : sel_param -> sel_param_ptr = '&$1';


proc WSARecv(s: SOCKET, len: &int, buf: address, eof: &bool)
{
    var pb: sel_param;
    init_pb(pb, buf, *len);
    var ppb: sel_param_ptr = to_ptr pb;

    var rev = mk_wsa_socketio(sys_demux,s, ppb, true);  // reading
    faio_req$ &rev;
// we do have a success flag
    calc_eof(ppb, len, eof);
}

proc WSASend(s: SOCKET, len: &int, buf: address, eof: &bool)
{
    var pb: sel_param;
    init_pb(pb, buf, *len);
    var ppb: sel_param_ptr = to_ptr pb;

    var rev = mk_wsa_socketio(sys_demux,s, ppb, false); // writing
    faio_req$ &rev;
    calc_eof(ppb, len, eof);
}


// general request for addition of socket to iocp. might be better to
// just create them that way.
type iocp_associator = "flx::faio::iocp_associator";
fun mk_iocp_associator: demuxer * SOCKET -> iocp_associator = 'flx::faio::iocp_associator($a)';

// this ends up just casting to a handle, so I should be able to use
// this for other HANDLEs. Note that the user cookie is not settable
// via this interface.
proc associate_with_iocp(s: SOCKET)
{
    // results? err code?
    var req = mk_iocp_associator(sys_demux, s);
    faio_req$ &req;
}

} // module win32_faio

Package: src/packages/program.fdoc

Program

key file
__init__.flx share/lib/std/program/__init__.flx
env.flx share/lib/std/program/env.flx
cmdopt.flx share/lib/std/program/cmdopt.flx
shell.flx share/lib/std/program/shell.flx
posix_shell.flx share/lib/std/posix/shell.flx
win32_shell.flx share/lib/std/win32/shell.flx
process.flx share/lib/std/program/process.flx
posix_errno.flx share/lib/std/posix/errno.flx
posix_process.flx share/lib/std/posix/process.flx
win32_process.flx share/lib/std/win32/process.flx
signal.flx share/lib/std/program/signal.flx
posix_signal.flx share/lib/std/posix/signal.flx
win32_signal.flx share/lib/std/win32/signal.flx
system.flx share/lib/std/program/system.flx
Synopsis
//[__init__.flx]

include "std/program/cmdopt";
include "std/program/system";
include "std/program/shell";
include "std/program/dynlink";
include "std/program/env";
include "std/program/process";
include "std/program/signal";
Environment Variables
//[env.flx]
//$ Access environment variables.
class Env_class[os]
{
  //$ Separator for filename lists
  virtual fun pathsep: 1 -> string;

  //$ Get the value of a given variable.
  //$ Returns empty string if the variable doesn't exist.
  fun getenv:string -> string =
    "::flx::rtl::strutil::atostr(std::getenv($1.c_str()))"
    requires package "flx_strutil", Cxx_headers::cstdlib;

  fun issetenv(s:string)=> getenv s != "";

  //$ Get the value of a given variable.
  //$ Returns specified default if the variable doesn't exist.
  fun getenv(name:string,dflt:string):string=>let result = getenv(name) in
    if String::len result != 0uz then result else dflt endif
  ;

  fun getenvlist (name:string) : list[string] =>
     split (getenv name, #pathsep)
  ;
}

instance Env_class[Win32] { fun pathsep() => ";"; }
instance Env_class[Posix] { fun pathsep() => ":"; }

class Env
{
  if PLAT_WIN32 do
    inherit Env_class[Win32];
  else
    inherit Env_class[Posix];
  done
}
Command Line Options
//[cmdopt.flx]

open class CmdOpt
{
  // Convert key/value pairs represented like -I path
  // into form --include=path
  noinline fun cvt-key-arg (keys: list[string * string]) (x:list[string]) =
  {
     var out = Empty[string];
     var inp = x.iterator;
     for word in inp do
       match keys.find word with
       | #None => out = Cons (word,out);
       | Some prefix =>
         match inp() with
         | #None => println$ "Error, expected argument to option " + word;
         | Some arg => out = Cons (prefix+"=" + arg, out);
         endmatch;
       endmatch;
     done
     return rev out;
  }

  // Parse key value pairs represented by --key=value.
  // Allows multiple values to be given.
  // Stores reversed list of values.
  // Returns ordered list of non-handled elements.
  var rekv = RE2 "(--.*)=(.*)";
  noinline gen parse-key-multi-value (keys:list[string]) (d:strdict[list[string]]) (x:list[string]) =
  {
    var out = Empty[string];
    var va = varray[StringPiece] (StringPiece "", StringPiece "", StringPiece "");
    for opt in x do
      if Match (rekv, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
        var key = va . 1 . string;
        if key in keys do
          val value= va . 2 . string ;
          val nuval = Cons (value, d.get_dflt (key,Empty[string]));
          d.add key nuval;
        else
          out = Cons (opt, out);
        done
      else
        out = Cons (opt, out);
      done
    done
    return rev out;
  }

  // Parse key value pairs represented by --key=value.
  // Keys must be unique.
  // Stores reversed list of values.
  // Returns ordered list of non-handled elements.
  noinline gen parse-key-single-value (keys:list[string]) (d:strdict[string]) (x:list[string]) =
  {
    var out = Empty[string];
    var va = varray[StringPiece] (StringPiece "", StringPiece "", StringPiece "");
    for opt in x do
      if Match (rekv, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
        var key = va . 1 . string;
        if key in keys do
          val value= va . 2 . string ;
          match d.get key with
          | #None => d.add key value;
          | _ => println$ "Duplicate option '" + opt +"'";
          endmatch;
        else
          println$ "Invalid option '" + opt+"'";
        done
      else
        out = Cons (opt, out);
      done
    done
    return rev out;
  }


  // Parse keys given by --key.
  // Allows multiple values.
  // Stores count of occurences.
  var rek = RE2 "(--.*)";
  noinline gen parse-key (keys:list[string]) (d:strdict[int]) (x:list[string]) =
  {
    var out = Empty[string];
    var va = varray[StringPiece] (StringPiece "", StringPiece "");
    for opt in x do
      if Match (rek, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
        var key = va . 1 . string;
        if key in keys do
          val nuval =d.get_dflt (key,0) + 1;
          d.add key nuval;
        else
          println$ "Invalid option '" + opt+"'";
        done
      else
        out = Cons (opt, out);
      done
    done
    return rev out;
  }

  // Parse keys given by -abcd
  // Allows multiple values.
  // Stores count of occurences.
  // Replaces option letter with specified long option key.
  // Returns ordered list of non-handled elements.
  var resw = RE2 "(-.*)";
  noinline gen parse-switches (switchmap: list[char * string] ) (d:strdict[int]) (x:list[string]) =
  {
    var out = Empty[string];
    var va = varray[StringPiece] (StringPiece "", StringPiece "");
    for opt in x do
      if Match (resw, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
        var switches = va . 1 . string . [1 to];
        for switch in switches do
          match switchmap.find switch with
          | #None =>
            println$ "Invalid option " + opt + " char '" + str switch+"'";
          | Some key=>
            val nuval = d.get_dflt (key,0) + 1;
            d.add key nuval;
          endmatch;
        done
      else
        out = Cons (opt, out);
      done
    done
    return rev out;
  }

  typedef cmdspec_t = (
    split-key-value-spec: list[string * string],
    multi-valued-keys-spec: list[string],
    single-valued-keys-spec: list[string],
    switches-spec: list[string],
    short-switch-map-spec: list[char * string]
  );

  typedef cmdopt-parse-result_t = (
     multi-valued-keys : strdict[list[string]],
     single-valued-keys : strdict[string],
     switches : strdict[int],
     positional : list[string]
  );

  ctor cmdopt-parse-result_t () =>
  (
    multi-valued-keys = strdict[list[string]](),
    single-valued-keys = strdict[string](),
    switches = strdict[int](),
    positional = Empty[string]
  );

  noinline gen parse-cmdline (spec:cmdspec_t) (x:list[string]) : cmdopt-parse-result_t = {
    var result = cmdopt-parse-result_t ();
    var nonk = cvt-key-arg spec.split-key-value-spec x;
    nonk = parse-key-multi-value spec.multi-valued-keys-spec result.multi-valued-keys nonk;
    nonk = parse-key-single-value spec.single-valued-keys-spec result.single-valued-keys nonk;
    nonk = parse-key spec.switches-spec result.switches nonk;
    &result.positional <- parse-switches spec.short-switch-map-spec result.switches nonk;
    return result;
  }
}
Process
//[process.flx]

class Process_class[os, process_status_t]
{
  virtual gen popen_in : string -> Cstdio::ifile;
  virtual gen pclose: Cstdio::ifile -> process_status_t;
}

class Process {
if PLAT_WIN32 do
  inherit Win32Process;
else
  inherit PosixProcess;
done
}
Posix Errno
//[posix_errno.flx]

open class Errno
{
  pod type errno_t = "int" requires C89_headers::errno_h;
  ctor int : errno_t = "$1";
  ctor errno_t : int = "$1";
  instance Eq[errno_t] {
    fun == : errno_t * errno_t -> bool= "$1==$2";
  }
  inherit Eq[errno_t];

  const errno : errno_t = "errno"; // SUCKS
  const ENOERROR : errno_t = "0";
  const EACCES: errno_t;
  const ENOENT: errno_t;
  const EAGAIN: errno_t;
  const ENOMEM: errno_t;
  const EEXIST: errno_t;
  const EINVAL: errno_t;
  const EINTR: errno_t; // call interrupted by a signal

  proc maybe_exit(var n:int) { if n != 0 do System::exit(errno.int); done }
  proc maybe_exit(var n:errno_t) { if n != ENOERROR  do System::exit(n.int); done }
  proc maybe_exit() { if errno != ENOERROR do System::exit(errno.int); done }

  // Unfortunately we get the crappy GNU version of strerror_r
  // even if we don't define _GNU_SOURCE
  // This stupidity returns a char*, instead of a void.
  // Unfortunately moron compilers complain about not using
  // the returned result, but there is no legal way to use a void.
  // There is no way out.

if PLAT_WIN32 do
  proc strerror_r: errno_t *  carray[char] * size  = "(void)strerror_s($2, $3, $1);"
    requires C89_headers::string_h /* on Linux.. on OSX it's in stdio.h */
  ;
else
  proc strerror_r: errno_t * carray[char] * size  =
    """
    strerror_r($1, $2, $3);
    """
    requires C89_headers::string_h
  ;
done
  fun strerror(e:errno_t) : string = {
    if e.int == 0 do
      return "OK";
    else
      var b:array[char,1000];
      var bad = "[strerror_r] Failed to find text for error number " + e.int.str;
      var p = bad._unsafe_cstr;
      CString::strncpy (carray (&b),p,1000.size); // safe because bad is a variable
      Memory::free p.address;
      strerror_r(e,carray (&b), b.len.size);
      return string( carray (&b));
    done
  }

  gen strerror()=> strerror errno;

  instance Str[errno_t] { fun str (e:errno_t) => strerror e; }
  inherit Str[errno_t];

  // Auto error check support
  class Check[T]
  {
    proc int_to_proc (var x:int) { if x == -1 do ehandler; done }
    fun int_to_int (var x:int) = { if x == -1 do ehandler; done return x; }
    fun pointer_to_pointer[U] (var p:&U) = { if C_hack::isNULL p do #ehandler; done return p; }
    virtual fun ehandler: unit -> any;
  }

  type check_ignore = "";
  instance Check[check_ignore]
  {
    fun ehandler ():any = {}
  }
  type check_throw = "";
  instance Check[check_throw]
  {
    fun ehandler ():any = { raise #strerror; }
  }
}
Posix Process
//[posix_process.flx]

class PosixProcess {
  open PosixSignal;

  instance Process_class[Posix, process_status_t]
  {
    gen popen_in: string -> Cstdio::ifile = 'popen($1.c_str(), "r")'
      requires C89_headers::stdio_h;
    gen pclose: Cstdio::ifile -> process_status_t = "pclose($1)";
  }
  inherit Process_class[Posix, process_status_t];

  type process_status_t = "int" requires Posix_headers::sys_wait_h;
  ctor int:process_status_t = "$1";
  ctor process_status_t : int = "$1";
  fun int_of_process_status_t: process_status_t -> int = "(int)$1";

  fun WIFCONTINUED: process_status_t -> bool = "WIFCONTINUED($1)!=0";
  fun WIFEXITED: process_status_t -> bool = "WIFEXITED($1)!=0";
  fun WIFSIGNALED: process_status_t -> bool = "WIFSIGNALED($1)!=0";
  fun WIFSTOPPED: process_status_t -> bool = "WIFSTOPPED($1)!=0";

  fun WEXITSTATUS: process_status_t -> int = "WEXITSTATUS($1)";
  fun WTERMSIG: process_status_t -> signal_t = "WTERMSIG($1)";
  fun WSTOPSIG: process_status_t -> signal_t = "WSTOPSIG($1)";

  // OSX only, not in Posix
  fun  WCOREDUMP: process_status_t -> int = "WCOREDUMP($1)";


  fun str(x:process_status_t) = {
    if WIFEXITED x do
       val e = x.WEXITSTATUS;
       return "Exit " + str e + ": " +e.errno_t.strerror;
    elif WIFSIGNALED x do
       val s = x.WTERMSIG;
       return "SIGNAL " + s.int.str + ": " + s.str;
    else
       return "Unknown temination status " + x.int.str;
    done
  }

  const environ: + (+char) = "environ" requires Posix_headers::unistd_h;

  type exec_result_t = "int";
  const bad_exec: exec_result_t = "-1";
  fun == : exec_result_t * exec_result_t -> bool= "$1==$2";

  gen execv:+char *  + (+char) -> exec_result_t = "execv($1, $2)" requires Posix_headers::unistd_h;
  gen execvp:+char *  + (+char) -> exec_result_t = "execvp($1, $2)" requires Posix_headers::unistd_h;
  gen execve:+char *  + (+char) * + (+char) -> exec_result_t = "execve($1, $2, $3)" requires Posix_headers::unistd_h;

  // do NOT try to fork Felix programs, it doesn't work
  // because of threads already running. We use fork only
  // to preceed exec() calls.
  type pid_t = "pid_t" requires Posix_headers::unistd_h;

  instance Str[pid_t] {
    fun str: pid_t -> string = "::flx::rtl::strutil::str<int>($1)" requires package "flx_strutil";
  }

  ctor int: pid_t = "((int)$1)";
  const child_process : pid_t = "0";
  const bad_process : pid_t = "-1";
  fun == : pid_t * pid_t -> bool= "$1==$2";

  gen fork: unit -> pid_t = "fork()" requires Posix_headers::unistd_h;

  variant spawn_result_t =
  // returned to parent process
  | BadFork of errno_t
  | ProcessId of pid_t

  // returned to child proces
  | BadExec of errno_t
  | BadSetup of int
  ;

  gen spawnv(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
    var x = fork();
    if x == child_process do  // CHILD
      var result = #setup;
      if result != 0 do
        return BadSetup result;
      done
      var y = execv(file.cstr, argv);
      if y == bad_exec do
        return BadExec errno;
      else
        return ProcessId x; // never taken! fool type system
      done
    elif x == bad_process do // PARENT
      return BadFork errno;
    else
      return ProcessId x;
    done
  }

  gen spawnvp(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
    var x = fork();
    if x == child_process do // CHILD
      var result = #setup;
      if result != 0 do
        return BadSetup result;
      done
      var y = execvp(file.cstr, argv);
      if y == bad_exec do
        return BadExec errno;
      else
        return ProcessId x; // never taken! fool type system
      done
    elif x == bad_process do  // PARENT
      return BadFork errno;
    else
      return ProcessId x;
    done
  }

  gen spawnve(file: string, argv:+ (+char), env: + (+char), setup:1->int) : spawn_result_t = {
    var x = fork();
    if x == child_process do // CHILD
      var result = #setup;
      if result != 0 do
        return BadSetup result;
      done
      var y = execve(file.cstr, argv, env);
      if y == bad_exec do
        return BadExec errno;
      else
        return ProcessId x; // never taken! fool type system
      done
    elif x == bad_process do // PARENT
      return BadFork errno;
    else
      return ProcessId x;
    done
  }

  type process_status_options_t = "int";
  const WCONTINUED: process_status_options_t;
  const WNOHANG: process_status_options_t;
  const WUNTRACED: process_status_options_t;
  const WNONE: process_status_options_t="0";
  fun \| : process_status_options_t * process_status_options_t -> process_status_options_t = "$1|$2";

  gen waitpid: pid_t * &process_status_t * process_status_options_t -> pid_t requires Posix_headers::sys_wait_h;

  gen waitpid(pid:pid_t) = {
    var status: process_status_t;
    var pid' = waitpid(pid,&status,WNONE);
    if pid' == bad_process do
      println$ "Waitpid failed .. fix me!";
      System::exit 1;
    else
      return status;
    done
  }

  variant ProcesStatus = | Running | Stopped of process_status_t;

  gen checkpid(pid:pid_t) = {
    var status: process_status_t;
    var pid' = waitpid(pid,&status,WNOHANG);
    if pid' == bad_process do
      println$ "Waitpid failed .. fix me!";
      System::exit 1;
    elif pid'.int == 0 do
      return Running;
    else
      return Stopped status;
    done
  }

  gen kill: pid_t * signal_t -> int;
  const OUR_PROCESS_GROUP: pid_t = "0";

}
Win32 Process
//[win32_process.flx]

class Win32Process {
  open Win32Signal;

  instance Process_class[Win32, process_status_t]
  {
    gen popen_in: string -> Cstdio::ifile = '_popen($1.c_str(), "r")' requires C89_headers::stdio_h;
    gen pclose: Cstdio::ifile -> process_status_t = "_pclose($1)" requires C89_headers::stdio_h;
  }
  inherit Process_class[Win32, process_status_t];
  type process_status_t = "intptr_t";
  ctor intptr:process_status_t = "$1";
  ctor int:process_status_t = "int($1)";
  ctor process_status_t : intptr = "$1";
  fun int_of_process_status_t: process_status_t -> int = "(int)$1";

/*

  fun WIFCONTINUED: process_status_t -> bool = "WIFCONTINUED($1)!=0";
  fun WIFEXITED: process_status_t -> bool = "WIFEXITED($1)!=0";
  fun WIFSIGNALED: process_status_t -> bool = "WIFSIGNALED($1)!=0";
  fun WIFSTOPPED: process_status_t -> bool = "WIFSTOPPED($1)!=0";

  fun WEXITSTATUS: process_status_t -> int = "WEXITSTATUS($1)";
  fun WTERMSIG: process_status_t -> signal_t = "WTERMSIG($1)";
  fun WSTOPSIG: process_status_t -> signal_t = "WSTOPSIG($1)";

  // OSX only, not in Posix
  fun  WCOREDUMP: process_status_t -> int = "WCOREDUMP($1)";


  fun str(x:process_status_t) = {
    if WIFEXITED x do
       val e = x.WEXITSTATUS;
       return "Exit " + str e + ": " +e.errno_t.strerror;
    elif WIFSIGNALED x do
       val s = x.WTERMSIG;
       return "SIGNAL " + s.int.str + ": " + s.str;
    else
       return "Unknown temination status " + x.int.str;
    done
  }
*/
  const environ: + (+char) = "environ" requires Posix_headers::unistd_h;

  type exec_result_t = "intptr_t";
  const bad_exec: exec_result_t = "intptr_t(-1)";
  fun == : exec_result_t * exec_result_t -> bool= "$1==$2";

  gen execv:+char *  + (+char) -> exec_result_t = "_execv($1, $2)" requires Win32_headers::process_h;
  gen execvp:+char *  + (+char) -> exec_result_t = "_execvp($1, $2)" requires Win32_headers::process_h;
  gen execve:+char *  + (+char) * + (+char) -> exec_result_t = "_execve($1, $2, $3)" requires Win32_headers::process_h;

  // do NOT try to fork Felix programs, it doesn't work
  // because of threads already running. We use fork only
  // to preceed exec() calls.
  type pid_t = "intptr_t" requires Posix_headers::unistd_h;
  ctor intptr: pid_t = "($1)";
  const bad_process : pid_t = "intptr_t(-1)";
  fun == : pid_t * pid_t -> bool= "$1==$2";

  instance Str[pid_t] {
    fun str: pid_t -> string = "::flx::rtl::strutil::str<intptr_t>($1)" requires package "flx_strutil";
  }

  variant spawn_result_t =
  // returned to parent process
  | BadFork of errno_t
  | ProcessId of pid_t

  // returned to child proces (can't happen on Windows)
  | BadExec of errno_t
  | BadSetup of int
  ;

  gen spawnv:+char *  + (+char) -> pid_t = "_spawn(_P_NOWAIT,$1, $2)" requires Win32_headers::process_h;
  gen spawnvp:+char *  + (+char) -> pid_t = "_spawnvp(_P_NOWAIT,$1, $2)" requires Win32_headers::process_h;
  gen spawnve:+char *  + (+char) * + (+char) -> pid_t = "_spawnve(_P_NOWAIT,$1, $2, $3)" requires Win32_headers::process_h;

  gen spawnv(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
    var x = spawnv(file.cstr, argv);
    if x == bad_process do // PARENT
      return BadFork errno;
    else
      return ProcessId x;
    done
  }

  gen spawnvp(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
    var x = spawnvp(file.cstr, argv);
    if x == bad_process do  // PARENT
      return BadFork errno;
    else
      return ProcessId x;
    done
  }

  gen spawnve(file: string, argv:+ (+char), env: + (+char), setup:1->int) : spawn_result_t = {
    var x = spawnve(file.cstr, argv, env);
    if x == bad_process do // PARENT
      return BadFork errno;
    else
      return ProcessId x;
    done
  }
/*
  type process_status_options_t = "int";
  const WCONTINUED: process_status_options_t;
  const WNOHANG: process_status_options_t;
  const WUNTRACED: process_status_options_t;
  const WNONE: process_status_options_t="0";
  fun \| : process_status_options_t * process_status_options_t -> process_status_options_t = "$1|$2";

  // Use WaitForSingleObject
  gen waitpid: pid_t * &process_status_t * process_status_options_t -> pid_t requires Posix_headers::sys_wait_h;

  gen waitpid(pid:pid_t) = {
    var status: process_status_t;
    var pid' = waitpid(pid,&status,WNONE);
    if pid' == bad_process do
      println$ "Waitpid failed .. fix me!";
      System::exit 1;
    else
      return status;
    done
  }

  variant ProcesStatus = | Running | Stopped of process_status_t;

  gen checkpid(pid:pid_t) = {
    var status: process_status_t;
    var pid' = waitpid(pid,&status,WNOHANG);
    if pid' == bad_process do
      println$ "Waitpid failed .. fix me!";
      System::exit 1;
    elif pid'.int == 0 do
      return Running;
    else
      return Stopped status;
    done
  }

  gen kill: pid_t * signal_t -> int;
  const OUR_PROCESS_GROUP: pid_t = "0";
*/
}
System Call
//[system.flx]

class System
{
  const argc:int = "PTF argc" requires property "needs_ptf";
  const _argv:&&char= "PTF argv" requires property "needs_ptf";

  fun argv:int -> string = '::std::string($1<0||$1>=PTF argc??"":PTF argv[$1])'
    requires property "needs_ptf";
  fun argv_dflt (x:int) (y:string) => match argv x with | "" => y | a => a;

  fun args () => List::map (argv) (List::range argc);

  proc setargs : + (+char) * size = "PTF argc=$2; PTF argv=$1;" requires property "needs_ptf";
  proc setargs[N] (a:string^N)
  {
    gen myget(i:size)=>a.i.cstr;
    var x = varray[+char] (a.len,a.len,myget);
    setargs (x.stl_begin,x.len);
  }

  gen system (cmd:string) : int => Shell::system(cmd);
  gen exit: int -> any = '::std::exit($1)' requires Cxx_headers::cstdlib;
  gen abort: 1 -> any =
    '(fprintf(stderr,"Felix code calling abort\\n"),::std::abort())'
    requires Cxx_headers::cstdlib;
  _gc_pointer type ptf_t = "thread_frame_t*";
  const ptf:ptf_t = "ptf" requires property "needs_ptf";

  //$ pexit examines the return code from a system call.
  //$ If the code is 0 it exists with 0.
  //$ On Windows:
  //$    if the code is -1, it exits with errno.
  //$    otherwise code 3
  //$ On Unix:
  //$   if the code is non-zero then
  //$     if the callout aborted, return its abort code.
  //$     if the callout died due to a signal, exit with code 2
  //$     otherwise exit with code 3
  //$ In both these cases a non-zero return causes a message
  //$ to be printed on stderr.

  if PLAT_WIN32 do
    proc pexit(e:int)
    {
      if e != 0 do
        if e == -1 do
          err :=  errno;
          eprintln$ "Error "+err.str+" in flx: " + strerror err;
          System::exit err.int;
        else
          eprintln$ "Unknown error in shell " + str e;
          System::exit 3;
        done
      done
      System::exit e;
    }
  else
    proc pexit(e:int)
    {
      if e != 0 do
        if PosixProcess::WIFEXITED e.PosixProcess::process_status_t do
          err :=  PosixProcess::WEXITSTATUS e.PosixProcess::process_status_t;
          eprintln$ "Error "+err.str+" in flx: " + strerror err.errno_t;
          System::exit err;
        elif PosixProcess::WIFSIGNALED e.PosixProcess::process_status_t do
          sig := Process::WTERMSIG e.PosixProcess::process_status_t;
          eprintln$ "Shell terminated by signal " + str sig;
          System::exit 2;
        else
          eprintln$ "Unknown error in shell " + str e;
          System::exit 3;
        done
      done
      System::exit e;
    }
  done

  gen get_stdout(x:string) : int * string => Shell::get_stdout x;

}
Shell
//[shell.flx]

// Note Shell_class interface doesn't use process_status_t
// but the implementation does.

class Shell_class[OS, process_status_t]
{
  // Quote a single argument.
  // Note: kills Bash wildcard replacement.
  virtual fun quote_arg:string->string;
  fun quote_args (s:list[string]) : string => catmap[string] ' ' quote_arg s;

  // Mainly for Windows we need a way to quote command line strings too.
  virtual fun quote_line_for_system: string->string;

  virtual fun parse: string -> list[string];

  //------------------------------------------------------------
  // system() function

  //$ System command is ISO C and C++ standard.
  gen raw_system: string -> int = "::std::system($1.c_str())"
    requires Cxx_headers::cstdlib
  ;
  //$ basic command with line quoting.
  gen basic_system (cmd: string) :int =>
    cmd.quote_line_for_system.raw_system
  ;

  // string argument
  gen system (cmd:string) = {
    if Env::getenv "FLX_SHELL_ECHO" != "" do
      eprintln$ "[system] " + cmd;
    done
    return basic_system cmd;
  }

  // list of string argument
  gen system (args:list[string]) : int =>
    args.quote_args.system
  ;

  gen system[T with Iterable[T,string]] (args:T) : int =
  {
    var lst = Empty[string];
    for arg in args do
      lst = lst + arg;
    done
    return system lst;
  }

  //------------------------------------------------------------
  // popen() function (get_stdout)

  virtual fun quote_line_for_popen: string -> string;

  //$ get_stdout is a synchronous version of popen_in/pclose pair.
  virtual gen raw_get_stdout : string -> int * string;

  gen basic_get_stdout (cmd: string) : int * string =>
    cmd.quote_line_for_popen.raw_get_stdout
  ;

  gen get_stdout (cmd:string) : int * string = {
    if Env::getenv "FLX_SHELL_ECHO" != "" do
      eprintln$ "[get_stdout] " + cmd;
    done
    return basic_get_stdout cmd;
  }

  // arbitrary Streamable argument
  gen get_stdout (args:list[string]) : int * string =>
    args.quote_args.get_stdout
  ;

  gen get_stdout[T with Iterable[T,string]] (args:T) : int * string =
  {
    var lst = Empty[string];
    for arg in args do
      lst = lst + arg;
    done
    return get_stdout lst;
  }

}

class Shell {
if PLAT_WIN32 do
  inherit CmdExe;
else
  inherit Bash;
done
}
Posix Shell (Bash)
//[posix_shell.flx]

// Note: shell functions here only work with Bash.
// However, the system() function always calls sh,
// and sh is always an ash, which is almost always bash

/* GNU Bash 3-2 Man page
QUOTING
       Quoting  is  used  to  remove  the  special meaning of certain characters or words to the shell.
       Quoting can be used to disable special treatment for special  characters,  to  prevent  reserved
       words from being recognized as such, and to prevent parameter expansion.

       Each  of  the metacharacters listed above under DEFINITIONS has special meaning to the shell and
       must be quoted if it is to represent itself.

       When the command history expansion facilities are being used (see HISTORY EXPANSION below),  the
       history expansion character, usually !, must be quoted to prevent history expansion.

       There are three quoting mechanisms: the escape character, single quotes, and double quotes.

       A  non-quoted backslash (\) is the escape character.  It preserves the literal value of the next
       character that follows, with the exception of <newline>.  If a \<newline> pair appears, and  the
       backslash is not itself quoted, the \<newline> is treated as a line continuation (that is, it is
       removed from the input stream and effectively ignored).

       Enclosing characters in single quotes preserves the literal value of each character  within  the
       quotes.   A single quote may not occur between single quotes, even when preceded by a backslash.

       Enclosing characters in double quotes preserves the literal value of all characters  within  the
       quotes,  with  the exception of $, `, \, and, when history expansion is enabled, !.  The charac-
       ters $ and ` retain their special meaning within double quotes.  The backslash retains its  spe-
       cial meaning only when followed by one of the following characters: $, `, ", \, or <newline>.  A
       double quote may be quoted within double quotes by preceding it with a backslash.   If  enabled,
       history  expansion  will be performed unless an !  appearing in double quotes is escaped using a
       backslash.  The backslash preceding the !  is not removed.

       The special parameters * and @ have special  meaning  when  in  double  quotes  (see  PARAMETERS
       below).

       Words  of the form $'string' are treated specially.  The word expands to string, with backslash-
       escaped characters replaced as specified by the ANSI C standard.  Backslash escape sequences, if
       present, are decoded as follows:
              \a     alert (bell)
              \b     backspace
              \e     an escape character
              \f     form feed
              \n     new line
              \r     carriage return
              \t     horizontal tab
              \v     vertical tab
              \\     backslash
              \'     single quote
              \nnn   the eight-bit character whose value is the octal value nnn (one to three digits)
              \xHH   the  eight-bit  character  whose value is the hexadecimal value HH (one or two hex
                     digits)
              \cx    a control-x character

       The expanded result is single-quoted, as if the dollar sign had not been present.

       A double-quoted string preceded by a dollar sign ($) will cause  the  string  to  be  translated
       according  to  the  current  locale.   If  the  current locale is C or POSIX, the dollar sign is
       ignored.  If the string is translated and replaced, the replacement is double-quoted.

*/

class Bash {

  instance Shell_class[Posix, PosixProcess::process_status_t] {
    // we can't use single quotes becase there's no way to represent a '
    // in a single quoted string .. so we have to use double quotes and
    // backslash the 4 special characters: " $ \ `
    // I think this is all ..
    fun quote_arg(s:string):string= {
      var r = "";
      for ch in s do
        if ch in "\\\"" do   // leave $ and ` in there, unquoted.
          r += "\\"+ str ch;
        else
          r+= ch;
        done
      done
      return '"'+r+'"';
    }
    fun quote_line_for_system (s:string) => s;
    fun quote_line_for_popen (s:string) => s + " ";

    gen raw_get_stdout(x:string) = {
        var fout = PosixProcess::popen_in(x+" ");
        if valid fout do
          var output = load fout;

          var result = PosixProcess::pclose fout;
          return PosixProcess::WEXITSTATUS result, output;
        else
          println$ "Unable to run command '" + x "'";
          return -1,"";
        done
    }

    //$ Parse a bash command line into words.
    fun parse (s:string) : list[string] =
    {
      var args = Empty[string];
      var current = "";
      variant mode_t = | copy | skip | quote | dquote | escape-copy | escape-dquote;
      var mode = skip;
      for ch in s do
        match mode with
        | #skip =>
          if ch == char "\\" do
            mode = escape-copy;
          elif ch == char "'" do
            mode = quote;
          elif ch == char '"' do
            mode = dquote;
          elif ord ch > ord (char ' ') do
            current += ch;
            mode = copy;
          done

        | #copy =>
          if ch == char "\\" do
            mode = escape-copy;
          elif ord ch <= ord (char ' ') do
            mode = skip;
            args += current;
            current = "";
          elif ch == char "'" do
             mode = quote;
          elif ch == char '"' do
            mode = dquote;
          else
            current += ch;
          done

        | #escape-copy =>
          current += ch;
          mode = copy;

        | #escape-dquote =>
          mode = dquote;
          if ch in '"\\$`' do
            current += ch;
          elif ch == char "'n" do ;
          else
            current += "\\" + ch;
          done

        | #dquote =>
          if ch == char '"' do
            mode = copy;
          elif ch == char "\\" do
            mode = escape-dquote;
          else
            current += ch;
          done
        | #quote =>
          if ch == char "'" do
            mode = copy;
          else
            current += ch;
          done
        endmatch;
      done
      match mode with
      | #skip => ;
      | _ => args += current;
      endmatch;
      return args;
    }
  }
  inherit Shell_class[Posix, PosixProcess::process_status_t];
}
Win32 Shell (cmd.exe)
//[win32_shell.flx]


/* http://msdn.microsoft.com/en-us/library/17w5ykft.aspx
Microsoft Specific

Microsoft C/C++ startup code uses the following rules when interpreting
arguments given on the operating system command line:

    Arguments are delimited by white space, which is either a space or a tab.

    The caret character (^) is not recognized as an escape character or delimiter.
    The character is handled completely by the command-line parser in the
    operating system before being passed to the argv array in the program.

    A string surrounded by double quotation marks ("string") is
    interpreted as a single argument, regardless of white space contained within.
    A quoted string can be embedded in an argument.

    A double quotation mark preceded by a backslash (\") is
    interpreted as a literal double quotation mark character (").

    Backslashes are interpreted literally, unless they
    immediately precede a double quotation mark.

    If an even number of backslashes is followed by a
    double quotation mark, one backslash is placed in the argv
    array for every pair of backslashes, and the double quotation mark
    is interpreted as a string delimiter.

    If an odd number of backslashes is followed by a
    double quotation mark, one backslash is placed in the argv
    array for every pair of backslashes, and the double quotation mark
    is "escaped" by the remaining backslash, causing a literal
    double quotation mark (") to be placed in argv.
*/

class CmdExe
{
  instance Shell_class[Win32, Win32Process::process_status_t]
  {
    fun quote_arg(s:string):string => '"' + s + '"';
    fun quote_line_for_system(s:string) => '"' + s + '"';
    fun quote_line_for_popen(s:string) => '"' + s + '"';

    gen raw_get_stdout(x:string) = {
      //eprintln("CMD.EXE: raw_get_stout of " + x);
      var fout = Win32Process::popen_in(x);
      if valid fout do
        var output = load fout;
        var result = Win32Process::pclose fout;
        return Win32Process::int_of_process_status_t result, output;
      else
        println$ "Unable to run command '" + x "'";
        return -1,"";
      done
    }

    //$ Parse a CMD.EXE command line into words.
    fun parse (s:string) : list[string] =
    {
      var args = Empty[string];
      var current = "";
      variant mode_t = | copy | skip | dquote | escape-copy | escape-dquote;
      var mode = skip;
      for ch in s do
        match mode with
        | #skip =>
          if ch == char "\\" do
            mode = escape-copy;
          elif ch == char '"' do
            mode = dquote;
          elif ord ch > ord (char ' ') do
            current += ch;
            mode = copy;
          done

        | #copy =>
          if ch == char "\\" do
            mode = escape-copy;
          elif ord ch <= ord (char ' ') do
            mode = skip;
            args += current;
            current = "";
          elif ch == char '"' do
            mode = dquote;
          else
            current += ch;
          done

        | #escape-copy =>
          mode = copy;
          if ch == char '"' do
            current += ch;
          else
            current += "\\" + ch;
          done

        | #escape-dquote =>
          mode = dquote;
          if ch == char '"' do
            current += ch;
          else
            current += "\\" + ch;
          done

        | #dquote =>
          if ch == char '"' do
            mode = copy;
          elif ch == char "\\" do
            mode = escape-dquote;
          else
            current += ch;
          done
        endmatch;
      done
      match mode with
      | #skip => ;
      | _ => args += current;
      endmatch;
      return args;
    }
  }
  inherit Shell_class[Win32, Win32Process::process_status_t];

}
Signals
//[signal.flx]

body ctrl_c_flag = """
  static bool ctrl_c_flag = false;
  bool get_ctrl_c_flag() { return ctrl_c_flag; }
  void set_ctrl_c_flag(int) { ctrl_c_flag = true; }
""";


class Signal_class [os] {
  gen get_ctrl_c_flag: 1 -> bool requires ctrl_c_flag;
  proc set_ctrl_c_flag: int requires ctrl_c_flag;
  virtual proc trap_ctrl_c: 1;

}

class Signal {
if PLAT_WIN32 do
  inherit Win32Signal;
else
  inherit PosixSignal;
done
}
Posix Signal
//[posix_signal.flx]

class PosixSignal {
  requires C89_headers::signal_h;
  type signal_t = "int";
  ctor signal_t: int = "$1";
  ctor int: signal_t = "$1";

  type sig_t = "sig_t"; // what a pity posix calls the handler sig_t
  gen signal: signal_t * sig_t -> sig_t = "signal($1, $2)";
  instance Eq[signal_t] {
    fun == : signal_t * signal_t ->  bool = "$1==$2";
  }
  inherit Eq[signal_t];

  // http://pubs.opengroup.org/onlinepubs/009695399/basedefs/signal.h.html
  const
    SIGABRT, SIGALRM, SIGBUS, SIGCHLD, SIGCONT, SIGFPE, SIGHUP, SIGILL, SIGINT, SIGKILL,
    SIGPIPE, SIGQUIT, SIGSEGV, SIGSTOP, SIGTERM, SIGTSTP, SIGTTN, SIGTTOU, SIGUSR1, SIGUSR2,
    SIGPOLL, SIGPROF, SIGSYS, SIGTRAP, SIGURG, SIGVTALRM, SIGXCPU,SIGXSZ
  : signal_t;

  instance Str[signal_t] {
    fun str: signal_t -> string =
    | $(SIGABRT) =>  "SIGABRT"
    | $(SIGALRM) =>  "SIGALRM"
    | $(SIGBUS) =>  "SIGBUS"
    | $(SIGCHLD) =>  "SIGCHLD"
    | $(SIGCONT) =>  "SIGCONT"
    | $(SIGFPE) =>  "SIGFPE"
    | $(SIGHUP) =>  "SIGHUP"
    | $(SIGILL) =>  "SIGILL"
    | $(SIGINT) =>  "SIGINT"
    | $(SIGKILL) =>  "SIGKILL"
    | $(SIGPIPE) =>  "SIGPIPE"
    | $(SIGQUIT) =>  "SIGQUIT"
    | $(SIGSEGV) =>  "SIGSEGV"
    | $(SIGSTOP) =>  "SIGSTOP"
    | $(SIGTERM) =>  "SIGTERM"
    | $(SIGTSTP) =>  "SIGTSTP"
    // | $(SIGTTN) =>  "SIGTTN"  // not in OSX
    | $(SIGTTOU) =>  "SIGTTOU"
    | $(SIGUSR1) =>  "SIGUSR1"
    | $(SIGUSR2) =>  "SIGUSR2"
    // | $(SIGPOLL) =>  "SIGPOLL" // not in OSX
    | $(SIGPROF) =>  "SIGPROF"
    | $(SIGSYS) =>  "SIGSYS"
    | $(SIGTRAP) =>  "SIGTRAP"
    | $(SIGURG) =>  "SIGURG"
    | $(SIGVTALRM) =>  "SIGVTALRM"
    | $(SIGXCPU) =>  "SIGXCPU"
    // | $(SIGXSZ) =>  "SIGXSZ" // not in OSX
    | x => "signal " + x.int.str
    ;
  }
  inherit Str[signal_t];

  body "void null_signal_handler(int){}";
  const null_signal_handler: sig_t;
  proc ignore_signal(s:signal_t) { C_hack::ignore(signal(s, null_signal_handler)); }

  // http://pubs.opengroup.org/onlinepubs/007904975/functions/sigaction.html
  body ctrl_c_handling = """
    void set_ctrl_c_flag(int);
    void trap_ctrl_c () {
      struct sigaction sa;
      sa.sa_handler = set_ctrl_c_flag;
      sigemptyset(&sa.sa_mask);
      sa.sa_flags = SA_RESTART;
      sigaction(SIGINT, &sa, NULL);
   }
  """ requires ctrl_c_flag;

  inherit Signal_class[Posix];

  instance Signal_class[Posix] {
    proc trap_ctrl_c: unit requires ctrl_c_handling;
  }
}
Win32 Signal
//[win32_signal.flx]

class Win32Signal {
  requires C89_headers::signal_h;
  type signal_t = "int";
  ctor signal_t: int = "$1";
  ctor int: signal_t = "$1";

  header sig_t_def = "typedef void (__cdecl *sig_t)(int);";
  type sig_t = "sig_t" requires sig_t_def;
  gen signal: signal_t * sig_t -> sig_t = "signal($1, $2)";
  instance Eq[signal_t] {
    fun == : signal_t * signal_t ->  bool = "$1==$2";
  }
  inherit Eq[signal_t];

  // http://pubs.opengroup.org/onlinepubs/009695399/basedefs/signal.h.html
  const
    SIGABRT,  SIGFPE, SIGILL, SIGINT,
    SIGSEGV,  SIGTERM
  : signal_t;

  instance Str[signal_t] {
    fun str: signal_t -> string =
    | $(SIGABRT) =>  "SIGABRT"
    | $(SIGFPE) =>  "SIGFPE"
    | $(SIGILL) =>  "SIGILL"
    | $(SIGINT) =>  "SIGINT"
    | $(SIGSEGV) =>  "SIGSEGV"
    | $(SIGTERM) =>  "SIGTERM"
    | x => "signal " + x.int.str
    ;
  }
  inherit Str[signal_t];

  body "void null_signal_handler(int){}";
  const null_signal_handler: sig_t;
  proc ignore_signal(s:signal_t) { C_hack::ignore(signal(s, null_signal_handler)); }

  // http://pubs.opengroup.org/onlinepubs/007904975/functions/sigaction.html
  body ctrl_c_handling = """
    void set_ctrl_c_flag(int);
    void trap_ctrl_c () {
     (void)signal(SIGINT,set_ctrl_c_flag);
   }
  """ requires ctrl_c_flag;

  inherit Signal_class[Win32];

  instance Signal_class[Win32] {
    proc trap_ctrl_c: unit requires ctrl_c_handling;
  }
}

Package: src/packages/time.fdoc

Time of Day

key file
time.flx share/lib/std/time.flx
posix_time.flx share/lib/std/posix/time.flx
win32_time.flx share/lib/std/win32/time.flx
RTC: Time of Day

A Real Time Clock (RTC) is a device that provides the current date and time of day.

//[time.flx]
class Time_class [os] {
  virtual gen time: 1 -> double; // time in seconds since Jan 1 1970 UTC, seconds
}

open class Time {
if PLAT_WIN32 do
  inherit Win32Time;
else
  inherit PosixTime;
done
  rename fun sleep =  Faio::sleep;

}
Posix RTC
//[posix_time.flx]

class PosixTime
{
  requires Posix_headers::sys_time_h;

  private type time_t = "time_t";
  private type suseconds_t = "suseconds_t";

  private fun _ctor_double: time_t -> double = "static_cast<double>($1)";
  private fun _ctor_double: suseconds_t -> double = "static_cast<double>($1)";

  private cstruct timeval {
    tv_sec: time_t;
    tv_usec: suseconds_t;
  };

  private proc gettimeofday: &timeval = "gettimeofday($1, NULL);";

  inherit Time_class[Posix];

  instance Time_class[Posix] {
    gen time () : double = {
      var tv:timeval;
      gettimeofday(&tv);
      return tv.tv_sec.double + tv.tv_usec.double / 1.0e6;
    }
  }

  type system_timepoint  = "::std::chrono::time_point<::std::chrono::system_clock>"
    requires Cxx11_headers::chrono, Cxx11_headers::ratio
  ;

  type system_duration = "::std::chrono::system_clock::duration"
    requires Cxx11_headers::chrono, Cxx11_headers::ratio
  ;

  gen system_clock_now : 1 -> system_timepoint = "::std::chrono::system_clock::now()";

  // elapsed time
  fun -: system_timepoint * system_timepoint -> system_duration = "$1-$2";

  ctor double : system_duration = """
    ((::std::chrono::duration<double>($1)).count())
  """;

}
Win32 RTC
//[win32_time.flx]

class Win32Time
{
  requires Posix_headers::sys_types_h;
  requires Win32_headers::sys_timeb_h;

  private type time_t = "time_t";
  private fun _ctor_double: time_t -> double = "static_cast<double>($1)";

  private cstruct __timeb64 {
    time: time_t; // seconds
    millitm: ushort; // milliseconds
  };

  private proc _ftime64_s: &__timeb64 = "_ftime64_s($1);";

  inherit Time_class[Win32];

  instance Time_class[Win32] {
    gen time () : double = {
      var tv:__timeb64;
      _ftime64_s(&tv);
      return tv.time.double + tv.millitm.double / 1.0e3;
    }
  }
}

Package: src/packages/web.fdoc

Http Server Support

key file
__init__.flx share/lib/web/__init__.flx
web_util.flx share/lib/web/web_util.flx
http_auth.flx share/lib/web/http_auth.flx
http_request.flx share/lib/web/http_request.flx
http_response.flx share/lib/web/http_response.flx
http_handler.flx share/lib/web/http_handler.flx
http_connection.flx share/lib/web/http_connection.flx
http_status_code.flx share/lib/web/http_status_code.flx
mime_type.flx share/lib/web/mime_type.flx
cookie.flx share/lib/web/cookie.flx
low_res_time.flx share/lib/web/low_res_time.flx
json.flx share/lib/web/json.flx
sundown.flx share/lib/web/sundown.flx
logger.flx share/lib/web/logger.flx
simple_config.flx share/lib/web/simple_config.flx
server_config.flx share/lib/web/server_config.flx
web_server.flx share/lib/web/web_server.flx
Web Server Support Library
//[__init__.flx]
// codecs
include "web/json";
include "web/mime_type";

// http protocol handlers
include "web/web_util";
include "web/http_handler";
include "web/http_connection";
include "web/http_request";
include "web/http_status_code";
include "web/http_response";
include "web/http_auth";
include "web/cookie";
include "web/low_res_time";
include "web/server_config";
include "web/sundown";
include "web/logger";
include "web/simple_config";

//[web_util.flx]
class WebUtil {

  fun parse_attribute_list(lst:list[string]):list[string^2] =>
    map (fun (s:string) => match split_first(s,"=") with
                             |Some (i,j) => (strip i),(strip j)
                             |_       => "",""
                           endmatch ) lst;



}

//[http_auth.flx]
include "web/__init__";

publish """ Implements Basic HTTP Authentication
"""
class HTTPBasicAuth {
  open HTTPConnection;
  open HTTPRequest;
  open Assoc_list;
  open HTTPResponse;
  open Base64;
  open ServerConfig;
  open HTTPHandler;

  publish """
  A default app_handler for implementing Basic Auth. You must supply a function that
  takes a user name and password and returns fru or fals if authenticated. You must
  also supply a realm string which appears in the Authentication Prompt of the browser.
  This app_handler uses a route that applies to all pages
  """
  fun app_handlers(auth_source:(string*string->bool),realm:string) =>
    (Cons (http_handler(http_basic_auth_route,(http_basic_auth(auth_source,realm))),
     Empty[http_handler]));

  publish """
  A default route for http auth applies to all pages
  """
  fun http_basic_auth_route(config:server_config,request:http_request) =>
    true;

  private fun basic(s:string) =>ltrim s "Basic ";

  publish """
  Handler for http_basic_auth if Authorization header supplied by browser attemps to authenticate against auth source.
  If Authorization header not supplied send WWW-Authenticate header
  """



  gen http_basic_auth (auth_source:(string*string->bool),realm:string) (conn:http_connection, request:http_request) =  {
    http_basic_auth (auth_source,realm,"Unauthorized") (conn, request);
}

  gen http_basic_auth (auth_source:(string*string->bool),realm:string,unauth_content:string) (conn:http_connection, request:http_request) =  {
    if match (find (fun(x:string)=>x=="Authorization") request.headers) with
      |Some a => match split(decode(basic(a)),":") with
                      |Cons(n,Cons(p,Empty)) => auth_source(n,p)
                      |_ => false
                    endmatch
       |_       => false
      endmatch do
        set_dirty(conn,false);
        return ;
    else
      val hdrs:assoc_list[string,string] = Cons (("WWW-Authenticate","Basic realm=\""+realm+"\""), Empty[string*string]);
      var us = make_unauthorized(hdrs,unauth_content);
      write(conn,us);
    done
    set_dirty(conn,true);
    return ;
  }

publish """Authentication wrapper for a http_handler function, prcesses HTTP Authentication
and passes control to handler if Authentication succedes otherwise returns Unauthorized response
to the browser"""
  proc requires_auth (auth_source:(string*string->bool),realm:string,
                     handler_fn:(http_connection*http_request) -> void)
                    (conn:http_connection, request:http_request ) = {
    http_basic_auth (auth_source,realm) (conn, request);
    if not *conn.dirty do
      handler_fn(conn,request);
    done
  }

   proc requires_auth (auth_source:(string*string->bool),realm:string,
                     handler_fn:(http_connection*http_request) -> void,
                     unauthorized_content:string)
                    (conn:http_connection, request:http_request ) = {
    http_basic_auth (auth_source,realm,unauthorized_content) (conn, request);
    if not *conn.dirty do
      handler_fn(conn,request);
    done
  }




  gen authorized_user (conn:http_connection, request:http_request) =>
     match (find (fun(x:string)=>x=="Authorization") request.headers) with
      |Some a => match split(decode(basic(a)),":") with
                      |Cons(n,Cons(p,Empty)) => Some n
                      |_ => None[string]
                    endmatch
       |_       => None[string]
      endmatch ;


}

//[http_request.flx]
include "web/__init__";

publish """
Defines types and container for http_request.
Main entry points are get_param (helper to extract params from http_request)
and get_http_request which extracts request from stream
"""

class HTTPRequest {
   open HTTPConnection;
   open Assoc_list;
   open URICodec;
   open Logger;
   open Cookie;
   open IOStream;
   open Socket;
   open TerminalIOByteStream[socket_t];
   open WebUtil;

   variant http_method =
     | GET
     | POST
     | BAD;

  instance Str[http_method] {
    fun str : http_method ->string =
      | #GET => "GET"
      | #POST => "POST"
      | #BAD => "BAD";
   }

  instance Eq[http_method] {
    fun == : http_method*http_method->bool = "$1==$2";
    fun != : http_method*http_method->bool = "$1!=$2";
  }


   struct http_request {
    hmethod: http_method;
    uri: string;
    path:string;
    params:assoc_list[string,string];
    entity_params:assoc_list[string,string];
    headers:assoc_list[string,string];
  }

  instance Str[http_request] {
    fun str (request: http_request) =>
      "HTTP Request\n"+
      "\tMethod:"+str(request.hmethod)+"\n"+
      //"\tURI:"""+request.uri+"\n"+
      "\tPath:"""+request.path+"\n"+
      "\tParams:"""+str(request.params)+"\n"+
      "\tHeaders:"""+str(request.headers)+"\n";
  }

  private proc copy_request(orig:&http_request,cpy:&http_request) = {
    cpy.hmethod <- *orig.hmethod;
    cpy.uri <- *orig.uri;
    cpy.path <- *orig.path;
    cpy.params <- *orig.params;
  }

  publish """
  Parses a list of URI encoded key value parameters and returns as an assoc_list.
  """
  fun get_params(p:string):list[string*string] ={
     var params = split(p,'&');
     return   map  (fun(x:string):string*string =>let Cons(hd,tl) = split(x,'=') in
                     (uri_decode(hd),uri_decode((fold_left (fun(x:string) (y:string):string => x + y) "" tl)))
                     ) params;
  }

  noinline proc get_headers(conn:http_connection,headers:&list[string^2])  {
    var line:string = "";
    get_line(conn.sock, &line);  // shouldg be the GET line.
    while line != "" and line != "\r" do
      get_line(conn.sock, &line);
      match split(line,':') with
        | Cons(key,value) =>
              headers <- Cons((uri_decode(strip(key)),
            uri_decode(strip(fold_left (fun(x:string) (y:string):string => x + y) "" value))),
              *headers);
         | x => println("WARNING:Possible malformed request headerline:"+x);
      endmatch;
    done
  }

  publish """ Main entry point for extracting HTTP request from stream """
  noinline proc get_request(conn:http_connection,request:&http_request) = {
    var k = conn.sock;
    var line: string = "";
    get_line(k, &line);  // shouldg be the GET line.
    var got = match split(line,' ') with
      | Cons (hmethod,Cons(uri,Cons(prot,_))) => match (hmethod,uri,prot) with
        | ("GET",uri,prot)  => match (GET,uri,split(uri,'?'),prot) with
          | (GET,uri,Cons(path,rest),prot) =>
               http_request(GET,uri,path,
                get_params((fold_left (fun(x:string) (y:string):string => x + y) "" rest)),
                Empty[string*string],Empty[string*string])
            endmatch
        | ("POST",uri,prot)  => match (POST,uri,split(uri,'?'),prot) with
          | (POST,uri,Cons(path,rest),prot) => http_request(POST,uri,path,
                get_params((fold_left (fun(x:string) (y:string):string => x + y) "" rest)),
                Empty[string*string],Empty[string*string])
          endmatch
        endmatch
        | _ =>  http_request(BAD,"","",Empty[string*string],Empty[string*string],
                             Empty[string*string])
    endmatch;
    var headers = Empty[string^2];
    get_headers(conn,&headers);
    got&.headers <- headers;
    copy_request(&got,request);
    request.headers <- headers;
  }




  publish """
  Populates entity_params in request. Entity params are URI encoded key value pairs in
  request body that are supplied when a POST request is made by the browser.
  """
  proc get_entity_params(conn:http_connection,request:&http_request,attribs:list[string^2]) = {
    val olen = match get_header(*request,"Content-Length") with |Some s=> int(s) |_ => 0 endmatch;
    var len = olen;
    var eof=false;
    var params:assoc_list[string,string] = Empty[string*string];
    if olen > 0 do
      var buf = C_hack::cast[+char] (Memory::malloc(len+1));
      var buf_a = address(buf);
      read(conn.sock,&len,buf_a,&eof);
      if len > 0 do
        params = get_params(string(buf,len));
      done
      Memory::free(buf_a);
    done
    request.entity_params <- params;
    return ;
  }

fun read_bytes(conn:http_connection,olen:int) = {
    var len = olen;
    var eof=false;

    var ret:string = "";
    if olen > 0 do
      var buf = C_hack::cast[+char] (Memory::malloc(len+1));
      var buf_a = address(buf);
      read(conn.sock,&len,buf_a,&eof);
      ret= str(buf);
      Memory::free(buf_a);
     done
     return ret;
  }


  proc get_multipart_params(conn:http_connection,request:&http_request,attribs:list[string^2]) {
    var line:string = "";
    val llen = match get_header(*request,"Content-Length") with |Some s=> int(s) |_ => 0 endmatch;
    var rest = read_bytes(conn,llen);
    write(conn,HTTPResponse::make_continue());
    conn.dirty <- false;

    match (find (fun (s:string) => s == "boundary") attribs) with
      |Some b => { get_line(conn.sock, &line);
        var headers = Empty[string^2];
        get_headers(conn,&headers);
      }
     |_ => {conn.config.log(DEBUG,"No Boundry"); }
    endmatch;
     request.entity_params <- Empty[string*string];
  }

  fun get_fname(request:http_request) ={
    val v = match rev(split(request.path,'/')) with
      | Cons(hd,_) => Some(hd)
      | _ => None[string]
    endmatch;
    return v;
  }

  fun get_path_and_fname(request:http_request):opt[string^2] ={
    return match rev(split(request.path,'/')) with
      | Cons(hd,tl) => Some(
            (fold_left (fun(x:string) (y:string):string => x +"/"+ y) "" (rev(tl))), hd)
      | _ => None[string*string]
    endmatch;
  }

  publish """ Return opt[string] parameter value for given name """
  fun get_param(request:http_request,name:string) =>
     find (fun (a:string,b:string) => eq(a,b)) request.params name;

  publish """ Return opt[string] post parameter value for given name """
  fun get_post_param(request:http_request,name:string) =>
     find (fun (a:string,b:string) => eq(a,b)) request.entity_params name;

  publish """ Return opt[string] request header value for given name """
  fun get_header(request:http_request,name:string) =>
     find (fun (a:string,b:string) => eq(a,b)) request.headers name;

  fun get_cookies(request:http_request):list[cookie] = {

     val cline= Assoc_list::find (fun (a:string,b:string) => eq(a,b)) (request.headers)  ('Cookie');
     val lines = match cline with
       | Some s => (match split(s,';') with
                       |Cons (h,t) => Cons(h,t)
                       |_            => Empty[string]
                     endmatch)
       | _        => Empty[string]
     endmatch;
     val pairs = filter (fun (sl:opt[string^2]) => match sl with |Some _ => true |_ => false endmatch) (map (fun (cl:string) => split_first(cl,"=")) lines);
      return (map (fun (p:opt[string^2]) => let Some q = p in cookie(q.(0),q.(1))) pairs);
}

}

//[http_response.flx]
include "web/__init__";

publish """
Use make_<response type> to wrap html in an apropriate response
"""

class HTTPResponse {
  open LowResTime;
  open HTTPStatusCodes;
  open MIMEType;
  open Assoc_list;
  struct http_response {
    status_code:status_code;
    last_modified:tm;
    content_type:mime_type;
    headers:assoc_list[string,string];
    content:string;
  }

  typedef headers_t = assoc_list[string,string];
  fun no_headers ():headers_t => Empty[string*string];

  fun http_header (response:http_response) =>
"""HTTP/1.0 """ + str(response.status_code) +"""\r
Date: """ + rfc1123_date() + """\r
Server: felix web server\r
Last-Modified: """ + rfc1123_date(response.last_modified) +"""\r
Connection: close\r
Content-Type: """ + str(response.content_type) + """\r
Content-Length: """ + str (len response.content) + """\r
"""+(fold_left (fun(x:string) (y:string):string => x + y) "" (map (fun (n:string*string) => n.(0)+": "+n.(1)+"\r\n") response.headers))+"""\r
""";


  fun make_image(mime:mime_type, content:string) =>
    http_header(http_response(SC_OK,localtime(#time_t),mime,#no_headers,content)) +
      content;

  fun make_image(mime:mime_type, content:string, headers:headers_t) =>
    http_header(http_response(SC_OK,localtime(#time_t),mime,headers,content)) +
      content;

  fun make_css (content:string) =>
    http_header(http_response(SC_OK,localtime(#time_t),text css,#no_headers,content)) +
      content;

  fun make_js (content:string) =>
    http_header(http_response(SC_OK,localtime(#time_t),application javascript,#no_headers,content)) +
      content;

  fun make_json (content:string) =>
    http_header(http_response(SC_OK,localtime(#time_t),application json,#no_headers,content)) +
      content;

  fun make_not_found (content:string) =>
    let response = http_response(SC_NOT_FOUND,localtime(#time_t),text html,#no_headers,
                                content) in
      http_header(response) + response.content;

  fun make_not_implemented (content:string) =>
    let response = http_response(SC_NOT_IMPLEMENTED,localtime(#time_t),text html,#no_headers,
                                content) in
      http_header(response) + response.content;


  fun make_see_other (location:string) =>
    let response = http_response(SC_SEE_OTHER,localtime(#time_t),text html,Cons(("Location",location),Empty[string^2]),"") in
      http_header(response) + response.content;

  fun make_forbidden (content:string) =>
    let response = http_response(SC_FORBIDDEN,localtime(#time_t),text html,#no_headers,
                                "Forbidden: "+content) in
      http_header(response) + response.content;

  fun make_unauthorized (headers:headers_t) =>
    let response = http_response(SC_UNAUTHORIZED,localtime(#time_t),text html,headers,
                                "") in
      http_header(response) +"\nUnauthorized";

  fun make_unauthorized (headers:headers_t,content:string) =>
    let response = http_response(SC_UNAUTHORIZED,localtime(#time_t),text html,headers,
                                "") in
      http_header(response) +"\n"+content;

  fun make_continue () =>
    let response = http_response(SC_CONTINUE,localtime(#time_t),text html,#no_headers,
                                "") in
      http_header(response) +"\r";

  fun make_raw (content:string) => make_raw(content,#no_headers);
  fun make_raw (content:string,headers:headers_t) =>
    http_header(http_response(SC_OK,localtime(#time_t),application octet_DASH_stream,
                              headers,content)) + content;

  fun make_html (content:string) => make_html(content,#no_headers);
  fun make_html (content:string,headers:headers_t) =>
    http_header(http_response(SC_OK,localtime(#time_t),text html,
                              headers,content)) + content;
  fun make_xhtml (content:string) => make_xhtml(content,#no_headers);
  fun make_xhtml (content:string,headers:headers_t) =>
    http_header(http_response(SC_OK,localtime(#time_t),application xhtml_PLUS_xml,
                              headers,content)) + content;

  fun make_mime (mime:mime_type, content:string) => make_mime(mime,content, #no_headers);
  fun make_mime (mime:mime_type, content:string, headers:headers_t) =>
    http_header(http_response(SC_OK,localtime(#time_t),mime,
                              headers,content)) + content;


}
//WWW-Authenticate: Basic realm="WallyWorld"

//[http_handler.flx]
include "web/__init__";

publish """
Implements default handlers for static content and error pages.
Defines container http_hadler for use in constructing custom handlers
for use in WebServer """
class HTTPHandler {
  open HTTPResponse;
  open HTTPRequest;
  open HTTPConnection;
  open ServerConfig;
  open MIMEType;
  open Tord[mime_type];

  publish """ handles determines what requests are handleded by handler_fn.
  handler_fn handles http request and respons on http_connection """
  struct http_handler {
    handles: (server_config*http_request)->bool;
    handler_fn: (http_connection*http_request) -> void;
  }

  publish """ return option of the first element in a list mapped to type V satisfying
  the combined transformer and predicate xf """

 fun / (x:string, y:string) => Filename::join (x,y);

fun find_and_map[T,V] (xf:T -> opt[V]) (xs:list[T]) : opt[V] =>
    match xs with
    | #Empty => None[V]
    | Cons (h,t) => match xf(h) with |Some (v) => Some(v) |_ => find_and_map xf t endmatch
    endmatch
  ;


fun get_fs_path (config:server_config,request:http_request) =>
    match get_path_and_fname(request) with
      | Some(path,fname) => find_and_map[string,string] (fun (r:string):opt[string] => (let fs_path =
        Filename::join(Filename::join(r,path),fname) in
        if (FileStat::fileexists fs_path) then
          Some(fs_path)
        else
          None[string]
        endif)) (list(config.document_root,
          Filename::join(Filename::join(Filename::join(#Config::std_config.FLX_SHARE_DIR,"lib"),"web"),"html")))
      | _ => None[string]
    endmatch;


  fun txt2html (x:string) =
  {
    var out2 = "";
    var i:int;
    for i in 0 upto (int(len x) - 1) do
      var ch = x.[i];
      if ch == char "<" do out2+="&lt;";
      elif ch == char ">" do out2+="&gt;";
      elif ch == char "&" do out2+="&amp;";
      else out2+=ch;
      done
    done
   return out2;
  }

   gen handle_not_found(conn:http_connection, request:http_request) =  {
     var txt = "<div style='text-color:red;'>Page "+
       (match get_fname request with | Some(fname) => fname | _ => "NONE" endmatch)+
       " not found.</div>";
     val data = make_not_found txt;
     write(conn,data);
     return ;
   }

  proc do_handle_not_found(conn:http_connection, request:http_request) {
    handle_not_found(conn,request);
  }

  fun handle_not_found_route (config:server_config, request:http_request) => true;

  gen handle_css(conn:http_connection, request:http_request) = {
    match get_fs_path(conn.config,request) with
      | Some(file) => {
                       val txt = load (file);
                             write(conn,(make_css txt));
                       }
      | _ => {do_handle_not_found(conn,request);}
   endmatch;
   return ;
  }

  fun handle_css_route (config:server_config, request:http_request) =>
    match (get_path_and_fname request) with
       | Some (p,f) => (match (mime_type_from_file f) with |text css => true | _ => false endmatch)
       | _ => false
     endmatch;

  gen handle_js(conn:http_connection, request:http_request) = {
    match get_fs_path(conn.config,request) with
      | Some(file) => {
                       val txt = load (file);
                             write(conn,(make_js txt));
                       }
      | _ => {do_handle_not_found(conn,request);}
   endmatch;
   return ;
  }

  fun handle_js_route (config:server_config, request:http_request) =>
    match (get_path_and_fname request) with
      | Some (p,f) => (match (mime_type_from_file f) with
        |application javascript => true | _ => false endmatch)
      | _ => false
     endmatch;

  gen handle_image(conn:http_connection, request:http_request) = {
    match get_fs_path(conn.config,request) with
      | Some(file) => {
                       val txt = load (file);
                             write(conn,make_image((mime_type_from_file file), txt));
                       }
      | _ => {do_handle_not_found(conn,request);}
   endmatch;
   return ;
  }

  fun handle_image_route (config:server_config,request:http_request) =>
     match (get_path_and_fname request) with
       | Some (p,f) => (match (mime_type_from_file f) with
            |image gif => true
            |image jpeg => true
            |image png => true
            |image tiff => true
            | _ => false endmatch)
       | _ => false
     endmatch;

  gen handle_html(conn:http_connection, request:http_request) = {
    if (request.uri == "/" and request.path == "/") do
      val txt = load (conn.config.document_root+"/index.html");
      write(conn,(make_html txt));
    else
      match get_fs_path(conn.config,request) with
        | Some(file) => {
                       val txt = load (file);
                             write(conn,(make_html txt));
                       }
        | _ => {do_handle_not_found(conn,request);}
       endmatch;
    done
    return ;
  }

  fun handle_html_route (config:server_config,request:http_request):bool =>
     if (request.uri == "/" and request.path == "/") then
       true
     else
       match (get_path_and_fname request) with
         | Some (p,f) => (match (mime_type_from_file f) with |text html => true | _ => false endmatch)
         | _ => false
       endmatch
     endif;

  publish """ Returns list of Stock handlers """
  fun default_handlers() => list (
    http_handler(handle_html_route,handle_html),
        http_handler(handle_image_route,handle_image),
    http_handler(handle_css_route,handle_css),
              http_handler(handle_js_route,handle_js),
    http_handler(handle_not_found_route,handle_not_found)
  );

}

//[http_connection.flx]
include "web/__init__";

publish """
Container for server config and socket_t
"""
class HTTPConnection {
  open ServerConfig;
  open Socket;
  open Logger;
  open IOStream;
  open Socket;
  open TerminalIOByteStream[socket_t];

  struct http_connection {
    config:server_config;
    sock:socket_t;
    dirty:&bool;
  };
  fun _ctor_http_connection(config:server_config,sock:socket_t) = {
    var b:bool = false;
    return http_connection(config,sock,&b);
  }
  proc set_dirty(conn:http_connection,state:bool) {
    conn.dirty <- state;
  }

  noinline proc write(var conn:http_connection,var content:string) {

    var eof_flag = false;
    val content_len = content.len;
    conn.config.log(DEBUG,"Content Size:"+str(content_len));
    val chunk_size = size(1024);
    var chunks:size = content.len / chunk_size;
    var remainder = content.len % chunk_size;
    var base = size(0);
    for var i in size(1) upto chunks do
      conn.config.log(DEBUG,"Writing[sock="+str conn.sock+"]:"+str(base)+" to "+str(base+chunk_size));
      write_string(conn.sock,content.[base to (base+chunk_size)],&eof_flag);
      base = base + chunk_size;

    done
    if remainder > size(0) do
       conn.config.log(DEBUG,"Writing[sock="+str conn.sock+"] Remainder:"+str(base)+" to "+str(content_len));
       write_string(conn.sock,content.[base to ],&eof_flag);
    done
    set_dirty(conn,true);
  }

}

//[http_status_code.flx]
/*
Example:
  println$ str SC_OK;
*/

class HTTPStatusCodes {
  enum status_code {
    SC_OK,
    SC_CREATED,
    SC_NO_CONTENT,
    SC_MOVED_PERMANENTLY,
    SC_TEMPORARY_REDIRECT,
    SC_BAD_REQUEST,
    SC_UNAUTHORIZED,
    SC_FORBIDDEN,
    SC_NOT_FOUND,
    SC_METHOD_NOT_ALLOWED,
    SC_INTERNAL_SERVER_ERROR,
    SC_NOT_IMPLEMENTED,
    SC_SERVICE_UNAVAILABLE,
    SC_SEE_OTHER,
    SC_CONTINUE
  }

  instance Str[status_code] {
    fun str: status_code -> string =
      |  #SC_CONTINUE => "100 Continue"
      |  #SC_OK => "200 OK"
      |  #SC_CREATED => "201 Created"
      |  #SC_NO_CONTENT => "204 No Content"
      |  #SC_MOVED_PERMANENTLY => "301 Moved Permanently"
      |  #SC_SEE_OTHER => "303 See Other"
      |  #SC_TEMPORARY_REDIRECT => "307 Temporary Redirect"
      |  #SC_BAD_REQUEST => "400 Bad Request"
      |  #SC_UNAUTHORIZED => "401 Unauthorized"
      |  #SC_FORBIDDEN => "403 Forbidden"
      |  #SC_NOT_FOUND => "404 Not Found"
      |  #SC_METHOD_NOT_ALLOWED => "405 Not Allowed"
      |  #SC_INTERNAL_SERVER_ERROR => "500 Internal Server Error"
      |  #SC_NOT_IMPLEMENTED => "501 Not Implemented"
      |  #SC_SERVICE_UNAVAILABLE => "503 Service Unavailable"
    ;
  }

}

//[mime_type.flx]
publish """
Implements variant types representing MIME types.
Also implements Str instance for mime types and parses MIME type from string

Example:
  open MIMETypes;
  println (javascript);
  println from_str("application/atom+xml");
  println (application zip);
"""

class MIMEType {
/*
TODO: implement more MIME types.
*/

  open WebUtil;
  variant application_mime_subtype =
    | atom_PLUS_xml //: Atom feeds
    | ecmascript // ECMAScript/JavaScript; Defined in RFC 4329
    | EDI_DASH_X12 // EDI X12 data; Defined in RFC 1767
    | EDIFACT  //EDI EDIFACT data; Defined in RFC 1767
    | json // JavaScript Object Notation JSON; Defined in RFC 4627
    | javascript // ECMAScript/JavaScript; Defined in RFC 4329
    | octet_DASH_stream // Arbitrary binary data.
    | ogg // Ogg, a multimedia bitstream container format;
    | pdf // Portable Document Format,
    | postscript // PostScript; Defined in RFC 2046
    | rss_PLUS_xml // RSS feeds
    | soap_PLUS_xml //SOAP; Defined by RFC 3902
    | font_DASH_woff //: Web Open Font Format;
    | xhtml_PLUS_xml //: XHTML; Defined by RFC 3236
    | xml_DASH_dtd //: DTD files; Defined by RFC 3023
    | xop_PLUS_xml //:XOP
    | zip //: ZIP archive files; Registered[7]
    | x_DASH_gzip //: Gzip
    | x_DASH_www_DASH_form_DASH_urlencoded;

  variant audio_mime_subtype =
    | basic //: mulaw audio at 8 kHz, 1 channel; Defined in RFC 2046
    | L24 //: 24bit Linear PCM audio at 8-48kHz, 1-N channels; Defined in RFC 3190
    | mp4 //: MP4 audio
    | mpeg //: MP3 or other MPEG audio; Defined in RFC 3003
    | ogg1 //: Ogg Vorbis, Speex, Flac and other audio; Defined in RFC 5334
    | vorbis //: Vorbis encoded audio; Defined in RFC 5215
    | x_DASH_ms_DASH_wma //: Windows Media Audio; Documented in Microsoft KB 288102
    | x_DASH_ms_DASH_wax //: Windows Media Audio Redirector
    | vnd_DOT_rn_DASH_realaudio //: RealAudio; Documented in RealPlayer
    | vnd_DOT_wave //: WAV audio; Defined in RFC 2361
    | webm //: WebM open media format
  ;

  variant image_mime_subtype =
    | gif //: GIF image; Defined in RFC 2045 and RFC 2046
    | jpeg // JPEG JFIF image; Defined in RFC 2045 and RFC 2046
    | pjpeg //: JPEG JFIF image; Associated with Internet Explorer;
    | png //: Portable Network Graphics; Registered,[8] Defined in RFC 2083
    | svg_PLUS_xml //: SVG vector image; Defined in SVG Tiny 1.2 Specification Appendix M
    | tiff // Tag Image File Format (only for Baseline TIFF); Defined in RFC 3302
    | vnd_DOT_microsoft_DOT_icon //: ICO image; Registered[9]
  ;

  variant text_mime_subtype =
    | cmd //: commands; subtype resident in Gecko browsers like Firefox 3.5
    | css //: Cascading Style Sheets; Defined in RFC 2318
    | csv //: Comma-separated values; Defined in RFC 4180
    | html //: HTML; Defined in RFC 2854
    | javascript1 //(Obsolete): JavaScript; Defined in and obsoleted by RFC 4329
    | plain //: Textual data; Defined in RFC 2046 and RFC 3676
    | vcard //: vCard (contact information); Defined in RFC 6350
    | xml //: Extensible Markup Language; Defined in RFC 3023
    | x_DASH_felix
    | x_DASH_fdoc
    | x_DASH_fpc
    | x_DASH_c
    | x_DASH_ocaml
    | x_DASH_python
  ;

  variant multipart_mime_subtype =
    | mixed
    | alternative
    | related
    | form-data
    | signed
    | encrypted;

  variant mime_type =
    | application of application_mime_subtype
    | audio of audio_mime_subtype
    | image of image_mime_subtype
    | text of text_mime_subtype
    | multipart of multipart_mime_subtype;

  typedef media_type =  mime_type * list[string^2];

  instance Str[application_mime_subtype] {
    fun str : application_mime_subtype ->string =
      | #atom_PLUS_xml => "application/atom+xml"
      | #ecmascript => "application/ecmascript"
      | #EDI_DASH_X12 => "application/EDI-X12"
      | #EDIFACT => "application/EDIFACT"
      | #json => "application/json"
      | #javascript => "application/javascript"
      | #octet_DASH_stream => "application/octet-stream"
      | #ogg => "application/ogg"
      | #pdf => "application/pdf"
      | #postscript => "appliction/postscript"
      | #rss_PLUS_xml => "application/rss+xml"
      | #soap_PLUS_xml => "application/soap+xml"
      | #font_DASH_woff => "application/font-woff"
      | #xhtml_PLUS_xml => "application/xhtml+xml"
      | #xml_DASH_dtd => "application/xml-dtd"
      | #xop_PLUS_xml => "application/xop+xml"
      | #zip => "application/zip"
      | #x_DASH_gzip => "application/x-gzip"
      | #x_DASH_www_DASH_form_DASH_urlencoded => "application/x-www-form-urlencoded";
 }

 instance Str[audio_mime_subtype] {
   fun str : audio_mime_subtype ->string =
     | #basic => "audio/basic"
     | #L24 => "audio/L24"
     | #mp4 => "audio/mp4"
     | #mpeg => "audio/mpeg"
     | #ogg1 => "audop/ogg"
     | #vorbis => "audio/vorbis"
     | #x_DASH_ms_DASH_wma => "audio/x-ms-wma"
     | #x_DASH_ms_DASH_wax => "audio/x-ms-wax"
     | #vnd_DOT_rn_DASH_realaudio => "audio/vnd.rn-realaudio"
     | #vnd_DOT_wave => "audio/vnd.wave"
     | #webm => "audio/webm";
  }

  instance Str[image_mime_subtype] {
    fun str : image_mime_subtype ->string =
      | #gif => "image/gif"
      | #jpeg => "image/jpeg"
      | #pjpeg => "image/pjpeg"
      | #png => "image/png"
      | #svg_PLUS_xml => "image/svg+xml"
      | #tiff => "image/tiff"
      | #vnd_DOT_microsoft_DOT_icon => "image/vnd.microsoft.icon";
  }

  instance Str[text_mime_subtype] {
    fun str : text_mime_subtype ->string =
      | #cmd => "text/cmd"
      | #css => "text/css"
      | #csv => "text/csv"
      | #html => "text/html"
      | #javascript1 => "text/javascript"
      | #plain => "text/plain"
      | #vcard => "text/vcard"
      | #xml => "text/xml"
      | #x_DASH_felix => "text/x-felix"
      | #x_DASH_fdoc => "text/x-fdoc"
      | #x_DASH_fpc => "text/x-fpc"
      | #x_DASH_c => "text/x-c"
      | #x_DASH_ocaml => "text/x-ocaml"
      | #x_DASH_python => "text/x-python";
  }

  instance Str[multipart_mime_subtype] {
    fun str : multipart_mime_subtype ->string =
      | #mixed => "multipart/mixed"
      | #alternative => "multipart/alternative"
      | #related => "multipart/related"
      | #form-data => "multipart/form-data"
      | #signed => "multipart/signed"
      | #encrypted => "multipart/encrypted";
  }

  instance Str[mime_type] {
    fun str : mime_type ->string =
      | application  a => str a
      | audio  a => str a
      | image  a => str a
      | text  a => str a
      | multipart  a => str a;
  }

  fun application_type_from_str : string -> opt[application_mime_subtype] =
    | "application/atom+xml"     => Some atom_PLUS_xml
    | "application/ecmascript"   => Some ecmascript
    | "application/EDI-X12"      => Some EDI_DASH_X12
    | "application/EDIFACT"      => Some EDIFACT
    | "application/json"         => Some json
    | "application/javascript"   => Some javascript
    | "application/octet-stream" => Some octet_DASH_stream
    | "application/ogg"          => Some ogg
    | "application/pdf"          => Some pdf
    | "appliction/postscript"    => Some postscript
    | "application/rss+xml"      => Some rss_PLUS_xml
    | "application/soap+xml"     => Some soap_PLUS_xml
    | "application/font-woff"    => Some font_DASH_woff
    | "application/xhtml+xml"    => Some xhtml_PLUS_xml
    | "application/xml-dtd"      => Some xml_DASH_dtd
    | "application/xop+xml"      => Some xop_PLUS_xml
    | "application/zip"          => Some zip
    | "application/x-gzip"       => Some x_DASH_gzip
    | "application/x-www-form-urlencoded" => Some x_DASH_www_DASH_form_DASH_urlencoded
    | _                          => None[application_mime_subtype];

  fun audio_type_from_str : string -> opt[audio_mime_subtype] =
    |  "audio/basic" => Some basic
    |  "audio/L24" => Some L24
    |  "audio/mp4" => Some mp4
    |  "audio/mpeg" => Some mpeg
    |  "audop/ogg" => Some ogg1
    |  "audio/vorbis" => Some vorbis
    |  "audio/x-ms-wma" => Some x_DASH_ms_DASH_wma
    |  "audio/x-ms-wax" => Some x_DASH_ms_DASH_wax
    |  "audio/vnd.rn-realaudio" => Some vnd_DOT_rn_DASH_realaudio
    |  "audio/vnd.wave" => Some vnd_DOT_wave
    |  "audio/webm" => Some webm
    |  _ => None[audio_mime_subtype] ;

  fun image_type_from_str : string -> opt[image_mime_subtype] =
    | "image/gif" => Some gif
    | "image/jpeg" => Some jpeg
    | "image/pjpeg" => Some pjpeg
    | "image/png" => Some png
    | "image/svg+xml" => Some svg_PLUS_xml
    | "image/tiff" => Some tiff
    | "image/vnd.microsoft.icon" => Some vnd_DOT_microsoft_DOT_icon
    | _ => None[image_mime_subtype];

  fun text_type_from_str : string -> opt[text_mime_subtype] =
    | "text/cmd" => Some cmd
    | "text/css" => Some css
    | "text/csv" => Some csv
    | "text/html" => Some html
    | "text/javascript" => Some javascript1
    | "text/plain" => Some plain
    | "text/vcard" => Some vcard
    | "text/xml" => Some xml
    | "text/x-felix" => Some x_DASH_felix
    | "text/x-fdoc" => Some x_DASH_fdoc
    | "text/x-fpc" =>  Some x_DASH_fpc
    | "text/x-c"  => Some x_DASH_c
    | "text/x-ocaml"  => Some x_DASH_ocaml
    | "text/x-python" => Some x_DASH_python
    | _ => None[text_mime_subtype];

  fun multipart_type_from_str : string -> opt[multipart_mime_subtype] =
    | "multipart/mixed" => Some mixed
    | "multipart/alternative" => Some alternative
    | "multipart/related" => Some related
    | "multipart/form-data" => Some form-data
    | "multipart/signed" => Some signed
    | "multipart/encrypted" => Some encrypted
  ;

  fun from_str (s:string):opt[mime_type] =>
    match application_type_from_str s with
      | Some t => Some (application t)
      | #None => match audio_type_from_str s with
        | Some t =>  Some (audio t)
        | #None => match image_type_from_str s with
           | Some t => Some (image t)
           | #None => match text_type_from_str s with
             | Some t => Some (text t)
             | #None => match multipart_type_from_str s with
               | Some t => Some (multipart t)
               | #None => None[mime_type]
             endmatch
           endmatch
         endmatch
       endmatch
     endmatch;

  fun mime_type_from_file(file:string) =>
    match rev(split(file,'.')) with
    | Cons(hd,_) => mime_type_from_extension hd
    | _ => text plain
    endmatch;

  fun mime_type_from_extension: string -> mime_type =
    | "atom" => application atom_PLUS_xml
    | "ecma" => application ecmascript
    | "json" => application json
    | "js" => application javascript
    | "application/octet-stream" => application octet_DASH_stream
    | "ogg" => application ogg
    | "ogx" => application ogg
    | "pdf" => application pdf
    | "ps" => application postscript
    | "eps" => application postscript
    | "ai" => application postscript
    | "xhtml" => application xhtml_PLUS_xml
    | "xht" => application xhtml_PLUS_xml
    | "dtd" => application xml_DASH_dtd
    | "xop" => application xop_PLUS_xml
    | "zip" => application zip
    | "x-gzip" => application x_DASH_gzip
    | "au" => audio basic
    | "snd" => audio basic
    | "mp4a" => audio mp4
    | "mpega" => audio mpeg
    | "mpga" => audio mpeg
    | "mp2a" => audio mpeg
    | "mp3a" => audio mpeg
    | "mp4a" => audio mpeg
    | "mp2" => audio mpeg
    | "mp3" => audio mpeg
    | "ogg" => audio ogg1
    | "oga" => audio ogg1
    | "spx" => audio ogg1
    | "wma" => audio x_DASH_ms_DASH_wma
    | "wax" => audio x_DASH_ms_DASH_wax
    | "ra" => audio vnd_DOT_rn_DASH_realaudio
    | "wav" => audio vnd_DOT_wave
    | "webma" => audio webm
    | "gif" => image gif
    | "image/jpeg" => image jpeg
    | "jpg" => image jpeg
    | "pjpeg" => image pjpeg
    | "png" => image png
    | "svg" => image svg_PLUS_xml
    | "tiff" => image tiff
    | "css" => text css
    | "csv" => text csv
    | "html" => text html
    | "htm" => text html
    | "shtm" => text html
    | "text/plain" => text plain
    | "asc" => text plain
    | "conf" => text plain
    | "def" => text plain
    | "diff" => text plain
    | "in" => text plain
    | "list" => text plain
    | "log" => text plain
    | "pot" => text plain
    | "text" => text plain
    | "txt" => text plain
    | _ => text plain
  ;


instance Eq[mime_type]  {
  fun == : mime_type * mime_type -> bool = "$1==$2";
}


  fun parse_media_type (s:string):opt[media_type] =>
    match split( s, ";") with
    | Cons(h,t) =>
      match from_str(h) with
      | Some m => Some (m,parse_attribute_list(t))
      | _       => None[media_type]
      endmatch
    | _ => None[media_type]
    endmatch
  ;

//instance Tord[test_mime_subtype] {
//    fun eq: t * t -> bool = "$1==$2";
//}
//open Tord[text_mime_subtype];
open Tord[mime_type];
/*
Other unimplemented types:
Type message
message/http: Defined in RFC 2616
message/imdn+xml: IMDN Instant Message Disposition Notification; Defined in RFC 5438
message/partial: Email; Defined in RFC 2045 and RFC 2046
message/rfc822: Email; EML files, MIME files, MHT files, MHTML files; Defined in RFC 2045 and RFC 2046
Type model
For 3D models.
model/example: Defined in RFC 4735
model/iges: IGS files, IGES files; Defined in RFC 2077
model/mesh: MSH files, MESH files; Defined in RFC 2077, SILO files
model/vrml: WRL files, VRML files; Defined in RFC 2077
model/x3d+binary: X3D ISO standard for representing 3D computer graphics, X3DB binary files
model/x3d+vrml: X3D ISO standard for representing 3D computer graphics, X3DV VRML files
model/x3d+xml: X3D ISO standard for representing 3D computer graphics, X3D XML files
Type multipart
Type video
For video.
video/mpeg: MPEG-1 video with multiplexed audio; Defined in RFC 2045 and RFC 2046
video/mp4: MP4 video; Defined in RFC 4337
video/ogg: Ogg Theora or other video (with audio); Defined in RFC 5334
video/quicktime: QuickTime video; Registered[10]
video/webm: WebM Matroska-based open media format
video/x-matroska: Matroska open media format
video/x-ms-wmv: Windows Media Video; Documented in Microsoft KB 288102
Type vnd
For vendor-specific files.
application/vnd.oasis.opendocument.text: OpenDocument Text; Registered[11]
application/vnd.oasis.opendocument.spreadsheet: OpenDocument Spreadsheet; Registered[12]
application/vnd.oasis.opendocument.presentation: OpenDocument Presentation; Registered[13]
application/vnd.oasis.opendocument.graphics: OpenDocument Graphics; Registered[14]
application/vnd.ms-excel: Microsoft Excel files
application/vnd.openxmlformats-officedocument.spreadsheetml.sheet: Microsoft Excel 2007 files
application/vnd.ms-powerpoint: Microsoft Powerpoint files
application/vnd.openxmlformats-officedocument.presentationml.presentation: Microsoft Powerpoint 2007 files
application/msword: Microsoft Word files
application/vnd.openxmlformats-officedocument.wordprocessingml.document: Microsoft Word 2007 files
application/vnd.mozilla.xul+xml: Mozilla XUL files
application/vnd.google-earth.kml+xml: KML files (e.g. for Google Earth)
Type x
For non-standard files.
application/x-www-form-urlencoded Form Encoded Data; Documented in HTML 4.01 Specification, Section 17.13.4.1
application/x-dvi: device-independent document in DVI format
application/x-latex: LaTeX files
application/x-font-ttf: TrueType Font No registered MIME type, but this is the most commonly used
application/x-shockwave-flash: Adobe Flash files for example with the extension .swf
application/x-stuffit: StuffIt archive files
application/x-rar-compressed: RAR archive files
application/x-tar: Tarball files
text/x-gwt-rpc: GoogleWebToolkit data
text/x-jquery-tmpl: jQuery template data
application/x-javascript:
application/x-deb: deb_(file_format), a software package format used by the Debian project
[edit]Type x-pkcs
For PKCS standard files.
application/x-pkcs12: p12 files
application/x-pkcs12: pfx files
application/x-pkcs7-certificates: p7b files
application/x-pkcs7-certificates: spc files
application/x-pkcs7-certreqresp: p7r files
application/x-pkcs7-mime: p7c files
application/x-pkcs7-mime: p7m files
application/x-pkcs7-signature: p7s files
*/
}

//[cookie.flx]
include "web/low_res_time";

class Cookie {
  open LowResTime;
  open WebUtil;

  struct cookie {
    name:string;
    value:string;
    domain:string;
    path:string;
    expires:string;
    secure:bool;
    http_only:bool;
  }

  fun _ctor_cookie (n:string,v:string) = {
    var c:cookie;c&.name<-n;c&.value<-v;return c;}



  instance Str[cookie] {
    fun str (c:cookie) => c.name+"="+c.value+"; "+match c.domain with
      |'' => ' ' | d => "Domain="+d+"; " endmatch+
      match c.path with |'' => ' ' |p => "Path="+p+"; " endmatch+
      match c.expires with |'' => ' ' |e => " Expires="+e+"; " endmatch+
      (if c.secure then "Secure; " else " " endif)+
      (if c.http_only then "HttpOnly;" else "" endif);
  }

  fun set_cookie (c:cookie):string*string => ("Set-Cookie",str(c));
  fun set_cookies (c:list[cookie]):string*string => ("Set-Cookie",
    fold_left (fun(x:string) (y:string):string => y +"\r"+ x) ""
      (map (fun(z:cookie):string => str(z)) c));

}

//[low_res_time.flx]
class LowResTime
{
  open C_hack;

  requires C89_headers::time_h;

  type time_t = "time_t";
  fun +: time_t*time_t -> time_t = "$1+$2";
  fun +: time_t*int -> time_t = "$1+(time_t)$2";

  //$ Current time
  proc time: &time_t = "time($1);";

  //$ Current time
  ctor time_t () = {
    var time_v:time_t;
    time(&time_v);
    return time_v;
  }


  // cast integer (in second since epoch) to time
  ctor time_t: !ints = "(time_t)$1:cast" is cast;

  cstruct tm {
    tm_sec:int;         /* seconds */
    tm_min:int;         /* minutes */
    tm_hour:int;        /* hours */
    tm_mday:int;        /* day of the month */
    tm_mon:int;         /* month */
    tm_year:int;        /* year */
    tm_wday:int;        /* day of the week */
    tm_yday:int;        /* day in the year */
    tm_isdst:int;       /* daylight saving time */
  };


if PLAT_WIN32 do
  private proc gmtime:&time_t * &tm = "gmtime_s($2,$1);";
else
  private proc gmtime:&time_t * &tm = "gmtime_r($1,$2);";
done

  fun gmtime (var t:time_t) :tm =
  {
    var atm : tm; gmtime (&t, &atm);
    return atm;
  }

if PLAT_WIN32 do
  private proc localtime:&time_t * &tm = "localtime_s($2,$1);";
else
  private proc localtime:&time_t * &tm = "localtime_r($1,$2);";
done
  fun localtime (var t:time_t) :tm =
  {
    var atm : tm; localtime (&t, &atm);
    return atm;
  }

  header """
    string asctime_helper(struct tm const * ti);
  """;

if PLAT_WIN32 do
  body """
    string asctime_helper(struct tm const * ti) {
      int len = 64;
      char *fmted = (char*) ::std::malloc(sizeof(char)*64);
      asctime_s(fmted,64,ti);
      string s = string(fmted);
      ::std::free(fmted);
      return s;
    }
  """;
else
  body """
    string asctime_helper(struct tm const * ti) {
      int len = 64;
      char *fmted = (char*) ::std::malloc(sizeof(char)*64);
      asctime_r(ti,fmted);
      string s = string(fmted);
      ::std::free(fmted);
      return s;
    }
  """;
done

  private fun asctime:&tm -> string = "asctime_helper($1)";
  fun asctime (var t:tm) : string => asctime (&t);

  header """
    string strftime_helper(const char *pat,    const struct tm * ti);
  """;

  body """
    string strftime_helper(const char *pat,    const struct tm * ti) {
      int len = 64;
      char *fmted = (char*) ::std::malloc(sizeof(char)*64);
      strftime(fmted,len,pat,ti);
      string s = string(fmted);
      ::std::free(fmted);
      return s;
    }
  """;

  private fun strftime: string * &tm -> string = "strftime_helper(($1.c_str()),$2)";
  fun strftime (fmt: string, var t: tm ) :string =
  {
     return strftime (fmt, &t);
  }

  fun rfc1123_date (dt:&tm) => strftime("%a, %d %b %Y %H:%M:%S %Z",dt);
  fun rfc1123_date (dt:tm) => strftime("%a, %d %b %Y %H:%M:%S %Z",dt);

  fun rfc1123_date () = {
    var time_epoch_seconds = time_t();
    var tm_struct : tm;
    gmtime(&time_epoch_seconds, &tm_struct);
    return rfc1123_date(&tm_struct);
  }

  fun hour() => 3600;

  fun day() => 86400;
  fun expires_seconds_from_now(seconds:int) ={
    var time_epoch_seconds = time_t() +seconds;
    var tm_struct : tm;
    gmtime(&time_epoch_seconds, &tm_struct);
   return rfc1123_date (&tm_struct);
 }

}

//[json.flx]
open class Json
{
  variant Jvalue =
  | Jstring of string
  | Jnumber of string
  | Jdictionary of list[Jpair]
  | Jarray of list [Jvalue]
  | Jname of string
  ;
  typedef Jpair = Jvalue * Jvalue;

  fun str (s:Jvalue, v:Jvalue) : string => str s + ': ' + str v;

  fun str (v: Jvalue) : string => match v with
  | Jstring s => '"' + s + '"' // hack, ignores quoting rules
  | Jnumber i => i
  | Jdictionary d => "{" + cat ", " (map str of (Jpair) d) + "}"
  | Jarray a => "[" + cat ", " (map str of (Jvalue) a) + "]"
  | Jname a => a
  endmatch
  ;

  variant ParseResult =
  | Good of Jvalue
  | Bad of int
  ;

  fun parse_json(s:string): ParseResult = {
    var i = skip_white s 0;
    def i, var v = parse_value s i;
    i = skip_white s i;
    if s.[i] != "".char do
      return Bad i;
    else
      return v;
    done
  }

  private fun skip_white (s:string) (var i:int) = {
    while s.[i] in " \t\r\n" do ++i; done
    return i;
  }

  private fun parse_value (s:string) (i:int): int * ParseResult =>
    if s.[i] in "-0123456789" then parse_number s i
    elif s.[i] == '"'.char then parse_string s (i+1)
    elif s.[i] == "{".char then parse_dictionary s (i+1)
    elif s.[i] ==  "[".char then parse_array s (i+1)
    elif s.[i] in "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" then parse_name s i
    else i, Bad i
    endif
  ;

  private fun parse_name (s:string) (var i:int) = {
    var j = s.[i].string;
    ++i;
    while s.[i] in "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_" do
       j += s.[i];
       ++i;
    done
    if j in ("true","false","null") do
      return i,Good (Jname j);
    else
      return i, Bad i;
    done
  }

  private fun parse_number (s:string) (var i:int) = {
    var j = "";

    // optional leading sign
    if s.[i] == "-".char do
      j += s.[i];
      ++i;
    done

    // zero integral part
    if s.[i] == "0".char do
      j+= s.[i];
      ++i;
      goto point;
    done

    // nonzero integral part
    if s.[i] in "123456789" do
      j += s.[i];
      ++i;
    else
      goto bad;
    done

    // rest of integral part
    while s.[i] in "0123456789" do
       j += s.[i];
       ++i;
    done

point:>
    if s.[i] != ".".char goto exponent;
    j += s.[i];
    ++i;

fraction:>
    if s.[i] in "0123456789" do
      while s.[i] in "0123456789" do
         j += s.[i];
         ++i;
      done
    else
      goto bad;
    done

exponent:>
    if s.[i] in "eE" do
      j += s.[i];
      ++i;
    else
      goto good;
    done

    // sign of exponent
    if s.[i] in "+-" do
      j += s.[i];
      ++i;
    done

    // exponent value
    if s.[i] in "0123456789" do
      while s.[i] in "0123456789" do
      j += s.[i];
      ++i;
      done
    else
      goto bad;
    done
good:>
    return i,Good (Jnumber j);
bad:>
    return i, Bad i;
  }

  private fun parse_string (s:string) (var i:int) = {
    var r = "";
ordinary:>
    while s.[i] != "".char and s.[i] != '"'.char and s.[i] != "\\".char do
      if s.[i].ord < 32 goto bad; // control chars are not allowed
      r += s.[i];
      ++i;
    done

    if s.[i] == '"'.char do // closing quote
      ++i;
      goto good;
    elif s.[i] == "\\".char do // escape
      r += s.[i];
      ++i;
      if s.[i] in '"\\/bfnrt' do // one char escape code
        r += s.[i];
        ++i;
        goto ordinary;
      elif s.[i] == "u".char do // hex escape
        r += s.[i];
        ++i;
        if s.[i] in "0123456789ABCDEFabcdef" do r += s.[i]; ++i; else goto bad; done
        if s.[i] in "0123456789ABCDEFabcdef" do r += s.[i]; ++i; else goto bad; done
        if s.[i] in "0123456789ABCDEFabcdef" do r += s.[i]; ++i; else goto bad; done
        if s.[i] in "0123456789ABCDEFabcdef" do r += s.[i]; ++i; else goto bad; done
        goto ordinary;
      else
        goto bad;
      done
    else // end of input
      goto bad;
    done

good:>
    return i,Good (Jstring r);
bad:>
    return i, Bad i;
}

  private fun parse_dictionary (s:string) (var i:int) = {
    var elts = #list[Jvalue * Jvalue];
    i = skip_white s i;
    while s.[i] != "}".char do
      if s.[i] == '"'.char do
        def i, var ms = parse_string s (i+1);
        match ms with
        | Good sv =>
          i = skip_white s i;
          if s.[i] == ":".char do
            ++i;
            i = skip_white s i;
            def i, var mv = parse_value s i;
            match mv with
            | Good v =>
              elts += sv,v;
              i = skip_white s i;
            | Bad j => return i, Bad j;
            endmatch;
          else
            return i, Bad i;
          done
          if s.[i] == ",".char do
            ++i;
            i = skip_white s i;
          elif s.[i] == "}".char do ;
          else
            return i, Bad i;
          done
        | Bad j => return i, Bad j;
        endmatch;
      else
        return i, Bad i;
      done
    done
    ++i;
    i = skip_white s i;
    return i, Good (Jdictionary elts);
  }

  private fun parse_array (s:string) (var i:int) = {
    var elts = #list[Jvalue];
    i = skip_white s i;
    while s.[i] != "]".char do
      def i, var mv = parse_value s i;
      match mv with
      | Good v => elts += v;
        i = skip_white s i;
        if s.[i] == ",".char do
          ++i;
          i = skip_white s i;
        elif s.[i] == "]".char do ;
        else
          return i, Bad i;
        done
      | Bad j => return i, Bad j;
      endmatch;
    done
    ++i;
    i = skip_white s i;
    return i, Good (Jarray elts);
  }
}

//[logger.flx]
publish """
Extensible Flexible Logger
example:
/* Creates two log files, my_info.log rolls over when log size exceeds 1024 bytes
   and is archived 4 times. my_debug.log does not roll over and will grow to infinite size.
   log messages with log_level INFO are routed to my_info.log.log messages with log level DEBUG
   are routed to my_debug.log */
open Logger;
var mylog = logger(simple_logger(
  Logger::log("log","my.log",size(1024),4ui),   INFO)+
  simple_logger(Logger::log("log","my_debug.log",size(0),0ui),  DEBUG));
mylog(DEBUG,"Debugging enabled");
"""
class Logger {

  open LowResTime;

  struct log {
    path:string;
    name:string;
    max_size:size;
    archives:uint;
  }

  publish """ Log Level definitions """
  variant log_level =
    | INFO
    | WARNING
    | ERROR
    | ACCESS
    | DEBUG
    | CUSTOM1
    | CUSTOM2;

  publish """ Definition of log_message """
  typedef log_message = log_level*string;

  publish """
  Container for log handler. handles governs what log messages are sent to handles_fn
  """
  struct log_handler {
    handles: (log_message)->bool;
    handler_fn: (log_message) -> void;
  }

  publish """
  Simple predicate generator. Returns closusre matching message against curried
  parameter handles
  """
  fun simple_log_handles [with Eq[log_level]] (handles:log_level) (message:log_message) =>
    handles == message.(0);

  publish """
  Simple log handler implementation. Creates log file give log_path and log_file
  and returns clousre accepting log_message writeing to files specified
  """
  gen simple_log_handler_fn (l:log):(log_message)->void = {
    var log_handle = open_log(l); //fopen_output (l.path+"/"+l.name);
    return (proc (message:log_message)  {
              log_handle = rotate_when_larger_than_max_size(log_handle,l);
              fprintln (log_handle, "["+log_date()+"]"+" "+to_str(message));
              fflush(log_handle);
            });
  }

  publish """
  Simple log handler implementation for logging to console.
  """
  fun console_log_handler_fn ():(log_message)->void = {
    return (proc (message:log_message)  {
              println ("["+log_date()+"]"+" "+to_str(message));
            });
  }

  publish """
  Convience log_handler creator for simple logger
  """
  fun simple_logger (l:log,level:log_level):list[log_handler] =>
   list(log_handler ((simple_log_handles(level))  ,
                simple_log_handler_fn(l)));

  publish """
  Convience log_handler creator for simple console logger
  """
  fun console_logger (level:log_level):list[log_handler] =>
   list(log_handler ((simple_log_handles(level))  ,
                      console_log_handler_fn()));


  publish """
  Generates logger handle used for sending messages to defined loggers.
  Accepts a list of log_handler and returns a closure accepting log_message
  writing to matching log handler
  """
  fun logger(handlers:list[log_handler]):log_message->void =  {
    var channel = mk_schannel[log_message]();
    spawn_fthread (listener(channel,handlers));
    return sender(channel);
  }

  publish  """Log writer runs as fthread"""
  private proc listener(chan:schannel[log_message],log_handlers:list[log_handler]) (){
    while true do
      var log_req:log_message = read chan;
      iter (proc (handler:log_handler) {
        if handler.handles log_req do
          handler.handler_fn(log_req);
        done
      }) log_handlers;
    done
    return;
  }

  private proc sender (log_channel:schannel[log_message]) (message:log_message) {
    write (log_channel,message);
  }

  instance Str[log_level] {
    fun str : log_level ->string =
      | #INFO => "[INFO]"
      | #WARNING  => "[WARNING]"
      | #ERROR  => "[ERROR]"
      | #ACCESS => "[ACCESS]"
      | #DEBUG => "[DEBUG]"
      | #CUSTOM1 => "[CUSTOM1]"
      | #CUSTOM2 => "[CUSTOM2]";
  }


  instance Eq[log_level]  {
    fun == : log_level * log_level -> bool = "$1==$2";
  }

  fun to_str (m:log_message):string  =>
       str(m.(0))+"\t"+m.(1);

  fun log_date_fmt (dt:tm) => strftime("%d/%b/%Y:%H:%M:%S %Z",dt);

  fun log_date () = {
    var time_epoch_seconds = time_t();
    val tm_struct =  gmtime(time_epoch_seconds);
    return log_date_fmt(tm_struct);
  }

  fun open_log(l:log):ofile = {
    val log_file = l.path+"/"+l.name;
    if (FileStat::fileexists log_file) and l.archives > 0ui do
      l.rotate();
    done
    var log_handle = fopen_output (log_file);
    if not valid log_handle do
      eprintln("Unable to open log at "+log_file+".\nLogging to console instead.");
      return stdout;
    else
      return log_handle;
    done
  }


  proc rotate(l:log) {
    val log_file = l.path+"/"+l.name;
    if FileStat::fileexists log_file do
      var last ="";
      for var i in l.archives downto 1ui  do
        val rlog =  log_file+"."+str(i) ;
        if FileStat::fileexists rlog and last != "" do
          if 0 != (FileSystem::rename_file (rlog, (log_file+"."+str(i+1ui)))) do
            eprintln("Unable to rotate log "+rlog+" to "+log_file+"."+str(i+1ui));
          done
        done
        last = rlog;
      done
      if 0 != (FileSystem::rename_file (log_file,(log_file+".1"))) do
        eprintln("Unable to rotate log "+log_file+" to "+log_file+".1");
      done
    done
  }

  fun rotate_when_larger_than_max_size(handle:ofile,l:log) = {
    if  l.max_size > size(0) and fsize(l.path+"/"+l.name) > l.max_size do
       if valid(handle) do
         fclose(handle);
       done
       return open_log(l);
    else
      return handle;
    done
  }

  proc fsize_: string*&size = """
    {struct stat st;
     stat($1.c_str(), &st);
     *$2 = st.st_size;}
  """;

  gen fsize(name:string):size = {
    var sz:size;
    fsize_(name,&sz);
    return sz;
  }
}

//[simple_config.flx]
publish """
Simple config file reader. Splits key value pairs seperated by the equals character.
Skips lines where first non-space character is the # character. Max configuration file size
is 65535 bytes

Example input:
  # Sample configuration file
  delay         =    0.05
  port          =    1234
  document_root =  ./html

Example code:
  open SimpleConfig;
  if System::argc > 0 do
    var arg = System::argv 1;
    println$ "config file:" + arg;
    iter (proc (kv:string*string) { println(kv.(0)+":"+kv.(1)); })
         (read_config(System::argv 1));
  else
    println("No config file specified");
  done
"""

class SimpleConfig {
  requires header '#include <sys/stat.h>';
  open Assoc_list;
  open Csv;

  typedef configuration = assoc_list[string,string];

  publish """
  Reads configuration file and returns associative list
  """
  fun read_config(config_file:string):configuration = {
    val fsz =  fsize(config_file);
    var config = Empty[string^2];
    if fsz > size(0) and fsz < size(65535) do
      val handle = fopen_input config_file;
      if valid handle do
        val config_text = load(handle);
        fclose(handle);
        println$ "Loaded config file " + config_file;
        config = config + read_config_text(config_text);
      done
    done
    return config;
  }

  fun read_config_text(config_text:string):configuration ={
    print$ "[Config Data]\n" + config_text+"[End Config Data]\n";
    var config = Cons(('INSTALL_ROOT',#Config::std_config.FLX_SHARE_DIR.[to -6]),
                      Empty[string^2]);
    iter (proc (line:string) {config = config + xparse(line);})
             (split(str(config_text),"\n"));
    return apply_param_vars(config);
  }


  publish """
    returns opt param value for given key
  """
  fun get_param(params:list[string*string],name:string) =>
     find (fun (a:string,b:string) => eq(a,b)) params name;

  publish """
    return list strings from comma seperated parameter value
  """
  fun get_param_list(params:list[string*string],name:string) =>
    match get_param(params,name) with |Some v => get_csv_values(v) |_ => Empty[string] endmatch;

  publish """
     Supports $variables in config files. Uses previously defined paramater keys
     as $ variables. Only supports first occurance of $variable. Also
     $INSTALL_ROOT is available nad populated with the value for the felix
     install root
  """
  fun apply_param_vars (par:list[string*string]):list[string*string] ={
    var kp:string = ""; var vp:string = "";
    return map (fun (k:string,v:string) = {
      kp = k; vp = v;
      iter (proc (k1:string,v1:string) {
        kp,vp = match find(vp,k1) with
          |Some p => (kp, substring(vp,0,(p - 1)) + v1 +
                          substring(vp,p+int(k1.len),vp.len))
          |_ => (kp,vp)
        endmatch;
      }) par;
      return (kp,vp);
    }) par;
  }

  fun apply_param_vars_to (par:list[string*string],v:string):string ={
    var vp:string;
    vp = v;
    iter (proc (k1:string,v1:string) {
      vp = match find(vp,k1) with
          |Some p => substring(vp,0,(p - 1)) + v1 +
                      substring(vp,p+int(k1.len),vp.len)
          |_ => vp
        endmatch;
      }) par;
      return vp;
  }

  fun apply_param_vars_to (par:list[string*string],l:list[string]):list[string] =>
    (map (fun (s:string) => apply_param_vars_to (par,s)) (l));

  private fun xparse(line:string):list[string*string] =>
    if startswith (strip line) (char '#') then
      Empty[string*string]
    else
      match split_first(line, "=") with
        |Some s => list[string*string]((strip(s.(0)),strip(s.(1))))
        |None => Empty[string*string]
      endmatch
    endif;

  private fun split_first (x:string, c:string): opt[string*string] ={
    return match find_first_of (x, c) with
      | #None => None[string*string]
      | Some n => Some(strip(x.[to n]),strip(x.[n+1 to]))
      endmatch
    ;
  }

  private proc fsize_: string*&size = """
    {struct stat st;
     stat($1.c_str(), &st);
     *$2 = st.st_size;}
  """;

  private gen fsize(name:string):size = {
    var sz:size;
    fsize_(name,&sz);
    return sz;
  }
}

//[server_config.flx]
include "web/__init__";

class ServerConfig {
  open HTTPHandler;
  open Logger;
  open SimpleConfig;
  open Assoc_list;

  struct server_config {
        delay : double;
        port : int;
        server_root : string;
        document_root : string;
        handlers: list[http_handler];
        log:log_message->void;
        params:list[string*string];
        file_name:string;
        application:string;
  };



  ctor server_config(handlers:list[http_handler]) =>
    server_config(0.05,8080,".","./html",handlers,
    logger(console_logger(INFO)+console_logger(ERROR)),Empty[string*string],"","");

  ctor server_config(handlers:list[http_handler],app:string) =>
    server_config(0.05,8080,".","./html",handlers,
    logger(console_logger(INFO)+console_logger(ERROR)),Empty[string*string],"",app);


  fun basic_server_config(handlers:list[http_handler]):server_config = {
    var cfg = server_config(handlers);
    match enhance_with_config_file(
     enhance_with_command_line_arguments(cfg)) with
    |Some(cfg),_ => return cfg;
    |None,m => return cfg;
    endmatch;

  }

  fun basic_server_config(handlers:list[http_handler],application:string,default_config:string):server_config = {
    var config = server_config(handlers,application);
    match enhance_with_config_file(
      enhance_with_command_line_arguments(config)) with
    |Some(cfg),_ => return cfg;
    |None,m =>  set_params(&config,read_config_text(default_config));
                 return config;
    endmatch;

 }

  fun enhance_with_command_line_arguments(var config:server_config):server_config = {
    var cfg:server_config = config;
    var arg = "";
    var argno = 1;
    while argno<System::argc do
      arg = System::argv argno;
      println$ "ARG=" + arg;
      if prefix(arg,"--document_root=") do
        cfg&.document_root <- arg.[16 to];
      elif prefix(arg,"--server_root=") do
        cfg&.server_root <- arg.[14 to];
      elif prefix(arg,"--port=") do
        cfg&.port <- atoi arg.[7 to];
      elif prefix(arg,"--config=") do
        cfg&.file_name <- arg.[9 to];
        if( not (FileStat::fileexists(cfg.file_name))) do
          proc_fail("unable to open config file:"+cfg.file_name);
        done
      elif prefix(arg,"--debug") do
        var dbg_log:list[log_handler];
        if prefix(arg,"--debug=") do
          val file:string =  str(arg.[8 to]);
          dbg_log = simple_logger(Logger::log("log",file,size(0),0ui),DEBUG);
        else
          dbg_log = console_logger(DEBUG);
        done;
        cfg&.log <- logger(console_logger(INFO)+console_logger(ERROR)+dbg_log);
      elif prefix(arg,"--help") do
        println("Usage: "+(System::argv 0)+""" [OPTION]
  --document-root=PATH    Path to document root directory defaults to ./html
  --server-root=PATH      Path to server root direcory defaults to cwd
  --port=PORT             Port to listen on
  --debug                 Logs DEBUG messages to STDOUT
  --debug=FILE            Logs DEBUG to log/FILE
""");
        System::exit(0);
      done
      ++argno;
    done
    return (cfg);
  }

  private fun tolower: char->char = "(char)::std::tolower($1)" requires Cxx_headers::cctype ;
  private fun toupper: char->char = "(char)::std::toupper($1)" requires Cxx_headers::cctype ;


  fun enhance_with_config_file(var config:server_config):opt[server_config]*string = {
    var cfg = config;
    val config_file_default = Filename::join("config","server_config.cfg");
    val enviro_config = Env::getenv((map toupper cfg.application)+"_CFG","");
    if cfg.file_name == "" do
        if enviro_config  == "" do
            var cwd_config = Filename::join(".",config_file_default);
            if FileStat::fileexists(cwd_config) do
                cfg&.file_name <- cwd_config;
            else
                var home = Env::getenv("HOME","");
                if home == "" do
                   return None[server_config],"Unable to open configuration file HOME environment variable undefined.";
                else
                    var home_config = Filename::join(home,
                    Filename::join(".felix",Filename::join(cfg.application,config_file_default)));
                    if FileStat::fileexists(home_config) do
                        cfg&.file_name <- home_config;
                    else
                        return None[server_config],("Unable to open configurationfile:" + home_config);
                    done
                done
            done
        else
            if FileStat::fileexists(enviro_config) do
                cfg&.file_name <- enviro_config;
            else
                return None[server_config],("Unable to open configurationfile:" + enviro_config);
            done
        done
    else
        if not(FileStat::fileexists(cfg.file_name)) do
            return None[server_config], ("Unable to open configurationfile:" + cfg.file_name);
        done
    done
    set_params(&cfg,read_config(cfg.file_name));
    return Some(cfg),("Configuration file " + cfg.file_name + " read.");
  }

  proc set_params(cfg:&server_config,params:list[string^2]) {
    cfg.params <- params;
    match find (fun (a:string,b:string) => eq(a,b)) params "port" with
      |Some s => cfg.port <- int(s);
      |_ => {}();
    endmatch;
    match find (fun (a:string,b:string) => eq(a,b)) params "server_root" with
      |Some s => cfg.server_root <- s;
      |_ => {}();
    endmatch;
    match find (fun (a:string,b:string) => eq(a,b)) params "document_root" with
      |Some s => cfg.document_root <- s;
      |_ => {}();
    endmatch;
    match find (fun (a:string,b:string) => eq(a,b)) params "delay" with
      |Some s => cfg.delay <- double(s);
      |_ => {}();
    endmatch;

  }

  fun strtod: string -> double = "strtod($1.data(),0)";


  instance Str[server_config] {
    fun str (cfg : server_config):string =>
       "Config file:" + cfg.file_name "\n" +
       (fold_left (fun(i:string) (c:string^2):string =>
         (i + c.(0) + " = " + c.(1) + "\n") ) "" (cfg.params));
  }

}

//[sundown.flx]
//$ A Markdown to Html translator.
class SunDown
{
  fun sundown: string -> string requires package "sundown";
}

//[web_server.flx]
publish """
Accepts connection and spawns fthread to handle request
See webapp.flx for usage example
"""

if PLAT_POSIX do
PosixSignal::ignore_signal(PosixSignal::SIGPIPE);
done

open Socket;
open IOStream;

open TerminalIByteStream[fd_t];
open TerminalIOByteStream[socket_t];


// this is a hack to make close work on a listenter
// RF got this right the first time:
// in the abstract a listener is NOT a socket
// In fact, it is a socket server, with accept() a way to
// read new sockets off it ..
open TerminalIByteStream[socket_t];

requires header '#include <stdlib.h>';

class WebServer {
  open ServerConfig;
  open HTTPRequest;
  open HTTPConnection;
  open MIMEType;
  open Eq[mime_type];
  open Assoc_list;
  open HTTPHandler;
  open Logger;

  proc serve(conn:http_connection, request: http_request)
  {
    val s = conn.sock;
    iter (proc (handler:http_handler) {
      if not *conn.dirty  do
        if handler.handles(conn.config,request) do
          handler.handler_fn(conn,request);
        done
      else
        goto finished;
      done
      }) conn.config.handlers;
    finished:>
    return;
  }

  proc start_webserver(config:server_config) {
    val webby_port = config.port;
    config.log(INFO, "Server started, listenting on "+str config.port);
    // up the queue len for stress testing
    var p = webby_port;
    var listener: socket_t;
    mk_listener(&listener, &p, 10);
    var clock = Faio::mk_alarm_clock();
    // noinline is necessary to stop the closure being
    // inlined into the loop, preventing the socket variable k
    // being duplicated as it must be [a bug in Felix]
    noinline proc handler (var k:socket_t) ()
    {
      config.log(DEBUG,"Spawned fthread running for socket "+str k);
      // should spawn fthread here to allow for more io overlap
      val conn = http_connection(config ,k);
      var request:http_request;
      open HTTPRequest;
      open  Eq[http_method];
      open MIMEType;
      HTTPRequest::get_request(conn,&request);
       Faio::sleep(clock,config.delay);
      /*Get entity form parameters if method is post and
        content type is application/x-www-form-urlencoded */
      //if str(request.hmethod) == str(POST) do
      match get_header(request,"Content-Type") with
        | Some c => {
          match parse_media_type(c) with
            | Some (m,a) => {
              if str(m) == str(application x_DASH_www_DASH_form_DASH_urlencoded) do
                HTTPRequest::get_entity_params(conn,&request,a);
              elif str(m) == str(form-data) do
                HTTPRequest::get_multipart_params(conn,&request,a);
              else
                request.entity_params=Empty[string*string];
              done
              }
            |_ =>  { request.entity_params=Empty[string*string]; }
          endmatch; }
        |_ => { request.entity_params=Empty[string*string]; }
      endmatch;
      serve(conn,request);
      Faio::sleep(clock,config.delay); // give OS time to empty its buffers
      // try this:
      // Advised by: koettermarkus@gmx.de, MANY THANKS!

      gen hack_recv: socket_t * &char * int * int -> int = "recv($1,$2,$3,$4)";

      var buf:char ^1025;
      var counter = 0;
      var extra = 0;
      shutdown(k,1); // shutdown write
      retry:>
        var b = hack_recv(k,C_hack::cast[&char] (&buf),1024,0);
        //println$ "Error code " + str b + " from read after shutdown";
        if b > 0 do
          extra += b;
          if extra > 2000 do
            config.log(WARNING,"Read too many extraneous bytes from OS buffer");
            goto force_close;
          done;
          goto retry;
        elif b == -1 do
        ++counter;
        if counter > 200 do
          config.log(WARNING,"Timeout waiting for write buffers to be flushed");
          goto force_close;
        done;
        Faio::sleep(clock,0.1); // 100 ms
        goto retry;
      done;
      assert b==0;

      force_close:>
      Socket::shutdown(k,2);
      ioclose(k);

    };

    noinline proc stuff {
      var s: socket_t;
      config.log(DEBUG,"Waiting for connection");
      accept(listener, &s);  // blocking
      config.log(DEBUG,"got connection "+str s);  // error check here

      //  - spawning an fthread is blocking the web server. don't know why
      config.log(DEBUG,"spawning fthread to handle connection "+str s);
      spawn_fthread$  handler s;
      collect(); // this hangs everything, no idea why!
    };
    while true do stuff; done

    config.log(INFO,"WEB SERVER SHUTDOWN");
    iclose (listener);
  }

}

Package: src/packages/grammar.fdoc

Base Grammar

key file
assertions.fsyn share/lib/grammar/assertions.fsyn
assignment.fsyn share/lib/grammar/assignment.fsyn
blocks.fsyn share/lib/grammar/blocks.fsyn
brackets.fsyn share/lib/grammar/brackets.fsyn
cbind.fsyn share/lib/grammar/cbind.fsyn
cgram.fsyn share/lib/grammar/cgram.fsyn
conditional.fsyn share/lib/grammar/conditional.fsyn
control.fsyn share/lib/grammar/control.fsyn
executable.fsyn share/lib/grammar/executable.fsyn
expressions.fsyn share/lib/grammar/expressions.fsyn
types.fsyn share/lib/grammar/types.fsyn
extra.files share/lib/grammar/extra.files
felix.fsyn share/lib/grammar/felix.fsyn
functions.fsyn share/lib/grammar/functions.fsyn
grammar.files share/lib/grammar/grammar.files
grammar_ident_lexer.fsyn share/lib/grammar/grammar_ident_lexer.fsyn
grammar_lexer.fsyn share/lib/grammar/grammar_lexer.fsyn
grammar_regdefs.fsyn share/lib/grammar/grammar_regdefs.fsyn
grammar_scheme_support.fsyn share/lib/grammar/grammar_scheme_support.fsyn
grammar_string_lexer.fsyn share/lib/grammar/grammar_string_lexer.fsyn
loops.fsyn share/lib/grammar/loops.fsyn
macros.fsyn share/lib/grammar/macros.fsyn
namespaces.fsyn share/lib/grammar/namespaces.fsyn
patterns.fsyn share/lib/grammar/patterns.fsyn
plugins.fsyn share/lib/grammar/plugins.fsyn
python_grammar.fsyn share/lib/grammar/python_grammar.fsyn
requirements.fsyn share/lib/grammar/requirements.fsyn
save.fsyn share/lib/grammar/save.fsyn
statements.fsyn share/lib/grammar/statements.fsyn
texsyms.fsyn share/lib/grammar/texsyms.fsyn
type_decls.fsyn share/lib/grammar/type_decls.fsyn
utility.fsyn share/lib/grammar/utility.fsyn
variables.fsyn share/lib/grammar/variables.fsyn
chips.fsyn share/lib/grammar/chips.fsyn
key file
setexpr.fsyn share/lib/std/algebra/setexpr.fsyn
cmpexpr.fsyn share/lib/std/algebra/cmpexpr.fsyn
pordcmpexpr.fsyn share/lib/std/algebra/pordcmpexpr.fsyn
tordcmpexpr.fsyn share/lib/std/algebra/tordcmpexpr.fsyn
addexpr.fsyn share/lib/std/algebra/addexpr.fsyn
mulexpr.fsyn share/lib/std/algebra/mulexpr.fsyn
divexpr.fsyn share/lib/std/algebra/divexpr.fsyn
bitexpr.fsyn share/lib/std/algebra/bitexpr.fsyn
key file
swapop.fsyn share/lib/grammar/swapop.fsyn
key file
int.fsyn share/lib/grammar/grammar_int_lexer.fsyn
float.fsyn share/lib/grammar/grammar_float_lexer.fsyn
tupleexpr.fsyn share/lib/std/datatype/tupleexpr.fsyn
debug.fsyn share/lib/grammar/debug.fsyn
exceptions.fsyn share/lib/std/control/exceptions.fsyn
spipeexpr.fsyn share/lib/std/control/spipeexpr.fsyn
listexpr.fsyn share/lib/std/datatype/listexpr.fsyn
key file
boolexpr.fsyn share/lib/std/scalar/boolexpr.fsyn
parser_syn.fsyn share/lib/std/strings/parser_syn.fsyn
pfor.fsyn share/lib/grammar/pfor.fsyn
key file
regexps.fsyn share/lib/std/regex/regexps.fsyn
stringexpr.fsyn share/lib/std/strings/stringexpr.fsyn

Type Grammar

//[types.fsyn]

syntax types {
  requires expressions;

  stype := t[slambda_pri] =># "_1";
  stypeexpr := t[>sor_condition_pri] =># "_1";
  stypeexpr_comma_list = list::commalist1<stypeexpr>;

  //$ Anonymous type function (lamda).
  t[slambda_pri] := "fun" stypefun_args ":" stypeexpr "=>" stype =>#
    """
    `(typ_typefun ,_sr ,_2 ,_4 ,_6)
    """;

  t[sas_expr_pri] := t[sas_expr_pri] "as" sname =># "`(typ_as ,_sr (,_1 ,_3))";

  t[stuple_pri] := stypeexpr ("," stypeexpr )+ =># "(chain 'typ_type_tuple _1 _2)";

  t[simplies_condition_pri] := t[simplies_condition_pri] "implies" t[>simplies_condition_pri] =># "`(typ_implies ,_sr ,_1 ,_3)";
  t[sor_condition_pri] := t[sor_condition_pri] "or" t[>sor_condition_pri] =># "`(typ_or ,_sr ,_1 ,_3)";
  t[sand_condition_pri] := t[sand_condition_pri]  "and" t[>sand_condition_pri] =># "`(typ_and ,_sr ,_1 ,_3)";
  t[snot_condition_pri] := "not" t[snot_condition_pri]  =># "`(typ_not ,_sr ,_2)";
  t[satomic_pri] := "true"  =># "`(typ_true,_sr)";
  t[satomic_pri] := "false"  =># "`(typ_false ,_sr)";

  t[ssum_pri] := t[ssum_pri] "`+" t[>ssum_pri] =># "(tInfix)";
  t[ssum_pri] := t[ssum_pri] "`-" t[>ssum_pri] =># "(tInfix)";
  t[ssum_pri] := t[ssum_pri] "`*" t[>ssum_pri] =># "(tInfix)";
  t[ssum_pri] := t[ssum_pri] "`/" t[>ssum_pri] =># "(tInfix)";
  t[ssum_pri] := t[ssum_pri] "`%" t[>ssum_pri] =># "(tInfix)";
  t[ssum_pri] := t[>scomparison_pri] "`==" t[>scomparison_pri] =># "(tInfix)";
  t[ssum_pri] := t[>scomparison_pri] "`<" t[>scomparison_pri] =># "(tInfix)";
  t[ssum_pri] := t[>scomparison_pri] "`>" t[>scomparison_pri] =># "(tInfix)";

  t[scomparison_pri]:= t[>scomparison_pri] cmp t[>scomparison_pri] =>#
   "(tbinop _2 _1 _3))";

  t[ssetunion_pri] := t[ssetunion_pri] "\cup" t[>ssetunion_pri] =># "`(typ_typesetunion ,_sr ,_1 ,_3)";
  t[ssetintersection_pri] := t[ssetintersection_pri] "\cap" t[>ssetintersection_pri] =># "`(typ_typesetintersection ,_sr ,_1 ,_3)";

  // right arrows: RIGHT ASSOCIATIVE!
  //$ Function type, right associative.
  t[sarrow_pri] := t[>sarrow_pri] "->" t[sarrow_pri] =># "`(typ_arrow (,_1 ,_3))";
  t[sarrow_pri] := t[>sarrow_pri] "->" "[" stype "]" t[sarrow_pri] =># "`(typ_effector (,_1 ,_4 ,_6))";

  //$ C function type, right associative.
  t[sarrow_pri] := t[>sarrow_pri] "-->" t[sarrow_pri] =># "`(typ_longarrow (,_1 ,_3))";

  //$ Addition: left non-associative.
  t[ssum_pri] := t[>ssum_pri] ("+" t[>ssum_pri])+ =># "(chain 'typ_sum _1 _2)" note "add";

  //$ multiplication: non-associative.
  t[sproduct_pri] := t[>sproduct_pri] ("*" t[>sproduct_pri])+ =># "(chain 'typ_tuple _1 _2)" note "mul";

  t[sproduct_pri] := t[>sproduct_pri] "*+" t[sproduct_pri] =># "`(typ_rptsum ,_sr ,_1 ,_3)";

  //$ Prefix
  t[sprefixed_pri] := "~" t[sprefixed_pri] =># "`(typ_dual ,_sr ,_2)";

  t[sprefixed_pri] := "!" t[sprefixed_pri] =># "(tPrefix)";
  t[sprefixed_pri] := "+" t[sprefixed_pri] =># "(tprefix 'prefix_plus)";
  t[sprefixed_pri] := "-" t[sprefixed_pri] =># "(tprefix 'neg)";


  //$ Fortran power.
  t[spower_pri] := t[ssuperscript_pri] "**" t[sprefixed_pri] =># "`(typ_tuple_cons ,_sr ,_1 ,_3)";
  t[spower_pri] := t[ssuperscript_pri] "<**>" t[sprefixed_pri] =># "(typ_tuple_snoc ,_sr ,_1 ,_3)";

  //$ Superscript, exponential.
  t[ssuperscript_pri] := t[ssuperscript_pri] "^" t[srefr_pri] =># "`(typ_superscript ,_1 ,_3)";

  t[sapplication_pri] := t[sapplication_pri] t[>sapplication_pri] =>#
    "`(typ_apply ,_sr (,_1 ,_2))" note "apply";

  t[sapplication_pri] := "typesetof" "(" list::commalist1<stypeexpr> ")" =>#
    "`(typ_typeset ,_sr ,_3)";

  t[sfactor_pri] := t[sfactor_pri] "." t[>sfactor_pri] =># "`(typ_apply ,_sr (,_3 ,_1))";


  t[sthename_pri] := "typeof" "(" sexpr ")" =># "`(typ_typeof ,_sr ,_3)";

  t[sthename_pri] := "_typeop" "(" sstring "," stypeexpr "," stypeexpr ")" =>#
    "`(typ_typeop ,_sr ,_3 ,_5 ,_7)";
  t[sthename_pri] := "&" t[sthename_pri] =># "`(typ_ref ,_sr ,_2)";

  //$ Felix pointer type and address of operator.
  t[sthename_pri] := "_uniq"   t[sthename_pri] =># "`(typ_uniq ,_sr ,_2)";
  t[sthename_pri] := "_rref"   t[sthename_pri] =># "`(typ_rref ,_sr ,_2)";
  t[sthename_pri] := "&<"      t[sthename_pri] =># "`(typ_rref ,_sr ,_2)";
  t[sthename_pri] := "_wref"   t[sthename_pri] =># "`(typ_wref ,_sr ,_2)";
  t[sthename_pri] := "&>"      t[sthename_pri] =># "`(typ_wref ,_sr ,_2)";
  t[sthename_pri] := "@"       t[sthename_pri] =># "(tPrefix)";
  t[sthename_pri] := squalified_name =># "_1";

// TYPE MATCH HACKS .. FIX LATER
  t[sthename_pri] := "?" sname =># "`(typ_patvar ,_sr ,_2)";

  t[sthename_pri] := "#?" sinteger =># "`(PARSER_ARGUMENT ,_2)";

  //$ Match anything without naming the subexpression.
  tatom := "_" =># "`(typ_patany ,_sr)";

  t[satomic_pri] := tatom =># "_1";

  //$ Record type.
  tatom := "(" srecord_mem_decl ("," srecord_mem_decl2)*  ")" =>#
   "`(ast_record_type ,(cons _2 (map second _3)))";
    srecord_mem_decl := sname ":" stypeexpr =># "`(,_1 ,_3)";
    srecord_mem_decl := ":" stypeexpr =># '`("" ,_2)';
    srecord_mem_decl2 := sname ":" stypeexpr =># "`(,_1 ,_3)";
    srecord_mem_decl2 := ":" stypeexpr =># '`("" ,_2)';
    srecord_mem_decl2 := stypeexpr =># '`("" ,_1)';

  //$ polyRecord type.
  tatom := "(" srecord_mem_decl ("," srecord_mem_decl2)*  "|" stypeexpr ")" =>#
   "`(ast_polyrecord_type ,(cons _2 (map second _3)) ,_5)";


  // INCONSISTENT GRAMMAR (no separator between items??
  //$ Variant type.
  tatom := "(" stype_variant_items ")" =># "`(ast_variant_type ,_2)";
    stype_variant_item := "case" sname "of" stypeexpr =># "`(ctor ,_2 ,_4)";
    stype_variant_item := "case" sname =># "`(ctor ,_2 ,(noi 'unit))";
    stype_variant_item := "`" sname "of" stypeexpr =># "`(ctor ,_2 ,_4)";
    stype_variant_item := "`" sname =># "`(ctor ,_2 ,(noi 'unit))";

    stype_variant_item_bar := "|" stype_variant_item =># "_2";
    stype_variant_item_bar := "|" stypeexpr =># "`(base ,_2)";
    stype_variant_items := stypeexpr stype_variant_item_bar+ =># "(cons `(base ,_1) _2)";
    stype_variant_items := stype_variant_item stype_variant_item_bar* =># "(cons _1 _2)";
    stype_variant_items := stype_variant_item_bar+ =># "_1";

  // can't use typeexpr here because trailing ">" is a comparison operator ..
  tatom := "_pclt<" t[>scomparison_pri] "," t[>scomparison_pri] ">" =># "`(typ_pclt ,_sr ,_2 ,_4)" ;
  tatom := "_rpclt<" t[>scomparison_pri] "," t[>scomparison_pri] ">" =># "`(typ_rpclt ,_sr ,_2 ,_4)" ;
  tatom := "_wpclt<" t[>scomparison_pri] "," t[>scomparison_pri] ">" =># "`(typ_wpclt ,_sr ,_2 ,_4)" ;


  //$ scalar literals (numbers, strings).
  tatom := sliteral =># "_1";
  tatom := "(" ")" =># "`(typ_type_tuple ,_sr ())";
  tatom := "(" stype ")" =># "_2";
  tatom := "extend" stypeexpr_comma_list "with" stypeexpr "end" =># """
    `(typ_type_extension ,_sr ,_2 ,_4)
  """;

  tatom := stypematch =># '_1';

  stypematch := "typematch" stype "with" stype_matching+ "endmatch" =>#
    "`(ast_type_match ,_sr (,_2 ,_4))";
  stypematch := "subtypematch" stype "with" stype_matching+ "endmatch" =>#
    "`(ast_subtype_match ,_sr (,_2 ,_4))";
  stype_matching := "|" stype "=>" stype =># "`(,_2 ,_4)";


// TYPE LANGUAGE ENDS
}
Expressions.

See also other packages containing extensions.

//[expressions.fsyn]
syntax expressions {
  priority
    let_pri <
    slambda_pri <
    spipe_apply_pri <
    sdollar_apply_pri <

    // TUPLES
    stuple_cons_pri <
    stuple_pri <

    // LOGIC
    simplies_condition_pri <
    sor_condition_pri <
    sand_condition_pri <
    snot_condition_pri <

    // TEX LOGIC
    stex_implies_condition_pri <
    stex_or_condition_pri <
    stex_and_condition_pri <
    stex_not_condition_pri <

    // COMPARISONS
    scomparison_pri <
    sas_expr_pri <

    // SETWISE OPERATORS
    ssetunion_pri <
    ssetintersection_pri <
    sarrow_pri <
    scase_literal_pri <

    // BITWISE OPERATORS
    sbor_pri <
    sbxor_pri <
    sband_pri <
    sshift_pri <

    // NUMERIC OPERATORS
    ssum_pri <
    ssubtraction_pri <
    sproduct_pri <
    s_term_pri <        // division

    // STUFF
    sprefixed_pri <
    spower_pri <
    ssuperscript_pri <
    srefr_pri <
    scoercion_pri <

    // WHITESPACE APPLICATION
    sapplication_pri <
    sfactor_pri <
    srcompose_pri <
    sthename_pri <
    satomic_pri
  ;

  requires
    types, setexpr, cmpexpr, pordcmpexpr, tordcmpexpr,
    addexpr, mulexpr, divexpr,
    bitexpr,
    spipeexpr, boolexpr, stringexpr, listexpr, tupleexpr
  ;
  sexpr := x[let_pri] =># "_1";

  //$ Let binding.
  x[let_pri] := "let" spattern "=" x[let_pri] "in" x[let_pri] =># "`(ast_letin ,_sr (,_2 ,_4 ,_6))";

  //$ Let fun binding.
  x[let_pri] := "let" "fun" sdeclname sfun_arg* fun_return_type "=>" x[let_pri] "in" x[let_pri] =>#
    """
    (let*
      (
        (body `((ast_fun_return ,_sr ,_7)))
        (fun_decl `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ,(first _5) ,(second _5) Function () ,body))
        (final_return `(ast_fun_return ,_sr ,_9))
      )
      (block_expr `(,fun_decl ,final_return))
    )
    """;

  // FIXME
  x[let_pri] := "let" "fun" sdeclname fun_return_type "=" smatching+ "in" x[let_pri] =>#
    """
    (let*
      (
        (ixname _3)
        (name (first ixname))
        (tvars (second ixname))
        (t (first (first _4)))
        (traint (second (first _4)))
        (matching _6)
        (expr _8)
      )
      (if (eq? 'typ_arrow (first t))
        (let*
          (
            (argt (caadr t))
            (ret (cadadr t))
            (params `((((,_sr PVal _a ,argt none)) none))) ;; parameters
            (body `((ast_fun_return ,_sr (ast_match ,_sr (,(noi '_a) ,matching)))))
            (fun_decl `(ast_curry ,_sr ,name ,tvars ,params
               (,ret ,traint)
               Function () ,body)
            )
            (final_return `(ast_fun_return ,_sr ,expr))
          )
          (block_expr `(,fun_decl ,final_return))
        )
        'ERROR
      )
    )
    """;



  //$ Unterminated match
  x[let_pri] := "let" pattern_match =># "_2";

  //$ Conditional expression.
  x[let_pri] := sconditional =># '_1';

  //$ Pattern matching.
  x[let_pri] := pattern_match =># '_1';


  //$ Low precedence right associative application.
  x[sdollar_apply_pri] := x[>sdollar_apply_pri] "$" x[sdollar_apply_pri] =>#
    "`(ast_apply ,_sr (,_1 ,_3))";

  //$ Low precedence left associative reverse application.
  x[spipe_apply_pri] := x[spipe_apply_pri] "|>" x[>spipe_apply_pri] =>#
    "`(ast_apply ,_sr (,_3 ,_1))";

  //$ Haskell-ish style infix notation of functions   foo(x,y) => x `(foo) y
  x[stuple_pri]  := x[stuple_pri] "`(" sexpr ")" sexpr =>#
    "(binop _3 _1 _5)";

  //$ Named temporary value.
  x[sas_expr_pri] := x[sas_expr_pri] "as" sname =># "`(ast_as ,_sr (,_1 ,_3))";

  //$ Named variable.
  x[sas_expr_pri] := x[sas_expr_pri] "as" "var" sname =># "`(ast_as_var ,_sr (,_1 ,_4))";


//  x[sarrow_pri] := x[>sarrow_pri] ".." x[>sarrow_pri] =># '''
//    `(ast_apply ,_sr ((ast_apply ,_sr (,(nos "slice_range") ,_1)) ,_3))
//  ''';
//
//  x[sarrow_pri] := x[>sarrow_pri] "..<" x[>sarrow_pri] =># '''
//    `(ast_apply ,_sr ((ast_apply ,_sr (,(nos "slice_range_excl") ,_1)) ,_3))
//  ''';

  x[sarrow_pri] := x[>sarrow_pri] ".." x[>sarrow_pri] =># "(infix 'Slice_range_incl)";
  x[sarrow_pri] := x[>sarrow_pri] "..<" x[>sarrow_pri] =># "(infix 'Slice_range_excl)";
  x[sarrow_pri] := "..<" x[>sarrow_pri] =># "(prefix 'Slice_to_excl)";
  x[sarrow_pri] := ".." x[>sarrow_pri] =># "(prefix 'Slice_to_incl)";
  x[sarrow_pri] := x[>sarrow_pri] ".." =># "(suffix 'Slice_from)";
  x[sarrow_pri] := ".." =># """`(ast_name ,_sr "Slice_all" () )""";
  x[sarrow_pri] := "..[" stypeexpr "]" =># """`(ast_type_slice ,_sr ,_2 )""";
  x[sarrow_pri] := x[>sarrow_pri] ".+" x[>sarrow_pri] =># "(infix 'Slice_from_counted)";


  x[scase_literal_pri] := "case" sinteger =># "`(ast_case_tag ,_sr ,_2))";
  x[scase_literal_pri] := "`" sinteger =># "`(ast_case_tag ,_sr ,_2))";

  //$ Case value.
  x[scase_literal_pri] := "case" sinteger "of" t[ssum_pri] =># "`(ast_unitsum_literal  ,_sr ,_2 ,_4)";
  x[scase_literal_pri] := "`" sinteger "of" t[ssum_pri] =># "`(ast_unitsum_literal ,_sr  ,_2 ,_4)";
  x[scase_literal_pri] := "`" sinteger ":" t[ssum_pri] =># "`(ast_unitsum_literal ,_sr ,_2 ,_4)";

  //$ Tuple projection function.
  x[scase_literal_pri] := "proj" sinteger "of" t[ssum_pri] =># "`(ast_projection ,_sr ,_2 ,_4)";
  x[scase_literal_pri] := "aproj" sexpr "of" t[ssum_pri] =># "`(ast_array_projection ,_sr ,_2 ,_4)";
  x[scase_literal_pri] := "ident" "of" t[ssum_pri] =># "`(ast_identity_function ,_sr ,_3)";

  // coarray injection
  // (ainj (r:>>4) of (4 *+ int)) 42
  x[scase_literal_pri] := "ainj"  stypeexpr "of" t[ssum_pri] =># "`(ast_ainj ,_sr ,_2 ,_4)";

  spv_name := "case" sname =># "_2";
  spv_name := "`" sname =># "_2";

  //$ Variant value.
  x[sthename_pri] := "#" spv_name =># "`(ast_variant (,_2 ()))";
  x[sapplication_pri] := spv_name  x[>sapplication_pri] =># "`(ast_variant (,_1 ,_2))";

  //$ multiplication: right associative
  x[sproduct_pri] := x[>sproduct_pri] "\otimes" x[sproduct_pri] =># "(Infix)";

  // repeated sum type, eg 4 *+ int == int + int + int + int
  // right associative:  2 *+ 3 *+ int is approx 6 *+ int
  //x[sproduct_pri] := x[>sproduct_pri] "*+" x[sproduct_pri] =># "`(ast_rptsum_type ,_sr ,_1 ,_3)";

//------------------------------------------------------------------------

  //$ Prefix exclaim.
  x[sprefixed_pri] := "!" x[sprefixed_pri] =># "(Prefix)";

  //$ Prefix plus.
  x[sprefixed_pri] := "+" x[sprefixed_pri] =># "(prefix 'prefix_plus)";

  //$ Prefix negation.
  x[sprefixed_pri] := "-" x[sprefixed_pri] =># "(prefix 'neg)";

  //$ Prefix complement.
  x[sprefixed_pri] := "~" x[sprefixed_pri] =># "(Prefix)";

  //$ Fortran power.
  x[spower_pri] := x[ssuperscript_pri] "**" x[sprefixed_pri] =># "(infix 'pow)";
  x[spower_pri] := x[ssuperscript_pri] "<**>" x[sprefixed_pri] =># "(infix 'tuple_snoc)";

  //$ Superscript, exponential.
  x[ssuperscript_pri] := x[ssuperscript_pri] "^" x[srefr_pri] =># "`(ast_superscript (,_1 ,_3))";

  //$ composition
  x[ssuperscript_pri] := x[ssuperscript_pri] "\circ" x[>ssuperscript_pri] =># "(Infix)";
  x[ssuperscript_pri] := x[ssuperscript_pri] "\cdot" x[>ssuperscript_pri] =># "(Infix)";

//------------------------------------------------------------------------
  //$ C dereference.
  x[srefr_pri] := "*" x[srefr_pri] =># "(prefix 'deref)";

  //$ Deref primitive.
  //x[srefr_pri] := "_deref" x[srefr_pri] =># "`(ast_deref ,_sr ,_2)";

  //$ Operator new.
  x[srefr_pri] := "new" x[srefr_pri] =># "`(ast_new ,_sr ,_2)";

//------------------------------------------------------------------------
  //$ Operator whitespace: application.
  x[sapplication_pri] := x[sapplication_pri] x[>sapplication_pri] =>#
    "`(ast_apply ,_sr (,_1 ,_2))" note "apply";

  //$ Variant index.
  x[sapplication_pri] := "caseno" x[>sapplication_pri] =># "`(ast_case_index ,_sr ,_2)";
  x[sapplication_pri] := "casearg" x[>sapplication_pri] =># "`(ast_rptsum_arg ,_sr ,_2)";

  //$ Optimisation hint: likely.
  //$ Use in conditionals, e.g. if likely(x) do ...
  x[sapplication_pri] := "likely" x[>sapplication_pri] =># "`(ast_likely ,_sr ,_2)";

  //$ Optimisation hint: unlikely.
  //$ Use in conditionals, e.g. if unlikely(x) do ...
  x[sapplication_pri] := "unlikely" x[>sapplication_pri] =># "`(ast_unlikely ,_sr ,_2)";

//------------------------------------------------------------------------
  //$ Suffixed coercion.
  x[slambda_pri] := x[>slambda_pri] ":>>" stypeexpr =># "`(ast_coercion ,_sr (,_1 ,_3))";

  x[sfactor_pri] := ssuffixed_name =># "_1";

//------------------------------------------------------------------------
  //$ Reverse application.
  x[sfactor_pri] := x[sfactor_pri] "." x[>sfactor_pri] =>#
    "`(ast_apply ,_sr (,_3 ,_1))";


  //$ Reverse application with dereference.
  //$ a *. b same as (*a) . b, like C  a -> b.
  x[sfactor_pri] := x[sfactor_pri] "*." x[>sfactor_pri] =># "`(ast_apply ,_sr (,_3 (ast_deref ,_sr ,_1)))";

  //$ a &. b is similar to &a . b for an array, but can be overloaded
  //$ for abstract arrays: like a + b in C. Returns pointer.
  // x[sfactor_pri] := x[sfactor_pri] "&." sthe_name =># "(Infix)";
  x[sfactor_pri] := x[sfactor_pri] "&." x[>sfactor_pri] =># "`(ast_apply ,_sr (,_3 (ast_ref ,_sr ,_1)))";

//------------------------------------------------------------------------

  //$ Reverse composition
  x[srcompose_pri] := x[srcompose_pri] "\odot" x[>srcompose_pri] =># "(Infix)";

//------------------------------------------------------------------------
  //$ High precedence unit application. #f = f ().
  x[sthename_pri] := "#" x[sthename_pri] =># "`(ast_apply ,_sr (,_2 (ast_tuple ,_sr ())))";

  //$ Felix pointer type and address of operator.
  x[sthename_pri] := "&" x[sthename_pri] =># "`(ast_ref ,_sr ,_2)";

  //$ Felix pointer type and address of operator.
  x[sthename_pri] := "_uniq" x[sthename_pri] =># "`(ast_uniq ,_sr ,_2)";
  x[sthename_pri] := "_rref" x[sthename_pri] =># "`(ast_rref ,_sr ,_2)";
  x[sthename_pri] := "&<" x[sthename_pri] =># "`(ast_rref ,_sr ,_2)";
  x[sthename_pri] := "_wref" x[sthename_pri] =># "`(ast_wref ,_sr ,_2)";
  x[sthename_pri] := "&>" x[sthename_pri] =># "`(ast_wref ,_sr ,_2)";


  //$ Felix address of operator.
  x[sthename_pri] := "label_address" sname =># "`(ast_label_ref ,_sr ,_2)";


  //$ macro expansion freezer.
  x[sthename_pri] := "noexpand" squalified_name =># "`(ast_noexpand ,_sr ,_2)";

  //$ pattern variable.
  x[sthename_pri] := "?" sname =># "`(ast_patvar ,_sr ,_2)";

  //$ Template replacement index.
  x[sthename_pri] := "#?" sinteger =># "`(PARSER_ARGUMENT ,_2)";

  x[sthename_pri] := squalified_name =># "_1";


  //$ Qualified name.
  sreally_qualified_name := squalified_name "::" ssimple_name_parts =>#
    "`(ast_lookup (,_1 ,(first _3) ,(second _3)))";

  squalified_name := sreally_qualified_name =># '_1';

  squalified_name := ssimple_name_parts =>#
    "`(ast_name ,_sr ,(first _1) ,(second _1))";

  ssimple_name_parts := sname =># "`(,_1 ())";
  ssimple_name_parts := sname "[" "]" =># "`(,_1 ())";
  ssimple_name_parts := sname "[" stypeexpr_comma_list "]" =># "`(,_1 ,_3)";

  //$ Suffixed name (to name functions).
  ssuffixed_name := squalified_name "of" t[sthename_pri] =>#
    "`(ast_suffix (,_1 ,_3))";

//------------------------------------------------------------------------
  x[satomic_pri] := satom =># "_1";
  //$ record value (comma separated).
  satom := "(" rassign ("," rassign2 )* ")" =>#
    "`(ast_record ,_sr ,(cons _2 (map second _3)))"
  ;
    rassign := sname "=" x[sor_condition_pri] =># "`(,_1 ,_3)";
    rassign := "=" x[sor_condition_pri] =># '`("" ,_2)';
    rassign2 := sname "=" x[sor_condition_pri] =># "`(,_1 ,_3)";
    rassign2 := "=" x[sor_condition_pri] =># '`("" ,_2)';
    rassign2 := x[sor_condition_pri] =># '`("" ,_1)';

  //$ polyrecord value
  //$ record value (comma separated).
  satom := "(" rassign ("," rassign2 )* "|" sexpr ")" =>#
    "`(ast_polyrecord ,_sr ,(cons _2 (map second _3)) ,_5)"
  ;

  satom := "(" sexpr "without" sname+ ")" =>#
    "`(ast_remove_fields ,_sr ,_2 ,_4)"
  ;

  satom := "(" sexpr "with" rassign ("," rassign2 )* ")" =>#
    "`(ast_replace_fields ,_sr ,_2 ,(cons _4 (map second _5)))"
  ;


  //$ record value, statement list.
  //$ this variant is useful for encapsulating
  //$ a series of var x = y; style statements.
  satom := "struct" "{" vassign+ "}" =>#
    "`(ast_record ,_sr ,_3 )"
  ;
    vassign := "var" sname "=" sexpr ";" =># "`(,_2 ,_4)";

  //$ scalar literals (numbers, strings).
  satom := sliteral =># "_1";

  //$ Wildcard pattern.
  satom := _ =># "`(ast_patany ,_sr)";

  //$ Ellipsis (for binding C varags functions).
  satom := "..." =># "`(ast_ellipsis ,_sr)";

  //$ Callback expression.
  satom := "callback" "[" sexpr "]" =># "`(ast_callback ,_sr ,_3)";

  //$ Short form anonymous procedure closure.
  satom := scompound =># "(lazy _1)";

  //$ Short form sequence operator.
  //$ ( stmt; expr ) means the same as #{stmt; return expr; }
  satom := "(" stmt+ sexpr ")" =>#
    """
    (
      let*
      (
        (stmts _2)
        (expr _3)
        (retexp `(ast_fun_return ,_sr ,expr))
        (nustmts (append stmts (list retexp)))
      )
      (block_expr nustmts)
    )
    """
  ;

  //$ special anonymous variable forces eager eval.
  satom := "(" "var" sexpr ")" =>#
    """
    (
      let
      (
        (name (fresh_name "asvar"))
      )
      `(ast_as_var ,_sr (,_3 ,name))
    )
    """
  ;

  //$ inline scheme
  satom := "schemelex" sstring =># "(schemelex _2)";
  satom := "schemerun" sstring =># "(schemerun _2)";
  //$ Empty tuple (unit tuple).
  satom := "(" ")" =># "'()";

  //$ Object extension.
  expr_comma_list := list::commalist1<x[scomparison_pri]> =># "_1";
  satom := "extend" expr_comma_list "with" sexpr "end" =># """
    `(ast_extension ,_sr ,_2 ,_4)
  """;

    setbar := "|" =># "_1";
    setbar := "\|" =># "_1";
    setbar := "\mid" =># "_1";

  setform := spattern ":" stypeexpr setbar sexpr =>#
    """
    (let*
      (
         (argt _3)
         (ret (nos "bool"))
         (matchings `((,_1 ,_5)((pat_setform_any ,_sr)(ast_false ,_sr))))
         (body `((ast_fun_return ,_sr (ast_match ,_sr (,(noi '_a) ,matchings)))))
         (param `(,_sr PVal _a ,argt none)) ;; one parameter
         (params `( Satom ,param ))            ;; parameter tuple list
         (paramsx `(,params none))     ;; parameter tuple list with precondition
         (paramsxs `(,paramsx))        ;; curry parameters
         (method `(ast_curry ,_sr "has_elt"  ,dfltvs ,paramsxs (,ret none) Method () ,body))
         (objsts `(,method))
         (object `(ast_object ,_sr (,dfltvs ,dfltparams typ_none ,objsts)))
      )
      `(ast_apply ,_sr (,object (ast_tuple ,_sr ())))
    )
    """;

  satom := "{" setform  "}" =># "_2";
  satom := "\{" setform  "\}" =># "_2";



}

Grammar Base

Assertions
//[assertions.fsyn]
//$ Assertion statements.
//$ See also functions to find pre- and post-conditions.
syntax assertions {
  requires statements;

  stmt = assertion_stmt;

  //$ The usual assert statement.
  //$ Abort the program if the argument expression evaluates to false
  //$ when control flows through the assert statement.
  //$ Cannot be switched off!
  private assertion_stmt := "assert" sexpr ";" =># "`(ast_assert ,_sr ,_2)";

  //$ Static assert: type expression of kind BOOL required
  private assertion_stmt := "static-assert" stype ";" =># "`(ast_static_assert ,_sr ,_2)";

  //$ Define an axiom with a general predicate.
  //$ An axiom is a function which is true for all arguments.
  //$ Axioms are core assertions about invariants which
  //$ can be used to specify semantics and form the basis
  //$ of reasoning about semantics which goes beyond
  //$ structure.
  private assertion_stmt  := "axiom" sdeclname sfun_arg ":" sexpr ";" =>#
    """
      `(ast_axiom ,_sr ,(first _2) ,(second _2) ,_3 (Predicate ,_5))
    """;

  //$ A variant of an axiom which expresses the semantic
  //$ equality of two expressions. Do not confuse this
  //$ with an expresion containing run time equality (==).
  //$ Semantic equality means that one expression could be
  //$ replaced by the other without any observable difference
  //$ in behaviour in any program, this can be asserted even
  //$ if the type does not provide an equality operator (==).
  private assertion_stmt  := "axiom" sdeclname sfun_arg ":" sexpr "=" sexpr ";" =>#
    """
      `(ast_axiom ,_sr ,(first _2) ,(second _2) ,_3 (Equation (,_5 ,_7)))
    """;

  //$ A lemma is a proposition which it is expected could
  //$ be proved by a good automatic theorem prover,
  //$ given the axioms. This is the predicate form.
  private assertion_stmt  := "lemma" sdeclname sfun_arg ":" sexpr ";" =>#
    """
      `(ast_lemma ,_sr ,(first _2) ,(second _2) ,_3 (Predicate ,_5))
    """;

  //$ A lemma is a proposition which it is expected could
  //$ be proved by a good automatic theorem prover,
  //$ given the axioms. This is the equational form.
  private assertion_stmt  := "lemma" sdeclname sfun_arg ":" sexpr "=" sexpr ";" =>#
    """
      `(ast_lemma ,_sr ,(first _2) ,(second _2) ,_3 (Equation (,_5 ,_7)))
    """;

  //$ A theorem is a proposition which it is expected could
  //$ NOT be proved by a good automatic theorem prover,
  //$ given the axioms.  In the future, we might like to
  //$ provide a "proof sketch" which a suitable tool could
  //$ fill in. For the present, you can give a proof as
  //$ plain text in a string as a hint to the reader.
  //$
  //$ This is the predicative form.
  private assertion_stmt  := "theorem" sdeclname sfun_arg ":" sexpr proof? ";" =>#
    """
      `(ast_axiom ,_sr ,(first _2) ,(second _2) ,_3 (Predicate ,_5))
    """;
    proof := "proof" sstring;

  //$ A theorem is a proposition which it is expected could
  //$ NOT be proved by a good automatic theorem prover,
  //$ given the axioms.  In the future, we might like to
  //$ provide a "proof sketch" which a suitable tool could
  //$ fill in. For the present, you can give a proof as
  //$ plain text in a string as a hint to the reader.
  //$
  //$ This is the equational form.
  private assertion_stmt  := "theorem" sdeclname sfun_arg ":" sexpr "=" sexpr proof? ";" =>#
    """
      `(ast_axiom ,_sr ,(first _2) ,(second _2) ,_3 (Equation (,_5 ,_7)))
    """;

  //$ A reduction is a special kind of proposition of equational
  //$ form which also directs the compiler to actually replace
  //$ the LHS expression with the RHS expression when found.
  //$
  //$ Reductions allow powerful high level optimisations,
  //$ such as eliminating two successive list reversals.
  //$
  //$ The client must take great care that reductions don't
  //$ lead to infinite loops. Confluence isn't required but
  //$ is probably desirable.
  //$
  //$ Reductions should be used sparingly because searching
  //$ for patterns to reduce is applied to every sub-expression
  //$ of every expression in the whole program, repeatedly
  //$ after any reduction is applied, and this whole process
  //$ is done at several different places in the program,
  //$ to try to effect the reductions. Particularly both
  //$ before and after inlining, since that can destroy
  //$ or create candidate patterns.

  private assertion_stmt  := "reduce" sname "|"? sreductions ";"  =>#
    """
      `(ast_reduce ,_sr ,_2 ,_4)
    """;

     private sreduce_args := "(" stypeparameter_comma_list ")" =># "_2";
     private sreduction := stvarlist sreduce_args ":" sexpr "=>" sexpr =># "`(,_1 ,_2 ,_4 ,_6)";
     private sreductions := sreduction =># "`(,_1)";
     private sreductions := sreduction "|" sreductions =># "(cons _1 _3)";
}
Assignments

Defines assignment forms.

//[assignment.fsyn]
//$ Assignment forms.
syntax assignment {
  requires statements, swapop;

  //$ Assignment form.
  sassignexpr := sexpr sassignop sexpr =># "`(ast_assign ,_sr ,_2 ((Expr ,_sr ,_1) none) ,_3)";

  //$ Assignment.
    sassignop:= "=" =># "'_set";

  //$ Store at pointer.
    //sassignop:= "<-" =># "'_pset";
    sassignop:= "<-" =># "'storeat"; // overloadable now

  //$ Short form val declaration.
    sassignop:= ":=" =># "'_init";

  //$ binary read-modify-write operators.
  sassignexpr := sexpr srmwop sexpr =># "`(ast_assign ,_sr ,_2 ((Expr ,_sr ,_1) none) ,_3)";

    //$ Increment.
    srmwop:= "+=" =># "_1";
    //$ Decrement.
    srmwop:= "-=" =># "_1";
    //$ Multiply.
    srmwop:= "*=" =># "_1";
    //$ Divide.
    srmwop:= "/=" =># "_1";
    //$ C remainder.
    srmwop:= "%=" =># "_1";
    //$ Left shift.
    srmwop:= "<<=" =># "_1";
    //$ Right shift.
    srmwop:= ">>=" =># "_1";
    //$ Bitwise exclusive or.
    srmwop:= "^=" =># "_1";
    //$ Bitwise or.
    srmwop:= "|=" =># "_1";
    //$ Bitwise and.
    srmwop:= "&=" =># "_1";
    //$ Left shift.
    srmwop:= "<<=" =># "_1";
    //$ Right shift.
    srmwop:= ">>=" =># "_1";

  //$ Swap operator.
  sassignexpr := sexpr sswapop sexpr =># "`(ast_call ,_sr ,(noi _2) ((ast_ref ,_sr ,_1) (ast_ref ,_sr ,_3)))";

  //$ Prefix read/modify/write.
  sassignexpr := spreincrop sexpr =># "`(ast_call ,_sr ,(noi _1) (ast_ref ,_sr ,_2))";
    //$ Pre-increment.
    spreincrop:= "++" =># "'pre_incr";
    //$ Pre-decrement.
    spreincrop:= "--" =># "'pre_decr";

  //$ Postfix read/modify/write.
  sassignexpr := sexpr spostincrop =># "`(ast_call ,_sr ,(noi _2) (ast_ref ,_sr ,_1))";
    //$ Post-increment.
    spostincrop:= "++" =># "'post_incr";
    //$ Post-decrement.
    spostincrop:= "--" =># "'post_decr";

  //$ Multiple initialisation/assignment form.
  //$
  //$ def x, (var y, val z) = 1,(2,3);
  //$
  //$ allows unpacking a tuple into a pre-existing variable,
  //$ creating a new variable, and binding a new value,
  //$ in a single form, with nesting.
  sassignexpr := "def" slexpr "=" sexpr =># "`(ast_assign ,_sr _set ,_2 ,_4)";
    slexpr := slexprs =># """ (if (null? (tail _1)) (first _1) `((List ,_1) none)) """;
    slexprs := stlelement "," slexprs =># "(cons _1 _3)";
    slexprs := stlelement =># "`(,_1)";

    slelement := "once" sname =># "`(Once ,_sr ,_2)";
    slelement := "val" sname =># "`(Val ,_sr ,_2)";
    slelement := "var" sname =># "`(Var ,_sr ,_2)";
    slelement := sname =># "`(Name ,_sr ,_1)";
    slelement := "_" =># "`(Skip ,_sr)";
    slelement := "(" slexprs ")" =># "`(List ,_2)";

    stlelement := slelement ":" x[sfactor_pri] =># "`(,_1 (some ,_3))";
    stlelement := slelement =># "`(,_1 none)";

}
Block forms
//[blocks.fsyn]
syntax blocks
{
  stmt = block;
  block := "do" stmt* "done" =># '`(ast_seq ,_sr ,_2)';
  block := "begin" stmt* "end" =># '(block _2)';
  block := "perform" stmt =># '_2';
}
Bracket Forms
//[brackets.fsyn]
syntax brackets
{
  //$ Array expression (deprecated).
  satom := "[|" sexpr "|]" =># "`(ast_arrayof ,_sr ,(mkexlist _2))";

  //$ Short form anonymous function closure.
  satom := "{" sexpr "}" =># "(lazy `((ast_fun_return ,_sr ,_2)))";

  //$ Grouping.
  satom := "(" sexpr ")" =># "_2";
  satom := "\(" sexpr "\)" =># "_2";
  satom := "\[" sexpr "\]" =># "_2";
  satom := "\{" sexpr "\}" =># "_2";

  //$ floor and ceiling
  satom := "\lceil" sexpr "\rceil" =># "`(ast_apply ,_sr (,(noi 'ceil) (,_2)))";
  satom := "\lfloor" sexpr "\rfloor" =># "`(ast_apply ,_sr (,(noi 'floor) (,_2)))";

  //$ absolute value
  satom := "\lvert" sexpr "\rvert" =># "`(ast_apply ,_sr (,(noi 'abs) (,_2)))";
  satom := "\left" "|" sexpr "\right" "|" =># "`(ast_apply ,_sr (,(noi 'abs) (,_3)))";
  satom := "\left" "\vert" sexpr "\right" "\vert" =># "`(ast_apply ,_sr (,(noi 'abs) (,_3)))";

  //$ norm or length
  satom := "\lVert" sexpr "\rVert" =># "`(ast_apply ,_sr (,(noi 'len) (,_2)))";
  satom := "\left" "\Vert" sexpr "\right" "\Vert" =># "`(ast_apply ,_sr (,(noi 'len) (,_3)))";

  // mediating morphism of a product <f,g>
  satom := "\langle" sexpr "\rangle" =># "`(ast_apply ,_sr (,(noi 'lrangle) (,_2)))";
  satom := "\left" "\langle" sexpr "\right" "\rangle" =># "`(ast_apply ,_sr (,(noi 'lrangle) (,_3)))";

  // mediating morphism of a sum [f,g]
  satom := "\lbrack" sexpr "\rbrack" =># "`(ast_apply ,_sr (,(noi 'lrbrack) (,_2)))";
  satom := "\left" "\lbrack" sexpr "\right" "\rbrack" =># "`(ast_apply ,_sr (,(noi 'lrbrack) (,_3)))";


}
C binding technology
//[cbind.fsyn]
//$ Technology for binding to C.
//$ The forms in this DSSL are used to lift types and functions
//$ from C into Felix, and, export Felix types and functions
//$ back into C.

syntax cbind {
  requires expressions, statements, requirements, list;

  stmt = cbind_stmt;

  //$ Export a Felix function into C.
  //$ The function is exported by generating a C wrapper function
  //$ which has external linkage and the link name
  //$ given in the "as" phrase.
  //$ The function must be identified by a suffixed name
  //$ to choose between overloads. Example:
  //$
  //$ export fun myfun of (int) as "MyFun";
  //$
  private cbind_stmt := "export" "fun" ssuffixed_name "as" sstring ";" =>#
    "`(ast_export_fun ,_sr ,_3 ,_5)";

  //$ Export a Felix function with C type into C.
  private cbind_stmt := "export" "cfun" ssuffixed_name "as" sstring ";" =>#
    "`(ast_export_cfun ,_sr ,_3 ,_5)";

  //$ Export a Felix procedure into C.
  private cbind_stmt := "export" "proc" ssuffixed_name "as" sstring ";" =>#
    "`(ast_export_fun ,_sr ,_3 ,_5)";

  //$ Export a Felix procedure with C type into C.
  private cbind_stmt := "export" "cproc" ssuffixed_name "as" sstring ";" =>#
    "`(ast_export_cfun ,_sr ,_3 ,_5)";

  //$ Export a Felix struct into C.
  private cbind_stmt := "export" "struct" ssuffixed_name "as" sstring ";" =>#
    "`(ast_export_struct ,_sr ,_3 ,_5)";

  //$ Export a Felix union into C.
  private cbind_stmt := "export" "variant" ssuffixed_name "as" sstring ";" =>#
    "`(ast_export_union,_sr ,_3 ,_5)";

  //$ Export a type into C.
  //$ This is done using a typedef that defines the alias
  //$ specified in the "as" phase to be the type expression.
  private cbind_stmt := "export" "type" "(" stypeexpr ")" "as" sstring ";" =>#
    "`(ast_export_type ,_sr ,_4 ,_7)";

  //$ The optional precedence phase specifies
  //$ the C++ precedence of an expression, to allow
  //$ the Felix compiler to minimise generated parentheses.
  //$
  //$ The precedence must be one of:
  //$
  //$ atom, primary, postfix, unary, cast, pm, mult, add, shift, rel, eq,
  //$ band, bxor, bor, and, xor, or, cond, assign, comma
  //$
  sopt_prec := "is" sname =># "_2";
  sopt_prec := sepsilon =># '(quote "")';

  //$ Define a function by a C expression.
  //$ If the optional C string is elided, the function
  //$ is taken to be bound to a C function of the same name.
  //$ For example:
  //$
  //$ fun sin : double -> double;
  //$
  //$ is equivalent to
  //$
  //$ fun sin : double -> double = "sin($1)";
  //$
  private cbind_stmt := sadjectives sfun_kind sdeclname fun_return_type sopt_cstring sopt_prec srequires_clause ";" =>#
    """
      (let* (
        (name (first _3))
        (vs (second _3))
        (kind (cal_funkind _1 _2))
        (t (first (first _4)))
        (traint (second (first _4)))
        (prec _6)
        (reqs (if (memv 'Virtual _1)
          `(rreq_and (rreq_atom (Property_req "virtual")) ,_7)
          _7)
        )
        (ct
          (if (eq? 'none _5)
            (if (memv 'Virtual _1)
              'Virtual
               ;; `(StrTemplate ,(string-append "(#0) ::" name "($a)"))
               `(StrTemplate ,(string-append "(#0) " name "($a)")) ;; the :: doesn't work cause it could be a macro!
             )
             (second _5))
        )
      )
      (let (
        (reqs
          (if (eq? 'Generator kind)
            `(rreq_and (rreq_atom (Property_req "generator")) ,reqs)
            reqs))
      )
      (if (eq? 'typ_arrow (first t))
        (let (
          (argt (caadr t))
          (ret (cadadr t)))
        `(ast_fun_decl ,_sr ,name ,vs ,(mktylist argt) ,ret ,ct ,reqs ,prec)
        )
        (giveup))))
    """;

  //$ Define a constructor function by a C expression.
  stmt := "ctor" stvarlist squalified_name ":" stypeexpr sopt_cstring sopt_prec srequires_clause ";" =>#
    """
    (let*
      (
        (name (string-append "_ctor_" (base_of_qualified_name _3)))
        (vs _2)
        (ret _3)
        (argt _5)
        (ct
          (if (eq? 'none _6)
            `(StrTemplate ,(string-append "::" (base_of_qualified_name _3) "($a)"))
            (second _6)
          )
        )
        (prec _7)
        (reqs _8)
      )
      `(ast_fun_decl ,_sr ,name ,vs ,(mktylist argt) ,ret ,ct ,reqs ,prec)
    )
    """;
  stmt := "supertype" stvarlist squalified_name ":" stypeexpr sopt_cstring sopt_prec srequires_clause ";" =>#
    """
    (let*
      (
        (name (string-append "_ctor_" (base_of_qualified_name _3)))
        (vs _2)
        (ret _3)
        (argt _5)
        (ct
          (if (eq? 'none _6)
            `(StrTemplate ,(string-append "::" (base_of_qualified_name _3) "($a)"))
            (second _6)
          )
        )
        (prec _7)
        (xreqs _8)
        (reqs `(rreq_and (rreq_atom (Subtype_req)) ,xreqs))
      )
      `(ast_fun_decl ,_sr ,name ,vs ,(mktylist argt) ,ret ,ct ,reqs ,prec)
    )
    """;
  cbind_stmt:= "virtual" "type" sname ";" =>#
    "`(ast_virtual_type ,_sr ,_3)"
  ;

  //$ Define a type by a C type expression.
  private cbind_stmt:= stype_qual* "type" sdeclname "=" scode_spec srequires_clause ";" =>#
    """
    `(ast_abs_decl ,_sr ,(first _3) ,(second _3) ,_1 ,_5 ,_6)
    """;

  //$ Define a special kind of procedure which can be used
  //$ as a C callback.
  private cbind_stmt := "callback" "proc" sname ":" stypeexpr srequires_clause ";" =>#
    """
    `(ast_callback_decl ,_sr ,_3 ,(mktylist _5) (ast_void ,_sr) ,_6)
    """;

  //$ Define a special kind of function which can be used
  //$ as a C callback.
  private cbind_stmt := "callback" "fun" sname ":" stypeexpr srequires_clause ";" =>#
    """
    (if (eq? 'typ_arrow (first _5))
      (let*
        (
          (ft (second _5))
          (dom (first ft))
          (cod (second ft))
          (args (mktylist dom))
        )
      `(ast_callback_decl ,_sr ,_3 ,args ,cod ,_6)
      )
      'ERROR
    )
    """;

  //$ The type qualifier incomplete is used to
  //$ prevent allocation of values of this type.
  //$ Pointers can still be formed.
  stype_qual := "incomplete" =># "'Incomplete";
  stype_qual := "uncopyable" =># "'Uncopyable";

  //$ The type qualified pod is used to specify
  //$ that a type has a trivial destructor.
  //$ This allows the garbage collector to omit
  //$ a call to the destructor, which is the default
  //$ finaliser.
  stype_qual := "pod" =># "'Pod";

  //$ Specify a C types is a garbage collectable
  //$ pointer type, so it will be tracked by the collector.
  stype_qual := "_gc_pointer" =># "'GC_pointer";

  //$ Specify the shape of the type should
  //$ be taken as the shape of the given type expression.
  //$ This is required when the type is immobile
  //$ and represented by a pointer.
  //$
  //$ For example, the C++ RE2 type of Google's RE2 package
  //$ cannot be used directly as a type because it is not
  //$ copy assignable. Instead we have to use a pointer.
  //$
  //$ Here is the way this is done:
  //$
  //$ private type RE2_ = "::re2::RE2";
  //$ _gc_pointer _gc_type RE2_ type RE2 = "::re2::RE2*";
  //$ gen _ctor_RE2 : string -> RE2 = "new (*PTF gcp, @0, false) RE2($1)";
  //$
  //$ We bind the private type RE2_ to the C type RE2.
  //$ It's private so the public cannot allocate it.
  //$
  //$ Instead we use the type RE2 which is a pointer, and thus
  //$ copyable. because it is a pointer we have to specify
  //$ _gc_pointer.
  //$
  //$ Now, the constructor _ctor_RE2 takes a string and returns
  //$ a Felix RE2 (C type RE2*) which is a pointer to a heap allocated
  //$ object of type _RE2 (C type RE2).
  //$
  //$ The constructor does the allocation, so it must provde the
  //$ shape of the RE2_ object, and this is what the specification
  //$ _gc_type RE2_ does. This allows the notation @0 to refer to
  //$ the shape of RE2_ instead of RE2 which it would normally.

  stype_qual := "_gc_type" stypeexpr =># "`(Raw_needs_shape ,_2)";

  //$ Define a set of types as C types with the same names.
  private cbind_stmt:= stype_qual* "ctypes" snames srequires_clause ";" =>#
    "`(ast_ctypes ,_sr ,_3 ,_1 ,_4)";

  //$ Embed a C statement into Felix code with arguments.
  private cbind_stmt:= "cstmt" scode_spec sexpr? ";" =># "`(ast_code ,_sr ,_2 ,_3)";


  //$ Embed a C statement which does not return normally
  //$ into Felix code. For example:
  //$
  //$ noreturn cstmt "exit(0);";
  //$
  private cbind_stmt:= "noreturn" "cstmt" scode_spec sexpr? ";" =># "`(ast_noreturn_code ,_sr ,_3 ,_4)";

  //$ Embed a C expression into Felix.
  //$ This required giving the Felix type of the expression.
  //$ The expression is contained in the string. For example:
  //$
  //$ code [double] "sin(0.7)"
  //$
  satom := "cexpr" "[" stypeexpr "]" scode_spec sexpr? "endcexpr" =># "`(ast_expr ,_sr ,_5 ,_3 ,_6)";

  //$ A short form embedding for variables.
  //$
  //$ code [double] M_PI
  //$
  satom := "cvar" "[" stypeexpr "]" sname =># "`(ast_expr ,_sr (Str ,_5) ,_3 ())";

  //$ Bind a C expression to a name.
  //$ Note that despite the binding being called "const",
  //$ the C expression does not have to be constant.
  //$ For example:
  //$
  //$ const rand : int = "rand()";
  //$
  // note: also needed by typeclasses atm for virtual consts
  private cbind_stmt := sadjectives "const" sdeclname ":" stypeexpr "=" scode_spec srequires_clause ";" =>#
    """
      (let ((reqs (if (memv 'Virtual _1)
        `(rreq_and (rreq_atom (Property_req "virtual")) ,_8)
        _8)))
      `(ast_const_decl ,_sr ,(first _3) ,(second _3) ,_5 ,_7 ,reqs)
      )
    """;

  //$ Short form of const that declares a variable
  //$ bound to the same name in C.
  //$ Example:
  //$
  //$ const RAND_MAX: long;
  //$
/*
  private cbind_stmt := sadjectives "const" sdeclname ":" stypeexpr srequires_clause ";" =>#
    """
      (let ((reqs (if (memv 'Virtual _1)
        `(rreq_and (rreq_atom (Property_req "virtual")) ,_6)
        _6)))
      `(ast_const_decl ,_sr ,(first _3) ,(second _3) ,_5 (Str ,(first _3)) ,reqs)
      )
    """;
*/



  //$ Short form of const that declares a list of variables
  //$ of the same type to be bound to their C names.
  //$ Useful for lifting enumerations. Example:
  //$
  //$ const a,b,c : int;
  //$
  private cbind_stmt := sadjectives "const" sdeclnames ":" stypeexpr srequires_clause ";" =>#
    """
      (let ((reqs (if (memv 'Virtual _1)
        `(rreq_and (rreq_atom (Property_req "virtual")) ,_6)
        _6)))
      (begin
         (define (constdef sym)
          `(ast_const_decl ,_sr ,(first sym) ,(second sym) ,_5 (Str ,(first sym)) ,reqs))
         `(ast_seq ,_sr ,(map constdef _3))
      )
    )
    """;

  //$ Special form for lifting C enumerations.
  //$ Specifies the type name and enumeration constants
  //$ in a single statement. Names bound to the same names in C.
  //$
  //$ This form also defined equality and inequality operators
  //$ for the type automatically, as an instance of class Eq.
  private cbind_stmt := "cenum" sname "=" snames srequires_clause ";" =>#
    """
      (begin
         (define (constdef sym)
          `(ast_const_decl ,_sr ,sym ,dfltvs ,(nos _2) (Str ,sym) ,_5))
           (let*
             (
               (tdec `(ast_abs_decl ,_sr ,_2 ,dfltvs (Pod) (Str ,_2) ,_5))
               (argt `(typ_tuple ,_sr (,(nos _2) ,(nos _2))))
               (eqdef `(ast_fun_decl ,_sr "==" ,dfltvs ,(mktylist argt) ,(nos "bool") (StrTemplate "$1==$2") rreq_true ""))
               (instdef `(ast_instance ,_sr ,dfltvs (ast_name ,_sr "Eq" (,(nos _2))) (,eqdef)))
               (inherit `(ast_inject_module ,_sr ,dfltvs (ast_name ,_sr "Eq" (,(nos _2)))))
             )
             `(ast_seq ,_sr ,(append `(,tdec ,instdef ,inherit) (map constdef _4)))
           )
      )
    """;

  // Very special form for binding C enumeration used as bit flags.
  //$ Specifies the type name and enumeration constants
  //$ in a single statement. Names bound to the same names in C.
  //$
  //$ This form automatically defines equality as an instance of class Eq.
  //$ Furthermore it defines all the standard bitwise operators,
  //$ as an instance of class Bits.
  private cbind_stmt := "cflags" sname "=" snames srequires_clause ";" =>#
    """
      (begin
         (define (constdef sym)
          `(ast_const_decl ,_sr ,sym ,dfltvs ,(nos _2) (Str ,sym) ,_5))
           (let*
             (
               (tdec `(ast_abs_decl ,_sr ,_2 ,dfltvs (Pod) (Str ,_2) ,_5))
               (argt `(typ_tuple ,_sr (,(nos _2) ,(nos _2))))
               (eqdef `(ast_fun_decl ,_sr "==" ,dfltvs ,(mktylist argt) ,(nos "bool") (StrTemplate "$1==$2") rreq_true ""))
               (instdef `(ast_instance ,_sr ,dfltvs (ast_name ,_sr "Eq" (,(nos _2))) (,eqdef)))
               (inherit `(ast_inject_module ,_sr ,dfltvs (ast_name ,_sr "Eq" (,(nos _2)))))
               (inherit2 `(ast_inject_module ,_sr ,dfltvs (ast_name ,_sr "Bits" (,(nos _2)))))
             )
             `(ast_seq ,_sr ,(append `(,tdec ,instdef ,inherit ,inherit2) (map constdef _4)))
           )
      )
    """;


  //$ Define a Felix procedures as a binding to a
  //$ C statement. Only one statement is allowed.
  //$ But you can use a block of course!
  //$
  //$ If the option C text is elided, the procedure
  //$ is taken to be bound to a C function returning void
  //$ of the same name.
  private cbind_stmt := sadjectives sproc_kind sdeclname ":" stypeexpr sopt_cstring srequires_clause ";" =>#
    """
      (let (
        (name (first _3))
        (vs (second _3))
        (kind (cal_funkind _1 _2))
        (t _5)
        (reqs (if (memv 'Virtual _1)
          `(rreq_and (rreq_atom (Property_req "virtual")) ,_7)
          _7)
        )
        (ct
          (if (eq? 'none _6)
            (if (memv 'Virtual _1)
              'Virtual
               `(StrTemplate ,(string-append "::" (first _3) "($a);"))
             )
             (second _6))
        )
      )
      (let (
        (reqs
          (if (eq? 'Generator kind)
            `(rreq_and (rreq_atom (Property_req "generator")) ,reqs)
            reqs))
      )
      (let (
        (argt t)
        (ret `(ast_void ,_sr)))
        `(ast_fun_decl ,_sr ,name ,vs ,(mktylist argt) ,ret ,ct ,reqs "")
        )))
    """;
}
Simple C grammar
//[cgram.fsyn]
//$ Embed C into Felix using extern "C" { } style.
//$ Direct name binding.
//$ WORK IN PROGRESS, NOT OPERATIONAL!
syntax cgram {
  stmt := "extern" '"C"' cstatement =># '`(ast_comment ,_sr "C code ..")';
  stmt := "extern" '"C"' "{" cstatement+ "}" =># '`(ast_comment ,_sr "C code ..")';
  cstatement := external_declaration;
  // this only for testing
  satom := "extern" '"C"' "(" expression ")" =># "_4";


TYPE_NAME := sname ; // special, needs to lookup typedef names

primary_expression
      := sname             =># "_1"
      | sliteral           =># "_1"
      | '(' expression ')' =># "_2"
      ;

postfix_expression
      := primary_expression =># "_1"
      | postfix_expression '[' expression ']' =># "`(subscript ,_sr ,_1 ,_3)"
      | postfix_expression '(' ')'            =># "`(apply ,_sr ,_1 ())"
      | postfix_expression '(' argument_expression_list ')' =># "`(ast_apply ,_sr ,(_1 (reverse _3)))"
      | postfix_expression '.' sname                        =># "`(ast_apply ,_sr (,_3 ,_1))"
      | postfix_expression '->' sname                       =># "`(typ_arrow ,_sr (,_1 ,_3))"
      | postfix_expression '++'                             =># "`(uop ,_sr 'postincr' ,_1)"
      | postfix_expression '--'                             =># "`(uop ,_sr 'postdecr' ,_1)"
      ;

argument_expression_list
      := assignment_expression =># "`(,_1)"
      | argument_expression_list ',' assignment_expression =># "(cons _3 _1)"
      ;

unary_expression
      := postfix_expression =># "_1"
      | unary_operator cast_expression =># "(prefix _2)"
      | 'sizeof' '(' type_name ')' =># "`(sizeoftype ,_sr ,_3)" // FIXME, WRONG!
      ;

unary_operator
      := '&' =># "'addressof"
      | '*'  =># "'deref"
      | '+'  =># "'pos"
      | '-'  =># "'neg"
      | '~'  =># "'compl"
      | '!'  =># "'excl"
  | '++' =># "'preincr"
  | '--' =># "'postincr"
  | 'sizeof' =># "'sizeof"
      ;

cast_expression
      := unary_expression =># "_1"
      | '(' type_name ')' cast_expression =># "`(ast_coercion ,_sr (,_3 ,_2))" // FIXME, WRONG!
      ;

multiplicative_expression
      := cast_expression =># "_1"
      | multiplicative_expression '*' cast_expression =># "(infix 'mul)"
      | multiplicative_expression '/' cast_expression =># "(infix 'div)"
      | multiplicative_expression '%' cast_expression =># "(infix 'mod)"
      ;

additive_expression
      := multiplicative_expression =># "_1"
      | additive_expression '+' multiplicative_expression =># "(infix 'add)"
      | additive_expression '-' multiplicative_expression =># "(infix 'sub)"
      ;

shift_expression
      := additive_expression =># "_1"
      | shift_expression '<<' additive_expression =># "(infix 'shl)"
      | shift_expression '>>' additive_expression =># "(infix 'shr)"
      ;

relational_expression
      := shift_expression =># "_1"
      | relational_expression '<' shift_expression =># "(infix 'lt)"
      | relational_expression '>' shift_expression =># "(infix 'gt)"
      | relational_expression '<=' shift_expression =># "(infix 'le)"
      | relational_expression '>=' shift_expression =># "(infix 'ge)"
      ;

equality_expression
      := relational_expression =># "_1"
      | equality_expression '==' relational_expression =># "(infix 'eq)"
      | equality_expression '!=' relational_expression =># "(infix 'ne)"
      ;

and_expression
      := equality_expression =># "_1"
      | and_expression '&' equality_expression =># "(infix 'band)"
      ;

exclusive_or_expression
      := and_expression =># "_1"
      | exclusive_or_expression '^' and_expression =># "(infix 'bxor)"
      ;

inclusive_or_expression
      := exclusive_or_expression =># "_1"
      | inclusive_or_expression '|' exclusive_or_expression =># "(infix 'bor)"
      ;

logical_and_expression
      := inclusive_or_expression =># "_1"
      | logical_and_expression '&&' inclusive_or_expression =># "(infix 'land)"
      ;

logical_or_expression
      := logical_and_expression =># "_1"
      | logical_or_expression '||' logical_and_expression =># "(infix 'lor))"
      ;

conditional_expression
      := logical_or_expression =># "_1"
      | logical_or_expression '?' expression ':' conditional_expression =># "`(ast_cond ,_sr (,_1 ,_3 ,_5))"
      ;

assignment_expression
      := conditional_expression =># "_1"
      | unary_expression assignment_operator assignment_expression =># "(infix _2)"
      ;

assignment_operator
      := '=' =># "'_set"
      | '*=' =># "'muleq"
      | '/=' =># "'diveq"
      | '%=' =># "'modeq"
      | '+=' =># "'addeq"
      | '-=' =># "'subeq"
      | '<<=' =># "'lsheq"
      | '>>=' =># "'rsheq"
      | '&=' =># "'bandeq"
      | '^=' =># "'bxoreq"
      | '|=' =># "'boreq"
      ;

expression
      := assignment_expression =># "_1"
      | expression ',' assignment_expression =># "(infix 'comma)"
      ;

declaration
      := declaration_specifiers ';'
      | declaration_specifiers init_declarator_list ';'
  | 'typedef' type_specifier declarator ';'
      ;

declaration_specifiers
      := storage_class_specifier
      | storage_class_specifier declaration_specifiers
      | type_specifier
      | type_specifier declaration_specifiers
      | type_qualifier
      | type_qualifier declaration_specifiers
      ;

init_declarator_list
      := init_declarator
      | init_declarator_list ',' init_declarator
      ;

init_declarator
      := declarator
      | declarator '=' initializer
      ;

storage_class_specifier
      :=
      | 'extern'
      | 'static'
      | 'auto'
      | 'register'
      ;

type_specifier
      := 'void'
      | 'char'
      | 'short'
      | 'int'
      | 'long'
      | 'float'
      | 'double'
      | 'signed'
      | 'unsigned'
      | struct_or_union_specifier
      | enum_specifier
//    | TYPE_NAME
      ;

struct_or_union_specifier
      := struct_or_union sname '{' struct_declaration_list '}'
      | struct_or_union '{' struct_declaration_list '}'
      | struct_or_union sname
      ;

struct_or_union
      := 'struct'
      | 'union'
      ;

struct_declaration_list
      := struct_declaration
      | struct_declaration_list struct_declaration
      ;

struct_declaration
      := specifier_qualifier_list struct_declarator_list ';'
      ;

specifier_qualifier_list
      := type_specifier specifier_qualifier_list
      | type_specifier
      | type_qualifier specifier_qualifier_list
      | type_qualifier
      ;

struct_declarator_list
      := struct_declarator
      | struct_declarator_list ',' struct_declarator
      ;

struct_declarator
      := declarator
      | ':' constant_expression
      | declarator ':' constant_expression
      ;

enum_specifier
      := 'enum' '{' enumerator_list '}'
      | 'enum' sname '{' enumerator_list '}'
      | 'enum' sname
      ;

enumerator_list
      := enumerator
      | enumerator_list ',' enumerator
      ;

enumerator
      := sname
      | sname '=' constant_expression
      ;

// Felix doesn't support const or volatile
type_qualifier
      := 'const'
      | 'volatile'
      ;

type_qualifier_list
      := type_qualifier
      | type_qualifier_list type_qualifier
      ;

declarator
      := pointer direct_declarator =># "`(ast_ref ,_sr ,_2)"
      | direct_declarator =># "_1"
      ;

direct_declarator
      := sname                        =># "_1"
      | '(' declarator ')'            =># "_2"
      | direct_declarator '[' constant_expression ']' =># "`(array ,_sr ,_1 ,_3)"
      | direct_declarator '[' ']'                     =># "`(array ,_sr ,_1 ())"
      | direct_declarator '(' parameter_type_list ')' =># "`(fun ,_sr ,_1 ,(reverse _3))"
      | direct_declarator '(' ')'                     =># "`(fun ,_sr ,_1 ())"
      ;

pointer
      := '*'                                          =># "`(ptr)"
      | '*' type_qualifier_list                       =># "`(ptr)"
      | '*' pointer                                   =># "(cons 'ptr ,_2)"
      | '*' type_qualifier_list pointer               =># "(cons 'ptr ,_3)"
      ;

parameter_type_list
      := parameter_list              =># "_1"
      | parameter_list ',' '...'     =># "(cons 'ellipsis _1)"
      ;

parameter_list
      := parameter_declaration                   =># "`(,_1)"
      | parameter_list ',' parameter_declaration =># "(cons _3 _1)"
      ;

parameter_declaration
      := declaration_specifiers declarator         =># "`(,_1 ,_2)"
      | declaration_specifiers abstract_declarator =># "`(,_1 ,_2)"
      | declaration_specifiers                     =># "`(,_1 ())"
      ;

identifier_list
      := sname                                =># "`(,_1)"
      | identifier_list ',' sname             =># "(cons _3 _1)"
      ;

type_name
      := specifier_qualifier_list                    =># "`(,_1 ())"
      | specifier_qualifier_list abstract_declarator =># "`(,_1 ,_2)"
      ;

abstract_declarator
      := pointer
      | direct_abstract_declarator
      | pointer direct_abstract_declarator
      ;

direct_abstract_declarator
      := '(' abstract_declarator ')'
      | '[' ']'
      | '[' constant_expression ']'
      | direct_abstract_declarator '[' ']'
      | direct_abstract_declarator '[' constant_expression ']'
      | '(' ')'
      | '(' parameter_type_list ')'
      | direct_abstract_declarator '(' ')'
      | direct_abstract_declarator '(' parameter_type_list ')'
      ;

initializer
      := assignment_expression
      | '{' initializer_list '}'
      | '{' initializer_list ',' '}'
      ;

initializer_list
      := initializer
      | initializer_list ',' initializer
      ;

statement
      := labeled_statement
      | compound_statement
      | expression_statement
      | selection_statement
      | iteration_statement
      | jump_statement
      ;

labeled_statement
      := sname ':' statement
      | 'case' constant_expression ':' statement
      | 'default' ':' statement
      ;

compound_statement
      := '{' '}'
      | '{' statement_list '}'
      | '{' declaration_list '}'
      | '{' declaration_list statement_list '}'
      ;

declaration_list
      := declaration
      | declaration_list declaration
      ;

statement_list
      := statement
      | statement_list statement
      ;

expression_statement
      := ';'
      | expression ';'
      ;

selection_statement
      := 'if' '(' expression ')' statement
      | 'if' '(' expression ')' statement 'else' statement
      | 'switch' '(' expression ')' statement
      ;

iteration_statement
      := 'while' '(' expression ')' statement
      | 'do' statement 'while' '(' expression ')' ';'
      | 'for' '(' expression_statement expression_statement ')' statement
      | 'for' '(' expression_statement expression_statement expression ')' statement
      ;

jump_statement
      := 'goto' sname ';'
      | 'continue' ';'
      | 'break' ';'
      | 'return' ';'
      | 'return' expression ';'
      ;

external_declaration
      := function_definition
      | declaration
      ;

function_definition
      := declaration_specifiers declarator declaration_list compound_statement
      | declaration_specifiers declarator compound_statement
      | declarator declaration_list compound_statement
      | declarator compound_statement
      ;
}
Conditional forms
//[conditional.fsyn]
//$ Basic conditional statements.
syntax conditional
{
  block = if_stmt;

  /* Unfortunately we cannot currently use "if sexpr block"
    because this makes if c do .. done and if c do .. else .. done
    ambiguous for some reason i do not fathom, so we have
    to list all the cases separately
  */
  if_stmt := "if" sexpr if_stmt =># '`(ast_ifdo ,_sr ,_2 (,_3) ())';
  if_stmt := "if" sexpr loop_stmt =># '`(ast_ifdo ,_sr ,_2 (,_3) ())';
  if_stmt := "if" sexpr match_stmt =># '`(ast_ifdo ,_sr ,_2 (,_3) ())';
  if_stmt := "if" sexpr "perform" stmt =># '`(ast_ifdo ,_sr ,_2 (,_4) ())';

  //$ Short form conditional goto statements.
  if_stmt := "if" sexpr "goto" sexpr ";" =># "`(ast_ifgoto_indirect ,_sr ,_2 ,_4)";
  if_stmt := "if" sexpr "break" sname =># '`(ast_ifgoto ,_sr ,_2 ,(string-append "break_" _4))';
  if_stmt := "if" sexpr "continue" sname =># '`(ast_ifgoto ,_sr ,_2 ,(string-append "continue_" _4))';
  if_stmt := "if" sexpr "redo" sname =># '`(ast_ifgoto ,_sr ,_2 ,(string-append "redo_" _4))';

  //$ Short form conditional return statement.
  if_stmt := "if" sexpr "return" ";" =># "`(ast_ifreturn ,_sr ,_2)";
  if_stmt := "if" sexpr "return" sexpr ";" =># "`(ast_ifdo ,_sr ,_2 ((ast_fun_return ,_sr ,_4)) ())";

  //$ Short form conditional call statement.
  if_stmt := "if" sexpr "call" sexpr ";" =>#
    "`(ast_ifdo ,_sr ,_2 (,(cons 'ast_call (cons _sr (splitapply _4))))())";

  //$ Short form one branch conditional.
  if_stmt := "if" sexpr "do" stmt* "done" =>#
    "`(ast_ifdo ,_sr ,_2 ,_4 ())";

  //$ Short form one branch conditional.
  if_stmt := "if" sexpr "begin" stmt* "end" =>#
    "(block (list `(ast_ifdo ,_sr ,_2 ,_4 ())))";

  //$ General conditional chain statement.
  //$
  //$ if condition do
  //$   ..
  //$ elif condition do
  //$   .
  //$   .
  //$ else
  //$  ..
  //$ done
  if_stmt := "if" sexpr "do"  stmt* selse_clause "done" =>#
    "`(ast_ifdo ,_sr ,_2 ,_4 ,_5)";

  if_stmt := "if" sexpr "begin" stmt* selse_clause "end" =>#
    "(block (list `(ast_ifdo ,_sr ,_2 ,_4 ,_5)))";

  //$ General elif clause.
  private selif_clause := "elif" sexpr "do" stmt* =># "`(,_2 ,_4)";

  //$ Short form elif return clause.
  private selif_clause := "elif" sexpr "return" ";" =># "`(,_2 ((ast_proc_return ,_sr)))";
  private selif_clause := "elif" sexpr "return" sexpr ";" =># "`(,_2 ((ast_fun_return ,_sr ,_4)))";

  //$ Short form elif goto clause.
  private selif_clause := "elif" sexpr "goto" sexpr ";" =># "`(,_2 (ast_cgoto ,_sr ,_4))";


  private selif_clauses := selif_clauses selif_clause =># "(cons _2 _1)"; // Reversed!
  private selif_clauses := selif_clause =># "`(,_1)";
  private selse_clause := selif_clauses "else" stmt* =>#
    """
        (let ((f (lambda (result condthn)
          (let ((cond (first condthn)) (thn (second condthn)))
            `((ast_ifdo ,_sr ,cond ,thn ,result))))))
        (fold_left f _3 _1))
    """;

  private selse_clause := "else" stmt* =># "_2";
  private selse_clause := selif_clauses =>#
    """
        (let ((f (lambda (result condthn)
          (let ((cond (first condthn)) (thn (second condthn)))
            `((ast_ifdo ,_sr ,cond ,thn ,result))))))
        (fold_left f () _1))
    """;

  //$ helpful error message for invalid if/then syntax on statements
  if_stmt := "if" sexpr "then"  stmt* "endif" =># """
    (raise (string-append
        "  Invalid syntax: This instance of 'if/then' is not valid. Try the following instead:\n"
        "    if (condition) do\n"
        "      ...\n"
        "    done\n"))
    """;

  //$ helpful error message for invalid if/then/else syntax on statements
  if_stmt := "if" sexpr "then"  stmt* ("else" | "elif") =># """
    (raise (string-append
        "  Invalid syntax: This instance of 'if/then/else' is not valid. Try the following instead:\n"
        "    if (condition) do\n"
        "      ...\n"
        "    elif (condition) do\n"
        "      ...\n"
        "    else do\n"
        "      ...\n"
        "    done\n"))
    """;

}

//[control.fsyn]
//$ Core control flow operators.
syntax control
{
  //$ Call a procedure (verbose).
  block := "call" sexpr  ";" =># """(cons 'ast_call (cons _sr (splitapply _2)))""";
  block := "call_with_trap" sexpr  ";" =># """(cons 'ast_call_with_trap (cons _sr (splitapply _2)))""";
  block := "callcc" sexpr  ";" =># """
    (let*
      (
        (labstring (fresh_name "_callcclab_"))
        (lab (nos labstring))
        (sa (splitapply _2))
        (fun (first sa))
        (arg (second sa))
        (apl `(ast_apply ,_sr (,fun ,lab)))
      )
      `(ast_seq ,_sr
        (
          (ast_jump ,_sr ,apl ,arg)
          (ast_label ,_sr ,labstring)
        )
      )
    )
  """;

  //$ Procedure return.
  block := "return" ";" =># "`(ast_proc_return ,_sr)";

  //$ Fast procedure return.
  //$ Returns immediately from enclosing procedure with given name.
  block := "return" "from" sname ";" =># "`(ast_proc_return_from ,_sr ,_3)";


  //$ Procedure explicit tail call.
  //$ Equivalent to a call followed by a return.
  block := "jump" sexpr ";" =># """(cons 'ast_jump (cons _sr (splitapply _2)))""";

  //$ Function return with value.
  block := "return" sexpr ";" =># "`(ast_fun_return ,_sr ,_2)";

  //$ Generator/iterator exchange with value (restart after yield).
  //$ Yield is like a return, except that re-entering the generator
  //$ will continue on after the yield statement rather that starting
  //$ from the top.
  block := "yield" sexpr ";" =># "`(ast_yield ,_sr ,_2)";

  //$ Special short form procedure self-tail call with argument.
  block := "loop" sname sexpr ";" =># "`(ast_jump ,_sr (ast_name ,_sr ,_2 ()) ,_3)";

  //$ Special short form procedure self-tail call without argument.
  block := "loop" sname ";" =># "`(ast_jump ,_sr (ast_name ,_sr ,_2 ()) (ast_tuple,_sr ()))";

  //$ Stop the program with prejudice and a message.
  block := "halt" sstring ";" =># "`(ast_halt ,_sr ,_2)";

  //$ Label any statement.
  //$ Do not confuse with loop labels.
  stmt := sname ":>" =># "`(ast_label ,_sr ,_1)";

  //$ Unconditional goto label.
  stmt := "goto" sexpr ";" =># "`(ast_goto_indirect ,_sr ,_2)";

  //$ Unconditional goto expression.
  block := "goto-indirect" sexpr ";" =># "`(ast_goto_indirect ,_sr ,_2)";

}
Executable support
//[executable.fsyn]
//$ Special executable forms.
syntax executable {
  requires statements;

  stmt := "type-error" stmt =># "`(ast_type_error ,_sr ,_2)";
  stmt := "type-assert" stmt =># "`(ast_type_assert ,_sr ,_2)";

  //$ System service call.
  stmt := "_svc" sname =># "`(ast_svc ,_sr ,_2)";

  //$ Assignment expression.
  stmt := sassignexpr ";" =># "_1";

  //$ Debug trace expression.
  stmt := "trace" sname sstring =># "`(ast_trace ,_sr ,_2 ,_3)";

  //$ Call expression.
  //$ Short form of "call f a;" is just "f a;"
  //$ Short form of "call f ();" is just "f"
  stmt := sexpr ";" =># "(cons 'ast_call (cons _sr (splitapply _1)))";

  //$ Template replacement index.
  stmt := "??" sinteger ";" =># "`(ast_seq ,_sr (PARSER_ARGUMENT ,_2))";
}
Stub extension file inclusion support

This file is included in the main include file list, and is extended during the build process by the python script src/tools/flx_find_grammar_files.py.

grammar/python_grammar.fsyn
grammar/debug.fsyn
Master DSSL dependency list.

Defines the standard felix grammar by specifying all the DSSLs required for it.

//[felix.fsyn]
syntax felix {
  requires
    list,
    blocks,
    lexer,
    statements,
    type_decls,
    variables,
    executable,
    assignment,
    control,
    exceptions,
    conditional,
    loops,
    pfor,
    assertions,
    namespaces,
    requirements,
    expressions,
    types,
    brackets,
    texsyms,
    functions,
    patterns,
    cbind,
    regexps,
    macros,
    plugins,
    debug,
    chips
  ;
}
Function forms
//[functions.fsyn]
//$ General functional forms.
syntax functions {
  requires expressions;

  //$ Anonymous function (lamda).
  satom := sadjectives "fun" stvarlist slambda_fun_args fun_return_type "="? scompound =>#
    """
    `(ast_lambda ,_sr (,_3 ,_4 ,(first (first _5)) ,_7))
    """;

  //$ Anonymous function (lamda).
  x[slambda_pri] := sadjectives "fun" stvarlist slambda_fun_args fun_return_type "=>" sexpr =>#
    """
    `(ast_lambda ,_sr (,_3 ,_4 ,(first (first _5)) ((ast_fun_return ,_sr ,_7))))
    """;

  //$ Anonymous generator (lamda).
  satom := sadjectives "gen" stvarlist slambda_fun_args fun_return_type "="? scompound =>#
    """
    `(ast_generator ,_sr (,_3 ,_4 ,(first (first _5)) ,_7))
    """;

  //$ Anonymous generator (lamda).
  x[slambda_pri] := sadjectives "gen" stvarlist slambda_fun_args fun_return_type "=>" sexpr =>#
    """
    `(ast_generator ,_sr (,_3 ,_4 ,(first (first _5)) ((ast_fun_return ,_sr ,_7))))
    """;


  //$ Anonymous procedure (lamda).
  satom := sadjectives "proc" stvarlist slambda_fun_args scompound =>#
    """
    `(ast_lambda ,_sr (,_3 ,_4 (ast_void ,_sr) ,_5))
    """;

  //$ Anonymous procedure (lamda).
  satom  := sadjectives "proc" stvarlist scompound =>#
    """
    `(ast_lambda ,_sr (,_3 ((() none)) (ast_void ,_sr) ,_4))
    """;

  //$ Anonymous object constructor (lamda).
  //$ UGLY.
  satom := sadjectives "object" stvarlist slambda_fun_args fun_return_type "="? scompound =>#
    """
    `(ast_object ,_sr (,_3 ,_4 ,(first (first _5)) ,_7))
    """;

  //$ Function adjective (prefix property) inline.
  sadjective := "inline" =># "'InlineFunction";

  //$ Function adjective (prefix property) noinline.
  sadjective := "noinline" =># "'NoInlineFunction";
  //sadjective := "static" =># "'Static";

  //$ Function adjective (prefix property) extern.
  sadjective := "extern" =># "'NoInlineFunction";

  //$ Function adjective (prefix property) virtual.
  //$ In classes only. Specifies an overrideable function.
  sadjective := "virtual" =># "'Virtual";

  //$ Function dependent on its arguments only,
  //$ not dependent on any variables in its enclosing context.
  sadjective := "pure" =># "'Pure";

  //$ Function which fails  to evaluate argument
  //$ if and only if its argument fails,
  //$ i.e. f (error) = error
  sadjective := "strict" =># "'Strict";

  //$ Function which fails  to evaluate argument
  //$ if and only if its argument fails,
  //$ i.e. f (error) = error
  sadjective := "nonstrict" =># "'NonStrict";


  //$ Function may be dependent on variables in its enclosing context.
  sadjective := "impure" =># "'Impure";

  //$ Function returns a result for all argument values.
  sadjective := "total" =># "'Total";

  //$ Function may fail for some argument values.
  //$ Equivalent to a function with a non-tautologous but unknown pre-condition.
  sadjective := "partial" =># "'Partial";

  //$ Specifies a method, in an object definition only.
  sadjective := "method" =># "'Method";

  //$ Specifies function is to be exported under its Felix name.
  //$ Function must be top level and non-polymorphic.
  //$ Top level means the global space or a non-polymorphic class
  //$ nested in a top level space (recursively).
  sadjective := "export" =># "'Export";
  sadjective := "export" sstring =># "`(NamedExport ,_2)";

  sadjectives := sadjective* =># "_1";

  slambda_fun_arg := "(" sparameter_comma_list "when" sexpr ")" =># "`(,_2 (some ,_4))";
  slambda_fun_arg := "(" sparameter_comma_list ")" =># "`(,_2 none)";
  slambda_fun_args := slambda_fun_arg+ =># "_1";

  //$ Function return type specification with post-condition.
  fun_return_type := ":" stypeexpr "expect" sexpr =># "`((,_2 (some ,_4)) ,dflteffects)";
  fun_return_type := ":" "[" stypeexpr "]" stypeexpr "expect" sexpr =># "`((,_5 (some ,_7)) ,_3)";

  //$ Function return type specification without post-condition.
  fun_return_type := ":" stypeexpr =># "`((,_2 none) ,dflteffects)";
  fun_return_type := ":" "[" stypeexpr"]" stypeexpr =># "`((,_5 none) ,_3)";

  //$ Function return postcondition without type.
  fun_return_type := "expect" sexpr =># "`((typ_none (some ,_2)) ,dflteffects)";
  fun_return_type := ":" "[" stypeexpr "]" "expect" sexpr =># "`((typ_none (some ,_6)) ,_3)";

  //$ No return type.
  fun_return_type := ":" "[" stypeexpr "]" =># "`((typ_none none) ,_3)";
  fun_return_type := sepsilon =># "`((typ_none none) ,dflteffects)";

  //$ Object factory return type.
  object_return_type := stypeexpr =># "`(,_1 none)";

  //$ Object invariant
  sfunction := "invariant" sexpr ";" =># "`(ast_invariant, _sr, _2)";

  //$ Function parameter with type and default value.
  private sparameter := sparam_qual sname ":" t[sarrow_pri] "=" x[sor_condition_pri] =># "`(,_sr ,_1 ,_2 ,_4 (some ,_6))";

  //$ Function parameter with type.
  private sparameter := sparam_qual sname ":" t[sarrow_pri] =># "`(,_sr ,_1 ,_2 ,_4 none)";

  //$ Function parameter without type.
  //$ Defaults to polymorphic in unnamed type variable.
  private sparameter := sparam_qual sname =># "`(,_sr ,_1 ,_2 typ_none none)";

  //$ Empty parameter tuple.
  //private sparameter_comma_list = list::commalist0<sparameter>;

  // parameter list including nested params
  private sxparam := sparameter =># "`(Satom ,_1)";
  private sxparam := "(" list::commalist0<sxparam> ")" =># "`(Slist ,_2)";
  private sparameter_comma_list := list::commalist0<sxparam> =># "`(Slist ,_1)";

  //$ Parameter qualifier: val.
  private sparam_qual := "val" =># "'PVal";

  //$ Parameter qualifier: once.
  private sparam_qual := "once" =># "'POnce";

  //$ Parameter qualifier: var.
  private sparam_qual := "var" =># "'PVar";

  //$ Default parameter qualifier is val.
  private sparam_qual := sepsilon =># "'PDef";

  //$ Function tuple parameter with pre-condition.
  sfun_arg :=  "(" sparameter_comma_list "when" sexpr ")" =># "`(,_2 (some ,_4))";

  //$ Function tuple parameter without pre-condition.
  sfun_arg :=  "(" sparameter_comma_list ")" =># "`(,_2 none)";

  //$ Short form function parameter single polymorphic variable.
  sfun_arg :=  sname =># "`(((Satom (,_sr PVal ,_1 typ_none none))) none)";

  //$ Function binder: C function.
  //$ A function with C function type.
  sfun_kind := "cfun" =># "'CFunction";

  //$ Function binder: Generator.
  //$ A function with side effects.
  sfun_kind := "gen" =># "'Generator";

  //$ Function binder: Function.
  //$ A function without side-effects.
  sfun_kind := "fun" =># "'Function";

  stmt := sfunction =># "_1";

  //$ General function definition. Multiple tuple arguments, body is expression.
  //$ Example:
  //$
  //$ inline fun f (x:int when x>0) (y:long when y>0l) : long expect result > 0l => x.long + y;
  sfunction := sadjectives sfun_kind sdeclname sfun_arg* fun_return_type "=>" sexpr ";" =>#
    """
      (begin ;;(display "GENERAL FUNCTION")
      (let ((body `((ast_fun_return ,_sr ,_7))))
      `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ,(first _5) ,(second _5) ,(cal_funkind _1 _2) ,_1 ,body))
      )
    """;

  //$ General function definition. Multiple tuple arguments, body of statements.
  //$ inline fun f (x:int when x>0) (y:long when y>0l) : long expect result > 0l { return x.long + y; }
  sfunction := sadjectives sfun_kind sdeclname sfun_arg* fun_return_type "="? scompound =>#
    """
      (begin ;;(display "COMPOUND FUNCTION")
      `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ,(first _5) ,(second _5) ,(cal_funkind _1 _2) ,_1 ,_7))
    """;

  //$ Object factory definition with interface type.
  sfunction := "object" sdeclname sfun_arg* "implements" object_return_type "="? scompound =>#
    """
      `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 ,_5 Object () ,_7)
    """;

  //$ Object factory definition without interface type.
  sfunction := "object" sdeclname sfun_arg*  "=" scompound =>#
    """
      `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 (typ_none none) Object () ,_5)
    """;

  //$ Object factory definition with inherited methods and
  //$ interface type.
  sfunction :=
    "object" sdeclname sfun_arg* "extends" expr_comma_list
    "implements" object_return_type "=" scompound
  =>#
    """
   (begin ;; (display "object function1\n")
   (let*
     (
       (d `(ast_object ,_sr (,dfltvs (,unitparam) typ_none ,_9)))  ;; extension function
       (a `(ast_apply ,_sr (,d ()))) ;; applied to unit
       (x `(ast_extension ,_sr ,_5 ,a)) ;; actual extension expression
       (retst `(ast_fun_return ,_sr ,x))
       (body `(,retst))
     )
     `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 ,_7 Function () ,body)
    ))
    """;

  //$ Object factory definition with inherited methods.
  sfunction := "object" sdeclname sfun_arg*  "extends" expr_comma_list "=" scompound =>#
    """
   (begin ;; (display "object function2\n")
   (let*
     (
       (noretype `(typ_none none))
       (d `(ast_object ,_sr (,dfltvs (,unitparam) typ_none ,_7)))  ;; extension function
       (a `(ast_apply ,_sr (,d ()))) ;; applied to unit
       (x `(ast_extension ,_sr ,_5 ,a)) ;; actual extension expression
       (retst `(ast_fun_return ,_sr ,x))
       (body `(,retst))
     )
     `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 ,noretype Function () ,body)
    ))
    """;


  sopt_cstring := "=" scode_spec =># "`(some ,_2)";
  sopt_cstring := sepsilon =># "'none";

  //$ Short form function definition. Example:
  //$
  //$ fun f : int -> int = | 0 => 0 | _ => 1;
/*
  sfunction := sadjectives sfun_kind sdeclname fun_return_type "=" smatching+ ";" =>#
    """
     (let
       (
        (t (first _4))
        (traint (second _4))
       )
      (begin ;;(display "MATCHING ftype=")(display t)(display "\\n")
      (if (eq? 'typ_arrow (first t))
        (let
          (
            (argt (caadr t))
            (ret (cadadr t))
            (body `((ast_fun_return ,_sr (ast_match ,_sr (,(noi '_a) ,_6)))))
          )
          `(ast_curry ,_sr ,(first _3) ,(second _3)
            (
              (((,_sr PVal _a ,argt none)) none)
            )
            (,ret ,traint)
            ,(cal_funkind _1 _2) ,_1 ,body)
        )
        (begin (display "ERROR MATCHINGS FUNDEF ")(display _sr) 'ERROR)
       )
       )
     )
    """;
*/

  sfunction := sadjectives sfun_kind sdeclname ":" stypeexpr "=" smatching+ ";" =>#
    """
     (let
       (
        (t _5)
       )
      (begin ;;(display "MATCHING ftype=")(display t)(display "\n")
        (let
          (
            (argt `(typ_apply ,_sr (,(nos "dom") ,t)))
            (ret `(typ_apply ,_sr (,(nos "cod") ,t)))
            (body `((ast_fun_return ,_sr (ast_match ,_sr (,(noi '_a) ,_7)))))
          )
          `(ast_curry ,_sr ,(first _3) ,(second _3)
            (
              ((Satom (,_sr PVal _a ,argt none)) none)
            )
            (,ret none)
            ,(cal_funkind _1 _2) ,_1 ,body)
        )
       )
     )
    """;


  sfunction := sadjectives sfun_kind sdeclname "=" sexpr ";" =>#
   """
      (let*
        (
          (traint 'none)
          (t `(ast_apply ,_sr (,(nos "typeof") ,_5)))
          (apl `(ast_apply ,_sr (,_5 ,(noi '_a))))
          (argt `(ast_apply ,_sr (,(nos "dom") ,t)))
          (ret `(ast_apply ,_sr (,(nos "cod") ,t)))
          (body `((ast_fun_return ,_sr ,apl )))
          (result `(ast_curry ,_sr ,(first _3) ,(second _3)
            (
              ((Satom (,_sr PVal _a ,argt none)) none)
            )
            (,ret ,traint)
            ,(cal_funkind _1 _2) ,_1 ,body)
          )
        )
        result
     )
    """;


  //$ Procedure binder.
  sproc_kind := "proc" =># "'Function";

  //$ C procedure binder.
  //$ Procedure has C function type (with void result type).
  sproc_kind := "cproc" =># "'CFunction";

  private sopt_traint_eq:= "expect" sexpr "=" =># "`((some ,_2) ,dflteffects)";
  private sopt_traint_eq:= "=" =># "`(none ,dflteffects)";
  private sopt_traint_eq:= sepsilon =># "`(none ,dflteffects)";

  private sopt_traint_eq:= "expect" sexpr ":" "[" stypeexpr "]" "=" =># "`((some ,_2) ,_5)";
  private sopt_traint_eq:= ":" "[" stypeexpr "]" "=" =># "`(none ,_3)";
  private sopt_traint_eq:= ":" "[" stypeexpr "]" =># "`(none ,_3)";


  private sopt_traint:= "expect" sexpr =># "`((some ,_2) ,dflteffects)";
  private sopt_traint:= sepsilon =># "`(none ,dflteffects)";

  private sopt_traint:= "expect" sexpr ":" "[" stypeexpr "]" =># "`((some ,_2) ,_5)";
  private sopt_traint:= ":" "[" stypeexpr "]" =># "`(none ,_3)";

  //$ Short form constructor function.
  //$ The name of the function must be a type name.
  //$ The return type is taken as the type with the name of the function.
  sfunction := "ctor" stvarlist squalified_name sfun_arg+ sopt_traint_eq scompound =>#
    """
    (let*
      (
        (name (string-append "_ctor_" (base_of_qualified_name _3)))
        (vs _2)
        (ret _3)
        (traint (first _5))
        (effects (second _5))
        (body _6)
        (args _4)
      )
      `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function () ,body))
    """;
  sfunction := "supertype" stvarlist squalified_name sfun_arg+ sopt_traint_eq scompound =>#
    """
    (let*
      (
        (name (string-append "_ctor_" (base_of_qualified_name _3)))
        (vs _2)
        (ret _3)
        (traint (first _5))
        (effects (second _5))
        (body _6)
        (args _4)
      )
      `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function (Subtype) ,body))
    """;

  //$ Short form constructor function.
  //$ The name of the function must be a type name.
  //$ The return type is taken as the type with the name of the function.
  sfunction := "ctor" stvarlist squalified_name sfun_arg+ sopt_traint "=>" sexpr ";" =>#
    """
    (let*
      (
        (name (string-append "_ctor_" (base_of_qualified_name _3)))
        (vs _2)
        (ret _3)
        (traint (first _5))
        (effects (second _5))
        (body `((ast_fun_return ,_sr ,_7)))
        (args _4)
      )
      `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function () ,body))
    """;
  sfunction := "supertype" stvarlist squalified_name sfun_arg+ sopt_traint "=>" sexpr ";" =>#
    """
    (let*
      (
        (name (string-append "_ctor_" (base_of_qualified_name _3)))
        (vs _2)
        (ret _3)
        (traint (first _5))
        (effects (second _5))
        (body `((ast_fun_return ,_sr ,_7)))
        (args _4)
      )
      `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function (Subtype) ,body))
    """;


  //$ Procedure definition, general form.
  sfunction := sadjectives sproc_kind sdeclname sfun_arg* sopt_traint_eq scompound =>#
    """
      `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ((ast_void ,_sr) ,(first _5)) ,(second _5)
         ,(cal_funkind _1 _2) ,_1 ,_6)
    """;

  //$ Procedure definition, short form (one statement).
  sfunction := sadjectives sproc_kind sdeclname sfun_arg* sopt_traint "=>" stmt =>#
    """
      `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ((ast_void ,_sr) ,(first _5)) ,(second _5)
         ,(cal_funkind _1 _2) ,_1 (,_7))
    """;

  //$ Routine definition, general form.
  sfunction := sadjectives "routine" sdeclname sfun_arg* sopt_traint_eq scompound =>#
    """
      `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 (,(noi 'any) ,(first _5)) ,(second _5)
         Function ,_1 ,_6)
    """;

  //$ Routine definition, short form (one statement).
  sfunction := sadjectives "routine" sdeclname sfun_arg* sopt_traint "=>" stmt =>#
    """
      `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 (,(noi 'any) ,(first _5)) ,(second _5)
         Function ,_1 (,_7))
    """;
}
Standard include file list

For files generated by this package. Includes grammar/extra.files for extensions in other packages.

grammar/utility.fsyn
grammar/blocks.fsyn
grammar/grammar_scheme_support.fsyn
grammar/grammar_regdefs.fsyn
grammar/grammar_ident_lexer.fsyn
grammar/grammar_string_lexer.fsyn
grammar/grammar_lexer.fsyn
grammar/expressions.fsyn
grammar/brackets.fsyn
grammar/texsyms.fsyn
grammar/patterns.fsyn
grammar/functions.fsyn
grammar/statements.fsyn
grammar/variables.fsyn
grammar/macros.fsyn
grammar/cbind.fsyn
grammar/executable.fsyn
grammar/assignment.fsyn
grammar/control.fsyn
grammar/conditional.fsyn
grammar/loops.fsyn
grammar/requirements.fsyn
grammar/type_decls.fsyn
grammar/assertions.fsyn
grammar/namespaces.fsyn
grammar/cgram.fsyn
grammar/plugins.fsyn

grammar/felix.fsyn grammar/save.fsyn

Identifier Lexer
//[grammar_ident_lexer.fsyn]
syntax felix_ident_lexer {
  /* identifiers */
  regdef ucn =
      "\u" hexdigit hexdigit hexdigit hexdigit
    | "\U" hexdigit hexdigit hexdigit hexdigit hexdigit hexdigit hexdigit hexdigit;

  regdef prime = "'";
  regdef dash = '-';
  regdef idletter = letter | underscore | hichar | ucn;
  regdef alphnum = idletter | digit;
  regdef innerglyph = idletter | digit | dash;
  regdef flx_ident = idletter (innerglyph ? (alphnum | prime) +)* prime*;
  regdef tex_ident = slosh letter+;
  regdef sym_ident =
    "+" | "-" | "*" | "/" | "%" | "^" | "~" |
    "\&" | "\|" | "\^" |
    /* mutator */
    "&=" | "|=" | "+=" | "-=" | "*=" | "/=" | "%=" | "^=" | "<<=" | ">>=" |
    /* comparison */
    "<" | ">" | "==" | "!=" | "<=" | ">=" | "<<" | ">>" | "<>"
  ;

  /* NOTE: upgrade to support n"wird + name" strings */
  literal flx_ident =># "(utf8->ucn _1)";
  literal tex_ident =># "_1";
  literal sym_ident =># "_1";

  sname := flx_ident =># "_1" | tex_ident =># "_1" | sym_ident =># "_1";

}

//[grammar_lexer.fsyn]



SCHEME """
(define (stripus s) ; strip underscores and primes in numbers
  (let*
    (
      (chrs (string->list s))
      (chrs (filter (lambda (x) (not (char=? x (integer->char 95)))) chrs)) ; strip underscores
      (chrs (filter (lambda (x) (not (char=? x (integer->char 39)))) chrs)) ; strip primes
    )
    (list->string chrs)
  )
)
""";

SCHEME """
(define (tolower-char c) ; convert one character to lower case
  (let*
    (
      (i (char->integer c))
      (i (if (and (>= i 65) (<= i 90)) (+ i 32) i))
    )
    (integer->char i)
  )
)
""";
SCHEME """
(define (tolower-string s) ; convert a whole string to lower case
  (let*
    (
      (chrs (string->list s))
      (chrs (map tolower-char chrs))
    )
    (list->string chrs)
  )
)
""";

syntax lexer {
  requires global_regdefs;
  requires felix_ident_lexer;
  requires felix_int_lexer;
  requires felix_float_lexer;
  requires felix_string_lexer;
}
Regular Definitions DSSL

Regular expressions and regular definitions for use with Google RE2 package via Felix binding library.

//[grammar_regdefs.fsyn]
syntax global_regdefs {
  /* ====================== REGULAR DEFINITIONS ============================ */
  /* special characters */
  regdef quote = "'";
  regdef dquote = '"';
  regdef slosh = '\';
  regdef hash = '#';
  regdef linefeed = 10;
  regdef tab = 9;
  regdef space = ' ';
  regdef formfeed = 12;
  regdef vtab = 11;
  regdef carriage_return = 13;
  regdef underscore = '_';

  /* character sets */
  regdef bindigit = ['01'];
  regdef octdigit = ['01234567'];
  regdef digit = ['0123456789'];
  regdef hexdigit = ["0123456789ABCDEFabcdef"];
  regdef lower = ['abcdefghijklmnopqrstuvwxyz'];
  regdef upper = ['ABCDEFGHIJKLMNOPQRSTUVWXYZ'];
  regdef letter = lower | upper;
  regdef hichar = [128-255];
  regdef white = space | tab;
  regdef dsep = underscore | quote;

  /* nasty: form control characters */
  regdef form_control = linefeed | carriage_return | vtab | formfeed;
  regdef newline_prefix = linefeed | carriage_return;
  regdef newline = formfeed | linefeed  | carriage_return linefeed;
  regdef hash = '#';

  regdef ordinary = letter | digit | hichar |
    '!' | '$' | '%' | '&' | '(' | ')' | '*' |
    '+' | ',' | '-' | '.' | '/' | ':' | ';' | '<' |
    '=' | '>' | '?' | '@' | '[' | ']' | '^' | '_' |
    '`' | '{' | '|' | '}' | '~';

  regdef printable = ordinary | quote | dquote | slosh | hash;
}
Utility Scheme definitions.

For use in the action codes of the grammar.

//[grammar_scheme_support.fsyn]
SCHEME """(define counter 100)""";

SCHEME """(define (fresh_int x)(begin (set! counter (+ counter 1)) counter))""";

SCHEME """(define (fresh_name x)(string-append "_" x "_" _filebase "_" (number->string (fresh_int()))))""";

SCHEME """
(begin
  ;; lists
  (define (first x)(car x))
  (define (second x)(cadr x))
  (define (third x)(caddr x))
  (define (tail x)(cdr x))
  (define fold_left
    (lambda (f acc lst)
      (if (null? lst) acc (fold_left f (f acc (first lst)) (tail lst)))))

  ;; list of pairs
  (define (myassoc elt alst)
    (let ((r (assoc elt alst)))
    (if r (second r) `(MISMATCHED_BRACKET ,elt ,alst))))

  (define (list-mem? item lst) (fold_left (lambda (acc elt)(or acc (eq? elt item))) #f lst))
  ;; name term constructor
  (define (nos x)`(ast_name ,_sr ,x ()))
  (define (tnos x)`(ast_name ,_sr ,x ()))
  (define (noi x)`(ast_name ,_sr ,(symbol->string x) ()))
  (define (qnoi c x)`(ast_lookup (,(noi c) ,(symbol->string x) ())))

  ;; polymorphic parameters
  (define dummysr '("dummysr" 0 0 0 0))
  (define (typesoftvarlist x) (map nos (map first (first x))))


  (define tunit `(typ_tuple ,dummysr ())) ;; unit type
  (define ttrue `(ast_name ,dummysr "TRUE" ()))
  (define dfltaux `(,ttrue ())) ;; constraint TRUE, typeclass list empty
  (define dfltvs `( () ,dfltaux)) ;; vs list: name list and constraint pair
  (define unitparam '((Slist ()) none))
  (define dfltparams `(,unitparam))
  (define dflteffects tunit)
)
""";

SCHEME """
(define (isvoid? x)
  (if
    (list? x)
      (equal? 'ast_void (first x))
       #f
   ))
""";

SCHEME """
(begin
  (define (base_of_ast_lookup qn) (second (second qn)))
  (define (base_of_ast_name n) (third n))
  (define (base_of_qualified_name qn)
    (cond
      ((eq? (first qn) 'ast_lookup) (base_of_ast_lookup qn))
      ((eq? (first qn) 'ast_name) (base_of_ast_name qn))
      (else (begin (display "QUALIFIED_NAME_EXPECTED got:")(display qn)))
    )
  )
)
""";

SCHEME """
;; lambda terms
(begin
  (define (lazy stmts) `(ast_lambda ,_sr (,dfltvs ,dfltparams typ_none ,stmts)))
  (define (lazy_proc stmts) `(ast_lambda ,_sr (,dfltvs ,dfltparams (ast_void ,_sr) ,stmts)))
  (define (block stmts)`(ast_call ,_sr ,(lazy_proc stmts) ()))
  (define (block_expr stmts) `(ast_apply ,_sr (,(lazy stmts) ())))
  (define call (lambda (f a) `(ast_call ,_sr (ast_name ,_sr ,f ()) ,a)))
)
""";

SCHEME """
;; split an application term apply (f a) into list (f a)
(define (splitapply x)
  (if (pair? x)
    (if (eq? (first x) 'ast_apply)
      (if (pair? (cddr x))
        (begin
;;           (display "f=")(display (caaddr x))
;;           (display " arg=")(display (cadaddr x))
;;           (display " pair=")(display (caddr x))
           (caddr x))
        (list x ()))
      (list x ()))
    (list ()))
)
""";

SCHEME """
(define (mkexlist x)
  (begin
  ;;(display "mkexlist x=")(display x)
  (if (pair? x)
    (if (eq? (first x) 'ast_tuple)
      (if (pair? (cddr x)) (caddr x) (list x))
      (list x))
    (list x)))
)
""";

SCHEME """
(define (mktylist x)
  (begin
  ;;(display "mktylist x=")(display x)(display "\n")
  (if (pair? x)
    (if (eq? (first x) 'typ_tuple )
      (if (pair? (cddr x)) (caddr x) (list x))
      (list x))
    (list x)))
)
""";


SCHEME """
(define (cal_funkind adjs fk)
  (if (eq? fk 'CFunction)'CFunction
  (if (and (eq? fk 'Generator)(list-mem? 'Method adjs))'GeneratorMethod
  (if (eq? fk 'Generator)'Generator
  (if (list-mem? 'NoInlineFunction adjs)'NoInlineFunction
  (if (list-mem? 'InlineFunction adjs)'InlineFunction
  (if (list-mem? 'Method adjs)'Method
  (if (list-mem? 'Ctor adjs)'Ctor
  (if (list-mem? 'Virtual adjs)'Virtual
  'Function
)))))))))
""";
SCHEME """
(define (tvfixup_folder vsct vtc)
  (begin ;;(display "\n*********\ntvfixup_folder vsct=")(display vsct)(display ", vtc=")(display vtc)(display "\n")
  (let*
    (
      (vs (first vsct))
      (ct (second vsct))
      (v (first vtc))
      (t (second vtc))
      (c (caddr vtc))
      (ct2
        (cond
          ((eq? 'NoConstraint c) ct )
          ((eq? 'Eq (first c)) ;; type  valconstraint
            `(typ_andchain
              ;;((ast_type_match ,_sr ((ast_name ,_sr ,v ()) ((,(second c) (typ_tuple ,_sr ())))))
              ((ast_type_match ,_sr ((ast_name ,_sr ,v ()) ((,(second c) ,ttrue))))
              ,ct)
            )
          )
          ((eq? 'In (first c)) ;; type constraint
            `(typ_andchain
              ((typ_isin ((ast_name ,_sr ,v ()) ,(second c)))
              ,ct)
            )
          )
        (else (display "ERROR!!!"))
        )
      )
    )
    (begin
    ;; (display "vs=")(display vs)
    ;; (display "\nct=")(display ct)
    ;; (display "\nv=")(display v)
    ;; (display "\nt=")(display t)
    ;; (display "\nc=")(display c)
    ;; (display "\nct2=")(display ct2)
    ;; (display "\n")
    (list (cons `(,v ,t) vs) ct2))
))))
""";

//
// rti = rtc:type constraint, rtr:class requirement list
//

SCHEME """
(define (tvfixup tv ct)
  (begin ;;(display "tvfixup tv=")(display tv)(display ", ct=")(display ct)(display "\\n")
  (let*
    (
      ;;(vscs (fold_left tvfixup_folder `(() (typ_tuple ,_sr ())) tv))
      (vscs (fold_left tvfixup_folder `(() ,ttrue ) tv))
      (vs (first vscs))
      (cs (second vscs))
      (rtc (first ct))
      (rtr (second ct))
      (ct `((typ_andchain (,rtc ,cs)) ,rtr))
    )
    (begin
    ;;  (display "vs=")(display vs)
    ;;  (display "\\ncs=")(display cs)
    ;;  (display "\\nrtc=")(display rtc)
    ;;  (display "\\nrtr=")(display rtr)
    ;;  (display "\\nct=")(display ct)
    ;;  (display "\\n")
    (list (reverse vs) ct))
  )
))
""";

SCHEME """
  (define (maybe k)(if (null? k)'none `(some ,(first k))))
""";

SCHEME """
  (define (strap a b)
  (if(null? b)a(if(equal? b "")a(if(equal? a "")b(string-append a " " b)))))
""";

SCHEME """
  (define (strcat ls)(fold_left strap "" ls))
""";

// chain 'and (x) yields just x,
// chain 'and (x y) yields ('and _sr (x y))
SCHEME """
  (define (chain op hd tl)
    (
      if (equal? tl ())
      hd
      `(,op ,_sr ,(cons hd (map second tl)))
    )
  )
""";

SCHEME """
  (define (infix op) `(ast_apply ,_sr (,(noi op) (ast_tuple ,_sr (,_1 ,_3)))))
""";

SCHEME """
  (define (binop f a b)`(ast_apply ,_sr (,f (ast_tuple ,_sr (,a ,b)))))
""";

SCHEME """
  (define (tbinop f a b)`(typ_apply ,_sr (,f (typ_type_tuple ,_sr (,a ,b)))))
""";

SCHEME """
  (define (prefix op) `(ast_apply ,_sr (,(noi op) ,_2)))
""";
SCHEME """
  (define (tprefix op) `(typ_apply ,_sr (,(noi op) ,_2)))
""";


SCHEME """
  (define (suffix op) `(ast_apply ,_sr (,(noi op) ,_1)))
""";


SCHEME """
  (define (Prefix) `(ast_apply ,_sr (,(nos _1) ,_2)))
""";
SCHEME """
  (define (tPrefix) `(typ_apply ,_sr (,(nos _1) ,_2)))
""";


SCHEME """
  (define (Infix) (binop (nos _2) _1 _3))
""";

SCHEME """
  (define (tInfix) (tbinop (nos _2) _1 _3))
""";

SCHEME """
  (define (filter pred lst)
    (reverse
      (fold_left
        (lambda (acc val) (if (pred val) (cons val acc) acc))
        ()
        lst
      )
    )
  )
""";


SCHEME """
  (define (filter_first sym lst)
    (reverse
      (fold_left
        (lambda (acc val) (if (equal? (first val) sym) (cons (tail val) acc) acc))
        ()
        lst
      )
    )
  )
""";

SCHEME """
  (define (prefix? p s)
    (let
      (
        (pl (string-length p))
        (sl (string-length s))
      )
      (if (< pl sl) (equal? p (substring s 0 pl)) #f)
    )
  )
""";

SCHEME """
  (define (suffix? p s)
    (let
      (
        (pl (string-length p))
        (sl (string-length s))
      )
      (if (< pl sl) (equal? p (substring s (- sl pl) sl)) #f)
    )
  )
""";

SCHEME """
  (define (make_private s) `(ast_private ,_sr ,s))
""";

SCHEME """
  (define (SUBST term vals)
    (cond
      ((symbol? term) term)
      ((number? term) term)
      ((string? term) term)
      ((null? term) term)
      ((list? term)
        (if (eq? (car term) 'PARSER_ARGUMENT)
          (vector-ref vals (cadr term) )
          (map (lambda (term) (SUBST term vals)) term)
        )
      )
    )
  )
""";

SCHEME """
  (define (stringof s)
    `(ast_literal ,_sr "string" ,s ,(string-append "::std::string(\"" s "\")"))
  )
""";
String like literals.

Note some of these forms are not strings.

//[grammar_string_lexer.fsyn]

SCHEME """
(define (decode-string s)
  (begin
    (adjust-linecount s)
    (let*
      (
        (n (string-length s))
        (result
          (cond
            ((prefix? "w'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "W'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "c'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "C'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "u'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "U'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "f'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "F'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "q'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "Q'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "n'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "N'''" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "r'''" s)(substring s 4 (- n 3)))
            ((prefix? "R'''" s)(substring s 4 (- n 3)))
            ((prefix? "'''" s)(unescape (substring s 3 (- n 3))))

            ((prefix? "w\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "W\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "c\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "C\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "u\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "U\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "f\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "F\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "q\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "Q\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "n\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "N\"\"\"" s)(unescape (substring s 4 (- n 3))))
            ((prefix? "r\"\"\"" s)(substring s 4 (- n 3)))
            ((prefix? "R\"\"\"" s)(substring s 4 (- n 3)))
            ((prefix? "\"\"\"" s)(unescape (substring s 3 (- n 3))))

            ((prefix? "w'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "W'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "c'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "C'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "u'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "U'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "f'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "F'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "q'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "Q'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "n'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "N'" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "r'" s)(substring s 2 (- n 1)))
            ((prefix? "R'" s)(substring s 2 (- n 1)))
            ((prefix? "'" s)(unescape (substring s 1 (- n 1))))

            ((prefix? "w\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "W\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "c\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "C\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "u\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "U\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "f\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "F\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "q\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "Q\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "n\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "N\"" s)(unescape (substring s 2 (- n 1))))
            ((prefix? "r\"" s)(substring s 2 (- n 1)))
            ((prefix? "R\"" s)(substring s 2 (- n 1)))
            ((prefix? "\"" s)(unescape (substring s 1 (- n 1))))

            (else error)
          )
        )
      )
      ;;(begin
      ;;   (newline)(display "string=")(display s)
      ;;   (newline)(display "text=")(display result)
         result
      ;;)
    )
  )
)
""";

// Scheme string to Felix string literal
SCHEME """
(define (strlit s)
    `(ast_literal ,_sr "string" ,s ,(string-append "::std::string(" (c-quote-string s) ")"))
)
""";

//$ String literals.
//$
//$ Generaly we follow Python here.
//$ Felix allows strings to be delimited by;
//$
//$ single quotes '
//$ double quotes "
//$ triped single quotes '''
//$ tripled double quotes """
//$
//$ The single quote forms must be on a single line.
//$ The triple quoted forms may span lines, and include embedded newline
//$ characters.
//$
//$ These forms all allows embedded escape codes.
//$ These are:
//$
//$  \a  -  7 : bell
//$  \b  -  8 : backspace
//$  \t  -  9 : horizontal tab
//$  \n  - 10 : linefeed, newline
//$  \r  - 13 : carriage return
//$  \v  - 11 : vertical tab
//$  \f  - 12 :form feed
//$  \e  - 27 : escape
//$  \\  - \  : slosh
//$  \"  - "  : double quote
//$  \'  - '  : single quote
//$  \   - 32 : space
//$
//$  \xFF - hexadecimal character code
//$  \o7 \o77 \o777 -- octal character code (stops on count of 3 or non-octal character)
//$  \d9 \d99 \d999 -- decimal character code (stops on count of 3 or non-decimal character)
//$  \uFFFF - utf8 encoding of specified hex value
//$  \UFFFFFFFF - utf8 encoding of specified hex value
//$
//$ A prefix "r" or "R" on a double quoted string
//$ or triple double quoted string suppresses escape processing,
//$ this is called a raw string literal.
//$ NOTE: single quoted string cannot be used!
//$
//$ A prefix "w" or "W" specifies a wide character string,
//$ of character type wchar. DEPRECATED.
//$
//$ A prefix of "u" or "U" specifes a string of uint32.
//$ This is a full Unicode string.
//$ THIS FEATURE WILL BE DEPRECATED.
//$ IT WILL BE REPLACED BY C++11 Unicode compliant strings.
//$
//$ A prefix of "c" or "C" specifies a C NTBS (Nul terminated
//$ byte string) be generated instead of a C++ string.
//$ Such a string has type +char rather than string.
//$
//$ A literal prefixed by "q" or "Q" is a Perl interpolation
//$ string. Such strings are actually functions.
//$ Each occurrence of $(varname) in the string is replaced
//$ at run time by the value "str varname". The type of the
//$ variable must provide an overload of "str" which returns
//$ a C++ string for this to work.
//$
//$ A literal prefixed by a "f" or "F" is a C format string.
//$ Such strings are actually functions.
//$ The string contains code such as "%d" or other supported
//$ C format string. Variable field width specifiers "*" are
//$ not permitted. The additional format specification %S
//$ is supported and requires a C++ string argument.
//$ Such functions accept a tuple of values like this:
//$
//$ f"%d-%S" (42, "Hello")
//$
//$ If vsnprintf is available on the local platform it is used
//$ to provide an implementation which cannot overrun.
//$ If it is not, vsprintf is used instead with a 1000 character
//$ buffer.
//$
//$ The argument types and code types are fully checked for type safety.
//$
//$ The special literal with a "n" or "N" prefix is a way to encode
//$ an arbitrary sequence of characters as an identifer in a context
//$ where the parser might interpret it otherwise.
//$ It can be used, for example, to define special characters as functions.
//$ For example:
//$
//$ typedef fun n"@" (T:TYPE) : TYPE => cptr[T];
//$
syntax felix_string_lexer {
  /* Python strings */
  regdef qqq = quote quote quote;
  regdef ddd = dquote dquote dquote;

  regdef escape = slosh _;

  regdef dddnormal = ordinary | hash | quote | escape | white | newline;
  regdef dddspecial = dddnormal | dquote dddnormal | dquote dquote dddnormal;

  regdef qqqnormal = ordinary | hash | dquote | escape | white | newline;
  regdef qqqspecial = qqqnormal | quote qqqnormal | quote quote qqqnormal;

  regdef qstring_tail = (ordinary | hash | dquote | escape | white) * quote;
  regdef dstring_tail = (ordinary | hash | quote | escape | white) * dquote;
  regdef qqqstring_tail = qqqspecial * qqq;
  regdef dddstring_tail = dddspecial * ddd;

  regdef qstring = quote qstring_tail;
  regdef dstring = dquote dstring_tail;
  regdef qqqstring = qqq qqqstring_tail;
  regdef dddstring = ddd dddstring_tail;


  regdef raw_dddnormal = ordinary | hash | quote | slosh | white | newline;
  regdef raw_dddspecial = raw_dddnormal | dquote raw_dddnormal | dquote dquote raw_dddnormal;

  regdef raw_qqqnormal = ordinary | hash | dquote | slosh | space | newline;
  regdef raw_qqqspecial = raw_qqqnormal | quote raw_qqqnormal | quote quote raw_qqqnormal;

  regdef raw = 'r' | 'R';

  regdef raw_dstring_tail =  (ordinary | hash | quote | escape | white) * dquote;
  regdef raw_qqqstring_tail = raw_qqqspecial * qqq;
  regdef raw_dddstring_tail = raw_dddspecial * ddd;

  regdef raw_dstring = raw dquote dstring_tail;
  regdef raw_qqqstring = raw qqq qqqstring_tail;
  regdef raw_dddstring = raw ddd dddstring_tail;

  regdef plain_string_literal = dstring | qqqstring | dddstring;
  regdef raw_string_literal = raw_dstring | raw_qqqstring | raw_dddstring;

  regdef string_literal = plain_string_literal | qstring | raw_string_literal;

  regdef wstring_literal = ('w' | 'W') plain_string_literal;
  regdef ustring_literal = ('u' | 'U') plain_string_literal;
  regdef cstring_literal = ('c' | 'C') plain_string_literal;
  regdef qstring_literal = ('q' | 'Q') plain_string_literal;
  regdef fstring_literal = ('f' | 'F') plain_string_literal;
  regdef nstring_literal = ('n' | 'N') plain_string_literal;

   // String as name.
  literal nstring_literal =># "(decode-string _1)";
  sname := nstring_literal =># "_1";

  // String for pattern or code template.
  regdef sstring = string_literal;
  literal sstring =># "(decode-string _1)";

  // Cstring for code.
  regdef scstring = cstring_literal;
  literal scstring =># "(decode-string _1)";

  // String for string parser.
  regdef strstring = string_literal;
  literal strstring =># "(c-quote-string (decode-string _1))";

  // String like literals.
  regdef String = string_literal;
  literal String =># """
    (let*
      (
        (ftype "string")
        (iv (decode-string _1))
        (cv (c-quote-string iv))
        (cv (string-append "::std::string(" cv ")"))
      )
      `(ast_literal ,_sr ,ftype ,iv ,cv)
    )
  """;
  sliteral := String =># "_1";

  regdef Wstring = wstring_literal;
  literal Wstring =># """
    (let*
      (
        (ftype "wstring")
        (iv (decode-string _1))
        (cv (c-quote-string iv))
        (cv (string-append "wstring(" cv ")"))
      )
      `(ast_literal ,_sr ,ftype ,iv ,cv)
    )
  """;
  sliteral := Wstring =># "_1";

  regdef Ustring = ustring_literal;
  literal Ustring =># """
    (let*
      (
        (ftype "ustring")
        (iv (decode-string _1))
        (cv (c-quote-string iv))
        (cv (string-append "ustring(" cv ")"))
      )
      `(ast_literal ,_sr ,ftype ,iv ,cv)
    )
  """;
  sliteral := Ustring =># "_1";

  regdef Cstring = cstring_literal;
  literal Cstring =>#
  """
    (let*
      (
        (ftype "cstring")
        (iv (decode-string _1))
        (cv (c-quote-string iv))
      )
      `(ast_literal ,_sr ,ftype ,iv ,cv)
    )
  """;
  sliteral := Cstring =># "_1";

  regdef Qstring = qstring_literal;
  literal Qstring =># "`(ast_interpolate ,_sr ,(decode-string _1))";
  sliteral := Qstring =># "_1";

  regdef Fstring = fstring_literal;
  literal Fstring =># "`(ast_vsprintf ,_sr ,(decode-string _1))";
  sliteral := Fstring =># "_1";

}
Loops
//[loops.fsyn]
  SCHEME """
    (define (notnumeric s) (fold_left notdigit #f (string->list s)))
  """;

  SCHEME """
    (define (check-label first last term)
      (if
        (notnumeric first)
        (if
          (equal? first last)
          term
          (begin
            (display (string-append first " != " last " giveup\n"))
            (giveup)
          )
        )
        (if
          (equal? "" last)
          term
          (begin
            (display (string-append first " != " last " giveup\n"))
            (giveup)
          )
        )
      )
    )
    """;

//$ Primary looping contructs.
SCHEME """
   (define (incluploop)
    `(ast_seq ,_sr
      ,(append
        `((ast_assign ,_sr _set ((Expr ,_sr (ast_name ,_sr ,_3 ())) none) ,_5))
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr
          ,(binop (noi '<=) `(ast_name ,_sr ,_3 ()) _7)
          ,(string-append "break_" _1)
        ))
        `(,_8)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `((ast_call ,_sr ,(noi 'pre_incr) (ast_ref ,_sr (ast_name ,_sr ,_3()))))
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
       ))
    )
    """;

SCHEME """
   (define (excluploop)
    `(ast_seq ,_sr
      ,(append
        `((ast_assign ,_sr _set ((Expr ,_sr (ast_name ,_sr ,_3 ())) none) ,_5))
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr
          ,(binop (noi '<) `(ast_name ,_sr ,_3 ()) _7)
          ,(string-append "break_" _1)
        ))
        `(,_8)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `((ast_call ,_sr ,(noi 'pre_incr) (ast_ref ,_sr (ast_name ,_sr ,_3()))))
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
       ))
    )
    """;

SCHEME """
  (define iterator_recursive_loop
    (lambda (loopname cvar iterator body)
      (begin (display "Eval iterator recursive loop\n")
      (let*
        (
          (proc_string_name (fresh_name "proc"))
          (proc_call_name (nos proc_string_name))
          (proc_param dfltparams)
          (proc_ret `((ast_void ,_sr) none))
          (proc_adjectives `())
          (proccall `(ast_call ,_sr ,proc_call_name (ast_tuple ,_sr ())))
          (generator_string_name (fresh_name "generator" ))
          (generator_call_name (nos generator_string_name))
          (generator_init `(ast_apply ,_sr (,(nos "iterator") ,iterator )))
          (generator_call `(ast_apply ,_sr (,generator_call_name ())))
          (some_pattern `(pat_nonconst_ctor ,_sr ,(nos "Some") (pat_as ,_sr (pat_any ,_sr) ,cvar) ))
          (some_exit proccall)
          (some_handler (append `(,body) `(,some_exit)))
          (none_pattern `(pat_const_ctor ,_sr ,(nos "None")))
          (none_handler `((ast_nop ,_sr, "drop thru")))
          (some_item `(,some_pattern ,some_handler))
          (none_item `(,none_pattern ,none_handler))
          (matchings `(,some_item ,none_item))
          (proc_body
            `( ast_seq ,_sr
              (
                (ast_label ,_sr ,(string-append "continue_" loopname))
                (ast_stmt_match (,_sr ,generator_call ,matchings))
                (ast_label ,_sr ,(string-append "break_" loopname))
              )
            )
          )
          (vardef `(ast_var_decl ,_sr ,generator_string_name ,dfltvs none (some ,generator_init)))
          (procdef
            `(
              ast_curry_effects ,_sr ,proc_string_name ,dfltvs ,proc_param ,proc_ret ,dflteffects
              Function ,proc_adjectives (,proc_body)
            )
          )
        )
        `(ast_seq ,_sr (,vardef ,procdef ,proccall))
      )
      ) ;;display
    )
  )
""";

syntax loops
{
  requires blocks;
  // ----------------------------------------------------------------------------------
  // Synopsis of loop forms
  // ----------------------------------------------------------------------------------
  stmt = escape_stmt;
  block = loop_stmt;

  // ----------------------------------------------------------------------------------
  //$ Statement groups controlled by loops
  // ----------------------------------------------------------------------------------

  // ----------------------------------------------------------------------------------
  // Escape statements for deviant processing
  // ----------------------------------------------------------------------------------
  //$ Labelled break.
  //$ Use to exit from the loop with the specified label.
  private escape_stmt := "break" sname =># '`(ast_goto ,_sr ,(string-append "break_" _2))';

  //$ Labelled continue.
  //$ Use to continue with the next iteration of the loop with the specified label.
  private escape_stmt := "continue" sname =># '`(ast_goto ,_sr ,(string-append "continue_" _2))';

  //$ Labelled redo.
  //$ Use to restart this iteration of the loop with the specified label.
  private escape_stmt := "redo" sname =># '`(ast_goto ,_sr ,(string-append "redo_" _2))';

  // ----------------------------------------------------------------------------------
  //$ Syntax for a loop label. Used by escapes to indicate which loop.
  // ----------------------------------------------------------------------------------
  //$ Use just before the loop.
  private optlabel := sname ":" =># "_1";

  //$ Loop labels aren't required.
  private optlabel := sepsilon =># '(fresh_name "ll")';

  // ----------------------------------------------------------------------------------
  // the loops
  // ----------------------------------------------------------------------------------
  //$ Standard while loop.
  loop_stmt := optlabel "while" sexpr block =>#
    """
    `(ast_seq ,_sr
      ,(list
        `(ast_label ,_sr ,(string-append "continue_" _1))
        `(ast_unlikely_ifnotgoto ,_sr ,_3 ,(string-append "break_" _1))
        _4
        `(ast_goto ,_sr ,(string-append "continue_" _1))
        `(ast_label ,_sr ,(string-append "break_" _1))
    ))
    """;

  //$ repeat loop.
  loop_stmt := optlabel "repeat" block =>#
    """
    `(ast_seq ,_sr
      ,(list
        `(ast_label ,_sr ,(string-append "continue_" _1))
        _3
        `(ast_goto ,_sr ,(string-append "continue_" _1))
        `(ast_label ,_sr ,(string-append "break_" _1))
    ))
    """;


  //$ Negated while loop.
  loop_stmt := optlabel "until" sexpr block =>#
    """
    `(ast_seq ,_sr
      ,(append
        `(( ast_label ,_sr ,(string-append "continue_" _1)))
        `(( ast_unlikely_ifgoto ,_sr ,_3 ,(string-append "break_" _1)))
        `(,_4)
        `(( ast_goto ,_sr ,(string-append "continue_" _1)))
        `(( ast_label ,_sr ,(string-append "break_" _1)))
    ))
    """;

  loop_stmt := optlabel "for" "(" stmt sexpr ";" stmt ")" stmt =>#
  """
  (begin
    `(ast_seq ,_sr
      ,(append
        `(,_4)
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr ,_5 ,(string-append "break_" _1)))
        `(,_9)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `(,_7)
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
      )
    )
  )
  """;

  loop_stmt := optlabel "for" stmt "while" sexpr ";" "next" stmt block =>#
  """
  (begin
    `(ast_seq ,_sr
      ,(append
        `(,_3)
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr ,_5 ,(string-append "break_" _1)))
        `(,_9)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `(,_8)
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
      )
    )
  )
  """;


  loop_stmt := optlabel "for" stmt "until" sexpr ";" "next" stmt block =>#
  """
  (begin
    `(ast_seq ,_sr
      ,(append
        `(,_3)
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifgoto ,_sr ,_5 ,(string-append "break_" _1)))
        `(,_9)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `(,_8)
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
      )
    )
  )
  """;

  //$ Numeric upwards for loop, existing control variable.
  //$ Ranges are inclusive. This is essential in case
  //$ the loops if over the complete domain of the control variable type.
  //$ The start and end argument types and the declared control variable type must be the same.

  // Unfortunately we have to have TWO comparisons with the terminating value
  // the first to see if the body is to execute and the second to see if
  // the incr/decr is to be done, this is because it might be the max/min value
  // in the range and the incr/decr would be invalid.

  //loop_stmt := optlabel "for" sname "in" sexpr ".." sexpr block =># "(incluploop)";
  loop_stmt := optlabel "for" sname "in" sexpr "upto" sexpr block =># "(incluploop)";
  //loop_stmt := optlabel "for" sname "in" sexpr "..<" sexpr block =># "(excluploop)";


  //$ Numeric upwards for loop, also declares the control variable with type.
  //$ The control variable is local to the enclosing context,
  //$ NOT the loop, so it can be inspected in code following the loop.
  //$ Ranges are inclusive. This is essential in case
  //$ the loops if over the complete domain of the control variable type.
  //$ The start and end argument types and the declared control variable type must be the same.
  loop_stmt := optlabel "for" "var" sname ":" sexpr "in" sexpr "upto" sexpr block =>#
    """
    `(ast_seq ,_sr
      ,(append
        `((ast_var_decl ,_sr ,_4 ,dfltvs (some ,_6) (some ,_8)))
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr
         ,(binop (noi '<=) `(ast_name ,_sr ,_4 ()) _10)
          ,(string-append "break_" _1)
        ))
        `(,_11)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `((ast_call ,_sr ,(noi 'pre_incr) (ast_ref ,_sr (ast_name ,_sr ,_4()))))
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
       ))
    """;

  //$ Numeric upwards for loop, also declares the control variable.
  //$ The control variable is local to the enclosing context,
  //$ NOT the loop, so it can be inspected in code following the loop.
  //$ Ranges are inclusive. This is essential in case
  //$ the loops if over the complete domain of the control variable type.
  //$ The start and end argument types must be the same.
  loop_stmt := optlabel "for" "var" sname "in" sexpr "upto" sexpr block =>#
    """
    `(ast_seq ,_sr
      ,(append
        `((ast_var_decl ,_sr ,_4 ,dfltvs none (some ,_6)))
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr
          ,(binop (noi '<=) `(ast_name ,_sr ,_4 ()) _8)
          ,(string-append "break_" _1)
        ))
        `(,_9)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `((ast_call ,_sr ,(noi 'pre_incr) (ast_ref ,_sr (ast_name ,_sr ,_4()))))
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
       ))
    """;


  //$ Numeric downwards for loop, existing control variable.
  //$ Ranges are inclusive. This is essential in case
  //$ the loops if over the complete domain of the control variable type.
  //$ The start and end argument types and the declared control variable type must be the same.
  loop_stmt := optlabel "for" sname "in" sexpr "downto" sexpr block =>#
    """
    `(ast_seq ,_sr
      ,(append
        `((ast_assign ,_sr _set ((Expr ,_sr (ast_name ,_sr ,_3 ())) none) ,_5))
        `((ast_call ,_sr ,(noi 'pre_incr) (ast_ref ,_sr (ast_name ,_sr ,_3()))))
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr
          ,(binop (noi '>) `(ast_name ,_sr ,_3 ()) _7)
          ,(string-append "break_" _1)
        ))
        `((ast_call ,_sr ,(noi 'pre_decr) (ast_ref ,_sr (ast_name ,_sr ,_3()))))
        `(,_8)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
       ))
    """;

  //$ Numeric downwards for loop, also declares the control variable with type.
  //$ The control variable is local to the enclosing context,
  //$ NOT the loop, so it can be inspected in code following the loop.
  //$ Ranges are inclusive. This is essential in case
  //$ the loops if over the complete domain of the control variable type.
  //$ The start and end argument types and the declared control variable type must be the same.
  loop_stmt := optlabel "for" "var" sname ":" sexpr "in" sexpr "downto" sexpr block =>#
    """
    `(ast_seq ,_sr
      ,(append
        `((ast_var_decl ,_sr ,_4 ,dfltvs (some ,_6) (some ,_8)))
        `((ast_call ,_sr ,(noi 'pre_incr) (ast_ref ,_sr (ast_name ,_sr ,_4()))))
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr
          ,(binop (noi '>) `(ast_name ,_sr ,_4 ()) _10)
          ,(string-append "break_" _1)
        ))
        `((ast_call ,_sr ,(noi 'pre_decr) (ast_ref ,_sr (ast_name ,_sr ,_4()))))
        `(,_11)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
       ))
    """;

  //$ Numeric downwards for loop, also declares the control variable.
  //$ The control variable is local to the enclosing context,
  //$ NOT the loop, so it can be inspected in code following the loop.
  //$ Ranges are inclusive. This is essential in case
  //$ the loops if over the complete domain of the control variable type.
  //$ The start and end argument types and the declared control variable type must be the same.
  loop_stmt := optlabel "for" "var" sname "in" sexpr "downto" sexpr block =>#
    """
    `(ast_seq ,_sr
      ,(append
        `((ast_var_decl ,_sr ,_4 ,dfltvs none (some ,_6)))
        `((ast_call ,_sr ,(noi 'pre_incr) (ast_ref ,_sr (ast_name ,_sr ,_4()))))
        `((ast_label ,_sr ,(string-append "redo_" _1)))
        `((ast_unlikely_ifnotgoto ,_sr
          ,(binop (noi '>) `(ast_name ,_sr ,_4 ()) _8)
          ,(string-append "break_" _1)
        ))
        `((ast_call ,_sr ,(noi 'pre_decr) (ast_ref ,_sr (ast_name ,_sr ,_4()))))
        `(,_9)
        `((ast_label ,_sr ,(string-append "continue_" _1)))
        `((ast_goto ,_sr ,(string-append "redo_" _1)))
        `((ast_label ,_sr ,(string-append "break_" _1)))
       ))
    """;

  //$ Basic stream consumer.
  //$ The second argument must be a value for which there is a generator:
  //$
  //$   iterator : D -> unit -> opt[T]
  //$
  //$ Due to a hack in std/datatype/slice.flx:
  //$    gen iterator[t] (f:1->opt[t]) => f;
  //$ you can also use an actual iterator.
  //$
  //$ 1. The iterator function is called.
  //$ 2. If the result is None, the loop exits.
  //$ 3. If the result is Some ?t, then t is assigned to the
  //$    control variable,
  //$ 4. the loop body is executed, and
  //$ 6. we go back to step 1.
  loop_stmt := optlabel "for" sname "in" sexpr block =>#
    """
    (let* (
     (generator_string_name (fresh_name "generator" ))
     (generator_call_name (nos generator_string_name))
     (generator_init `(ast_apply ,_sr (,(nos "iterator") ,_5 )))
     (generator_call `(ast_apply ,_sr (,generator_call_name ())))
     (some_pattern `(pat_nonconst_ctor ,_sr ,(nos "Some") (pat_as ,_sr (pat_any ,_sr) ,_3) ))
     (some_exit `(ast_goto ,_sr ,(string-append "continue_" _1)))
     (some_handler (append `(,_6) `(,some_exit)))
     (none_pattern `(pat_const_ctor ,_sr ,(nos "None")))
     (none_handler `((ast_nop ,_sr, "drop thru")))
     (some_item `(,some_pattern ,some_handler))
     (none_item `(,none_pattern ,none_handler))
     (matchings `(,some_item ,none_item))
    )
    `(ast_seq ,_sr (
        (ast_var_decl ,_sr ,generator_string_name ,dfltvs none (some ,generator_init))
        (ast_label ,_sr ,(string-append "continue_" _1))
        (ast_stmt_match (,_sr ,generator_call ,matchings))
        (ast_label ,_sr ,(string-append "break_" _1))
       )))
    """;

  loop_stmt := optlabel "rfor" sname "in" sexpr block =># '(iterator_recursive_loop _1 _3 _5 _6)';

  //$ Upmarket stream consumer.
  //$ The second argument must be a value for which there is a generator:
  //$
  //$   iterator : D -> unit -> opt[T]
  //$
  //$ Due to a hack in std/datatype/slice.flx:
  //$    gen iterator[t] (f:1->opt[t]) => f;
  //$ you can also use an actual iterator.
  //$
  //$
  //$ 1. The iterator function is called.
  //$ 2. If the result is None, the loop exits.
  //$ 3. If the result is Some ?t,
  //$    then t is matched against the pattern.
  //$ 4. If the pattern matches, loop body is executed, and
  //$ 5. we go back to step 1.
  //$ 6. If the pattern does not match,
  //$ 7. we go back to step 1
  //$    without executing the loop body.
  loop_stmt := optlabel "match" spattern "in" sexpr block =>#
    """
    (let* (
     (generator_string_name (fresh_name "generator" ))
     (generator_call_name (nos generator_string_name))
     (generator_init `(ast_apply ,_sr (,(nos "iterator") ,_5 )))
     (generator_call `(ast_apply ,_sr (,generator_call_name ())))
     (some_pattern `(pat_nonconst_ctor ,_sr ,(nos "Some")  ,_3 ))
     (some_exit `(ast_goto ,_sr ,(string-append "continue_" _1)))
     (some_handler (append `(,_6) `(,some_exit)))
     (some_item `(,some_pattern ,some_handler))
     (other_pattern `(pat_nonconst_ctor ,_sr ,(nos "Some")  (pat_any ,_sr) ))
     (other_handler `(,some_exit))
     (other_item `(,other_pattern ,other_handler))
     (none_pattern `(pat_const_ctor ,_sr ,(nos "None")))
     (none_handler `((ast_nop ,_sr, "drop thru")))
     (none_item `(,none_pattern ,none_handler))
     (matchings `(,some_item ,other_item ,none_item))
    )
    `(ast_seq ,_sr (
        (ast_var_decl ,_sr ,generator_string_name ,dfltvs none (some ,generator_init))
        (ast_label ,_sr ,(string-append "continue_" _1))
        (ast_stmt_match (,_sr ,generator_call ,matchings))
        (ast_label ,_sr ,(string-append "break_" _1))
       )))
    """;


}
Macros
//[macros.fsyn]
syntax macros {
  requires expressions, statements, list;

  stmt := "macro" "val" snames "=" sexpr ";" =>#
    "`(ast_macro_val ,_sr ,_3 ,_5)";

  stmt := "forall" sname "in" sexpr "do" stmt* "done" =>#
    "`(ast_macro_forall ,_sr (,_2) ,_4 ,_6)"
  ;

}
Namespaces
//[namespaces.fsyn]
//$ Felix namespace control.
syntax namespaces {
  requires statements;

  stmt = namespace_stmt;

  //$ Create a new solo name and bind it to an existing name.
  //$ NOTE: it doesn't rename anything!
  //$ Used to inject solo names into a namespace.

  private namespace_stmt := "rename" sdeclname "=" squalified_name ";" =>#
    """
    `(ast_inherit ,_sr ,(first _2) ,(second _2) ,_4)
    """;

  //$ Create a new name for an existing set of function names.
  //$ NOTE: it doesn't rename anything!
  //$ Used to inject an overload set into a namespace.
  private namespace_stmt := "rename" "fun" sdeclname "=" squalified_name ";" =>#
    """
    `(ast_inherit_fun ,_sr ,(first _3) ,(second _3) ,_5)
    """;

  //$ Inject all the public members of a class or module
  //$ into a namespace.
  private namespace_stmt := "inherit" stvarlist squalified_name ";" =>#
    "`(ast_inject_module ,_sr ,_2 ,_3)";

  //$ Inject all the public members of a class or module
  //$ "just underneath" a namespace. Such names will be
  //$ hidden by any names actually defined or injected
  //$ into the actual namespace scope.
  //$ NOTE: The names are not public members of the namespace.
  //$ But they're not private members either, they're not
  //$ members at all.
  //$
  //$ Open makes names available for use in a namespace
  //$ without making them members for export.
  private namespace_stmt := "open" stvarlist squalified_name ";" =>#
    "`(ast_open ,_sr ,_2 ,_3)";

  //$ Open a single name to a namespace bound to the given qualified name.
  private namespace_stmt := "use" sname "=" squalified_name ";" =># "`(ast_use ,_sr ,_2 ,_4)";

  //$ A short form for opening a single name as the
  //$ base part of a qualified name.
  private namespace_stmt := "use" squalified_name ";" =>#
    """
    (let ((name
      (if (eq? (first _2) 'ast_lookup) (cadadr _2)
        (if (eq? (first _2) 'ast_name) (second _2)
        ("ERROR")))))
    `(ast_use ,_sr ,name ,_2))
    """;

  //$ Define a module.
  //$ DEPRECATED. Use classes instead.
  private namespace_stmt := "module" sdeclname "=" ? scompound =>#
    """
    `(ast_untyped_module ,_sr ,(first _2) ,(second _2) ,_4)
     """;

  private namespace_stmt := "library" sname "=" ? scompound =>#
    """
    `(ast_library ,_sr ,_2 ,_4)
     """;


  //$ Define a module and open in it in the current scope.
  //$ DEPRECATED: Use classes instead.
  private namespace_stmt := "open" "module" sdeclname "=" ? scompound =>#
    """
    `(ast_seq ,_sr (
      (ast_untyped_module ,_sr ,(first _3) ,(second _3) ,_5)
      (ast_open ,_sr ,dfltvs (ast_name ,_sr ,(first _3) ()))))
     """;

  private namespace_stmt := "open" "library" sname "=" ? scompound =>#
    """
    `(ast_seq ,_sr (
      (ast_library ,_sr ,_3 ,_5)
      (ast_open ,_sr ,dfltvs (ast_name ,_sr ,_3 ()))))
     """;

  //$ Define a class.
  //$ A class is a collection of constants, variables,
  //$ types, functions, and other entities.
  //$
  //$ A polymorphic class may contain virtual functions, which are
  //$ functions which can be defined later for particular types.
  //$ This is equivalent to a specialisation of a template in C++.
  //$
  //$ NOTE: polymorphic classes may not contain variables.
  //$ Only variables of non-polymorphic classes can be instantiated.
  private namespace_stmt := "class" sdeclname "=" ? scompound =>#
    """
    `(ast_typeclass ,_sr ,(first _2) ,(second _2) ,_4)
    """;

  private namespace_stmt := "class" sdeclname ";" =>#
    """
    `(ast_begin_typeclass ,_sr ,(first _2) ,(second _2))
    """;


  //$ Define a class and open it.
  private namespace_stmt := "open" "class" sdeclname "=" ? scompound =>#
    """
    `(ast_seq ,_sr (
      (ast_typeclass ,_sr ,(first _3) ,(second _3) ,_5)
      (ast_open ,_sr ,dfltvs (ast_name ,_sr ,(first _3) ()))))
    """;

  //$ Define an instance of a class.
  //$ This is a specialisation of the class which may contain
  //$ overrides of virtual functions for a subset of the possible types.
  //$
  //$ Instances can be defined in any class scope (including and usually
  //$ at the top level of the program).
  //$
  //$ Members of instances which are not overrides are private
  //$ to the instance.
  //$
  private namespace_stmt := "instance" stvarlist squalified_name "=" ? scompound =>#
    """
    `(ast_instance ,_sr ,_2 ,_3 ,_5)
    """;


  //$ Provide a set of definitions in the with block
  //$ which are available in the do block but are lost
  //$ thereafter.
  //$
  //$ Effectively these definitions are private to the
  //$ do block. The with block is basically an anonymous
  //$ class which is opened in the do block. Example:
  //$
  //$ var x = 42;
  //$ with var x = 1; do var y = x; done
  //$ println$ x; // prints 42 not 1
  //$
  //$ This is the statement form of a let expression ..
  private namespace_stmt := "with" stmt+ block =>#
  """
  (let*
    (
      (dummy_class_name (fresh_name "dummy_class"))
      (decls1 (map make_private _2))
      (decls (append decls1 `(,_3)))
    )
    `(ast_seq ,_sr
      (
        (ast_typeclass ,_sr ,dummy_class_name ,dfltvs ,decls)
        (ast_inject_module ,_sr ,dfltvs ,(nos dummy_class_name))
      )
    )
  )
  """;
}
Patterns
//[patterns.fsyn]
//$ Pattern matching.
//$
//$ Pattern matching is a way to "take apart" a value according
//$ to its structure.
//$
//$ Matches operate "inside out".

syntax patterns {

  block = match_stmt;

  smatch_head := "chainmatch" sexpr "with" stmt_matching+ =># "`(,_2 ,_4)";
  smatch_link := "ormatch" sexpr "with" stmt_matching+ =># "`(,_2 ,_4)";
  smatch_chain := smatch_chain smatch_link =># "(cons _2 _1)"; // revsersed
  smatch_chain := smatch_link =># "`(,_1)";

  match_stmt := smatch_head smatch_chain "endmatch" ";" =>#
    "`(ast_stmt_chainmatch ,_sr ,(cons _1 (reverse _2)))"
  ;

  match_stmt := smatch_head "endmatch" ";" =>#
    "`(ast_stmt_match (,_sr ,_1))"
  ;

  //$ Pattern match statement.
  //$ At least one branch must match or the program aborts with a match failure.
  match_stmt:= "match" sexpr "with" stmt_matching+ "endmatch" ";" =>#
    "`(ast_stmt_match (,_sr ,_2 ,_4))";

  match_stmt:= "match" sexpr "do" stmt_matching+ "done" =>#
    "`(ast_stmt_match (,_sr ,_2 ,_4))";

  //$ A single branch of a pattern match statement.
  //$ The match argument expression is compared to the pattern.
  //$ If it matches any contained pattern variables are assigned
  //$ the values in the corresponding possition of the expression,
  //$ and the statements are executed.
  private stmt_matching := "|" spattern "=>" stmt+ =># "`(,_2 ,_4)";

  //$ Pattern match expression with terminator.
  satom := pattern_match "endmatch" =># "_1";

  //$ Pattern match expression without terminator.
  //$ Match the expression against each of the branches in the matchings.
  //$ At least one branch must match or the program aborts with a match failure.
  pattern_match := "match" sexpr "with" smatching+ =>#
    "`(ast_match ,_sr (,_2 ,_4))";

  //$ The match argument expression is compared to the pattern.
  //$ If it matches any contained pattern variables are assigned
  //$ the values in the corresponding possition of the expression,
  //$ and expression is evaluated and becomes the return value
  //$ of the whole match.
  smatching := "|" spattern "=>" x[let_pri] =># "`(,_2 ,_4)";

  //$ Match nothing.
  smatching := "|" "=>" sexpr =># "`((pat_none ,_sr) ,_3)";

  spattern := sguard_pattern ("|" sguard_pattern)* =># "(chain 'pat_alt _1 _2)";

  //$ Match with guard.
  //$ The LHS pattern is match first.
  //$ Then the RHS guard expression is evaluated,
  //$ in a context which includes any extracted match variables.
  //$ If the guard is true, the whole pattern matches,
  //$ otherwise the matching fails.
  sguard_pattern := swith_pattern "when" x[sor_condition_pri] =># "`(pat_when ,_sr ,_1 ,_3)";
  sguard_pattern := swith_pattern =># "_1";

  swith_pattern := sas_pattern "with" spat_avars =># "`(pat_with ,_sr ,_1 ,_3)";
    spat_avar := sname "=" x[sor_condition_pri] =># "`(,_1 ,_3)";
    spat_avars := list::commalist1<spat_avar> =># "_1";
  swith_pattern := sas_pattern =># "_1";

  //$ Match with naming of subexpression.
  //$ Matches the pattern against the corresponding subexpression,
  //$ and gives it a name.
  private sas_pattern := scons_pattern "as" sname =># "`(pat_as ,_sr ,_1 ,_3)";
  private sas_pattern := scons_pattern =># "_1";

  //$ Match a non-empty list.
  //$ The LHS is the head of the list and the RHS is the tail.
  //$ Does not match the empty list.
  private scons_pattern := stuple_cons_pattern "!" scons_pattern =>#
    '''`(pat_nonconst_ctor ,_sr ,(nos "Cons") (pat_tuple ,_sr (,_1 ,_3)))''';
  private scons_pattern := stuple_cons_pattern =># "_1";

  //$ Match a non-empty list using standard list syntax
  //$ This allows for variables in the list syntax and bindings should "just work"
  private scons_pattern :="[" slist_pattern "]" =>#
    "_2";
  private slist_pattern := scoercive_pattern "," slist_pattern  =>#
    """`(pat_nonconst_ctor ,_sr ,(nos "Cons") (pat_tuple ,_sr (,_1 ,_3)))""";
  private slist_pattern := scoercive_pattern =>#
    """`(pat_nonconst_ctor ,_sr ,(nos "Cons") (pat_tuple ,_sr (,_1
      (pat_const_ctor ,_sr ,(nos "Empty") ))))""";
  private slist_pattern := scoercive_pattern ",," scoercive_pattern =>#
    """`(pat_nonconst_ctor ,_sr ,(nos "Cons") (pat_tuple ,_sr (,_1 ,_3)))""";

  private scons_pattern :="[" "]" =># """`(pat_const_ctor ,_sr ,(nos "Empty"))""";

  //$ Match a tuple of at least 3 elements.
  //$ The LHS is the first element of the tuple.
  //$ The RHS is the rest of the tuple.
  private stuple_cons_pattern := stuple_pattern ",," stuple_cons_pattern =>#
    "`(pat_tuple_cons ,_sr ,_1 ,_3)";
  private stuple_cons_pattern := stuple_pattern "<,,>" stuple_cons_pattern =>#
    "`(pat_tuple_snoc ,_sr ,_1 ,_3)";
  private stuple_cons_pattern := stuple_pattern =># "_1";


  //$ Match a tuple with 2 or more components.
  private stuple_pattern := scoercive_pattern ("," scoercive_pattern )* =>#
    "(chain 'pat_tuple _1 _2)";

  //$ Match a value with a coercion.
  //$ The subexpression corresponding to the LHS is compared.
  //$ If it matches the result is coerced to the RHS type expression.
  private scoercive_pattern := sapplicative_pattern "|>" t[sarrow_pri] =>#
    "`(pat_coercion ,_sr ,_1 ,_3)";


  // NOTE THIS IS A HACK I just wanted var x : t = expr to be
  // convertable to let x : t = expr in, i.e. without having to delete the type
  private scoercive_pattern := sapplicative_pattern ":" t[sarrow_pri] =>#
    "`(pat_coercion ,_sr ,_1 ,_3)";
  private scoercive_pattern := sapplicative_pattern =># "_1";

  private scoercive_pattern := stypeexpr ":>>" sname =>#
    "`(pat_subtype ,_sr ,_1 ,_3)";


  //$ Match a non-constant sum type constructor
  //$ that is, one with an argument.
  //$ The LHS name must match the constructor used to make the value.
  //$ The RHS pattern is matched against the argument it was constructed with.
  private sapplicative_pattern := sctor_name sargument_pattern =>#
    "`(pat_nonconst_ctor ,_sr ,_1 ,_2)";

  // NOTE: the precednece of the argument is suspect!
  private sapplicative_pattern := sctor_name x[>sapplication_pri]+ sargument_pattern =>#
    """;;(begin (display "HO PATTERN ")(display _1)(display "\n")
       ;;(display "arguments=")(display _2) (display "\n")
       ;;(display "pattern=")(display _3)(display "\n")
       `(pat_ho_ctor ,_sr ,_1 ,_2 ,_3)
       ;;)
    """;


    //$ The sum type constructor can either be a qualified name...
    private sctor_name := sname =># "`(ast_name ,_sr ,_1 ())";

    //$ or it can be a case literal.
    private sctor_name := "case" sinteger =># "`(ast_case_tag ,_sr ,_2)";
    private sctor_name := "`" sinteger =># "`(ast_case_tag ,_sr ,_2)";


  private sapplicative_pattern := "case" sname sargument_pattern =>#
    "`(pat_nonconst_variant ,_sr ,_2 ,_3)";
  private sapplicative_pattern := "`" sname sargument_pattern =>#
    "`(pat_nonconst_variant ,_sr ,_2 ,_3)";

  private sapplicative_pattern := satomic_pattern =># "_1";
  private sargument_pattern := satomic_pattern =># "_1";

  //-----------------------------------------------------------------------
  // atomic pattern

  private satomic_pattern := sname =>#
  """
    (if
      (char-upper-case? (string-ref _1 0))
      `(pat_const_ctor ,_sr (ast_name ,_sr ,_1 ()))
      `(pat_as ,_sr (pat_any ,_sr) ,_1)
    )
  """;

  private satomic_pattern := "?" sname =># "`(pat_as ,_sr (pat_any ,_sr) ,_2)";
  private satomic_pattern := "val" sname =># "`(pat_as ,_sr (pat_any ,_sr) ,_2)";
  private satomic_pattern := "#" sctor_name =># "`(pat_const_ctor ,_sr ,_2)";
  private satomic_pattern := "#" "case" sname =># "`(pat_const_variant ,_sr ,_3)";
  private satomic_pattern := "`" sname =># "`(pat_const_variant ,_sr ,_2)";
  private satomic_pattern := "case" sinteger =># "`(pat_const_ctor ,_sr (ast_case_tag ,_sr ,_2))";
  private satomic_pattern := "`" sinteger =># "`(pat_const_ctor ,_sr (ast_case_tag ,_sr ,_2))";


  //$ Match the value true = case 1 of 2.
  private satomic_pattern := "true" =># "`(pat_const_ctor ,_sr (ast_case_tag ,_sr 1))";

  //$ Match the value false = case 0 of 2.
  private satomic_pattern := "false" =># "`(pat_const_ctor ,_sr (ast_case_tag ,_sr 0))";

  //$ Match anything without naming the subexpression.
  private satomic_pattern := "_" =># "`(pat_any ,_sr)";

  //$ Precedence control.
  private satomic_pattern := "(" spattern ")" =># "_2";

  //$ Match the unit tuple.
  private satomic_pattern := "(" ")" =># "`(pat_tuple ,_sr ())";

  //$ Match a record.
  //$ The record must have fields with the given names.
  //$ It may have more fields though, these are ignored.
  private satomic_pattern :=  "(" spat_assign ("," spat_assign )* ")" =>#
    "`(pat_record ,_sr ,(cons _2 (map second _3)))"
  ;
    private spat_assign := sname "=" spattern =># "`(,_1 ,_3)";

  //$ Polyrecord pattern
  //$ Matches a record with the given fields and assigns
  //$ the rest of the fields to the extension
  private satomic_pattern :=  "(" spat_assign ("," spat_assign )* "|" sname ")" =>#
    "`(pat_polyrecord ,_sr ,(cons _2 (map second _3)) ,_5)"
  ;

  //$ Match an arbitrary expression.
  //$ Equivalent to
  //$
  //$  ?name when name == expr.
  //$
  private satomic_pattern := "$" "(" sexpr ")" =># "`(pat_expr ,_sr ,_3)";

  //$ Match against any literal value.
  //$ This includes integers, strings, whatever.
  //$ The underlying type must support equality operator (==).
  //$ Usually it would be instance of class Eq.
  private satomic_pattern := sliteral =># "`(pat_literal ,_sr ,_1)";

  //$ Match against a range specified by two literals.
  //$ The range is inclusive.
  //$ The underlying type must support less than operator (<).
  //$ Usually it would be an instance of class Tord.

// FIXME: use slices!!!!
  private satomic_pattern := sliteral ".." sliteral =># "`(pat_range ,_sr ,_1 ,_3)";

}
Plugin Support DSSL

Use to create a preload wrapper around programs that do dynamic loading to statically link some libraries and then emulate dynamic loading. Used to create standalone executables for clients from developer dynamic link model.

//[plugins.fsyn]
// Dummy: FIXME: stupid skaller forgot to commit me, and then did a git clean -f.
SCHEME """
(begin
  (define (static-link-symbol lib sym)
    (let*
      (
         (dummy (begin (display "lib ")(display lib)(display ", symbol ") (display sym)(display "\n")))
         (externc (string-append "extern \"C\" void *" sym ";\n"))
         (rcode `(Str ,externc))
         (hreq `(Header_req ,rcode))
         (reqs `(rreq_atom ,hreq))
         (address_type (nos "address"))
         (address `(Str ,(string-append "&" sym)))
         (const `(ast_const_decl ,_sr ,sym ,dfltvs ,address_type ,address ,reqs))
         (arg `(ast_tuple ,_sr ,(list (stringof lib) (stringof sym) (nos sym))))
         (addsym `(ast_call ,_sr ,(nos "add_symbol")  ,arg))
      )
      `(ast_seq ,_sr ,(list const addsym))
    )
  )
  (define (plugin-syms lib)
    `(
      ,(string-append lib "_create_thread_frame")
      ,(string-append lib "_flx_start")
      ,(string-append lib "_setup")
      ,lib
    )
  )
  (define (plugin-defs lib)
    (let*
      (
        (syms (plugin-syms lib))
        (defs (map (lambda (sym) (static-link-symbol lib sym)) syms))
      )
      `(ast_seq ,_sr ,defs)
    )
  )
)
""";

syntax plugins
{
  stmt := "static-link-symbol" sname "in" "plugin" sname ";" =># "(static-link-symbol _5 _2)";

  stmt := "static-link-plugin" sname ("," sname)* ";" =>#
  """
  (let*
    (
      (plugins (cons _2 (map second _3)))
      (defs (map plugin-defs plugins))
    )
    `(ast_seq ,_sr ,defs)
  )
  """;

}
Python export grammar.

Used to create Python3 modules in emitted libraries.

//[python_grammar.fsyn]
syntax python_grammar {
  stmt := "export" "python" "fun" ssuffixed_name "as" sstring ";" =>#
    "`(ast_export_python_fun ,_sr ,_4 ,_6)";
}
Requirements

Used to define dependencies on external resources.

//[requirements.fsyn]
//$ Syntax to express and provide dependencies.
//$
//$ Requirements operate as extensions to the usual
//$ usage dependencies, to provide the compiler additional
//$ information regarding C/C++ contructions used in bindings.
//$
//$ A requirement of a C type is
//$ activated if, and only if, that type is used
//$ in a program (or plugin).
//$
//$ Similarly, a requirement of a function is
//$ activated if, and only if, the function is used.
//$
//$ An unnamed requirement in a class is activated
//$ if any C binding in the class is used.
//$ Such bindings also propagate to descendent (contained) classes.
//$
//$ A named requirement is activated only if an active
//$ requirement requires it.
//$ Requirements may have "tag names".
//$ When a requirement is required by name,
//$ all requirements with that name are activated.
//$ Circularities in named requirements are permitted and harmless.
//$
//$ Floating insertions (header, body) are emitted in order of writting
//$ at fixed places in the generated C++ header and implementation files.
//$ Floating insertions can themselves have requirements.
//$
//$ WARNING: there are two gotchas!
//$
//$ Gotcha 1: requirements on names cannot fail, even if no
//$ resource is tagged wih that name. This is because requirements
//$ activate the set of resources with the given name, and as
//$ usual, a set may be empty.
//$
//$ Gotcha 2; Just because you put a requires statement in a class
//$ doesn't mean it will be activated. requirements are only
//$ triggered by the use of C bindings! Using a Felix entity
//$ will not trigger the requirement!


syntax requirements {
  //$ General form of required clause.
  srequires_clause := "requires" srequirements =># "_2";

  //$ An empty requirement is deemed satisfied.
  srequires_clause := sepsilon =># "'rreq_true";

  //$ A requirement on a requirement defined by name elsewhere.
  private srequirement:= squalified_name =># "`(Named_req ,_1)";

  //$ A generic "catch all" requirement or specification
  //$ of some property named by a string.
  private srequirement :=  "property" sstring =># "`(Property_req ,_2)";

  //$ A dependency on an external package with a given name.
  //$ Also known as a resource abstraction.
  //$
  //$ The package name refers to an entry in an external database
  //$ usually represented by directory of text files (usually called "config"),
  //$ each of which usually has extension "fpc".
  //$
  //$ Each file contains a number of fields, which
  //$ may specify a platform dependent filename for
  //$ a shared/dynamic link library, static link library,
  //$ header file, compiler option switch, or other
  //$ information.
  //$
  //$ The package construction abstracts the platform dependent
  //$ data required to locate and use a resource.
  //$
  //$ The Felix compiler "flxg" generates a list of required
  //$ abstract resources.
  //$
  //$ The Felix command line harness "flx" queries the database
  //$ of resources using the "flx_pkgconfig" tool, and applies
  //$ the relevant arguments to the relevant steps of the
  //$ compilation process.
  //$
  //$ This allows fully automatic compilation and execution
  //$ of Felix programs without the programmer needing to
  //$ continually worry about build scripts.
  //$
  //$ Instead the system installer is required, once,
  //$ to provide the resource database.
  private srequirement :=  "package" scode_spec =># "`(Package_req ,_2)";

  //$ The scanner requirement applies only to a C type binding.
  //$ It specifies the name of a C function which the garbage
  //$ collector can called to search a data structure for pointers.
  //$
  //$ By default, if no scanner is specified for a C type,
  //$ the type is assumed not to contain any Felix pointers.
  private srequirement :=  "scanner" scode_spec =># "`(Scanner_req ,_2)";

  //$ The finaliser requirement applies only to a C type binding.
  //$ It specifies the name of a C function which the garbage
  //$ collector can call to finalise an object prior to freeing up
  //$ the underlying memory.
  //$
  //$ By default, if no finaliser is specifed, the C++ destructor is called.
  private srequirement :=  "finaliser" scode_spec =># "`(Finaliser_req ,_2)";

  //$ The encoder requirement applies only to a C type binding.
  //$ It specifies the name of a C function which can be called
  //$ to serialise one element of the object.
  //$
  //$ By default, if no encoder is specifed, memcpy is used.
  private srequirement :=  "encoder" scode_spec =># "`(Encoder_req ,_2)";

  //$ The decoder requirement applies only to a C type binding.
  //$ It specifies the name of a C function which can be called
  //$ to deserialise one element of the object.
  //$
  //$ By default, if no decoder is specifed, memcpy is used.
  private srequirement :=  "decoder" scode_spec =># "`(Decoder_req ,_2)";

  private srequirement :=  "index" sinteger =># "`(Index_req ,_2)";
  private srequirement :=  "index" sname =># "`(Named_index_req ,_2)";

  //$ Requirement expressions. Deprecated.
  private srequirement_atom:= srequirement =># "`(rreq_atom ,_1)";

  //$ Requirement expressions. Deprecated.
  private srequirement_atom:= "(" srequirements ")" =># "_2";

  //$ Requirement expressions. Deprecated.
  private srequirement_and:= srequirement_and "and" srequirement_atom =>#
    "`(rreq_and ,_1 ,_3)";
  private srequirement_and:= srequirement_atom =># "_1";

  //$ Requirement expressions. Deprecated.
  private srequirement_or:= srequirement_or "or" srequirement_and =>#
    "`(rreq_or ,_1 ,_3)";
  private srequirement_or:= srequirement_and =># "_1";

  //$ Requirement expressions: a comma separated list
  //$ of requirements specified each one of the requirements
  //$ applies independently.
  private srequirements:= srequirements "," srequirement_or =>#
    "`(rreq_and ,_1 ,_3)";
  private srequirements:= srequirement_or =># "_1";

  //$ The body requirement is a floating requirement that
  //$ specifies that the given code
  //$ string be inserted into the output "near the top"
  //$ of the generated C++ body (cpp) file.
  //$
  //$ It can be used to emit utiliy functions
  //$ written in C.
  private srequirement := "body" scode_spec =># "`(Body_req ,_2)";

  //$ The header requirement is a floating requirement that
  //$ specifies that the given code
  //$ string be inserted into the output "near the top"
  //$ of the generated C++ header (hpp) file.
  //$
  //$ It is typically used to emit a "#include" directive
  //$ so that the requiring binding has relevant types
  //$ and functions available.
  private srequirement := "header" scode_spec =># "`(Header_req ,_2)";

  //$ A Felix string used as a code specification
  //$ is treated as a template with special coding
  //$ internally which can be replaced.
  //$
  //$ This feature supports the fact that Felix code
  //$ insertions can be polymorphic.
  scode_spec := sstring =># "`(StrTemplate ,_1)";

  //$ A c-string like c"xxxx" is emitted literally
  //$ without any substitutions.
  scode_spec := scstring =># "`(Str ,_1)";

  //$ This is a special code to make specific
  //$ that a binding is an identity which can
  //$ be optimised away.
  scode_spec := "ident" =># "'Identity";

  //$ The anonymous requires statement specifies requirements which
  //$ propagates to all C bindings
  //$ in the same class, or any descendant (enclosed) class.
  stmt := "requires" srequirements ";" =>#
    """`(ast_insert ,_sr "_root" ,dfltvs (Str "") body ,_2)""";

  stmt := "export" "requires" srequirements ";" =>#
    """`(ast_seq ,_sr
         ,(list
           `(ast_insert ,_sr "_root" ,dfltvs (Str "") body ,_3)
           `(ast_export_requirement ,_sr ,_3)
         )
      )
    """;


  //$ The named requires statement simply names a requirement.
  stmt := sname "requires" srequirements ";" =>#
    """`(ast_insert ,_sr ,_1 ,dfltvs (Str "") body ,_3)""";

  //$ The header statement specifies a header requirement which
  //$ propagates to all C bindings
  //$ in the same class, or any descendant (enclosed) class.
  stmt := "header" scode_spec srequires_clause ";" =>#
    """`(ast_insert ,_sr "_root" ,dfltvs ,_2 header ,_3))""";

  //$ The body statement specifies a header requirement which
  //$ propagates to all C bindings
  //$ in the same class, or any descendant (enclosed) class.
  stmt := "body" scode_spec srequires_clause ";" =>#
    """`(ast_insert ,_sr "_root" ,dfltvs ,_2 body ,_3))""";

  //$ Named header requirement.
  stmt := "header" sdeclname "=" scode_spec srequires_clause ";" =>#
    """
    `(ast_insert ,_sr ,(first _2) ,(second _2) ,_4 header ,_5)
     """;

  //$ Named body requirement.
  stmt := "body" sdeclname "=" scode_spec srequires_clause ";" =>#
    """
    `(ast_insert ,_sr ,(first _2) ,(second _2) ,_4 body ,_5)
     """;
}
Save Thunk.

Special code to tell the parser when to save the automaton to disk.

//[save.fsyn]
open syntax felix;
SAVE;
Statements

General statements.

//[statements.fsyn]
//$ A grab bag of miscellaneous statements and
//$ nonterminals used to construct other statements.
syntax statements {
  requires expressions;

  //$ A comment statement based on a string argument.
  stmt := "comment" sstring ";" =># "`(ast_comment ,_sr ,_2)";

  //$ Statement qualifier which makes a definition
  //$ private to the containing module or class.
  stmt := "private" stmt =># "`(ast_private ,_sr ,_2)";

  //$ Deprecated method of documenting a definition.
  stmt := "publish" sstring stmt =># "_3";

  //$ An empty statement.
  stmt := ";" =># """`(ast_nop ,_sr "")""";

  //$ Include file directive.
  //$ This is similar to C's pre-processor include except that
  //$ the file is parsed and macro processed first, entirely
  //$ independently of the including file, and then the
  //$ resulting AST is inserted into the current AST.
  //$ Thus the included file also has no influence on
  //$ the including file either: the two files are parsed
  //$ entirely independently.
  stmt := "include" sstring ";" =># "`(ast_include ,_sr ,_2)";

  //$ A declarative name consists of an identifier and
  //$ an (optional) type variable specification.
  // note: list is reversed, eg X::Y::name goes to list name, Y, Z
  sdeclname := sname stvarlist =># "`(,_1 ,_2)";

  //$ A way to contruct a new abstract type out of an existing type.
  //$ Only two operations are available on this new type:
  //$
  //$ _repr_ t: exposes the underlying type
  //$ make_t  : constructs the type from the underlying type.
  //$
  //$ These operations are only available in the class or module
  //$ containing the new type definition. This allows the private
  //$ details of the type to be accessed so as to define operations
  //$ on it, inside the same space as the definition, but leaves
  //$ the type abstract externally.
  stmt := stype_qual* "type" sdeclname "=" "new" stype ";" =>#
    """
    `(ast_newtype ,_sr ,(first _3) ,(second _3) ,_6)
    """;

  stmt := "instance" "type" sdeclname "=" stype ";" =>#
    """
    `(ast_instance_type ,_sr ,(first _3) ,(second _3) ,_5)
    """;


  //$ Type constraint syntax.
  //$ Type constraints are ways to constrain possible types
  //$ which type variables may take on.
  stypeclass_constraint_list := stypeclass_constraint ("," stypeclass_constraint )* =>#
    "(cons _1 (map second _2))";

  stypeclass_constraint := squalified_name =># "_1";

  //$ Allow T is Real to mean Real[T].
  // probably should generalise to use ast_lookup
  stypeclass_constraint := stypeexpr "is" sname =># "`(ast_name ,_sr ,_3 (,_1))";

  //$ A constraint specifying types require an instance
  //$ of a particular type class.
  stype_constraint := "with" stypeclass_constraint_list =>#
   "`(,ttrue ,_2)";

  //$ A predicative or equational constraint.
  stype_constraint := "where" stype =># "`(,_2 ())";

  //$ Both types of constraint together.
  stype_constraint := "with" stypeclass_constraint_list "where" stype =>#
    "`(,_4 ,_2)";

  //$ Both types of constraint together.
  stype_constraint := "where" stype "with" stypeclass_constraint_list =>#
    "`(,_2 ,_4)";

  //$ The constraint is empty if the polymorphism is parametric.
  stype_constraint := sepsilon =># "`(,ttrue ())";

  //$ Individual type variable equational constraint.
  seqorin:= "=" stypeexpr =># "`(Eq ,_2)";

  //$ Individual type variable membership constraint.
  seqorin:= "in" stypeexpr =># "`(In ,_2)";

  //$ No constraint!
  seqorin:= sepsilon =># "'NoConstraint";

  //$ A type variable, possibly with an individual constraint.
  stvar := sname seqorin =># """`(,_1 (ast_name ,_sr "TYPE" ()) ,_2)""";

  //$ A type variable with an individual constraint.
  //$ This is usually the same as a predicate.
  stvar := sname ":" stypeexpr seqorin =># "`(,_1 ,_3 ,_4)";

  //$ A list of type variables with optional individual constraints.
  stvar_comma_list := stvar ("," stvar)* =># "(cons _1 (map second _2))";
  stvar_comma_list := sepsilon =># "'()";

  //$ A type variable specification consists of
  //$ a possibly empty list of type variables with
  //$ individual constraints, plus an optional
  //$ type constraint relating the specified variables.
  stvarlist := sepsilon =># "dfltvs";
  stvarlist := "[" stvar_comma_list stype_constraint "]" =>#
    "(tvfixup _2 _3)";

  stypeparameter := sname ":" t[sarrow_pri] =># "`(,_1 ,_3)";
  stypeparameter := sname =># "`(,_1 typ_none)";
  stypeparameter_comma_list := sepsilon =># "()";
  stypeparameter_comma_list := stypeparameter ("," stypeparameter)* =># "(cons _1 (map second _2))";

  stypefun_arg := sname =># "`((,_1 typ_none))";
  stypefun_arg := "(" stypeparameter_comma_list ")" =># "_2";
  stypefun_args := stypefun_arg+  =># "_1";

  //$ The todo no-op is primarily a way to document
  //$ unfinished code. Currently no action is taken.
  //$ Felix reserves the right to throw an exception,
  //$ or emit some diagnostics in future versions.
  stodo := "todo" sstring ";" =># "`(ast_nop ,_sr ,_2)";
  stodo := "todo" ";" =># """`(ast_nop ,_sr "todo")""";

  //$ Compound construction.
  //$ Note his is NOT a statement.
  //$ A compound followed by a semi-colon ";" is, however.
  //scompound := "{" stmt* "}" =># "_2";
  scompound := "{" sstatements "}" =># "_2";

  //$ A suffixed name.
  //$ Used  to name an overloaded function.
  sname_suffix:= "," sname sname_suffix =># "(cons _2 _3)";
  sname_suffix:= "," sname =># "`(,_2)";


}
TeX Symbols

A fairly complete set of TeX, LaTeX and AMSTeX symbols available for client use with predefined precedences. Some symbols are used elsewhere in the grammar and may not be included here because they have been assigned different precedences.

//[texsyms.fsyn]
//$ This file contains a huge set of operators from TeX, AMSTeX and LaTeX.
//
//$ The precedence classification is currently very crude.
//$ Some operators are duplicate semantics with different names.
//$ Some are negations, and should be handled properly.
//$
//$ Nouns such as Greek letters are not included because they're atoms and don't
//$ need any parsing.
//$
syntax texsyms {

// A

  bin := "\amalg" =># '(nos _1)';
  cmp := "\approx" =># '(nos _1)';
  cmp := "\approxeq" =># '(nos _1)';
  cmp := "\Arrowvert" =># '(nos _1)';
  cmp := "\arrowvert" =># '(nos _1)';
  cmp := "\asymp" =># '(nos _1)';

// B

  cmp := "\backsim" =># '(nos _1)';
  cmp := "\backsimeq" =># '(nos _1)';
  cmp := "\bar" =># '(nos _1)';
  cmp := "\barwedge" =># '(nos _1)';
  cmp := "\between" =># '(nos _1)';
  bin := "\bigcap" =># '(nos _1)';
  bin := "\bigcirc" =># '(nos _1)';
  bin := "\bigcup" =># '(nos _1)';
  bin := "\bigodot" =># '(nos _1)';
  bin := "\bigoplus" =># '(nos _1)';
  bin := "\bigotimes" =># '(nos _1)';
  bin := "\bigsqcup" =># '(nos _1)';
  bin := "\bigtriangledown" =># '(nos _1)';
  bin := "\bigtriangleup" =># '(nos _1)';
  bin := "\biguplus" =># '(nos _1)';
  bin := "\bigvee" =># '(nos _1)';
  bin := "\bigwedge" =># '(nos _1)';
  bin := "\bowtie" =># '(nos _1)';
  bin := "\Box" =># '(nos _1)';
  bin := "\boxdot" =># '(nos _1)';
  bin := "\boxminus" =># '(nos _1)';
  bin := "\boxplus" =># '(nos _1)';
  bin := "\boxtimes" =># '(nos _1)';
  cmp := "\Bumpeq" =># '(nos _1)';
  cmp := "\bumpeq" =># '(nos _1)';

// C

  bin := "\Cap" =># '(nos _1)';
  bin := "\cdot" =># '(nos _1)';
  bin := "\cdotp" =># '(nos _1)';
  cmp := "\circeq" =># '(nos _1)';
  bin := "\circledast" =># '(nos _1)';
  bin := "\circledcirc" =># '(nos _1)';
  bin := "\circleddash" =># '(nos _1)';
  cmp := "\cong" =># '(nos _1)';
  bin := "\coprod" =># '(nos _1)';
  bin := "\Cup" =># '(nos _1)';
  cmp := "\curlyeqprec" =># '(nos _1)';
  cmp := "\curlyeqsucc" =># '(nos _1)';
  bin := "\curlyvee" =># '(nos _1)';
  bin := "\curlywedge" =># '(nos _1)';

// D

  arr := "\dashleftarrow" =># '(nos _1)';
  arr := "\dashrightarrow" =># '(nos _1)';
  bin := "\divideontimes" =># '(nos _1)';
  cmp := "\doteq" =># '(nos _1)';
  cmp := "\Doteq" =># '(nos _1)';
  cmp := "\doteqdot" =># '(nos _1)';
  bin := "\dotplus" =># '(nos _1)';
  bin := "\doublebarwedge" =># '(nos _1)';
  bin := "\doublecap" =># '(nos _1)';
  bin := "\doublecup" =># '(nos _1)';
  bin := "\Downarrow" =># '(nos _1)';
  bin := "\downarrow" =># '(nos _1)';
  bin := "\downdownarrows" =># '(nos _1)';
  bin := "\downharpoonleft" =># '(nos _1)';
  bin := "\downharpoonright" =># '(nos _1)';

// E

  cmp := "\eqcirc" =># '(nos _1)';
  cmp := "\eqsim" =># '(nos _1)';
  cmp := "\eqslantgtr" =># '(nos _1)';
  cmp := "\eqslantless" =># '(nos _1)';
  cmp := "\equiv" =># '(nos _1)';

// F

  bin := "\fallingdotseq" =># '(nos _1)';

// G

  cmp := "\geqslant" =># '(nos _1)';
  arr := "\gets" =># '(nos _1)';
  cmp := "\gg" =># '(nos _1)';
  cmp := "\ggg" =># '(nos _1)';
  cmp := "\gggtr" =># '(nos _1)';
  cmp := "\gnapprox" =># '(nos _1)';
  cmp := "\gnsim" =># '(nos _1)';
  cmp := "\gtrapprox" =># '(nos _1)';
  cmp := "\gtrdot" =># '(nos _1)';
  cmp := "\gtreqless" =># '(nos _1)';
  cmp := "\gtreqqless" =># '(nos _1)';
  cmp := "\gtrless" =># '(nos _1)';
  cmp := "\gtrsim" =># '(nos _1)';
  cmp := "\gvertneqq" =># '(nos _1)';

// H

  arr := "\hookleftarrow" =># '(nos _1)';
  arr := "\hookrightarrow" =># '(nos _1)';

// I

// J

  bin := "\Join" =># '(nos _1)';

// K

// L

  arr := "\leadsto" =># '(nos _1)';
  arr := "\Leftarrow" =># '(nos _1)';
  arr := "\leftarrow" =># '(nos _1)';
  arr := "\leftarrowtail" =># '(nos _1)';
  arr := "\leftharpoondown" =># '(nos _1)';
  arr := "\leftharpoonup" =># '(nos _1)';
  arr := "\leftleftarrows" =># '(nos _1)';
  arr := "\Leftrightarrow" =># '(nos _1)';
  arr := "\leftrightarrow" =># '(nos _1)';
  cmp := "\leftrightarrows" =># '(nos _1)';
  cmp := "\leftrightharpoons" =># '(nos _1)';
  arr := "\leftrightsquigarrow" =># '(nos _1)';
  cmp := "\leqslant" =># '(nos _1)';
  cmp := "\lessapprox" =># '(nos _1)';
  cmp := "\lessdot" =># '(nos _1)';
  cmp := "\lesseqgtr" =># '(nos _1)';
  cmp := "\lesseqqgtr" =># '(nos _1)';
  cmp := "\lessgtr" =># '(nos _1)';
  cmp := "\lesssim" =># '(nos _1)';
  arr := "\Lleftarrow" =># '(nos _1)';
  cmp := "\lll" =># '(nos _1)';
  cmp := "\llless" =># '(nos _1)';
  cmp := "\lnapprox" =># '(nos _1)';
  cmp := "\lnot" =># '(nos _1)';
  cmp := "\lnsim" =># '(nos _1)';
  arr := "\Longleftarrow" =># '(nos _1)';
  arr := "\longleftarrow" =># '(nos _1)';
  arr := "\Longleftrightarrow" =># '(nos _1)';
  arr := "\longleftrightarrow" =># '(nos _1)';
  arr := "\longmapsto" =># '(nos _1)';
  arr := "\Longrightarrow" =># '(nos _1)';
  arr := "\longrightarrow" =># '(nos _1)';
  cmp := "\ltimes" =># '(nos _1)';
  cmp := "\lvertneqq" =># '(nos _1)';

// M

  arr := "\mapsto" =># '(nos _1)';

// N

  cmp := "\ncong" =># '(nos _1)';
  cmp := "\ngeqslant" =># '(nos _1)';
  cmp := "\ni" =># '(nos _1)';
  cmp := "\nleqslant" =># '(nos _1)';
  cmp := "\nparallel" =># '(nos _1)';
  cmp := "\nprec" =># '(nos _1)';
  cmp := "\npreceq" =># '(nos _1)';
  cmp := "\nsim" =># '(nos _1)';
  cmp := "\nsucc" =># '(nos _1)';
  cmp := "\nsucceq" =># '(nos _1)';
  cmp := "\ntriangleleft" =># '(nos _1)';
  cmp := "\ntrianglelefteq" =># '(nos _1)';
  cmp := "\ntriangleright" =># '(nos _1)';
  cmp := "\ntrianglerighteq" =># '(nos _1)';

// O

  bin := "\odot" =># '(nos _1)';
  bin := "\ominus" =># '(nos _1)';
  bin := "\oplus" =># '(nos _1)';
  bin := "\oslash" =># '(nos _1)';
  //bin := "\otimes" =># '(nos _1)';

// P

  cmp := "\perp" =># '(nos _1)';
  bin := "\pm" =># '(nos _1)';
  cmp := "\prec" =># '(nos _1)';
  cmp := "\precapprox" =># '(nos _1)';
  cmp := "\preccurlyeq" =># '(nos _1)';
  cmp := "\preceq" =># '(nos _1)';
  cmp := "\precnapprox" =># '(nos _1)';
  cmp := "\precneqq" =># '(nos _1)';
  cmp := "\precnsim" =># '(nos _1)';
  cmp := "\precsim" =># '(nos _1)';
  bin := "\prod" =># '(nos _1)';
  cmp := "\propto" =># '(nos _1)';

// Q

// R

  cmp := "\rhd" =># '(nos _1)';
  arr := "\Rightarrow" =># '(nos _1)';
  arr := "\rightarrow" =># '(nos _1)';
  arr := "\rightarrowtail" =># '(nos _1)';
  arr := "\rightharpoondown" =># '(nos _1)';
  arr := "\rightharpoonup" =># '(nos _1)';
  arr := "\rightleftarrows" =># '(nos _1)';
  arr := "\rightleftharpoons" =># '(nos _1)';
  arr := "\rightleftharpoons" =># '(nos _1)';
  arr := "\rightrightarrows" =># '(nos _1)';
  arr := "\rightsquigarrow" =># '(nos _1)';
  arr := "\Rrightarrow" =># '(nos _1)';
  cmp := "\rtimes" =># '(nos _1)';

// S

  bin := "\setminus" =># '(nos _1)';
  cmp := "\sim" =># '(nos _1)';
  cmp := "\simeq" =># '(nos _1)';
  cmp := "\smallsetminus" =># '(nos _1)';
  bin := "\sqcap" =># '(nos _1)';
  bin := "\sqcup" =># '(nos _1)';
  cmp := "\sqsubset" =># '(nos _1)';
  cmp := "\sqsubseteq" =># '(nos _1)';
  cmp := "\sqsupset" =># '(nos _1)';
  cmp := "\sqsupseteq" =># '(nos _1)';
  bin := "\square" =># '(nos _1)';
  cmp := "\Subset" =># '(nos _1)';
  cmp := "\succ" =># '(nos _1)';
  cmp := "\succapprox" =># '(nos _1)';
  cmp := "\succcurlyeq" =># '(nos _1)';
  cmp := "\succeq" =># '(nos _1)';
  cmp := "\succnapprox" =># '(nos _1)';
  cmp := "\succneqq" =># '(nos _1)';
  cmp := "\succnsim" =># '(nos _1)';
  cmp := "\succsim" =># '(nos _1)';
  cmp := "\Supset" =># '(nos _1)';

// T

  cmp := "\thickapprox" =># '(nos _1)';
  cmp := "\thicksim" =># '(nos _1)';
  bin := "\times" =># '(nos _1)';
  arr := "\to" =># '(nos _1)';
  bin := "\triangle" =># '(nos _1)';
  bin := "\triangledown" =># '(nos _1)';
  cmp := "\triangleleft" =># '(nos _1)';
  cmp := "\trianglelefteq" =># '(nos _1)';
  cmp := "\triangleq" =># '(nos _1)';
  cmp := "\triangleright" =># '(nos _1)';
  cmp := "\trianglerighteq" =># '(nos _1)';
  arr := "\twoheadleftarrow" =># '(nos _1)';
  arr := "\twoheadrightarrow" =># '(nos _1)';

// U

  cmp := "\unlhd" =># '(nos _1)';
  cmp := "\unrhd" =># '(nos _1)';
  bin := "\Uparrow" =># '(nos _1)';
  bin := "\uparrow" =># '(nos _1)';
  bin := "\Updownarrow" =># '(nos _1)';
  bin := "\updownarrow" =># '(nos _1)';
  bin := "\upharpoonleft" =># '(nos _1)';
  bin := "\upharpoonright" =># '(nos _1)';
  bin := "\uplus" =># '(nos _1)';
  bin := "\upuparrows" =># '(nos _1)';

// V

  cmp := "\varsubsetneq" =># '(nos _1)';
  cmp := "\varsubsetneqq" =># '(nos _1)';
  cmp := "\varsupsetneq" =># '(nos _1)';
  cmp := "\varsupsetneqq" =># '(nos _1)';
  cmp := "\veebar" =># '(nos _1)';

// W


// X

  arr := "\xleftarrow" =># '(nos _1)';
  arr := "\xrightarrow" =># '(nos _1)';

// Y


// Z



// The precedences here are a hack: so many operators.
// The general effect is: except for keyword logic connectives,
// these operations are all done AFTER any ASCII art ops
// and, only one is allowed per sub-expression: you must use parens
// if you use more than one. We'll fix this for some key operations later,
// particularly the setwise and logic connectors. However, the comparisons
// are at the right precedence.
// (fact is, I don't know what half the operators are for anyhow .. )

  x[stuple_pri] := x[>stuple_pri] "\brace" x[>stuple_pri] =># "(Infix)";
  x[stuple_pri] := x[>stuple_pri] "\brack" x[>stuple_pri] =># "(Infix)";


  x[scomparison_pri]:= x[>scomparison_pri] bin x[>scomparison_pri] =>#
    "(binop _2 _1 _3)";

  // set ops (note: no setminus, its a standard binop at the moment ;)
  // note: no \Cap or other variants .. would interfere with chain
  // there's no reason at all to chain these anyhow, they're standard left assoc operators

  // All arrows are right associative .. hmm ..
  x[sarrow_pri] := x[scase_literal_pri] arr x[sarrow_pri] =>#
    "(binop _2 _1 _3)";
}
Type definitions
//[type_decls.fsyn]
//$ Stuff for defining types.
//$
//$ Felix type expressions use the same syntax as value expressions.

  SCHEME """
    (define (makecstruct type members reqs)
      (begin ;;(display "makecstruct ")(display type)(display "\n")
      (let*
       (
         (vals (filter_first 'Pval members))
         (funs (filter_first 'Pfun members))
         (struct-name (first type))
         (struct-polyspec (second type))
         (struct-polyvars (first struct-polyspec))
         (struct-pvids (map first struct-polyvars))
         (struct-pvs (map nos struct-pvids))
         (struct-polyaux (second struct-polyspec))
         (struct `(ast_cstruct ,_sr ,struct-name ,struct-polyspec ,vals ,reqs))
         (mfuns (map (lambda (x)
           (let*
             (
               (lst (first x))
               (t0 (list-ref lst 0)) ; ast_curry
               (t1 (list-ref lst 1)) ; sr
               (t2 (list-ref lst 2)) ; name
               (polyspec (list-ref lst 3)) ; polyvars
               (t4 (list-ref lst 4)) ; args
               (t5 (list-ref lst 5)) ; return type
               (t6 (list-ref lst 6)) ; fun kind
               (t7 (list-ref lst 7)) ; adjective properties
               (t8 (list-ref lst 8)) ; body
               (polyvars (first polyspec))
               (polyaux (second polyspec))
               (outpolyvars `(,(append struct-polyvars polyvars) ,polyaux))
               (kind (if (isvoid? (first t5)) 'PRef 'PVal))
               (self-name 'self)
               (self-type `(ast_name ,_sr ,struct-name ,struct-pvs))
               (self-arg `(,kind ,self-name ,self-type none))
               (self-args `((,self-arg) none))
               (args (cons self-args t4))
             )
             `(,t0 ,t1 ,t2 ,outpolyvars ,args, t5 ,t6 ,t7 ,t8)
           )) funs)
         )

         (sts (cons struct mfuns))
       )
       `(ast_seq ,_sr ,sts)
      ))
    )
  """;

  SCHEME """
  (define (asserteq a b code)
    (if (equal? a b)
      code
      (begin
        (display "struct tag ")(display a)(display " and typedef name ")
        (display b)(display " must be equal\n")
        (raise "typedef-struct-error")
      )
    )
  )
  """;

syntax type_decls {
  requires statements;

  tatom := stypematch =># "_1";
  satom := stypecasematch =># "_1";

  //$ Typedef creates an alias for a type.
  stmt := "typedef" sdeclname "=" stype ";" =>#
    """
    `(ast_type_alias ,_sr ,(first _2) ,(second _2) ,_4)
    """;

  //$ Typedef fun create a type function or functor.
  //$ It maps some types to another type.
  //$ This is the simple expression form.
  stmt := "typedef" "fun" sdeclname stypefun_args ":" stypeexpr "=>" stype ";" =>#
    """
    `(mktypefun ,_sr ,(first _3) ,(second _3) ,_4 ,_6 ,_8)
    """;

  //$ Typedef fun create a type function or functor.
  //$ It maps some types to another type.
  //$ This is the simple matching form.
  stmt := "typedef" "fun" sdeclname ":" stypeexpr "=" stype_matching+ ";" =>#
    """
    (if (eq? 'typ_arrow (first _5))
      (let (
        (argt (caadr _5))
        (ret (cadadr _5))
        (body `(ast_type_match ,_sr (,(noi '_a) ,_7))))
        (let ((args `(((_a ,argt)))))
      `(mktypefun ,_sr ,(first _3) ,(second _3) ,args ,ret ,body)
      ))
      ('ERROR)
    )
    """;

  stypecasematch := "typecase" sexpr "with" stypecase_matching+ "endmatch" =>#
    "`(ast_typecase_match ,_sr (,_2 ,_4))";
  stypecase_matching := "|" stype "=>" sexpr =># "`(,_2 ,_4)";

  //$ A struct is a nominally type product type similar to a C struct.
  //$ A struct may be polymorphic.  Felix generates a constructor for
  //$ the struct from a tuple of the types of the fields of te struct,
  //$ in the order they're written.
  //$
  //$ The syntax allows functions and procedures to be included in a struct,
  //$ however these are not non-static members.
  //$ Rather they global functions with an additional
  //$ argument prefixed of the struct type (for a fun) or pointer
  //$ to the struct type (for a proc). In such functinos the special
  //$ identifier "self" must be used to refer to the struct.
  //$ For example:
  //$
  //$ struct X {
  //$   a : int;
  //$   fun f(b: int) => self.a + b;
  //$ }
  //$ println$ X 1 . f 2;
  //$ // f is equivalent to
  //$ fun f (self:X) (b:int) => self.a + b;
  //$
  sexport := "export" =># "'export";
  sexport := sepsilon =># "'noexport";
  stmt := sexport "struct" sdeclname "=" ? "{" sstruct_mem_decl * "}" =>#
    """
     (begin ;;(display "defining struct .. \n")
     ;;(display "struct name=")(display (first _3))(display "\n")
     (let*
       (
         (vals (filter_first 'Pval _6))
         (funs (filter_first 'Pfun _6))
         (struct-name (first _3))
         (struct-polyspec (second _3))
         (struct-polyvars (first struct-polyspec))
         (struct-pvids (map first struct-polyvars))
         (struct-pvs (map nos struct-pvids))
         (struct-polyaux (second struct-polyspec))
         (struct `(ast_struct ,_sr ,struct-name ,struct-polyspec ,vals))
         (mfuns (map (lambda (x)
           (begin ;; (display "nested fun=")(display x)(display "\n")
           (let*
             (
               (lst (first x))
               (t0 (list-ref lst 0)) ; ast_curry_effects
               (t1 (list-ref lst 1)) ; sr
               (t2 (list-ref lst 2)) ; name
               ;;(dummy (begin (display "t2=")(display t2)(display "\n")))
               (polyspec (list-ref lst 3)) ; polyvars
               (t4 (list-ref lst 4)) ; args
               (t5 (list-ref lst 5)) ; return type, constraint
               ;;(dummy (begin (display "t5=")(display t5)(display "\n")))
               (t6 (list-ref lst 6)) ; effects
               (t7 (list-ref lst 7)) ; fun kind
               (t8 (list-ref lst 8)) ; adjective properties
               (t9 (list-ref lst 9)) ; body
               (polyvars (first polyspec))
               (polyaux (second polyspec))
               (outpolyvars `(,(append struct-polyvars polyvars) ,polyaux))
               (self-name 'self)
               (self-type
                 (if (isvoid? (first t5))
                   (begin ;; (display "procedure\n")
                     `(typ_ref ,_sr (ast_name ,_sr ,struct-name ,struct-pvs))
                   )
                   (begin ;; (display "function\n")
                     `(ast_name ,_sr ,struct-name ,struct-pvs)
                   )
                 )
               )
               (self-arg `(,_sr PVal ,self-name ,self-type none))
               (self-args `((Satom ,self-arg) none))
               (args (cons self-args t4))
             )
             `(,t0 ,t1 ,t2 ,outpolyvars ,args ,t5 ,t6 ,t7 ,t8 ,t9)
           ))) funs)
         )
         (sts (cons struct mfuns))
         (sts
           (if
             (equal? _1 'export)
             (cons `(ast_export_struct ,_sr ,struct-name) sts)
             sts
           )
         )
       )
       `(ast_seq ,_sr ,sts)
     ))
     """;
    sstruct_mem_decl := stypeexpr sname ";" =># "`(Pval ,_2 ,_1)"; // like C: int x;!
    sstruct_mem_decl := sname ":" stypeexpr ";" =># "`(Pval ,_1 ,_3)";
    sstruct_mem_decl := sfunction  =># """
     (let
       (
         (curry_kind (first _1))
       )
       (if
         (equal? curry_kind 'ast_curry_effects)
         `(Pfun ,_1)
         (let*
           (
             (lst _1)
             (t1 (list-ref lst 1)) ; sr
             (t2 (list-ref lst 2)) ; name
             (t3 (list-ref lst 3)) ; vs
             (t4 (list-ref lst 4)) ; args
             (t5 (list-ref lst 5)) ; return type, constraint
             (t6 (list-ref lst 6)) ; fun kind
             (t7 (list-ref lst 7)) ; adjective properties
             (t8 (list-ref lst 8)) ; body
           )
          `(Pfun (ast_curry_effects ,t1 ,t2 ,t3 ,t4 ,t5 ,dflteffects ,t6 ,t7 ,t8))
         )
       )
     )
     """;

  //$ A ctruct provides a model of a C structure.
  //$ This is the same as a struct except the structure is not emitted.
  //$ Instead, it is assumed to be already defined in C.
  //$
  //$ CAVEAT: A C struct constructor should not be used
  //$ unless the cstruct definition is a complete model of the C struct.

  stmt := "cstruct" sdeclname "=" ? "{" sstruct_mem_decl * "}" srequires_clause ";" =>#
    "(makecstruct _2 _5 _7)"
  ;

  //$ A hack to help with cut and paste from C headers into Felix
  stmt := "typedef" "struct" "{" sstruct_mem_decl * "}" sdeclname srequires_clause ";" =>#
    "(makecstruct _6 _4 _7)"
  ;

  //$ A hack to help with cut and paste from C headers into Felix
  stmt := "typedef" "struct" sdeclname "{" sstruct_mem_decl * "}" sdeclname srequires_clause ";" =>#
    "(asserteq (first _3)(first _7) (makecstruct _7 _5 _8))"
  ;

  sopt_name := sname =># "_1";
  sopt_name := sepsilon =># '""';

  //$ A union is a model of a discriminated union or variant.
  //$ Such unions have a discriminant tag that determines
  //$ at run time which component is populated.
  //$ The only way to access the union field is by using a
  //$ match which automatically enforces proper access.
  //$
  //$ The fields of a union are called type constructors.
  //$ A constant type constructor has no arguments.
  //$ A non-constant type constructor has an argument
  //$ which can be extracted in a match.
  //$
  //$ Unions provide a safe way to "unify" heterogenous data
  //$ into a single data type.

  // shared by both union decl forms..
    stype_sum_item := sname sopt_value stvarlist "of" stypeexpr =># "`(,_1 ,_2 ,_3 ,_5)";
    stype_sum_item := sname sopt_value stvarlist "of" stypeexpr "=>" sexpr =># "`(,_1 ,_2 ,_3 ,_5 ,_7)";
    stype_sum_item := sname sopt_value stvarlist =># "`(,_1 ,_2 ,_3 (ast_void ,_sr))";
    stype_sum_item := "#" sname sopt_value stvarlist =># "`(,_2 ,_3 ,_4 (ast_void ,_sr))";

    stype_sum_item_bar := "|" stype_sum_item =># "_2";
    stype_sum_items := stype_sum_item stype_sum_item_bar* =># "(cons _1 _2)";
    stype_sum_items := stype_sum_item_bar* =># "_1";

 // deviant form using trailing ";" per item used inside { } unions
    stype_sum_item1 := stype_sum_item ";" =># "_1";

  suexport := "export" =># "'export";
  suexport := sepsilon =># "'noexport";
  suexport := "export" sstring =># "`(namedexport ,_2)";
  stmt := suexport "variant" sdeclname "=" stype_sum_items ";" =>#
    """
    (let*
      (
        (union-name (first _3))
        (sts (list `(ast_union ,_sr ,union-name ,(second _3) ,_5)))
        (sts
          (if
            (equal? _1 'export)
            (cons `(ast_export_union ,_sr ,(nos union-name) ,union-name) sts)
            (if
              (equal? _1 'noexport)
               sts
              (cons `(ast_export_union ,_sr ,(nos union-name) ,(second _1)) sts)
            )
          )
        )
      )
      `(ast_seq ,_sr ,sts)
    )
    """;

  //$ Deprecated C like syntax for unionx.
  stmt := "variant" sdeclname "{" stype_sum_item1* "}" =>#
    """
    `(ast_union ,_sr ,(first _2) ,(second _2) ,_4)
     """;


  stmt := senum_decl =># "_1";

  //$ Short for for declaring an enumeration,
  //$ which is a union all of whose fields are constant constructors.
  //$ Deprecated syntax.
  stmt := "enum" sdeclname "{" senum_items "}" =>#
    """
    `(ast_union ,_sr ,(first _2) ,(second _2) ,_4)
     """;

  //$ Short for for declaring an enumeration,
  //$ which is a union all of whose fields are constant constructors.
  stmt := "enum" sdeclname "=" senum_items ";" =>#
    """
    `(ast_union ,_sr ,(first _2) ,(second _2) ,_4)
     """;

  sopt_value := "=" sinteger =># "`(some ,_2)";
  sopt_value := sepsilon =># "'none";
  senum_item := sname sopt_value =># "`(,_1 ,_2 ,dfltvs (ast_void ,_sr))";
  senum_items := senum_item "," senum_items =># "(cons _1 _3)";
  senum_items := senum_item =># "`(,_1)";
  senum_items := sepsilon =># "()";

/*
  //$ Java like interface of an object type.
  //$ Equivalent to a record type.
  stmt := "interface" sdeclname "{" srecord_type "}" =>#
    """
    `(ast_type_alias ,_sr ,(first _2) ,(second _2) ,_4)
    """;
*/

  //$ Java like interface of an object type.
  //$ Equivalent to a record type.
  stmt := "interface" sdeclname stype_extension "{" srecord_type "}" =>#
    """
    `(ast_type_alias ,_sr ,(first _2) ,(second _2) (typ_type_extension ,_sr ,_3 ,_5))
    """;

    srecord_type := srecord_mem_decl (";" srecord_mem_decl)* ";" =>#
     "`(ast_record_type ,(cons _1 (map second _2)))";
    stype_extension := "extends" stypeexpr_comma_list =># "_2";
    stype_extension := sepsilon =># "()";
}
Utility nonterminals.
//[utility.fsyn]
// Utility macros
syntax list
{
  seplist1 sep a := a (sep a)* =># '(cons _1 (map second _2))';
  seplist0 sep a = seplist1<sep><a>;
  seplist0 sep a := sepsilon =># '()';
  commalist1 a = seplist1<","><a>;
  commalist0 a = seplist0<","><a>;

  snames = commalist1<sname>;
  sdeclnames = commalist1<sdeclname>;
}
Variable definitions.
//[variables.fsyn]
//$ General variable binders.
syntax variables {
  requires statements, executable;

  //$ Value binder: multi declaration. Like:
  //$
  //$ val x,y,z = 1,2,3;
  //$
  stmt := "val" sname sname_suffix "=" sexpr ";" =>#
    """
    (let
      (
        (names (cons _2 _3))
        (vals (mkexlist _5))
      )
      (begin
      ;;(display "names=")(display names)
      ;;(display "init=")(display vals)
      ;;(display "\\n")
      (if (eq? (length names)(length vals))
        (let
          (
            (f (lambda (n v)`(ast_val_decl ,_sr ,n ,dfltvs none (some ,v))))
          )
          `(ast_seq ,_sr ,(map f names vals))
        )
        (let*
          (
            (f (lambda (n)`((Val ,_sr ,n) none)))
            (lexpr (map f names))
          )
          `(ast_assign ,_sr _set ((List ,lexpr) none) ,_5)
        )
    )))
    """;

  //$ Value binder, single.
  stmt := "val" sdeclname "=" sexpr ";" =>#
    """
    `(ast_val_decl ,_sr ,(first _2) ,(second _2) none (some ,_4))
     """;

  //$ Once binder, single.
  stmt := "once " sdeclname "=" sexpr ";" =>#
    """
    `(ast_once_decl ,_sr ,(first _2) ,(second _2) none (some ,_4))
     """;


  stmt := "device" sdeclname "=" sexpr ";" =>#
    """
    `(ast_val_decl ,_sr ,(first _2) ,(second _2) none (some ,_4))
     """;


  //$ Value binder, single, with type.
  stmt := "val" sdeclname ":" stypeexpr "=" sexpr ";" =>#
    """
    `(ast_val_decl ,_sr ,(first _2) ,(second _2) (some ,_4) (some ,_6))
     """;

  //$ Variable binder, multiple.
  stmt := "var" sname sname_suffix "=" sexpr ";" =>#
    """
    (let
      (
        (names (cons _2 _3))
        (vals (mkexlist _5))
      )
      (begin
      ;;(display "names=")(display names)
      ;;(display "init=")(display vals)
      ;;(display "\\n")
      (if (eq? (length names)(length vals))
        (let
          (
            (f (lambda (n v)`(ast_var_decl ,_sr ,n ,dfltvs none (some ,v))))
          )
          `(ast_seq ,_sr ,(map f names vals))
        )
        (let*
          (
            (f (lambda (n)`((Var ,_sr ,n) none)))
            (lexpr (map f names))
          )
          `(ast_assign ,_sr _set ((List ,lexpr) none) ,_5)
        )
    )))
    """;

  //$ Variable binder, single.
  stmt := "var" sdeclname "=" sexpr ";" =>#
    """
    `(ast_var_decl ,_sr ,(first _2) ,(second _2) none (some ,_4))
     """;

  //$ Variable binder, single, with type.
  stmt := "var" sdeclname ":" stypeexpr "=" sexpr ";" =>#
    """
    `(ast_var_decl ,_sr ,(first _2) ,(second _2) (some ,_4) (some ,_6))
     """;

  //$ Variable binder, single, with type, no explicit initialiser.
  stmt := "var" sdeclname ":" stypeexpr ";" =>#
    """
    `(ast_var_decl ,_sr ,(first _2) ,(second _2) (some ,_4) none)
     """;
}
Chips
//[chips.fsyn]
syntax chips {
  //$ input schannel type %<T
  pintype := "%<" t[spower_pri] =># '`(ast_name ,_sr "ischannel" (,_2))';

  //$ output schannel type %>T
  pintype := "%>" t[spower_pri] =># '`(ast_name ,_sr "oschannel" (,_2))';

  //$ input/output schannel type %<>T
  pintype := "%<>" t[spower_pri] =># '`(ast_name ,_sr "ioschannel" (,_2))';

  //$ duplex schannel type %<INPUT%>OUTPUT
  pintype := "%<" t[spower_pri] "%>" t[spower_pri] =>#
    '`(ast_name ,_sr "duplex_schannel" (,_2 ,_4))'
  ;

  pinspec :=  "pin" sname ":"  pintype =># "`(,_2 ,_4)";

  stmt := "chip" sdeclname sfun_arg*
    "connector" sname pinspec*
     scompound =>#
    """
      (let*
        (
          (name (first _2))
          (vs (second _2))
          (args _3)
          (effects dflteffects)
          (ret `(ast_void ,_sr))
          (traint 'none)
          (body _7)
          (pinstype `(ast_record_type ,_6))
          (pinsarg `(,_sr PVal ,_5 ,pinstype none))
          (pinsargs `((Satom ,pinsarg) none))
          (args (append args `(,pinsargs ,unitparam)))
        )
        `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects
         NoInlineFunction (NoInlineFunction) ,body)
      )
    """;

  stmt := "circuit" sconnection+ "endcircuit" =># "`(ast_circuit ,_sr ,_2)";
   spin := sname "." sname =># "`(,_1 ,_3)";
   sconnection := "connect" list::commalist1<spin> =># "`(connect ,_2)";
   sconnection := "wire" sexpr "to" sname "." sname =># "`(wire (,_2 ,_4 ,_6))";

}
Syntax
//[setexpr.fsyn]
syntax setexpr
{
  cmp := "in" =># '(nos "\\in")';
  cmp := "\in" =># "(nos _1)";
  cmp := "\notin" =># '(nos _1)';
  cmp := "\owns" =># '(nos _1)';

  x[ssetunion_pri] := x[ssetunion_pri] "\cup" x[>ssetunion_pri] =># "(Infix)" note "setunion";
  x[ssetintersection_pri] := x[ssetintersection_pri] "\cap" x[>ssetintersection_pri] =># "(Infix)" note "setintersection";

}

Syntax

//[cmpexpr.fsyn]
syntax cmpexpr
{
  x[scomparison_pri]:= x[>scomparison_pri] cmp x[>scomparison_pri] =>#
    "(binop _2 _1 _3)";
  x[scomparison_pri]:= x[>scomparison_pri] "not" cmp x[>scomparison_pri] =>#
   "`(ast_not ,_sr ,(binop _3 _1 _4))";
  cmp := "==" =># "(nos _1)";
  cmp := "!=" =># "(nos _1)";
  cmp := "\ne" =># '(nos _1)';
  cmp := "\neq" =># '(nos _1)';
}
Syntax
//[pordcmpexpr.fsyn]
syntax pordcmpexpr
{
  cmp := "\subset" =># '(nos _1)';
  cmp := "\supset" =># '(nos _1)';
  cmp := "\subseteq" =># '(nos _1)';
  cmp := "\subseteqq" =># '(nos _1)';
  cmp := "\supseteq" =># '(nos _1)';
  cmp := "\supseteqq" =># '(nos _1)';

  cmp := "\nsubseteq" =># '(nos _1)';
  cmp := "\nsubseteqq" =># '(nos _1)';
  cmp := "\nsupseteq" =># '(nos _1)';
  cmp := "\nsupseteqq" =># '(nos _1)';

  cmp := "\subsetneq" =># '(nos _1)';
  cmp := "\subsetneqq" =># '(nos _1)';
  cmp := "\supsetneq" =># '(nos _1)';
  cmp := "\supsetneqq" =># '(nos _1)';
}
Syntax
//[tordcmpexpr.fsyn]
syntax tordcmpexpr
{
  cmp := "<" =># "(nos _1)";

  cmp := "\lt" =># '(nos _1)';
  cmp := "\lneq" =># '(nos _1)';
  cmp := "\lneqq" =># '(nos _1)';

  cmp := "<=" =># "(nos _1)";
  cmp := "\le" =># '(nos _1)';
  cmp := "\leq" =># '(nos _1)';
  cmp := "\leqq" =># '(nos _1)';

  cmp := ">" =># "(nos _1)";
  cmp := "\gt" =># '(nos _1)';
  cmp := "\gneq" =># '(nos _1)';
  cmp := "\gneqq" =># '(nos _1)';

  cmp := ">=" =># "(nos _1)";
  cmp := "\ge" =># '(nos _1)';
  cmp := "\geq" =># '(nos _1)';
  cmp := "\geqq" =># '(nos _1)';

  cmp := "\nless" =># '(nos _1)';
  cmp := "\nleq" =># '(nos _1)';
  cmp := "\nleqq" =># '(nos _1)';
  cmp := "\ngtr" =># '(nos _1)';
  cmp := "\ngeq" =># '(nos _1)';
  cmp := "\ngeqq" =># '(nos _1)';

  bin := "\vee" =># '(nos _1)';
  bin := "\wedge" =># '(nos _1)';
}
Syntax
//[mulexpr.fsyn]
syntax mulexpr
{
  //$ multiplication: non-associative.
  x[sproduct_pri] := x[sproduct_pri] "*" x[>sproduct_pri] =># "(Infix)";
}
Notation
//[addexpr.fsyn]
syntax addexpr
{
  //$ Addition: left associative.
  x[ssum_pri] := x[ssum_pri] "+" x[>ssum_pri] =># "(Infix)";

  //$ Subtraction: left associative.
  x[ssum_pri] := x[ssum_pri] "-" x[>ssum_pri] =># "(Infix)";
}
Syntax
//[divexpr.fsyn]
syntax divexpr
{
  //$ division: right associative low precedence fraction form
  x[stuple_pri] := x[>stuple_pri] "\over" x[>stuple_pri] =># "(Infix)";

  //$ division: left associative.
  x[sproduct_pri] := x[sproduct_pri] "/" x[>sproduct_pri] =># "(Infix)";

  //$ remainder: left associative.
  x[sproduct_pri] := x[sproduct_pri] "%" x[>sproduct_pri] =># "(Infix)";

  //$ remainder: left associative.
  x[sproduct_pri] := x[sproduct_pri] "\bmod" x[>sproduct_pri] =># "(Infix)";
}
Syntax
//[swapop.fsyn]
syntax bitexpr
{
  //$ Bitwise or, left associative.
  x[sbor_pri] := x[sbor_pri] "\|" x[>sbor_pri] =># "(Infix)";

  //$ Bitwise xor, left associative.
  x[sbxor_pri] := x[sbxor_pri] "\^" x[>sbxor_pri] =># "(Infix)";

  //$ Bitwise exclusive and, left associative.
  x[sband_pri] := x[sband_pri] "\&" x[>sband_pri] =># "(Infix)";

  //$ Bitwise left shift, left associative.
  x[sshift_pri] := x[sshift_pri] "<<" x[>sshift_pri] =># "(Infix)";

  //$ Bitwise right shift, left associative.
  x[sshift_pri] := x[sshift_pri] ">>" x[>sshift_pri] =># "(Infix)";
}


syntax swapop
{
  sswapop := "<->" =># "'_swap";
}

//[int.fsyn]

SCHEME """
(define (findradix s)  ; find the radix of integer lexeme
  (let*
    (
      (n (string-length s))
      (result
        (cond
          ((prefix? "0b" s)`(,(substring s 2 n) 2))
          ((prefix? "0o" s)`(,(substring s 2 n) 8))
          ((prefix? "0d" s)`(,(substring s 2 n) 10))
          ((prefix? "0x" s)`(,(substring s 2 n) 16))
          (else `(,s 10))
        )
      )
    )
    result
  )
)
""";

SCHEME """
(define (findtype s) ;; find type of integer lexeme
  (let*
    (
      (n (string-length s))
      (result
        (cond
          ((suffix? "ut" s)`(,(substring s 0 (- n 2)) "utiny"))
          ((suffix? "tu" s)`(,(substring s 0 (- n 2)) "utiny"))
          ((suffix? "t" s)`(,(substring s 0 (- n 1)) "tiny"))

          ((suffix? "us" s)`(,(substring s 0 (- n 2)) "ushort"))
          ((suffix? "su" s)`(,(substring s 0 (- n 2)) "ushort"))
          ((suffix? "s" s)`(,(substring s 0 (- n 1)) "short"))

          ((suffix? "ui" s)`(,(substring s 0 (- n 2)) "uint"))
          ((suffix? "iu" s)`(,(substring s 0 (- n 2)) "uint"))
          ((suffix? "i" s)`(,(substring s 0 (- n 1)) "int"))

          ((suffix? "uz" s)`(,(substring s 0 (- n 2)) "size"))
          ((suffix? "zu" s)`(,(substring s 0 (- n 2)) "size"))
          ((suffix? "z" s)`(,(substring s 0 (- n 1)) "ssize"))

          ((suffix? "uj" s)`(,(substring s 0 (- n 2)) "uintmax"))
          ((suffix? "ju" s)`(,(substring s 0 (- n 2)) "uintmax"))
          ((suffix? "j" s)`(,(substring s 0 (- n 1)) "intmax"))

          ((suffix? "up" s)`(,(substring s 0 (- n 2)) "uintptr"))
          ((suffix? "pu" s)`(,(substring s 0 (- n 2)) "uintptr"))
          ((suffix? "p" s)`(,(substring s 0 (- n 1)) "intptr"))

          ((suffix? "ud" s)`(,(substring s 0 (- n 2)) "uptrdiff"))
          ((suffix? "du" s)`(,(substring s 0 (- n 2)) "uptrdiff"))
          ((suffix? "d" s)`(,(substring s 0 (- n 1)) "ptrdiff"))

          ;; must come first!
          ((suffix? "uvl" s)`(,(substring s 0 (- n 3)) "uvlong"))
          ((suffix? "vlu" s)`(,(substring s 0 (- n 3)) "uvlong"))
          ((suffix? "ulv" s)`(,(substring s 0 (- n 3)) "uvlong"))
          ((suffix? "lvu" s)`(,(substring s 0 (- n 3)) "uvlong"))
          ((suffix? "llu" s)`(,(substring s 0 (- n 3)) "uvlong"))
          ((suffix? "ull" s)`(,(substring s 0 (- n 3)) "uvlong"))

          ((suffix? "uv" s)`(,(substring s 0 (- n 2)) "uvlong"))
          ((suffix? "vu" s)`(,(substring s 0 (- n 2)) "uvlong"))

          ((suffix? "lv" s)`(,(substring s 0 (- n 2)) "vlong"))
          ((suffix? "vl" s)`(,(substring s 0 (- n 2)) "vlong"))
          ((suffix? "ll" s)`(,(substring s 0 (- n 2)) "vlong"))

          ;; comes next
          ((suffix? "ul" s)`(,(substring s 0 (- n 2)) "ulong"))
          ((suffix? "lu" s)`(,(substring s 0 (- n 2)) "ulong"))

          ;; last
          ((suffix? "v" s)`(,(substring s 0 (- n 1)) "vlong"))
          ((suffix? "u" s)`(,(substring s 0 (- n 1)) "uint"))
          ((suffix? "l" s)`(,(substring s 0 (- n 1)) "long"))

          ;; exact
          ((suffix? "u8" s)`(,(substring s 0 (- n 2)) "uint8"))
          ((suffix? "u16" s)`(,(substring s 0 (- n 3)) "uint16"))
          ((suffix? "u32" s)`(,(substring s 0 (- n 3)) "uint32"))
          ((suffix? "u64" s)`(,(substring s 0 (- n 3)) "uint64"))
          ((suffix? "i8" s)`(,(substring s 0 (- n 2)) "int8"))
          ((suffix? "i16" s)`(,(substring s 0 (- n 3)) "int16"))
          ((suffix? "i32" s)`(,(substring s 0 (- n 3)) "int32"))
          ((suffix? "i64" s)`(,(substring s 0 (- n 3)) "int64"))
          (else `(,s "int"))
        )
      )
    )
    result
  )
)
""";

SCHEME """
(define (parse-int s)
  (let*
    (
      (s (tolower-string s))
      (x (findradix s))
      (radix (second x))
      (x (first x))
      (x (findtype x))
      (type (second x))
      (digits (first x))
      (value (string->number digits radix))
    )
    (if (equal? value #f)
       (begin
         (newline)
         (display "Invalid integer literal ") (display s)
         (newline)
         (display "Radix ")(display radix)
         (newline)
         (display "Type ")(display type)
         (newline)
         (display "Digits ")(display digits)
         (newline)
         error
       )
       `(,type ,value)
    )
  )
)
""";

//$ Integer literals.
//$
//$ Felix integer literals consist of an optional radix specifer,
//$ a sequence of digits of the radix type, possibly separated
//$ by an underscore (_) character, and a trailing type specifier.
//$
//$ The radix can be:
//$ 0b, 0B - binary
//$ 0o, 0O - octal
//$ 0d, 0D - decimal
//$ 0x, 0X - hex
//$
//$ The default is decimal.
//$ NOTE: unlike C a leading 0 in does NOT denote octal.
//$
//$ Underscores are allowed between digits or the radix
//$ and the first digit, or between the digits and type specifier.
//$
//$ The adaptable signed type specifiers are:
//$
//$ t        -- tiny   (char as int)
//$ s        -- short
//$ i        -- int
//$ l        -- long
//$ v,ll     -- vlong (long long in C)
//$ z        -- ssize (ssize_t in C, a signed variant of size_t)
//$ j        -- intmax
//$ p        -- intptr
//$ d        -- ptrdiff
//$
//$ These may be upper of lower case.
//$ A "u" or "U" before or after such specifier indicates
//$ the correspondin unsigned type.
//$
//$ The follingw exact type specifiers can be given:
//$
//$      "i8" | "i16" | "i32" | "i64"
//$    | "u8" | "u16" | "u32" | "u64"
//$    | "I8" | "I16" | "I32" | "I64"
//$    | "U8" | "U16" | "U32" | "U64";
//$
//$ The default type is "int".
//$

syntax felix_int_lexer {
  /* integers */
  regdef bin_lit  = '0' ('b' | 'B') (dsep ? bindigit) +;
  regdef oct_lit  = '0' ('o' | 'O') (dsep ? octdigit) +;
  regdef dec_lit  = '0' ('d' | 'D') (dsep ? digit) +;
  regdef dflt_dec_lit  =  digit (dsep ? digit) *;
  regdef hex_lit  = '0' ('x' | 'X') (dsep ? hexdigit)  +;
  regdef int_prefix = bin_lit | oct_lit | dec_lit | dflt_dec_lit | hex_lit;

  regdef fastint_type_suffix =
    't'|'T'|'s'|'S'|'i'|'I'|'l'|'L'|'v'|'V'|"ll"|"LL"|"z"|"Z"|"j"|"J"|"p"|"P"|"d"|"D";
  regdef exactint_type_suffix =
      "i8" | "i16" | "i32" | "i64"
    | "u8" | "u16" | "u32" | "u64"
    | "I8" | "I16" | "I32" | "I64"
    | "U8" | "U16" | "U32" | "U64";

  regdef signind = 'u' | 'U';

  regdef int_type_suffix =
      '_'? exactint_type_suffix
    | ('_'? fastint_type_suffix)? ('_'? signind)?
    | ('_'? signind)? ('_'? fastint_type_suffix)?;

  regdef int_lit = int_prefix int_type_suffix;

  // Untyped integer literals.
  literal int_prefix =># """
  (let*
    (
      (val (stripus _1))
      (x (parse-int val))
      ;; (type (first x))
      (value (second x))
    )
    value
  )
  """;
  sinteger := int_prefix =># "_1";

  // Typed integer literal.
  literal int_lit =># """
  (let*
    (
      (val (stripus _1))
      (x (parse-int val))
      (type (first x))
      (value (second x))
      (fvalue (number->string value))
      (cvalue fvalue)       ;; FIXME!!
    )
    `(,type ,fvalue ,cvalue)
  )
  """;
  sliteral := int_lit =># "`(ast_literal ,_sr ,@_1)";

  // Typed signed integer constant.
  sintegral := int_lit =># "_1";
  sintegral := "-" int_lit =># """
  (let*
    (
      (type (first _2))
      (val (second _2))
      (val (* -1 val))
    )
    `(,type ,val)
  )
  """;

  strint := sintegral =># "(second _1)";
}

Float literal constructors

//[float.fsyn]

//$ Floating point literals.
//$
//$ Follows ISO C89, except that we allow underscores;
//$ AND we require both leading and trailing digits so that
//$ x.0 works for tuple projections and 0.f is a function
//$ application
syntax felix_float_lexer {
  regdef decimal_string = digit (dsep ? digit) *;
  regdef hexadecimal_string = hexdigit (dsep ? hexdigit) *;

  regdef decimal_fractional_constant =
    decimal_string '.' decimal_string;

  regdef hexadecimal_fractional_constant =
    ("0x" |"0X")
    hexadecimal_string '.' hexadecimal_string;

  regdef decimal_exponent = ('E'|'e') ('+'|'-')? decimal_string;
  regdef binary_exponent = ('P'|'p') ('+'|'-')? decimal_string;

  regdef floating_suffix = 'L' | 'l' | 'F' | 'f' | 'D' | 'd';
  regdef floating_literal =
    (
      decimal_fractional_constant decimal_exponent ? |
      hexadecimal_fractional_constant binary_exponent ?
    )
    floating_suffix ?;

 // Floating constant.
  regdef sfloat = floating_literal;
  literal sfloat =># """
  (let*
     (
       (val (stripus _1))
       (val (tolower-string val))
       (n (string-length val))
       (n-1 (- n 1))
       (ch (substring val n-1 n))
       (rest (substring val 0 n-1))
       (result
         (if (equal? ch "l") `("ldouble" ,val ,val)
           (if (equal? ch "f") `("float" ,val ,val) `("double" ,val ,val))
         )
       )
     )
     result
   )
   """;

  strfloat := sfloat =># "(second _1)";

  // Floating literal.
  sliteral := sfloat =># "`(ast_literal ,_sr ,@_1)";

}

Tuple Constructor Syntax

//[debug.fsyn]
syntax tupleexpr
{
  //$ Tuple formation by cons: right associative.
  x[stuple_cons_pri] := x[>stuple_cons_pri] ",," x[stuple_cons_pri] =>#
    """`(ast_tuple_cons ,_sr ,_1 ,_3)""";

  //$ Tuple formation by append: left associative
  x[stuple_cons_pri] := x[stuple_cons_pri] "<,,>" x[>stuple_cons_pri] =>#
   """`(ast_tuple_snoc ,_sr ,_1 ,_3)""";

  //$ Tuple formation non-associative.
  x[stuple_pri] := x[>stuple_pri] ( "," x[>stuple_pri])+ =># "(chain 'ast_tuple _1 _2)";

}


syntax debug
{
   satom := "HERE" =># "`(ast_here ,_sr)";
}

Exception Grammar

//[spipeexpr.fsyn]
syntax exceptions
{
  //$ Exception handling.
  //$
  //$ try .. catch x : T => handler endtry
  //$
  //$ can be used to execute code which might throw
  //$ an exception, and catch the exception.
  //$
  //$ This is primarily intended to for wrapping C bindings.
  //$ Exceptions do not propage properly in Felix across
  //$ multiple function/procedure layers. If you have to use
  //$ this construction be sure to keep wrap the try block
  //$ closely around the throwing code.
  block := "try" stmt+ catches "endtry" =>#
    "`(ast_seq ,_sr ,(append `((ast_try ,_sr)) _2 _3 `((ast_endtry ,_sr))))";

  catch := "catch" sname ":" sexpr  "=>" stmt+ =>#
    "`(ast_seq ,_sr ,(cons `(ast_catch ,_sr ,_2 ,_4) _6))";

  catches := catch+ =># "_1";
}

syntax spipeexpr
{
  //$ Left assoc, for schannel pipes.
  x[ssetunion_pri] := x[ssetunion_pri] "|->" x[>ssetunion_pri] =># "(infix 'pipe)";

  //$ Right assoc, for schannel pipes transformers
  // => BREAKS PATTERN MATCHING, replaced with >=> but can't find any uses
  //x[ssetunion_pri] := x[>ssetunion_pri] ">=>" x[ssetunion_pri] =># "(infix 'trans_type)";

  //$ Non associative, streaming data structure into transducer.
  x[ssetunion_pri] := x[>ssetunion_pri] ">->" x[>ssetunion_pri] =># "(infix 'xpipe)";

  //$ input schannel type %<T
  t[sprefixed_pri] := "%<" t[spower_pri] =># '`(ast_name ,_sr "ischannel" (,_2))';

  //$ output schannel type %>T
  t[sprefixed_pri] := "%>" t[spower_pri] =># '`(ast_name ,_sr "oschannel" (,_2))';

  //$ input/output schannel type %<>T
  t[sprefixed_pri] := "%<>" t[spower_pri] =># '`(ast_name ,_sr "ioschannel" (,_2))';

  //$ duplex schannel type %<INPUT%>OUTPUT
  t[sprefixed_pri] := "%<" t[spower_pri] "%>" t[spower_pri] =>#
    '`(ast_name ,_sr "duplex_schannel" (,_2 ,_4))'
  ;
}

List syntax

//[listexpr.fsyn]
syntax listexpr
{
  //$ List cons, right associative.
  x[sarrow_pri] := x[>sarrow_pri] "!" x[sarrow_pri] =>#
    '(binop (nos "Snoc") _3 _1)'
  ;

  satom := "(" "[" expr_comma_list "]" ")" =>#
    '''`(ast_apply ,_sr (,(nos "list") (ast_tuple ,_sr ,_3)))'''
  ;
}

Syntax

//[parser_syn.fsyn]
syntax boolexpr
{
  //$ Boolean false.
  satom := "false" =># "`(ast_false ,_sr)";

  //$ Boolean true.
  satom := "true" =># "`(ast_true ,_sr)";

  //$ Logical implication.
  x[simplies_condition_pri] := x[>simplies_condition_pri] "implies" x[>simplies_condition_pri] =># "(infix 'implies)";

  //$ Logical disjunction (or).
  x[sor_condition_pri] := x[sor_condition_pri] "or" x[>sor_condition_pri] =># "(infix 'lor)";

  //$ Logical conjunction (and).
  x[sand_condition_pri] := x[sand_condition_pri] "and" x[>sand_condition_pri] =># "(infix 'land)";

  //$ Logical negation (not).
  x[snot_condition_pri] := "not" x[snot_condition_pri]  =># "`(ast_not ,_sr ,_2)";

  x[scomparison_pri]:= x[>scomparison_pri] "\not" cmp x[>scomparison_pri] =>#
    "`(ast_not ,_sr (binop _3 _1 _4))";

  // tex logic operators
  x[stex_implies_condition_pri] := x[>stex_implies_condition_pri]  "\implies" x[>stex_implies_condition_pri] =>#
    "(infix 'implies)";

  x[stex_or_condition_pri] := x[stex_or_condition_pri] "\lor" x[>stex_or_condition_pri] =>#
    "(infix 'lor)";

  x[stex_and_condition_pri] := x[stex_and_condition_pri] ( "\land" x[>stex_and_condition_pri])+ =>#
    "(infix 'land)" note "land";

  x[stex_not_condition_pri] := "\lnot" x[stex_not_condition_pri]  =># "`(ast_not ,_sr ,_2)";


  bin := "\iff" =># '(nos _1)'; // NOT IMPLEMENTED FIXME
  bin := "\impliedby" =># '(nos _1)'; // NOT IMPLEMENTED FIXME

  //$ Conditional expression.
  satom := sconditional "endif" =># "_1";

  //$ Conditional expression (prefix).
  sconditional := "if" sexpr "then" sexpr selse_part =>#
      "`(ast_cond ,_sr (,_2 ,_4 ,_5))";

      selif := "elif" sexpr "then" sexpr =># "`(,_2 ,_4)";

      selifs := selif =># "`(,_1)";
      selifs := selifs selif =># "(cons _2 _1)";

      selse_part:= "else" sexpr =># "_2";
      selse_part:= selifs "else" sexpr =>#
          """
            (let ((f (lambda (result condthn)
              (let ((cond (first condthn)) (thn (second condthn)))
                `(ast_cond ,_sr (,cond ,thn ,result))))))
            (fold_left f _3 _1))
          """;
}




syntax parser_syn
{
  priority
    palt_pri <
    pseq_pri <
    patom_pri
  ;

  stmt := plibrary =># "_1";

  plibrary := "gramlib" sname "{" plibentry* "}" =>#
    """
    (let*
      (
        (tup `(ast_tuple ,_sr ,_4))
        (v `(ast_apply ,_sr (,(nos "list") ,tup)))
      )
      `(ast_var_decl ,_sr ,_2 ,dfltvs none (some ,v))
    )
    """
  ;

  plibentry := sname "=" pexpr[palt_pri] ";" =>#
  """`(ast_tuple ,_sr (,(strlit _1) ,_3))""";

  sexpr := "parser" "(" pexpr[palt_pri] ")" =># "_3";

  private pexpr[palt_pri] := "|"? pexpr[>palt_pri] ("|" pexpr[>palt_pri])+ =>#
    """`(ast_apply ,_sr (
      ,(qnoi 'Parser_synlib 'ALT)
      (ast_apply ,_sr (,(noi 'list) ,(cons _2 (map second _3))))))"""
  ;

  private pexpr[pseq_pri] := pexpr[>pseq_pri] (pexpr[>pseq_pri])+ =>#
    """`(ast_apply ,_sr (
      ,(qnoi 'Parser_synlib 'SEQ)
      (ast_apply ,_sr (,(noi 'list) ,(cons _1 _2)))))"""
  ;

  private pexpr[patom_pri] := "(" pexpr[palt_pri] ")" =># "_2";

  private pexpr[patom_pri] := String =>#
    """`(ast_apply ,_sr ( ,(qnoi 'Parser_synlib 'STR) ,_1)) """
  ;

  private pexpr[patom_pri] := "#EPS" =>#
    """`(ast_apply ,_sr ( ,(qnoi 'Parser_synlib 'EPS) ())) """
  ;

  private pexpr[patom_pri] := sname=>#
    """`(ast_apply ,_sr ( ,(qnoi 'Parser_synlib 'NT) ,(strlit _1))) """
  ;

  private pexpr[patom_pri] := "{" sexpr "}" =># "_2";


}
Parallel loop grammar
//[pfor.fsyn]
syntax pfor
{
   requires loops, blocks;

   //$ Parallel For loop
   loop_stmt := "pfor" sname "in" sexpr "upto" sexpr block =>#
    """
    (let*
      (
        (ctlvar _2)
        (first _4)
        (last _6)
        (body _7)
        (int (nos "int"))
        (param `(,_sr PVar ,ctlvar ,int none)) ;; kind name type defaultvalue
        (params `((Satom ,param) none))               ;; parameter list with constraint
        (sfunargs `(,params))                   ;; HOF list of parameter lists
        (proc `(ast_lambda ,_sr (,dfltvs ,sfunargs (ast_void ,_sr) (,body))))
        (call `(ast_call ,_sr ,(nos "tpfor")  (ast_tuple ,_sr (,first ,last ,proc))))
      )
      ;;(begin (display body) (display "\n*****\n")
      call
      ;;)
    )
    """;


}

Syntax

//[regexps.fsyn]

//$ Syntax for regular definitions.
//$ Binds to library class Regdef,
//$ which in turn binds to the binding of Google RE2.
SCHEME """(define (regdef x) `(ast_lookup (,(noi 'Regdef) ,x ())))""";

syntax regexps {
  priority
    ralt_pri <
    rseq_pri <
    rpostfix_pri <
    ratom_pri
  ;


  //$ Regular definition binder.
  //$ Statement to name a regular expression.
  //$ The expression may contain names of previously named regular expressions.
  //$ Defines the LHS symbol as a value of type Regdef::regex.
  stmt := "regdef" sdeclname "=" sregexp[ralt_pri] ";" =>#
    """
    `(ast_val_decl ,_sr ,(first _2) ,(second _2) (some ,(regdef "regex" )) (some ,_4))
    """;

  //$ Inline regular expression.
  //$ Can be used anywhere in Felix code.
  //$ Returns a a value of type Regdef::regex.
  x[sapplication_pri] := "regexp" "(" sregexp[ralt_pri] ")" =># "_3";

  //$ Alternatives.
  private sregexp[ralt_pri] := sregexp[>ralt_pri] ("|" sregexp[>ralt_pri])+ =>#
    """`(ast_apply ,_sr (
      ,(regdef "Alts")
      (ast_apply ,_sr (,(noi 'list) (ast_tuple ,_sr ,(cons _1 (map second _2)))))))"""
  ;

  //$ Sequential concatenation.
  private sregexp[rseq_pri] := sregexp[>rseq_pri] (sregexp[>rseq_pri])+ =>#
    """`(ast_apply ,_sr (
      ,(regdef "Seqs")
      (ast_apply ,_sr (,(noi 'list) (ast_tuple ,_sr ,(cons _1 _2)))))))"""
  ;


  //$ Postfix star (*).
  //$ Kleene closure: zero or more repetitions.
  private sregexp[rpostfix_pri] := sregexp[rpostfix_pri] "*" =>#
    """`(ast_apply ,_sr ( ,(regdef "Rpt") (ast_tuple ,_sr (,_1 0 -1))))"""
  ;

  //$ Postfix plus (+).
  //$ One or more repetitions.
  private sregexp[rpostfix_pri] := sregexp[rpostfix_pri] "+" =>#
    """`(ast_apply ,_sr ( ,(regdef "Rpt") (ast_tuple ,_sr (,_1 1 -1))))"""
  ;

  //$ Postfix question mark (?).
  //$ Optional. Zero or one repetitions.
  private sregexp[rpostfix_pri] := sregexp[rpostfix_pri] "?" =>#
    """`(ast_apply ,_sr (,(regdef "Rpt") (ast_tuple ,_sr (,_1 0 1))))"""
  ;

  //$ Parenthesis. Non-capturing group.
  private sregexp[ratom_pri] := "(" sregexp[ralt_pri] ")" =># "_2";

  //$ Group psuedo function.
  //$ Capturing group.
  private sregexp[ratom_pri] := "group" "(" sregexp[ralt_pri] ")" =>#
    """`(ast_apply ,_sr ( ,(regdef "Group") ,_3))"""
  ;

  //$ The charset prefix operator.
  //$ Treat the string as a set of characters,
  //$ that is, one of the contained characters.
  private sregexp[ratom_pri] := "charset" String =>#
    """`(ast_apply ,_sr ( ,(regdef "Charset") ,_2))"""
  ;

  //$ The string literal.
  //$ The given sequence of characters.
  //$ Any valid Felix string can be used here.
  private sregexp[ratom_pri] := String =>#
    """`(ast_apply ,_sr ( ,(regdef "String") ,_1)) """
  ;

  //$ The Perl psuedo function.
  //$ Treat the argument string expression as
  //$ a Perl regular expression, with constraints
  //$ as specified for Google RE2.
  private sregexp[ratom_pri] := "perl" "(" sexpr ")" =>#
    """`(ast_apply ,_sr ( ,(regdef "Perl") ,_3)) """
  ;

  //$ The regex psuedo function.
  //$ Treat the argument Felix expression of type Regdef::regex
  //$ as a regular expression.
  private sregexp[ratom_pri] := "regex" "(" sexpr ")" =># "_3";

  //$ Identifier.
  //$ Must name a previously defined variable of type Regdef:;regex.
  //$ For example, the LHS of a regdef binder.
  private sregexp[ratom_pri] := sname=># "`(ast_name ,_sr ,_1 ())";

}

String syntax

//[stringexpr.fsyn]
syntax stringexpr
{
  //$ String subscript.
  x[sfactor_pri] := x[sfactor_pri] "." "[" sexpr "]" =>#
    "(binop (noi 'subscript) _1 _4)";

  //$ String substring.
  x[sfactor_pri] := x[sfactor_pri] "." "[" sexpr "to" sexpr "]" =>#
    "`(ast_apply ,_sr (,(noi 'substring) (ast_tuple ,_sr (,_1 ,_4 ,_6))))";

  //$ String substring, to end of string.
  x[sfactor_pri] := x[sfactor_pri] "." "[" sexpr "to" "]" =>#
   "(binop (noi 'copyfrom) _1 _4)";

  //$ String substring, from start of string.
  x[sfactor_pri] := x[sfactor_pri] "." "[" "to" sexpr "]" =>#
   "(binop (noi 'copyto) _1 _5)";
}

Package: src/packages/libstruct.fdoc

Library structure

key file
std.flx share/lib/std.flx
key file
linux.flx share/lib/std/linux/linux.flx
linux_smaps.flx share/lib/std/linux/smaps.flx
key file
cstdlib.flx share/lib/std/c/cstdlib.flx
c_hack.flx share/lib/std/c/c_hack.flx
platindep.flxh share/lib/std/plat/platindep.flxh

Library structure

Specifies some of the automatic inclusion files. Others are located in other packages.

Also throw in some “don’t know where to put them” files.

Std.flx

The top level library module.

//[std.flx]
header '#include "flx_rtl_config.hpp"';
include "std/__init__";

Default includes for Standard library.

open String;

// ISO C++99 standard header tags
include "std/c/__init__";

// core type classes
include "std/algebra/__init__";

// base scalar types
include "std/scalar/__init__";

// utility
include "std/debug";

// control
include "std/control/__init__";
include "std/pthread/__init__";
include "std/program/__init__";

//memory management
include "std/gc";

// I/O
include "std/io/__init__";
include "std/time";

// codecs
include "std/codec/__init__";

// base data types
include "std/datatype/__init__";
include "std/strings/__init__";

// regexes
include "std/regex/__init__";

// database REMOVED
//include "std/db/__init__";

// Version
include "std/version";

// Platform support (implementation exposure)
include "std/osx/__init__";
include "std/posix/__init__";
include "std/win32/__init__";

// Felix (implementation exposure)
include "std/felix/__init__";

C stuff

Structure of C sublibrary.

include "std/c/c_headers";
include "std/c/cxx_headers";
include "std/c/cptr";
include "std/c/cstdlib";
include "std/c/carray";
include "std/c/c_hack";
include "std/c/shared_ptr";

Data types

Structure of datatype library.

// special
include "std/datatype/typing";
include "std/datatype/functional";
include "std/datatype/special";
include "std/datatype/unitsum";

// base data types
include "std/datatype/tuple";
include "std/datatype/option";
include "std/datatype/slice";
include "std/datatype/list";
include "std/datatype/assoc_list";
include "std/datatype/stream";
//include "std/datatype/sexpr";
//include "std/datatype/lsexpr";
//include "std/datatype/ralist";

// arrays
include "std/datatype/array_class";
include "std/datatype/array";
include "std/datatype/varray";
include "std/datatype/darray";
//include "std/datatype/sarray";
//include "std/datatype/bsarray";
include "std/datatype/judy";
include "std/datatype/sort";

// dictionaries
include "std/datatype/strdict";

// tree
//include "std/datatype/avl";

Posix

Structure of Posix support library.

struct Posix {};
include "std/posix/posix_headers";
include "std/posix/errno";
include "std/posix/signal";
include "std/posix/time";
include "std/posix/filestat";
include "std/posix/directory";
include "std/posix/filesystem";
include "std/posix/process";
include "std/posix/shell";
include "std/posix/faio_posix";
include "std/posix/mmap";

Win32

Structure of Win32 library.

struct Win32 {};

// windows services
include "std/win32/shell";
include "std/win32/filestat";
include "std/win32/directory";
include "std/win32/process";
include "std/win32/filesystem";
include "std/win32/time";
include "std/win32/signal";
include "std/win32/faio_win32";
include "std/win32/win32_headers";

Platform independent Computation enforcement

Using –import=std/plat/platindep.flxh on flxg command fails to set any of the usual platform macros like FLX_LINUX, FLX_POSIX, FLX_WIN32. Instead it sets the macro PLAT_INDEP. This should bug out any compilations requiring platform specific macros.

// Platform independent compilation enforced by
// failing to set any platform macros.
macro val PLAT_INDEP = 1;

C hackery

Hackery for mapping between Felix and C/C++.

//[c_hack.flx]

//$ This class provides access to raw C/C++ encodings.
//$ Incorrect typing is likely to pass by Felix and
//$ be trapped by the C/C++ compiler. Incorrect management
//$ of storage can lead to corruption. The use of the
//$ C_hack class is necessary for interfacing.
class C_hack
{
  //$ C void type. Incomplete, can't be instantiated.
  incomplete type void_t = "void";

  //$ Standard variable argument list pointer type.
  type va_list = "va_list";

  //$ GCC specific valist thingo: it will
  //$ be optimised away if not used (eg on MSVC).
  type __builtin_va_list = '__builtin_va_list';

  //$ Throw away result of a function call:
  //$ only useful for C functions that are mainly
  //$ called for side effects.
  proc ignore[t]:t = "(void)$t;";

  //$ C style cast.
  fun cast[dst,src]: src->dst = '(?1)($t/*cast*/)' is cast;

  //$ C++ static cast.
  fun static_cast[dst,src]: src->dst = 'static_cast<?1>($t)' is postfix;

  //$ C++ dynamic cast.
  fun dynamic_cast[dst,src]: src->dst = 'dynamic_cast<?1>($t)' is postfix;

  //$ C++ const cast.
  fun const_cast[dst,src]: src->dst = 'const_cast<?1>($t)' is postfix;

  //$ C++ reinterpret cast.
  fun reinterpret_cast[dst,src]: src->dst = 'reinterpret_cast<?1>($t)' is postfix;

  //$ Felix reinterpret cast.
  //$ More powerful than C++ reinterpret cast.
  //$ Allows casting an rvalue to an lvalue.
  fun reinterpret[dst,src]: src->dst = 'reinterpret<?1>($t)' is postfix;

  const sizeof[t]:size = 'sizeof(?1)';

  //$ Special NULL check for Felix pointers.
  //$ Should never succeed.
  fun isNULL[t]: &t -> bool = "(0==$1)";

  //$ Special NULL check for carray.
  //$ Should never succeed.
  fun isNULL[t]: +t -> bool = "(0==$1)";

  //$ Polymorphic null pointer constant
  //$ Values of this type should not exist.
  //$ This value is provided for checking.
  const null[t]:&t = "(?1*)NULL";

  //$ C++ default value for a type T.
  //$ Workaround for g++ 3.2.2 parsing bug,
  //$ it can parse T() as a default ctor call,
  //$ but screws up on (T())
  fun dflt[t]:1->t = "dflt<?1>()" requires header
    "template<class T> T dflt() { return T(); }";

  //$ Invoke C++ destructor
  proc destroy[T] : &T = "::destroy($1);/*C_hack*/"; // from flx_compiler_support_bodies
}

C stdlib Rand

Just to get random functions.

//[cstdlib.flx]

open class Cstdlib
{
  requires Cxx_headers::cstdlib;
  const RAND_MAX:long;

  //$ C89 Standard C library seed random number generator.
  proc srand: uint = '::std::srand($1);';

  //$ C89 Standard C library random number generator.
  //$ Known to be not very good. Try not to use it!
  fun rand: unit -> int = '::std::rand()';
}

OSX platform tag

struct Osx{};
include "std/posix/__init__";

Linux specifics

//[linux.flx]

module Linux {
  header '#include "plat_linux.hpp"';
  requires package "plat_linux";
  fun get_cpu_nr: 1 -> int;
}

Linux smap

Parses and totals proc/PID/smaps memory stats.

//[linux_smaps.flx]

publish """
Parses and totals proc/PID/smaps memory stats.
See smaps_total

** don't do [stack] as is last map in smaps and feof appear to be broken or
** doesnt work with /proc files

Example: (gets total smaps values for heap
 open Smaps;
  val my_smaps = smaps_total(getpid(),"[heap]");
  println("Heap Size=>"+str(my_smaps.size)+" kB");
  //Smaps for other processes
  val m = smaps_total(uint_topid(23264ui),"/usr/lib/libsqlite3.so.0.8.6");
  println("SQLite Size:RSS=>"+str((m.size))+" kB:"+ str((m.rss))+" kB");
"""

class Smaps {
  open Smaps;
  struct smaps_metric {
     size:uint;
     rss:uint;
     pss:uint;
     shared_clean:uint;
     shared_dirty:uint;
     private_clean:uint;
     private_dirty:uint;
     referenced:uint;
     anonymous:uint;
     anonhugepages:uint;
     swap:uint;
     kernelpagesize:uint;
     mmupagesize:uint;
     locked:uint;
  }

  fun getpid: ()->Process::pid_t = "getpid()";

  fun pid_touint: Process::pid_t->uint = "((unsigned int)$1)";

  fun uint_topid: uint->Process::pid_t = "((pid_t)$1)";

  fun min_whitespace(s:string) = {
    var fw = false;
    var m = "";
    for var i in 0ui upto (len s) - 1ui do
      val c = s.[int(i)];
      if  (c == char ' ' and not fw) do
        fw = true; m = m + c;
      elif not c == char ' ' do
        fw = false; m = m + c;
      done
    done
    return m;
  }

publish """
  Returns summation of blocks for each path specified for a given pid.
  Path is one of [heap] | [vdso] | [stack] | path dynamic lib (e.g /lib/libbz2.so.1.0.6)
"""
fun smaps_total(p:Process::pid_t,path:string):smaps_metric ={
  var y = pid_touint p;
  val file = fopen_input ("/proc/"+str(pid_touint p)+"/smaps");
  var at_map = false;
  var end_of_map = false;
  var nums = smaps_metric(0ui,0ui,0ui,0ui,0ui,0ui,0ui,0ui,0ui,0ui,0ui,0ui,0ui,0ui);
  var size = 0ui;
  while not (feof file) and not end_of_map do
    val ln = min_whitespace(strip(readln file));
    val cols = split(ln,' ');
    var spath = let Cons (h,_) = rev cols in h;
    if not at_map  do
      at_map = match find (ln,path) with |Some _ => true |_ => false endmatch;
    elif (at_map  and (len cols) > 5ui) and not spath == path do
      end_of_map=true;
    else
      var kv = let Cons (k,Cons (s,_)) = cols in (k,uint(s));
      match kv with
        |("Size:",e) => nums.size = nums.size + uint(e);
      |("Rss:",e) => nums.rss = nums.rss + uint(e);
      |("Pss:",e) => nums.pss = nums.pss + uint(e);
      |("Shared_Clean:",e) => nums.shared_clean = nums.shared_clean + uint(e);
      |("Shared_Dirty:",e) => nums.shared_dirty = nums.shared_dirty + uint(e);
      |("Private_Clean:",e) => nums.private_clean = nums.private_clean + uint(e);
      |("Private_Dirty:",e) => nums.private_dirty = nums.private_dirty + uint(e);
      |("Referenced:",e) => nums.referenced = nums.referenced + uint(e);
      |("Anonymous:",e) => nums.anonymous = nums.anonymous + uint(e);
      |("AnonHugePages:",e) => nums.anonhugepages = nums.anonhugepages +  uint(e);
      |("Swap:",e) => nums.swap = nums.swap +  uint(e);
      |("KernelPageSize:",e) => nums.kernelpagesize = nums.kernelpagesize + uint(e);
      |("MMUPageSize:",e) => nums.mmupagesize = nums.mmupagesize + uint(e);
      |("Locked:",e) => nums.locked = nums.locked + uint(e);
        |(k,v) => {}();
      endmatch;
    done;
  done;
  fclose file;
  return nums;
  }
}

Package: src/packages/rparse.fdoc

Felix library add ons

key file
rparse.flx share/src/flxlibs/rparse.flx
unix_rparse.fpc $PWD/src/config/unix/rparse.fpc
win_rparse.fpc $PWD/src/config/win/rparse.fpc
build_rparse.sh $PWD/build_rparse.sh
test_rparse.sh $PWD/test_rparse.sh
testrparse.flx $PWD/testrparse.flx

Synopsis

This package contains part of the Felix standard library written in Felix. The code is compiled into a normal binary static archive and dll/shared library and installed into the target RTL directory. The C++ header is installed there too.

The interface, being generated, is stored in the target branch of the standard library.

This is an experiment, the provided bash script works only on Unix.

The code here is for the respectful parser which allows a string to be split in the usual way, but respecting quotes and escapes, that is, quoted or escaped split characters are ignored.

Note: this code cannot be used to build Felix because Felix is required to build it. The bootstrap version of Felix may not have all the required capabilities.

//[rparse.flx]
class NewRespectfulParser
{
    export variant quote_action_t =
      | ignore-quote
      | keep-quote
      | drop-quote
    ;
    export variant dquote_action_t =
      | ignore-dquote
      | keep-dquote
      | drop-dquote
    ;
    export variant escape_action_t =
      | ignore-escape
      | keep-escape
      | drop-escape
    ;
    typedef action_t = (quote:quote_action_t, dquote:dquote_action_t, escape:escape_action_t);

    export "rparse_mode_t" variant mode_t  = | copying | skipping | quote | dquote | escape-copying | escape-quote | escape-dquote;
    typedef state_t = (mode:mode_t, current:string, parsed: list[string] );

    export noinline fun respectful_parse (action:action_t) (var state:state_t) (var s:string) : state_t =
    {
      var mode = state.mode;
      var current = state.current;
      var result = Empty[string];

      noinline proc handlecopying(ch:char)
      {
        if ch == char "'" do
          match action.quote with
          | #ignore-quote =>
            current += ch;
          | #keep-quote =>
            current += ch;
            mode = quote;
          | #drop-quote =>
            mode = quote;
          endmatch;
        elif ch == char '"' do
          match action.dquote with
          | #ignore-dquote =>
            current += ch;
          | #keep-dquote =>
            current += ch;
            mode = dquote;
          | #drop-dquote =>
            mode = dquote;
          endmatch;
        elif ch == char '\\' do
          match action.escape with
          | #ignore-escape =>
            current += ch;
          | #keep-escape =>
            current += ch;
            mode = escape-copying;
          | #drop-escape =>
            mode = escape-copying;
          endmatch;
        elif ord ch <= ' '.char.ord  do // can't happen if called from skipping
          result += current;
          current = "";
          mode = skipping;
        else
          current += ch;
          mode = copying;
        done
      } //nested proc

      for ch in s do
        match mode with
        | #copying => handlecopying ch;
        | #quote =>
          if ch == char "'" do
            match action.quote with
            | #ignore-quote =>
              assert false;
              //current += ch;
            | #keep-quote =>
              current += ch;
              mode = copying;
            | #drop-quote =>
              mode = copying;
            endmatch;
          elif ch == char "\\" do
            match action.escape with
            | #ignore-escape =>
              current += ch;
            | #keep-escape =>
              current += ch;
              mode = escape-quote;
            | #drop-escape =>
              mode = escape-quote;
            endmatch;
          else
            current += ch;
          done

        | #dquote =>
          if ch == char '"' do
            match action.dquote with
            | #ignore-dquote =>
              assert false;
              //current += ch;
            | #keep-dquote =>
              current += ch;
              mode = copying;
            | #drop-dquote =>
              mode = copying;
            endmatch;
          elif ch == char "\\" do
            match action.escape with
            | #ignore-escape =>
              current += ch;
            | #keep-escape =>
              current += ch;
              mode = escape-dquote;
            | #drop-escape =>
              mode = escape-dquote;
            endmatch;
          else
            current += ch;
          done

        | #escape-copying =>
           current += ch;
           mode = copying;

        | #escape-quote =>
           current += ch;
           mode = quote;

        | #escape-dquote =>
           current += ch;
           mode = dquote;

        | #skipping =>
          if ord ch > ' '.char.ord  do
            handlecopying ch;
          done
        endmatch;
      done
      return (mode=mode, current=current, parsed=state.parsed + result);
    }

  // simplified one shot parser.
  // ignores mismatched quotes and backslashes.
  export fun respectful_split (action:RespectfulParser::action_t) (s:string) : list[string] =
  {
    var state = RespectfulParser::respectful_parse
      action
      (
        mode=RespectfulParser::skipping,
        current="",
        parsed=Empty[string]
      )
      s
    ;
    // ignore mismatched quotes and backslashes.
    match state.mode with
    | #skipping => ;
    | _ => state.parsed = state.parsed + state.current;
    endmatch;
    return state.parsed;

  }

  export fun default_respectful_split (s:string) : list[string] =>
    respectful_split (
      quote=RespectfulParser::keep-quote,
      dquote=RespectfulParser::keep-dquote,
      escape=RespectfulParser::keep-escape
    )
    s
  ;
}

Resource files

//[unix_rparse.fpc]
Description: Respectful Parser, binary edition
Location: Part of the standard library
provides_slib: -lrparse_static
provides_dlib: -lrparse_dynamic

//[win_rparse.fpc]
Description: Respectful Parser, binary edition
Location: Part of the standard library
provides_slib: /DEFAULTLIB:librparse_static
provides_dlib: /DEFAULTLIB:librparse_dynamic

Interim Build script.

This is an interim build script for bash only. Until a proper Felix tool can be organised!

rm -rf rparse
build/release/host/bin/flx --felix=build.fpc --bundle-dir=rparse --staticlib -ox librparse_static build/release/share/src/flxlibs/rparse.flx
build/release/host/bin/flx --felix=build.fpc --bundle-dir=rparse -c -ox librparse_dynamic build/release/share/src/flxlibs/rparse.flx
mkdir -p build/release/host/lib/std/strings
cp rparse/rparse_interface.flx build/release/host/lib/std/strings
cp rparse/librparse_dynamic.dylib build/release/host/lib/rtl
cp rparse/librparse_static.a build/release/host/lib/rtl
cp rparse/rparse.hpp build/release/host/lib/rtl
cp rparse/rparse.includes build/release/host/lib/rtl
cp src/config/unix/rparse.fpc build/release/host/config

test

Note: currently interfaces don’t contain package requjirements! So we have to add it manually!

//[testrparse.flx]
include "std/strings/rparse_interface";
var s = 'Hello "world ish" stuff';
var k = rparse_interface::default_respectful_split s;
println$ s " splits to " + k.str;

build/release/host/bin/flx --felix=build.fpc --static --pkg=rparse testrparse.flx
build/release/host/bin/flx --felix=build.fpc --pkg=rparse testrparse.flx

Bindings

Contents:

Package: src/packages/botan.fdoc

Botan Interface

key file
botan_unix.fpc $PWD/src/config/unix/botan.fpc
rng.fpc $PWD/src/config/botan_rng.fpc
system_rng.fpc $PWD/src/config/botan_system_rng.fpc
rng.flx share/lib/botan/rng.flx
key file
bigint.flx share/lib/botan/bigint.flx
bigint.fpc $PWD/src/config/botan_bigint.fpc
key file
hash.flx share/lib/botan/hash.flx
hash.fpc $PWD/src/config/botan_hash.fpc

Random number generators.

//[rng.flx]
library Botan { class Rng
{
  requires package "botan_rng", package "botan_system_rng";
  type RandomNumberGenerator = "Botan::RandomNumberGenerator*";
  fun System_RNG: 1 -> RandomNumberGenerator = "new Botan::System_RNG()";
  proc add_entropy: RandomNumberGenerator * +byte * size = "$1->add_entropy($2,$3);";
  proc randomize_with_input:
    RandomNumberGenerator * +byte * size * +byte * size=
    "$1->add_entropy($2,$3,$4,$5);"
  ;
  proc randomize_with_ts_input: RandomNumberGenerator * +byte * size =
    "$1->randomize_with_ts_input($2,$3);"
  ;
  proc randomize: RandomNumberGenerator * +byte * size =
    "$1->randomize_with_input($2,$3);"
  ;
}}

Big Integers

//[bigint.flx]
library Botan { class BigInt
{
  requires package "botan_bigint";
  type bigint = "Botan::BigInt";
  body strbigint = """
    static ::std::string strbigint (Botan::BigInt const &pi) {
      ::std::stringstream s;
      s << pi;
      return s.str();
    }
  """;

  ctor bigint : string = "Botan::BigInt ($1)";

  instance ForwardSequence[bigint] {
    fun succ: bigint -> bigint = "$1+Botan::BigInt(1)";
    proc pre_incr: &bigint = "$1->operator++();";
    proc post_incr: &bigint = "$1->operator++();";
  }
  instance BidirectionalSequence[bigint] {
    fun pred: bigint -> bigint = "$1-Botan::BigInt(1)";
    proc pre_decr: &bigint = "$1->operator--();";
    proc post_decr: &bigint = "$1->operator--();";
  }

  instance FloatAddgrp[bigint] {
    fun zero: 1 -> bigint = "Botan::Bigint(0)";
    fun neg: bigint -> bigint = "-$1";
    proc += : &bigint * bigint = "$1->operator+= ($2);";
    proc -= : &bigint * bigint = "$1->operator-=($2);";

    fun + : bigint * bigint -> bigint = "$1+$2";
    fun - : bigint * bigint -> bigint = "$1-$2";
  }
  instance FloatMultSemi1[bigint] {
    fun one : 1 -> bigint = "Botan::BigInt(1)";
    fun * : bigint * bigint -> bigint = "$1*$2";
    proc *= : &bigint * bigint = "$1->operator*=($2);";
  }
  instance FloatDring[bigint] {
    fun / : bigint * bigint -> bigint = "$1/$2";
    fun % : bigint * bigint -> bigint = "$1%$2";
    proc /= : &bigint * bigint = "$1->operator/=($2);";
    proc %= : &bigint * bigint = "$1->operator%=($2);";
  }
  instance Integer[bigint] {
    body bigintshl = """
       // throws if right argument abs value is too big
       static Botan::BigInt shl(Botan::BigInt const &l, Botan::BigInt r) {
         if (r.is_negative()) {
            r = -r;
            ::std::size_t rr = r.to_u32bit();
            return l >> rr;
         } else {
           ::std::size_t rr = r.to_u32bit();
           return l << rr;
         }
       }
    """;
    fun << : bigint * bigint -> bigint = "bigint_shl($1,$2)" requires bigintshl;
    fun >> : bigint * bigint -> bigint = "bigint_shl($1,-$2)" requires bigintshl;
  }
  instance Signed_integer[bigint] {
    fun abs: bigint -> bigint = "$1.abs()";
    fun sgn: bigint -> int = "$1.is_zero()? 0 : ($1.is_positive() ? 1 : -1)";
  }
  inherit Signed_integer[bigint];

  instance Eq[bigint] {
    fun == : bigint * bigint -> bool = "$1==$2";
  }
  instance Tord[bigint] {
    fun < : bigint * bigint -> bool = "$1<$2";
    fun <= : bigint * bigint -> bool = "$1<=$2";
    fun > : bigint * bigint -> bool = "$1>$2";
    fun >= : bigint * bigint -> bool = "$1>=$2";
  }
  inherit Tord[bigint]; // includes Eq
  instance Str[bigint] {
    fun str: bigint -> string = "strbigint($1)" requires strbigint;
  }
  fun gcd: bigint * bigint -> bigint = "Botan::gcd($1,$2)";
  fun lcm: bigint * bigint -> bigint = "Botan::lcm($1,$2)";
  fun jacobi: bigint * bigint -> bigint = "Botan::jacobi($1,$2)";

  // b^x % m
  fun power_mod: bigint * bigint * bigint -> bigint = "Botan::power_mod($1,$2,$3)";
}}

Hash functions

//[hash.flx]
library Botan { class Hash {
  type BufferedComputation = "::Botan::BufferedComputation*";
  fun output_length : BufferedComputation -> size = "$1->output_length()";
  proc update : BufferedComputation * +byte * size = "$1->update($2,$3);";
  proc update : BufferedComputation * byte = "$1->update($2);";
  proc final: BufferedComputation * +byte = "$1->final($2);";

}}

//[botan_unix.fpc]
Name: botan
Platform: Unix
Description: Botan Crypto Library
provides_dlib: -L/usr/local/lib -lbotan-2
provides_slib: -L/usr/local/lib -lbotan-2
cflags: -I/usr/local/include/botan-2.0

//[rng.fpc]
Requires: botan
includes: '"botan/rng.h"'
cflags: -I/usr/local/include/botan-2.0

//[system_rng.fpc]
Requires: botan
includes: '"botan/system_rng.h"'
cflags: -I/usr/local/include/botan-2.0

//[bigint.fpc]
Requires: botan
includes: '"botan/bigint.h"' '"botan/numthry.h"'
cflags: -I/usr/local/include/botan-2.0

Package: src/packages/gmp.fdoc

GMP Bindings.

key file
gmp.flx share/lib/gnu/gmp.flx
gmp.fpc host/config/gmp.fpc

Bindings for GNU Multiple Precision Library.

We use the gmp++ C++ binding so you need both libgmp and libgmp++ installed.

You may need to edit the gmp.fpc file found in packages/host/config/gmp.fpc. This file is set up for Linux or OSX with gmp build from source and installed in the default PREFIX=/usr/lib.

To build gmp download from GNU website. Make sure to use ./configure –enable-cxx make make check make install

//[gmp.fpc]
Name: gmp
Description: GNU Multiple Precision Arithmetic Library
includes: '"gmpxx.h"'
cflags: -I/usr/local/include
provides_slib:  -L/usr/local/lib -lgmp -lgmpxx
provides_dlib:  -L/usr/local/lib -lgmp -lgmpxx

//[gmp.flx]

// THIS WRAPPER IS FFAU .. it is NOT LGPL licenced
// This is because the wrapper was hand written from
// scratch .. it was NOT derived from any LGPL headers
// Code LINKED against libgmp, however, may be governed
// by the LGPL licence, since the object files ARE
// derived from gmp.h
requires package "gmp";
header "#include <cstdio>";
header gmpxx_h = """
#include <gmpxx.h>
#include <string>
#include <cstdio>
namespace flx { namespace gmp {
extern mpz_class lcm(mpz_class const&,mpz_class const&);
extern mpz_class gcd(mpz_class const&,mpz_class const&);
extern ::std::string flx_mpf_get_str(mpf_class const&);
}}
""";

body gmpxx_lcm = """
namespace flx { namespace gmp {
mpz_class lcm(mpz_class const &a, mpz_class const &b)
{
  mpz_t r; mpz_init(r);
  mpz_lcm(r,a.get_mpz_t(),b.get_mpz_t());
  return mpz_class(r);
}
}}
""";

body gmpxx_gcd = """
namespace flx { namespace gmp {
mpz_class gcd(mpz_class const &a, mpz_class const &b)
{
  mpz_t r; mpz_init(r);
  mpz_gcd(r,a.get_mpz_t(),b.get_mpz_t());
  return mpz_class(r);
}
}}
""";

body flx_mpf_get_str_h = """
namespace flx { namespace gmp {
::std::string flx_mpf_get_str(mpf_class const &a)
{
  mp_exp_t x;
  ::std::string s = a.get_str(x,10,0);
  char b[100];
  ::std::snprintf(b,100,"e%ld",(long)x);
  return std::string(".")+s+b;
}
}}
""";
class Gmp
{
  requires gmpxx_h;
  type mpz='mpz_class';
  type mpq='mpq_class';
  type mpf='mpf_class';
  fun + :mpz*mpz->mpz="$1+$2";
  fun - :mpz*mpz->mpz="$1-$2";
  fun * :mpz*mpz->mpz="$1*$2";
  fun / :mpz*mpz->mpz="$1/$2";
  fun -:mpz->mpz="-$1";
  fun abs:mpz->mpz="abs($1)";
  fun sgn:mpz->int="sgn($1)";
  fun sqrt:mpz->mpz="sqrt($1)";
  fun cmp:mpz*mpz->int="cmp($1,$2)";
  fun + :mpq*mpq->mpq="$1+$2";
  fun - :mpq*mpq->mpq="$1-$2";
  fun * :mpq*mpq->mpq="$1*$2";
  fun / :mpq*mpq->mpq="$1/$2";
  fun - :mpq->mpq="-$1";
  fun abs:mpq->mpq="abs($1)";
  fun sgn:mpq->int="sgn($1)";
  fun sqrt:mpq->mpq="sqrt($1)";
  fun cmp:mpq*mpq->int="cmp($1,$2)";
  fun + :mpf*mpf->mpf="$1+$2";
  fun - :mpf*mpf->mpf="$1-$2";
  fun * :mpf*mpf->mpf="$1*$2";
  fun / :mpf*mpf->mpf="$1/$2";
  fun - :mpf->mpf="-$1";
  fun abs:mpf->mpf="abs($1)";
  fun sgn:mpf->int="sgn($1)";
  fun sqrt:mpf->mpf="sqrt($1)";
  fun lcm: mpz * mpz -> mpz = "flx::gmp::lcm($1,$2)" requires gmpxx_lcm;
  fun gcd: mpz * mpz -> mpz = "flx::gmp::gcd($1,$2)" requires gmpxx_gcd;
  fun wedge: mpz * mpz -> mpz = "flx::gmp::lcm($1,$2)" requires gmpxx_lcm;
  fun vee: mpz * mpz -> mpz = "flx::gmp::gcd($1,$2)" requires gmpxx_gcd;

  fun % : mpz * mpz -> mpz = "$1%$2";
  fun mpz_of_int: int -> mpz = "mpz_class($1)";
  fun mpq_of_int: int -> mpq = "mpq_class($1)";
  fun mpf_of_double: double -> mpf = "mpf_class($1)";

  instance Eq[mpz] {
    fun == :mpz*mpz->bool="(cmp($1,$2) == 0)";
    fun != :mpz*mpz->bool="(cmp($1,$2) != 0)";
  }
  instance Tord[mpz] {
    fun <  :mpz*mpz->bool="$1<$2";
    fun <= :mpz*mpz->bool="$1<=$2";
    fun >  :mpz*mpz->bool="$1>$2";
    fun >= :mpz*mpz->bool="$1>=$2";
  }
  instance Eq[mpq] {
    fun == :mpq*mpq->bool="(cmp($1,$2) == 0)";
    fun != :mpq*mpq->bool="(cmp($1,$2) != 0)";
  }
  instance Tord[mpq] {
    fun <  :mpq*mpq->bool="$1<$2";
    fun <= :mpq*mpq->bool="$1<=$2";
    fun >  :mpq*mpq->bool="$1>$2";
    fun >= :mpq*mpq->bool="$1>=$2";
  }
  instance Eq[mpf] {
    fun == :mpf*mpf->bool="(cmp($1,$2) == 0)";
    fun != :mpf*mpf->bool="(cmp($1,$2) != 0)";
  }
  instance Tord[mpf] {
    fun <  :mpf*mpf->bool="$1<$2";
    fun <= :mpf*mpf->bool="$1<=$2";
    fun >  :mpf*mpf->bool="$1>$2";
    fun >= :mpf*mpf->bool="$1>=$2";
  }
  instance Str[mpz] {
    fun str:mpz->string="#1($1).get_str(10)";
  }
  instance Str[mpq] {
    fun str:mpq->string="#1($1).get_str(10)";
  }

  instance Str[mpf] {
    fun str:mpf->string="flx::gmp::flx_mpf_get_str($1)" requires flx_mpf_get_str_h;
  }

}

open Eq[Gmp::mpz];
open Tord[Gmp::mpz];
open Str[Gmp::mpz];
open Eq[Gmp::mpq];
open Tord[Gmp::mpq];
open Str[Gmp::mpq];
open Eq[Gmp::mpf];
open Tord[Gmp::mpf];
open Str[Gmp::mpf];
Test code
//[gmp-01.flx]

//Check gmp

include "gnu/gmp";
open Gmp;

syntax gmp_syntax {
  x[ssetunion_pri] := x[ssetunion_pri] "/\" x[>ssetunion_pri] =>#
    "`(ast_apply ,_sr (lcm (ast_tuple ,_sr (,_1 ,_3))))" note "lcm";
  x[ssetintersection_pri] := x[ssetintersection_pri] "\/" x[>ssetintersection_pri] =>#
    "`(ast_apply ,_sr (gcd (ast_tuple ,_sr (,_1 ,_3))))" note "gcd";
}
open syntax gmp_syntax;

{
  val x:mpz = mpz_of_int 99;
  val y:mpz = mpz_of_int 7;
  print x; endl;
  print y; endl;
  print$ x + y; endl;
  print$ x - y; endl;
  print$ x * y; endl;
  print$ x / y; endl;
  print$ x % y; endl;

  print$ x == y; endl;
  print$ x != y; endl;
  print$ x < y; endl;
  print$ x <= y; endl;
  print$ x > y; endl;
  print$ x >= y; endl;

  print$ lcm (x,y); endl;
  print$ gcd (x,y); endl;
  print$ x /\ y; endl;
  print$ x \/ y; endl;
};
{
  val x:mpq = mpq_of_int 99;
  val y:mpq = mpq_of_int 7;
  print x; endl;
  print y; endl;
  print$ x + y; endl;
  print$ x - y; endl;
  print$ x * y; endl;
  print$ x / y; endl;
  print$ x == y; endl;
  print$ x != y; endl;
  print$ x < y; endl;
  print$ x <= y; endl;
  print$ x > y; endl;
  print$ x >= y; endl;
};
{
  val x:mpf = mpf_of_double 99.0;
  val y:mpf = mpf_of_double 7.0;
  print x; endl;
  print y; endl;
  print$ x + y; endl;
  print$ x - y; endl;
  print$ x * y; endl;
  print$ x / y; endl;
  print$ x == y; endl;
  print$ x != y; endl;
  print$ x < y; endl;
  print$ x <= y; endl;
  print$ x > y; endl;
  print$ x >= y; endl;
};

Expected results:

99
7
106
92
693
14
1
false
true
false
false
true
true
693
1
693
1
99
7
106
92
693
99/7
false
true
false
false
true
true
.99e2
.7e1
.106e3
.92e2
.693e3
.141428571428571428571e2
false
true
false
false
true
true

Package: src/packages/gsl.fdoc

GSL binding

key file
gsl.flx share/lib/gnu/gsl.flx
cblas.flx share/lib/blas.flx
gslffi.flx $PWD/gslffi.flx

A binding for GNU GSL

Licence for this file: GNU documentation licence NOT LGPL.

As at 4 Aug 2015 most of the functions are in here. But no types, constants, or macros. No links to docs. No docs. No test cases. No classes and no requirements clauses. Work in progress.

DO NOT EDIT YET. Most of this file is mechanically generated from over 400 pages which were painfully copied from my web browser by hand.

Binding generator

Run with flx gslffi ~/gslspec >binding.flx to create the binding. The directory gslspec contains hand copied text versions of the official GSL library documentation.

//[gslffi.flx]

// extract gsl functions from docs
var lre = RE2 "([0-9]+)(\\.([0-9]+)(\\.([0-9]+))?)? +(.*)";
if not lre.ok do
  println "BAD RE";
  assert false;
done

var dirname = System::argv 1;
var files = FileSystem::regfilesin (dirname,".*\\.txt");
match files do
| #Empty=> println$ "// NO FILES FOUND in " + dirname;
| files =>
    println$ "// Dirname " + dirname;
    //println$ "// Files: " + files.str;
    var sfiles = map (fun (file:string)=> find_index$ Filename::join(dirname, file))  files;
    sfiles = sort sfiles;
    iter (proc (file:string){ process_file$ (file.[to 8],file.[9 to]);}) sfiles;
done

fun find_index (filename:string) : string =
{
  var text = load filename;
  var lines = split(text,char "\n");
  var ready = false;
  for line in lines do
    if ready == true do
//println$ "Index line " + line;
      var result = Match (lre, line);
      match result do
      | #None =>
        if prefix(line, "Appendix D") do
          return ("D .00.00 "+filename);
        elif prefix(line,"D.") do
          return "D .0"+line.[2 to 3]+".00 "+filename;
        else
          println$ "BUG unexpected index format in " + line;
          assert false;
        done
      | Some v =>
//println$ "Got match "+ v.str;
//        println$ "Index=" + v.1 + "." + v.3 + "." + v.5 + " title=" + v.6;
        var s = f"%02d.%02d.%02d %S" (v.1.int,v.3.int,v.5.int,filename);
//println$ "CODE=" + s;
        return s;
      done
    done
    if prefix(line,"Next:") or prefix(line,"Previous") do ready = true; done;
  done
  println$ "BUG no index number";
  assert false;
  return ""; // hack
}

proc process_file (section:string, filename:string)
{
  println$ "// "+section+ " " + filename.[23 to -3];
  var text = load filename;
  var lines = split(text,char "\n");
  for line in lines do
    //println$ "// " + line;
    if prefix(line,"Function: ") do
      println$ "// " + line;
      var munged = line.[10 to];
      munged = search_and_replace (munged, "("," ( ");
      munged = search_and_replace (munged, ")"," ) ");
      munged = search_and_replace (munged, ","," , ");
      var words = filter (fun (s:string) => s != "" and s != "const") (munged,char " ").split;
      var parsed = parse_cfun words;
      var felix = format_fun parsed;
      println$ "  " + felix;
    done
  done
  println "//*****";
}

typedef type_t = list[string];
typedef arg_t = (aname:string, atype: type_t);
typedef fun_t = (fname:string, args:list[arg_t], ret:type_t);

fun parse_cfun (var w:list[string]) =
{
  var ret = list[string] ();
  var fname = "";
  var args = list[arg_t] ();
  var argt = list[string] ();

  grab_ret:>
    match w do
    | ty ! nm ! "(" ! tl =>
      ret = ret + ty;
      fname = nm;
      w = tl;
      goto grab_args;
    | nm ! "(" ! tl =>
      fname = nm;
      w = tl;
      goto grab_args;
    | x ! tl =>
      ret = ret + x;
      w = tl;
      goto grab_ret;
    | _ =>
println$ "BUG parsing return type: w="+w.str;
      assert false;
    done

  grab_args:>
    argt = list[string]();
    match w do
    | ")" ! tl => goto fin;
    | "void" ! ")" ! tl => goto fin;
    | _ => ;
    done
  grab_arg:>
    match w do
    | "..." ! ")" ! tl =>
      args = args + (aname="", atype=list[string] "...");
      goto fin;

    | ty ! nm ! "," ! tl =>
      if nm.[-2 to] == "[]" do
        argt = argt + ty + "[]";
        args = args + (aname = nm.[to -2],  atype = argt);
      else
        argt = argt + ty;
        args = args + (aname = nm,  atype = argt);
      done
      w = tl;
      goto grab_args;


    | ty ! nm ! ")" ! tl =>
      if nm.[-2 to] == "[]" do
        argt = argt + ty + "[]";
        args = args + (aname = nm.[to -2],  atype = argt);
      else
        argt = argt + ty;
        args = args + (aname = nm,  atype = argt);
      done
      w = tl;
      goto fin;

    | x ! tl =>
      argt = argt + x;
      w = tl;
      goto grab_arg;
    | _ =>
println$ "BUG parsing arguments w="+w.str;
     assert false;
    done
  fin:>
   return (fname=fname, args=args, ret=ret);
}

fun get_base_type (t:type_t) : string * type_t =>
  match t with
  | "unsigned" ! "long" ! "int" ! tl => "ulong", tl
  | "unsigned" ! "int" ! tl => "uint", tl
  | "enum" ! nm ! tl => nm,tl
  | "struct" ! nm ! tl => nm,tl
  | "size_t" ! tl => "size",tl
  | x ! tl => x, tl
;

fun format_type (t:type_t) : string =
{
  var base, rest = get_base_type t;
  match rest do
  | #Empty => return base;
  | "[]" ! #Empty => return "+" + base;
  | "*" ! #Empty => return "&" + base;
  | "**" ! #Empty => return "&&" + base;
  | _ =>
    println$ "BUG parsing type t="+t;
    assert false;
  done
  return ""; //Ugg!
}


fun format_args (args:list[arg_t]) =>
  match args with
  | #Empty => "unit"
  | _ => catmap " * " (fun (p:arg_t) => format_type p.atype) args
  endmatch
;

// fix for procs ..
fun format_fun (f: fun_t) =>
  if format_type f.ret == "void" then
  "proc " + f.fname + ": " + format_args f.args +
  " = '" + f.fname + "($a);';"
  else
  "fun " + f.fname + ": " +
  format_args f.args +
  " -> " + format_type f.ret +
  " = '" + f.fname + "($a)';"
  endif
;

Generated binding

For GSL.

//[gsl.flx]

// TEMPORARY HACKS: type names
ctypes
  gsl_error_handler_t,
  gsl_complex,
  gsl_poly_complex_workspace,
  gsl_complex_packed_ptr,
  gsl_mode_t,
  gsl_sf_result,
  gsl_sf_result_e10,
  gsl_sf_mathieu_workspace,
  gsl_block,
  gsl_vector,
  gsl_vector_view,
  gsl_vector_const_view,
  gsl_vector_complex,
  gsl_matrix,
  gsl_matrix_view,
  gsl_matrix_const_view,
  gsl_permutation,
  gsl_combination,
  gsl_multiset,
  gsl_comparison_fn_t,
  gsl_vector_float,
  gsl_vector_complex_float,
  gsl_complex_float,
  CBLAS_INDEX_t,
  CBLAS_TRANSPOSE_t,
  gsl_matrix_float,
  gsl_matrix_complex_float,
  gsl_matrix_complex,
  CBLAS_UPLO_t,
  CBLAS_DIAG_t,
  CBLAS_SIDE_t,
  gsl_eigen_symm_workspace,
  gsl_eigen_symmv_workspace,
  gsl_eigen_herm_workspace,
  gsl_eigen_hermv_workspace,
  gsl_eigen_nonsymm_workspace,
  gsl_eigen_nonsymmv_workspace,
  gsl_eigen_gensymm_workspace,
  gsl_eigen_gensymmv_workspace,
  gsl_eigen_genherm_workspace,
  gsl_eigen_genhermv_workspace,
  gsl_eigen_gen_workspace,
  gsl_eigen_genv_workspace,
  gsl_eigen_sort_t,
  gsl_complex_packed_array,
  gsl_fft_direction,
  gsl_fft_complex_wavetable,
  gsl_fft_complex_workspace,
  gsl_fft_real_wavetable,
  gsl_fft_halfcomplex_wavetable,
  gsl_fft_real_workspace,
  gsl_function,
  gsl_integration_workspace,
  gsl_integration_qaws_table,
  gsl_integration_qawo_enum,
  gsl_integration_qawo_table,
  gsl_integration_cquad_workspace,
  gsl_integration_glfixed_table,
  gsl_rng_type,
  gsl_rng,
  gsl_qrng_type,
  gsl_qrng,
  gsl_histogram,
  gsl_histogram_pdf,
  gsl_histogram2d,
  gsl_histogram2d_pdf,
  gsl_ntuple,
  gsl_ntuple_value_fn,
  gsl_ntuple_select_fn,
  gsl_monte_plain_state,
  gsl_monte_function,
  gsl_monte_miser_state,
  gsl_monte_miser_params,
  gsl_monte_vegas_state,
  gsl_monte_vegas_params,
  gsl_siman_Efunc_t,
  gsl_siman_step_t,
  gsl_siman_copy_construct_t,
  gsl_siman_destroy_t,
  gsl_siman_metric_t,
  gsl_siman_print_t,
  gsl_siman_copy_t,
  gsl_siman_params_t,
  gsl_odeiv2_step_type,
  gsl_odeiv2_step,
  gsl_odeiv2_driver,
  gsl_odeiv2_system,
  gsl_odeiv2_control,
  gsl_odeiv2_control_type,
  gsl_odeiv2_evolve,
  gsl_interp_type,
  gsl_interp,
  gsl_interp_accel,
  gsl_spline,
  gsl_cheb_series,
  gsl_sum_levin_u_workspace,
  gsl_sum_levin_utrunc_workspace,
  gsl_wavelet_type,
  gsl_wavelet,
  gsl_wavelet_workspace,
  gsl_wavelet_direction,
  gsl_dht,
  gsl_root_fsolver_type,
  gsl_root_fsolver,
  gsl_root_fdfsolver_type,
  gsl_root_fdfsolver,
  gsl_function_fdf,
  gsl_min_fminimizer_type,
  gsl_min_fminimizer,
  gsl_multiroot_fsolver_type,
  gsl_multiroot_fsolver,
  gsl_multiroot_fdfsolver_type,
  gsl_multiroot_fdfsolver,
  gsl_multiroot_function,
  gsl_multiroot_function_fdf,
  gsl_multimin_fdfminimizer_type,
  gsl_multimin_fdfminimizer,
  gsl_multimin_fminimizer_type,
  gsl_multimin_fminimizer,
  gsl_multimin_function_fdf,
  gsl_multimin_function,
  gsl_multifit_linear_workspace,
  gsl_multifit_robust_type,
  gsl_multifit_robust_workspace,
  gsl_multifit_robust_stats,
  gsl_multifit_fsolver_type,
  gsl_multifit_fsolver,
  gsl_multifit_fdfsolver_type,
  gsl_multifit_fdfsolver,
  gsl_multifit_function,
  gsl_multifit_function_fdf,
  gsl_bspline_workspace,
  gsl_bspline_deriv_workspace
;

// Dirname /Users/skaller/gslspec
// 03.02.00 GSL-Error-Codes.
// Function: const char * gsl_strerror (const int gsl_errno)
  fun gsl_strerror: int -> &char = 'gsl_strerror($a)';
//*****
// 03.03.00 GSL-Error-Handlers.
// Function: gsl_error_handler_t * gsl_set_error_handler (gsl_error_handler_t * new_handler)
  fun gsl_set_error_handler: &gsl_error_handler_t -> &gsl_error_handler_t = 'gsl_set_error_handler($a)';
// Function: gsl_error_handler_t * gsl_set_error_handler_off ()
  fun gsl_set_error_handler_off: unit -> &gsl_error_handler_t = 'gsl_set_error_handler_off($a)';
//*****
// 03.04.00 GSL-Error-Reporting.
//*****
// 04.01.00 Mathematical-Constants.
//*****
// 04.02.00 Infinities-and-Not-a-number.
// Function: int gsl_isnan (const double x)
  fun gsl_isnan: double -> int = 'gsl_isnan($a)';
// Function: int gsl_isinf (const double x)
  fun gsl_isinf: double -> int = 'gsl_isinf($a)';
// Function: int gsl_finite (const double x)
  fun gsl_finite: double -> int = 'gsl_finite($a)';
//*****
// 04.03.00 Elementary-Functions.
// Function: double gsl_log1p (const double x)
  fun gsl_log1p: double -> double = 'gsl_log1p($a)';
// Function: double gsl_expm1 (const double x)
  fun gsl_expm1: double -> double = 'gsl_expm1($a)';
// Function: double gsl_hypot (const double x, const double y)
  fun gsl_hypot: double * double -> double = 'gsl_hypot($a)';
// Function: double gsl_hypot3 (const double x, const double y, const double z)
  fun gsl_hypot3: double * double * double -> double = 'gsl_hypot3($a)';
// Function: double gsl_acosh (const double x)
  fun gsl_acosh: double -> double = 'gsl_acosh($a)';
// Function: double gsl_asinh (const double x)
  fun gsl_asinh: double -> double = 'gsl_asinh($a)';
// Function: double gsl_atanh (const double x)
  fun gsl_atanh: double -> double = 'gsl_atanh($a)';
// Function: double gsl_ldexp (double x, int e)
  fun gsl_ldexp: double * int -> double = 'gsl_ldexp($a)';
// Function: double gsl_frexp (double x, int * e)
  fun gsl_frexp: double * &int -> double = 'gsl_frexp($a)';
//*****
// 04.04.00 Small-integer-powers.
// Function: double gsl_pow_int (double x, int n)
  fun gsl_pow_int: double * int -> double = 'gsl_pow_int($a)';
// Function: double gsl_pow_uint (double x, unsigned int n)
  fun gsl_pow_uint: double * uint -> double = 'gsl_pow_uint($a)';
// Function: double gsl_pow_2 (const double x)
  fun gsl_pow_2: double -> double = 'gsl_pow_2($a)';
// Function: double gsl_pow_3 (const double x)
  fun gsl_pow_3: double -> double = 'gsl_pow_3($a)';
// Function: double gsl_pow_4 (const double x)
  fun gsl_pow_4: double -> double = 'gsl_pow_4($a)';
// Function: double gsl_pow_5 (const double x)
  fun gsl_pow_5: double -> double = 'gsl_pow_5($a)';
// Function: double gsl_pow_6 (const double x)
  fun gsl_pow_6: double -> double = 'gsl_pow_6($a)';
// Function: double gsl_pow_7 (const double x)
  fun gsl_pow_7: double -> double = 'gsl_pow_7($a)';
// Function: double gsl_pow_8 (const double x)
  fun gsl_pow_8: double -> double = 'gsl_pow_8($a)';
// Function: double gsl_pow_9 (const double x)
  fun gsl_pow_9: double -> double = 'gsl_pow_9($a)';
//*****
// 04.05.00 Testing-the-Sign-of-Numbers.
//*****
// 04.06.00 Maximum-and-Minimum-functions.
//*****
// 04.06.00 Testing-for-Odd-and-Even-Numbers.
//*****
// 04.08.00 Approximate-Comparison-of_Floating-Point-Numbers.
// Function: int gsl_fcmp (double x, double y, double epsilon)
  fun gsl_fcmp: double * double * double -> int = 'gsl_fcmp($a)';
//*****
// 05.01.00 Representation-of-complex-numbers.
// Function: gsl_complex gsl_complex_rect (double x, double y)
  fun gsl_complex_rect: double * double -> gsl_complex = 'gsl_complex_rect($a)';
// Function: gsl_complex gsl_complex_polar (double r, double theta)
  fun gsl_complex_polar: double * double -> gsl_complex = 'gsl_complex_polar($a)';
//*****
// 05.02.00 Properties-of-complex-numbers.
// Function: double gsl_complex_arg (gsl_complex z)
  fun gsl_complex_arg: gsl_complex -> double = 'gsl_complex_arg($a)';
// Function: double gsl_complex_abs (gsl_complex z)
  fun gsl_complex_abs: gsl_complex -> double = 'gsl_complex_abs($a)';
// Function: double gsl_complex_abs2 (gsl_complex z)
  fun gsl_complex_abs2: gsl_complex -> double = 'gsl_complex_abs2($a)';
// Function: double gsl_complex_logabs (gsl_complex z)
  fun gsl_complex_logabs: gsl_complex -> double = 'gsl_complex_logabs($a)';
//*****
// 05.03.00 Complex-arithmetic-operators.
// Function: gsl_complex gsl_complex_add (gsl_complex a, gsl_complex b)
  fun gsl_complex_add: gsl_complex * gsl_complex -> gsl_complex = 'gsl_complex_add($a)';
// Function: gsl_complex gsl_complex_sub (gsl_complex a, gsl_complex b)
  fun gsl_complex_sub: gsl_complex * gsl_complex -> gsl_complex = 'gsl_complex_sub($a)';
// Function: gsl_complex gsl_complex_mul (gsl_complex a, gsl_complex b)
  fun gsl_complex_mul: gsl_complex * gsl_complex -> gsl_complex = 'gsl_complex_mul($a)';
// Function: gsl_complex gsl_complex_div (gsl_complex a, gsl_complex b)
  fun gsl_complex_div: gsl_complex * gsl_complex -> gsl_complex = 'gsl_complex_div($a)';
// Function: gsl_complex gsl_complex_add_real (gsl_complex a, double x)
  fun gsl_complex_add_real: gsl_complex * double -> gsl_complex = 'gsl_complex_add_real($a)';
// Function: gsl_complex gsl_complex_sub_real (gsl_complex a, double x)
  fun gsl_complex_sub_real: gsl_complex * double -> gsl_complex = 'gsl_complex_sub_real($a)';
// Function: gsl_complex gsl_complex_mul_real (gsl_complex a, double x)
  fun gsl_complex_mul_real: gsl_complex * double -> gsl_complex = 'gsl_complex_mul_real($a)';
// Function: gsl_complex gsl_complex_div_real (gsl_complex a, double x)
  fun gsl_complex_div_real: gsl_complex * double -> gsl_complex = 'gsl_complex_div_real($a)';
// Function: gsl_complex gsl_complex_add_imag (gsl_complex a, double y)
  fun gsl_complex_add_imag: gsl_complex * double -> gsl_complex = 'gsl_complex_add_imag($a)';
// Function: gsl_complex gsl_complex_sub_imag (gsl_complex a, double y)
  fun gsl_complex_sub_imag: gsl_complex * double -> gsl_complex = 'gsl_complex_sub_imag($a)';
// Function: gsl_complex gsl_complex_mul_imag (gsl_complex a, double y)
  fun gsl_complex_mul_imag: gsl_complex * double -> gsl_complex = 'gsl_complex_mul_imag($a)';
// Function: gsl_complex gsl_complex_div_imag (gsl_complex a, double y)
  fun gsl_complex_div_imag: gsl_complex * double -> gsl_complex = 'gsl_complex_div_imag($a)';
// Function: gsl_complex gsl_complex_conjugate (gsl_complex z)
  fun gsl_complex_conjugate: gsl_complex -> gsl_complex = 'gsl_complex_conjugate($a)';
// Function: gsl_complex gsl_complex_inverse (gsl_complex z)
  fun gsl_complex_inverse: gsl_complex -> gsl_complex = 'gsl_complex_inverse($a)';
// Function: gsl_complex gsl_complex_negative (gsl_complex z)
  fun gsl_complex_negative: gsl_complex -> gsl_complex = 'gsl_complex_negative($a)';
//*****
// 05.04.00 Elementary-Complex-Function.
// Function: gsl_complex gsl_complex_sqrt (gsl_complex z)
  fun gsl_complex_sqrt: gsl_complex -> gsl_complex = 'gsl_complex_sqrt($a)';
// Function: gsl_complex gsl_complex_sqrt_real (double x)
  fun gsl_complex_sqrt_real: double -> gsl_complex = 'gsl_complex_sqrt_real($a)';
// Function: gsl_complex gsl_complex_pow (gsl_complex z, gsl_complex a)
  fun gsl_complex_pow: gsl_complex * gsl_complex -> gsl_complex = 'gsl_complex_pow($a)';
// Function: gsl_complex gsl_complex_pow_real (gsl_complex z, double x)
  fun gsl_complex_pow_real: gsl_complex * double -> gsl_complex = 'gsl_complex_pow_real($a)';
// Function: gsl_complex gsl_complex_exp (gsl_complex z)
  fun gsl_complex_exp: gsl_complex -> gsl_complex = 'gsl_complex_exp($a)';
// Function: gsl_complex gsl_complex_log (gsl_complex z)
  fun gsl_complex_log: gsl_complex -> gsl_complex = 'gsl_complex_log($a)';
// Function: gsl_complex gsl_complex_log10 (gsl_complex z)
  fun gsl_complex_log10: gsl_complex -> gsl_complex = 'gsl_complex_log10($a)';
// Function: gsl_complex gsl_complex_log_b (gsl_complex z, gsl_complex b)
  fun gsl_complex_log_b: gsl_complex * gsl_complex -> gsl_complex = 'gsl_complex_log_b($a)';
//*****
// 05.05.00 Complex-Trigonometric-Functions.
// Function: gsl_complex gsl_complex_sin (gsl_complex z)
  fun gsl_complex_sin: gsl_complex -> gsl_complex = 'gsl_complex_sin($a)';
// Function: gsl_complex gsl_complex_cos (gsl_complex z)
  fun gsl_complex_cos: gsl_complex -> gsl_complex = 'gsl_complex_cos($a)';
// Function: gsl_complex gsl_complex_tan (gsl_complex z)
  fun gsl_complex_tan: gsl_complex -> gsl_complex = 'gsl_complex_tan($a)';
// Function: gsl_complex gsl_complex_sec (gsl_complex z)
  fun gsl_complex_sec: gsl_complex -> gsl_complex = 'gsl_complex_sec($a)';
// Function: gsl_complex gsl_complex_csc (gsl_complex z)
  fun gsl_complex_csc: gsl_complex -> gsl_complex = 'gsl_complex_csc($a)';
// Function: gsl_complex gsl_complex_cot (gsl_complex z)
  fun gsl_complex_cot: gsl_complex -> gsl_complex = 'gsl_complex_cot($a)';
//*****
// 05.06.00 Inverse-Complex-Trigonometric-Functions.
// Function: gsl_complex gsl_complex_arcsin (gsl_complex z)
  fun gsl_complex_arcsin: gsl_complex -> gsl_complex = 'gsl_complex_arcsin($a)';
// Function: gsl_complex gsl_complex_arcsin_real (double z)
  fun gsl_complex_arcsin_real: double -> gsl_complex = 'gsl_complex_arcsin_real($a)';
// Function: gsl_complex gsl_complex_arccos (gsl_complex z)
  fun gsl_complex_arccos: gsl_complex -> gsl_complex = 'gsl_complex_arccos($a)';
// Function: gsl_complex gsl_complex_arccos_real (double z)
  fun gsl_complex_arccos_real: double -> gsl_complex = 'gsl_complex_arccos_real($a)';
// Function: gsl_complex gsl_complex_arctan (gsl_complex z)
  fun gsl_complex_arctan: gsl_complex -> gsl_complex = 'gsl_complex_arctan($a)';
// Function: gsl_complex gsl_complex_arcsec (gsl_complex z)
  fun gsl_complex_arcsec: gsl_complex -> gsl_complex = 'gsl_complex_arcsec($a)';
// Function: gsl_complex gsl_complex_arcsec_real (double z)
  fun gsl_complex_arcsec_real: double -> gsl_complex = 'gsl_complex_arcsec_real($a)';
// Function: gsl_complex gsl_complex_arccsc (gsl_complex z)
  fun gsl_complex_arccsc: gsl_complex -> gsl_complex = 'gsl_complex_arccsc($a)';
// Function: gsl_complex gsl_complex_arccsc_real (double z)
  fun gsl_complex_arccsc_real: double -> gsl_complex = 'gsl_complex_arccsc_real($a)';
// Function: gsl_complex gsl_complex_arccot (gsl_complex z)
  fun gsl_complex_arccot: gsl_complex -> gsl_complex = 'gsl_complex_arccot($a)';
//*****
// 05.07.00 Complex-Hyperbolic-Functions.
// Function: gsl_complex gsl_complex_sinh (gsl_complex z)
  fun gsl_complex_sinh: gsl_complex -> gsl_complex = 'gsl_complex_sinh($a)';
// Function: gsl_complex gsl_complex_cosh (gsl_complex z)
  fun gsl_complex_cosh: gsl_complex -> gsl_complex = 'gsl_complex_cosh($a)';
// Function: gsl_complex gsl_complex_tanh (gsl_complex z)
  fun gsl_complex_tanh: gsl_complex -> gsl_complex = 'gsl_complex_tanh($a)';
// Function: gsl_complex gsl_complex_sech (gsl_complex z)
  fun gsl_complex_sech: gsl_complex -> gsl_complex = 'gsl_complex_sech($a)';
// Function: gsl_complex gsl_complex_csch (gsl_complex z)
  fun gsl_complex_csch: gsl_complex -> gsl_complex = 'gsl_complex_csch($a)';
// Function: gsl_complex gsl_complex_coth (gsl_complex z)
  fun gsl_complex_coth: gsl_complex -> gsl_complex = 'gsl_complex_coth($a)';
//*****
// 05.08.00 Inverse-Complex-Hyperbolic-Functions.
// Function: gsl_complex gsl_complex_arcsinh (gsl_complex z)
  fun gsl_complex_arcsinh: gsl_complex -> gsl_complex = 'gsl_complex_arcsinh($a)';
// Function: gsl_complex gsl_complex_arccosh (gsl_complex z)
  fun gsl_complex_arccosh: gsl_complex -> gsl_complex = 'gsl_complex_arccosh($a)';
// Function: gsl_complex gsl_complex_arccosh_real (double z)
  fun gsl_complex_arccosh_real: double -> gsl_complex = 'gsl_complex_arccosh_real($a)';
// Function: gsl_complex gsl_complex_arctanh (gsl_complex z)
  fun gsl_complex_arctanh: gsl_complex -> gsl_complex = 'gsl_complex_arctanh($a)';
// Function: gsl_complex gsl_complex_arctanh_real (double z)
  fun gsl_complex_arctanh_real: double -> gsl_complex = 'gsl_complex_arctanh_real($a)';
// Function: gsl_complex gsl_complex_arcsech (gsl_complex z)
  fun gsl_complex_arcsech: gsl_complex -> gsl_complex = 'gsl_complex_arcsech($a)';
// Function: gsl_complex gsl_complex_arccsch (gsl_complex z)
  fun gsl_complex_arccsch: gsl_complex -> gsl_complex = 'gsl_complex_arccsch($a)';
// Function: gsl_complex gsl_complex_arccoth (gsl_complex z)
  fun gsl_complex_arccoth: gsl_complex -> gsl_complex = 'gsl_complex_arccoth($a)';
//*****
// 06.01.00 Polynomial-Evaluation.
// Function: double gsl_poly_eval (const double c[], const int len, const double x)
  fun gsl_poly_eval: +double * int * double -> double = 'gsl_poly_eval($a)';
// Function: gsl_complex gsl_poly_complex_eval (const double c[], const int len, const gsl_complex z)
  fun gsl_poly_complex_eval: +double * int * gsl_complex -> gsl_complex = 'gsl_poly_complex_eval($a)';
// Function: gsl_complex gsl_complex_poly_complex_eval (const gsl_complex c[], const int len, const gsl_complex z)
  fun gsl_complex_poly_complex_eval: +gsl_complex * int * gsl_complex -> gsl_complex = 'gsl_complex_poly_complex_eval($a)';
// Function: int gsl_poly_eval_derivs (const double c[], const size_t lenc, const double x, double res[], const size_t lenres)
  fun gsl_poly_eval_derivs: +double * size * double * +double * size -> int = 'gsl_poly_eval_derivs($a)';
//*****
// 06.02.00 Divided-Difference-Representation-of-Polynomials.
// Function: int gsl_poly_dd_init (double dd[], const double xa[], const double ya[], size_t size)
  fun gsl_poly_dd_init: +double * +double * +double * size -> int = 'gsl_poly_dd_init($a)';
// Function: double gsl_poly_dd_eval (const double dd[], const double xa[], const size_t size, const double x)
  fun gsl_poly_dd_eval: +double * +double * size * double -> double = 'gsl_poly_dd_eval($a)';
// Function: int gsl_poly_dd_taylor (double c[], double xp, const double dd[], const double xa[], size_t size, double w[])
  fun gsl_poly_dd_taylor: +double * double * +double * +double * size * +double -> int = 'gsl_poly_dd_taylor($a)';
// Function: int gsl_poly_dd_hermite_init (double dd[], double za[], const double xa[], const double ya[], const double dya[], const size_t size)
  fun gsl_poly_dd_hermite_init: +double * +double * +double * +double * +double * size -> int = 'gsl_poly_dd_hermite_init($a)';
//*****
// 06.03.00 Quadratic-Equations.
// Function: int gsl_poly_solve_quadratic (double a, double b, double c, double * x0, double * x1)
  fun gsl_poly_solve_quadratic: double * double * double * &double * &double -> int = 'gsl_poly_solve_quadratic($a)';
// Function: int gsl_poly_complex_solve_quadratic (double a, double b, double c, gsl_complex * z0, gsl_complex * z1)
  fun gsl_poly_complex_solve_quadratic: double * double * double * &gsl_complex * &gsl_complex -> int = 'gsl_poly_complex_solve_quadratic($a)';
//*****
// 06.04.00 Cubic-Equations.
// Function: int gsl_poly_solve_cubic (double a, double b, double c, double * x0, double * x1, double * x2)
  fun gsl_poly_solve_cubic: double * double * double * &double * &double * &double -> int = 'gsl_poly_solve_cubic($a)';
// Function: int gsl_poly_complex_solve_cubic (double a, double b, double c, gsl_complex * z0, gsl_complex * z1, gsl_complex * z2)
  fun gsl_poly_complex_solve_cubic: double * double * double * &gsl_complex * &gsl_complex * &gsl_complex -> int = 'gsl_poly_complex_solve_cubic($a)';
//*****
// 06.05.00 General-Polynomial-Equations.
// Function: gsl_poly_complex_workspace * gsl_poly_complex_workspace_alloc (size_t n)
  fun gsl_poly_complex_workspace_alloc: size -> &gsl_poly_complex_workspace = 'gsl_poly_complex_workspace_alloc($a)';
// Function: void gsl_poly_complex_workspace_free (gsl_poly_complex_workspace * w)
  proc gsl_poly_complex_workspace_free: &gsl_poly_complex_workspace = 'gsl_poly_complex_workspace_free($a);';
// Function: int gsl_poly_complex_solve (const double * a, size_t n, gsl_poly_complex_workspace * w, gsl_complex_packed_ptr z)
  fun gsl_poly_complex_solve: &double * size * &gsl_poly_complex_workspace * gsl_complex_packed_ptr -> int = 'gsl_poly_complex_solve($a)';
//*****
// 07.02.00 The-gsl_sf_result-struct.
//*****
// 07.03.00 Special-Function-Modes.
//*****
// 07.04.00 Airy-Functions-and-Derivatives.
//*****
// 07.04.02 Derivatives-of-Airy-Functions.
// Function: double gsl_sf_airy_Ai_deriv (double x, gsl_mode_t mode)
  fun gsl_sf_airy_Ai_deriv: double * gsl_mode_t -> double = 'gsl_sf_airy_Ai_deriv($a)';
// Function: int gsl_sf_airy_Ai_deriv_e (double x, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_airy_Ai_deriv_e: double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_airy_Ai_deriv_e($a)';
// Function: double gsl_sf_airy_Bi_deriv (double x, gsl_mode_t mode)
  fun gsl_sf_airy_Bi_deriv: double * gsl_mode_t -> double = 'gsl_sf_airy_Bi_deriv($a)';
// Function: int gsl_sf_airy_Bi_deriv_e (double x, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_airy_Bi_deriv_e: double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_airy_Bi_deriv_e($a)';
// Function: double gsl_sf_airy_Ai_deriv_scaled (double x, gsl_mode_t mode)
  fun gsl_sf_airy_Ai_deriv_scaled: double * gsl_mode_t -> double = 'gsl_sf_airy_Ai_deriv_scaled($a)';
// Function: int gsl_sf_airy_Ai_deriv_scaled_e (double x, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_airy_Ai_deriv_scaled_e: double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_airy_Ai_deriv_scaled_e($a)';
// Function: double gsl_sf_airy_Bi_deriv_scaled (double x, gsl_mode_t mode)
  fun gsl_sf_airy_Bi_deriv_scaled: double * gsl_mode_t -> double = 'gsl_sf_airy_Bi_deriv_scaled($a)';
// Function: int gsl_sf_airy_Bi_deriv_scaled_e (double x, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_airy_Bi_deriv_scaled_e: double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_airy_Bi_deriv_scaled_e($a)';
//*****
// 07.04.03 Zeros-of-Airy-Functions.
// Function: double gsl_sf_airy_zero_Ai (unsigned int s)
  fun gsl_sf_airy_zero_Ai: uint -> double = 'gsl_sf_airy_zero_Ai($a)';
// Function: int gsl_sf_airy_zero_Ai_e (unsigned int s, gsl_sf_result * result)
  fun gsl_sf_airy_zero_Ai_e: uint * &gsl_sf_result -> int = 'gsl_sf_airy_zero_Ai_e($a)';
// Function: double gsl_sf_airy_zero_Bi (unsigned int s)
  fun gsl_sf_airy_zero_Bi: uint -> double = 'gsl_sf_airy_zero_Bi($a)';
// Function: int gsl_sf_airy_zero_Bi_e (unsigned int s, gsl_sf_result * result)
  fun gsl_sf_airy_zero_Bi_e: uint * &gsl_sf_result -> int = 'gsl_sf_airy_zero_Bi_e($a)';
//*****
// 07.04.03 Zeros-of-Derivatives-of-Airy-Functions.
// Function: double gsl_sf_airy_zero_Ai (unsigned int s)
  fun gsl_sf_airy_zero_Ai: uint -> double = 'gsl_sf_airy_zero_Ai($a)';
// Function: int gsl_sf_airy_zero_Ai_e (unsigned int s, gsl_sf_result * result)
  fun gsl_sf_airy_zero_Ai_e: uint * &gsl_sf_result -> int = 'gsl_sf_airy_zero_Ai_e($a)';
// Function: double gsl_sf_airy_zero_Bi (unsigned int s)
  fun gsl_sf_airy_zero_Bi: uint -> double = 'gsl_sf_airy_zero_Bi($a)';
// Function: int gsl_sf_airy_zero_Bi_e (unsigned int s, gsl_sf_result * result)
  fun gsl_sf_airy_zero_Bi_e: uint * &gsl_sf_result -> int = 'gsl_sf_airy_zero_Bi_e($a)';
//*****
// 07.05.00 Bessel-Functions.
//*****
// 07.05.01 Regular-Cylindrical-Bessel-Functions.
// Function: double gsl_sf_bessel_J0 (double x)
  fun gsl_sf_bessel_J0: double -> double = 'gsl_sf_bessel_J0($a)';
// Function: int gsl_sf_bessel_J0_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_J0_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_J0_e($a)';
// Function: double gsl_sf_bessel_J1 (double x)
  fun gsl_sf_bessel_J1: double -> double = 'gsl_sf_bessel_J1($a)';
// Function: int gsl_sf_bessel_J1_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_J1_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_J1_e($a)';
// Function: double gsl_sf_bessel_Jn (int n, double x)
  fun gsl_sf_bessel_Jn: int * double -> double = 'gsl_sf_bessel_Jn($a)';
// Function: int gsl_sf_bessel_Jn_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Jn_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Jn_e($a)';
// Function: int gsl_sf_bessel_Jn_array (int nmin, int nmax, double x, double result_array[])
  fun gsl_sf_bessel_Jn_array: int * int * double * +double -> int = 'gsl_sf_bessel_Jn_array($a)';
//*****
// 07.05.02 Irregular-Cylindrical-Bessel-Functions.
// Function: double gsl_sf_bessel_Y0 (double x)
  fun gsl_sf_bessel_Y0: double -> double = 'gsl_sf_bessel_Y0($a)';
// Function: int gsl_sf_bessel_Y0_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Y0_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_Y0_e($a)';
// Function: double gsl_sf_bessel_Y1 (double x)
  fun gsl_sf_bessel_Y1: double -> double = 'gsl_sf_bessel_Y1($a)';
// Function: int gsl_sf_bessel_Y1_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Y1_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_Y1_e($a)';
// Function: double gsl_sf_bessel_Yn (int n, double x)
  fun gsl_sf_bessel_Yn: int * double -> double = 'gsl_sf_bessel_Yn($a)';
// Function: int gsl_sf_bessel_Yn_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Yn_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Yn_e($a)';
// Function: int gsl_sf_bessel_Yn_array (int nmin, int nmax, double x, double result_array[])
  fun gsl_sf_bessel_Yn_array: int * int * double * +double -> int = 'gsl_sf_bessel_Yn_array($a)';
//*****
// 07.05.03 Regular-Modified-Cylindrical-Bessel-Functions.
// Function: double gsl_sf_bessel_I0 (double x)
  fun gsl_sf_bessel_I0: double -> double = 'gsl_sf_bessel_I0($a)';
// Function: int gsl_sf_bessel_I0_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_I0_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_I0_e($a)';
// Function: double gsl_sf_bessel_I1 (double x)
  fun gsl_sf_bessel_I1: double -> double = 'gsl_sf_bessel_I1($a)';
// Function: int gsl_sf_bessel_I1_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_I1_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_I1_e($a)';
// Function: double gsl_sf_bessel_In (int n, double x)
  fun gsl_sf_bessel_In: int * double -> double = 'gsl_sf_bessel_In($a)';
// Function: int gsl_sf_bessel_In_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_In_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_In_e($a)';
// Function: int gsl_sf_bessel_In_array (int nmin, int nmax, double x, double result_array[])
  fun gsl_sf_bessel_In_array: int * int * double * +double -> int = 'gsl_sf_bessel_In_array($a)';
// Function: double gsl_sf_bessel_I0_scaled (double x)
  fun gsl_sf_bessel_I0_scaled: double -> double = 'gsl_sf_bessel_I0_scaled($a)';
// Function: int gsl_sf_bessel_I0_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_I0_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_I0_scaled_e($a)';
// Function: double gsl_sf_bessel_I1_scaled (double x)
  fun gsl_sf_bessel_I1_scaled: double -> double = 'gsl_sf_bessel_I1_scaled($a)';
// Function: int gsl_sf_bessel_I1_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_I1_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_I1_scaled_e($a)';
// Function: double gsl_sf_bessel_In_scaled (int n, double x)
  fun gsl_sf_bessel_In_scaled: int * double -> double = 'gsl_sf_bessel_In_scaled($a)';
// Function: int gsl_sf_bessel_In_scaled_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_In_scaled_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_In_scaled_e($a)';
// Function: int gsl_sf_bessel_In_scaled_array (int nmin, int nmax, double x, double result_array[])
  fun gsl_sf_bessel_In_scaled_array: int * int * double * +double -> int = 'gsl_sf_bessel_In_scaled_array($a)';
//*****
// 07.05.04 Irregular-Modified-Cylindrical-Bessel-Functions.
// Function: double gsl_sf_bessel_K0 (double x)
  fun gsl_sf_bessel_K0: double -> double = 'gsl_sf_bessel_K0($a)';
// Function: int gsl_sf_bessel_K0_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_K0_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_K0_e($a)';
// Function: double gsl_sf_bessel_K1 (double x)
  fun gsl_sf_bessel_K1: double -> double = 'gsl_sf_bessel_K1($a)';
// Function: int gsl_sf_bessel_K1_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_K1_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_K1_e($a)';
// Function: double gsl_sf_bessel_Kn (int n, double x)
  fun gsl_sf_bessel_Kn: int * double -> double = 'gsl_sf_bessel_Kn($a)';
// Function: int gsl_sf_bessel_Kn_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Kn_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Kn_e($a)';
// Function: int gsl_sf_bessel_Kn_array (int nmin, int nmax, double x, double result_array[])
  fun gsl_sf_bessel_Kn_array: int * int * double * +double -> int = 'gsl_sf_bessel_Kn_array($a)';
// Function: double gsl_sf_bessel_K0_scaled (double x)
  fun gsl_sf_bessel_K0_scaled: double -> double = 'gsl_sf_bessel_K0_scaled($a)';
// Function: int gsl_sf_bessel_K0_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_K0_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_K0_scaled_e($a)';
// Function: double gsl_sf_bessel_K1_scaled (double x)
  fun gsl_sf_bessel_K1_scaled: double -> double = 'gsl_sf_bessel_K1_scaled($a)';
// Function: int gsl_sf_bessel_K1_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_K1_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_K1_scaled_e($a)';
// Function: double gsl_sf_bessel_Kn_scaled (int n, double x)
  fun gsl_sf_bessel_Kn_scaled: int * double -> double = 'gsl_sf_bessel_Kn_scaled($a)';
// Function: int gsl_sf_bessel_Kn_scaled_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Kn_scaled_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Kn_scaled_e($a)';
// Function: int gsl_sf_bessel_Kn_scaled_array (int nmin, int nmax, double x, double result_array[])
  fun gsl_sf_bessel_Kn_scaled_array: int * int * double * +double -> int = 'gsl_sf_bessel_Kn_scaled_array($a)';
//*****
// 07.05.05 Regular-Spherical-Bessel-Functions.
// Function: double gsl_sf_bessel_j0 (double x)
  fun gsl_sf_bessel_j0: double -> double = 'gsl_sf_bessel_j0($a)';
// Function: int gsl_sf_bessel_j0_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_j0_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_j0_e($a)';
// Function: double gsl_sf_bessel_j1 (double x)
  fun gsl_sf_bessel_j1: double -> double = 'gsl_sf_bessel_j1($a)';
// Function: int gsl_sf_bessel_j1_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_j1_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_j1_e($a)';
// Function: double gsl_sf_bessel_j2 (double x)
  fun gsl_sf_bessel_j2: double -> double = 'gsl_sf_bessel_j2($a)';
// Function: int gsl_sf_bessel_j2_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_j2_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_j2_e($a)';
// Function: double gsl_sf_bessel_jl (int l, double x)
  fun gsl_sf_bessel_jl: int * double -> double = 'gsl_sf_bessel_jl($a)';
// Function: int gsl_sf_bessel_jl_e (int l, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_jl_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_jl_e($a)';
// Function: int gsl_sf_bessel_jl_array (int lmax, double x, double result_array[])
  fun gsl_sf_bessel_jl_array: int * double * +double -> int = 'gsl_sf_bessel_jl_array($a)';
// Function: int gsl_sf_bessel_jl_steed_array (int lmax, double x, double * result_array)
  fun gsl_sf_bessel_jl_steed_array: int * double * &double -> int = 'gsl_sf_bessel_jl_steed_array($a)';
//*****
// 07.05.06 Irregular-Spherical-Bessel-Functions.
// Function: double gsl_sf_bessel_y0 (double x)
  fun gsl_sf_bessel_y0: double -> double = 'gsl_sf_bessel_y0($a)';
// Function: int gsl_sf_bessel_y0_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_y0_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_y0_e($a)';
// Function: double gsl_sf_bessel_y1 (double x)
  fun gsl_sf_bessel_y1: double -> double = 'gsl_sf_bessel_y1($a)';
// Function: int gsl_sf_bessel_y1_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_y1_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_y1_e($a)';
// Function: double gsl_sf_bessel_y2 (double x)
  fun gsl_sf_bessel_y2: double -> double = 'gsl_sf_bessel_y2($a)';
// Function: int gsl_sf_bessel_y2_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_y2_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_y2_e($a)';
// Function: double gsl_sf_bessel_yl (int l, double x)
  fun gsl_sf_bessel_yl: int * double -> double = 'gsl_sf_bessel_yl($a)';
// Function: int gsl_sf_bessel_yl_e (int l, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_yl_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_yl_e($a)';
// Function: int gsl_sf_bessel_yl_array (int lmax, double x, double result_array[])
  fun gsl_sf_bessel_yl_array: int * double * +double -> int = 'gsl_sf_bessel_yl_array($a)';
//*****
// 07.05.07 Regular-Modified-Spherical-Bessel-Functions.
// Function: double gsl_sf_bessel_i0_scaled (double x)
  fun gsl_sf_bessel_i0_scaled: double -> double = 'gsl_sf_bessel_i0_scaled($a)';
// Function: int gsl_sf_bessel_i0_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_i0_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_i0_scaled_e($a)';
// Function: double gsl_sf_bessel_i1_scaled (double x)
  fun gsl_sf_bessel_i1_scaled: double -> double = 'gsl_sf_bessel_i1_scaled($a)';
// Function: int gsl_sf_bessel_i1_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_i1_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_i1_scaled_e($a)';
// Function: double gsl_sf_bessel_i2_scaled (double x)
  fun gsl_sf_bessel_i2_scaled: double -> double = 'gsl_sf_bessel_i2_scaled($a)';
// Function: int gsl_sf_bessel_i2_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_i2_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_i2_scaled_e($a)';
// Function: double gsl_sf_bessel_il_scaled (int l, double x)
  fun gsl_sf_bessel_il_scaled: int * double -> double = 'gsl_sf_bessel_il_scaled($a)';
// Function: int gsl_sf_bessel_il_scaled_e (int l, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_il_scaled_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_il_scaled_e($a)';
// Function: int gsl_sf_bessel_il_scaled_array (int lmax, double x, double result_array[])
  fun gsl_sf_bessel_il_scaled_array: int * double * +double -> int = 'gsl_sf_bessel_il_scaled_array($a)';
//*****
// 07.05.08 Irregular-Modified-Spherical-Bessel-Functions.
// Function: double gsl_sf_bessel_k0_scaled (double x)
  fun gsl_sf_bessel_k0_scaled: double -> double = 'gsl_sf_bessel_k0_scaled($a)';
// Function: int gsl_sf_bessel_k0_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_k0_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_k0_scaled_e($a)';
// Function: double gsl_sf_bessel_k1_scaled (double x)
  fun gsl_sf_bessel_k1_scaled: double -> double = 'gsl_sf_bessel_k1_scaled($a)';
// Function: int gsl_sf_bessel_k1_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_k1_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_k1_scaled_e($a)';
// Function: double gsl_sf_bessel_k2_scaled (double x)
  fun gsl_sf_bessel_k2_scaled: double -> double = 'gsl_sf_bessel_k2_scaled($a)';
// Function: int gsl_sf_bessel_k2_scaled_e (double x, gsl_sf_result * result)
  fun gsl_sf_bessel_k2_scaled_e: double * &gsl_sf_result -> int = 'gsl_sf_bessel_k2_scaled_e($a)';
// Function: double gsl_sf_bessel_kl_scaled (int l, double x)
  fun gsl_sf_bessel_kl_scaled: int * double -> double = 'gsl_sf_bessel_kl_scaled($a)';
// Function: int gsl_sf_bessel_kl_scaled_e (int l, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_kl_scaled_e: int * double * &gsl_sf_result -> int = 'gsl_sf_bessel_kl_scaled_e($a)';
// Function: int gsl_sf_bessel_kl_scaled_array (int lmax, double x, double result_array[])
  fun gsl_sf_bessel_kl_scaled_array: int * double * +double -> int = 'gsl_sf_bessel_kl_scaled_array($a)';
//*****
// 07.05.09 Regular-Bessel-Function-Fractional-Order.
// Function: double gsl_sf_bessel_Jnu (double nu, double x)
  fun gsl_sf_bessel_Jnu: double * double -> double = 'gsl_sf_bessel_Jnu($a)';
// Function: int gsl_sf_bessel_Jnu_e (double nu, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Jnu_e: double * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Jnu_e($a)';
// Function: int gsl_sf_bessel_sequence_Jnu_e (double nu, gsl_mode_t mode, size_t size, double v[])
  fun gsl_sf_bessel_sequence_Jnu_e: double * gsl_mode_t * size * +double -> int = 'gsl_sf_bessel_sequence_Jnu_e($a)';
//*****
// 07.05.10 Irregular-Bessel-Functions-Fractional-Order.
// Function: double gsl_sf_bessel_Ynu (double nu, double x)
  fun gsl_sf_bessel_Ynu: double * double -> double = 'gsl_sf_bessel_Ynu($a)';
// Function: int gsl_sf_bessel_Ynu_e (double nu, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Ynu_e: double * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Ynu_e($a)';
//*****
// 07.05.11 Regular-Modified-Bessel-Functions-Fractional-Order.
// Function: double gsl_sf_bessel_Inu (double nu, double x)
  fun gsl_sf_bessel_Inu: double * double -> double = 'gsl_sf_bessel_Inu($a)';
// Function: int gsl_sf_bessel_Inu_e (double nu, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Inu_e: double * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Inu_e($a)';
// Function: double gsl_sf_bessel_Inu_scaled (double nu, double x)
  fun gsl_sf_bessel_Inu_scaled: double * double -> double = 'gsl_sf_bessel_Inu_scaled($a)';
// Function: int gsl_sf_bessel_Inu_scaled_e (double nu, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Inu_scaled_e: double * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Inu_scaled_e($a)';
//*****
// 07.05.12 Irregular-Modified-Bessel-Functions-Fractional-Order.
// Function: double gsl_sf_bessel_Knu (double nu, double x)
  fun gsl_sf_bessel_Knu: double * double -> double = 'gsl_sf_bessel_Knu($a)';
// Function: int gsl_sf_bessel_Knu_e (double nu, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Knu_e: double * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Knu_e($a)';
// Function: double gsl_sf_bessel_lnKnu (double nu, double x)
  fun gsl_sf_bessel_lnKnu: double * double -> double = 'gsl_sf_bessel_lnKnu($a)';
// Function: int gsl_sf_bessel_lnKnu_e (double nu, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_lnKnu_e: double * double * &gsl_sf_result -> int = 'gsl_sf_bessel_lnKnu_e($a)';
// Function: double gsl_sf_bessel_Knu_scaled (double nu, double x)
  fun gsl_sf_bessel_Knu_scaled: double * double -> double = 'gsl_sf_bessel_Knu_scaled($a)';
// Function: int gsl_sf_bessel_Knu_scaled_e (double nu, double x, gsl_sf_result * result)
  fun gsl_sf_bessel_Knu_scaled_e: double * double * &gsl_sf_result -> int = 'gsl_sf_bessel_Knu_scaled_e($a)';
//*****
// 07.05.13 Zeros-of-Resular-Bessel-Functions.
// Function: double gsl_sf_bessel_zero_J0 (unsigned int s)
  fun gsl_sf_bessel_zero_J0: uint -> double = 'gsl_sf_bessel_zero_J0($a)';
// Function: int gsl_sf_bessel_zero_J0_e (unsigned int s, gsl_sf_result * result)
  fun gsl_sf_bessel_zero_J0_e: uint * &gsl_sf_result -> int = 'gsl_sf_bessel_zero_J0_e($a)';
// Function: double gsl_sf_bessel_zero_J1 (unsigned int s)
  fun gsl_sf_bessel_zero_J1: uint -> double = 'gsl_sf_bessel_zero_J1($a)';
// Function: int gsl_sf_bessel_zero_J1_e (unsigned int s, gsl_sf_result * result)
  fun gsl_sf_bessel_zero_J1_e: uint * &gsl_sf_result -> int = 'gsl_sf_bessel_zero_J1_e($a)';
// Function: double gsl_sf_bessel_zero_Jnu (double nu, unsigned int s)
  fun gsl_sf_bessel_zero_Jnu: double * uint -> double = 'gsl_sf_bessel_zero_Jnu($a)';
// Function: int gsl_sf_bessel_zero_Jnu_e (double nu, unsigned int s, gsl_sf_result * result)
  fun gsl_sf_bessel_zero_Jnu_e: double * uint * &gsl_sf_result -> int = 'gsl_sf_bessel_zero_Jnu_e($a)';
//*****
// 07.06.00 Clausen-Functions.
// Function: double gsl_sf_clausen (double x)
  fun gsl_sf_clausen: double -> double = 'gsl_sf_clausen($a)';
// Function: int gsl_sf_clausen_e (double x, gsl_sf_result * result)
  fun gsl_sf_clausen_e: double * &gsl_sf_result -> int = 'gsl_sf_clausen_e($a)';
//*****
// 07.06.00 Coulomb-Functions.
// Function: double gsl_sf_clausen (double x)
  fun gsl_sf_clausen: double -> double = 'gsl_sf_clausen($a)';
// Function: int gsl_sf_clausen_e (double x, gsl_sf_result * result)
  fun gsl_sf_clausen_e: double * &gsl_sf_result -> int = 'gsl_sf_clausen_e($a)';
//*****
// 07.07.01 Normalized-Hydrogenic-Bond-States.
// Function: double gsl_sf_hydrogenicR_1 (double Z, double r)
  fun gsl_sf_hydrogenicR_1: double * double -> double = 'gsl_sf_hydrogenicR_1($a)';
// Function: int gsl_sf_hydrogenicR_1_e (double Z, double r, gsl_sf_result * result)
  fun gsl_sf_hydrogenicR_1_e: double * double * &gsl_sf_result -> int = 'gsl_sf_hydrogenicR_1_e($a)';
// Function: double gsl_sf_hydrogenicR (int n, int l, double Z, double r)
  fun gsl_sf_hydrogenicR: int * int * double * double -> double = 'gsl_sf_hydrogenicR($a)';
// Function: int gsl_sf_hydrogenicR_e (int n, int l, double Z, double r, gsl_sf_result * result)
  fun gsl_sf_hydrogenicR_e: int * int * double * double * &gsl_sf_result -> int = 'gsl_sf_hydrogenicR_e($a)';
//*****
// 07.07.02 Coulomb-Wave-Functions.
// Function: int gsl_sf_coulomb_wave_FG_e (double eta, double x, double L_F, int k, gsl_sf_result * F, gsl_sf_result * Fp, gsl_sf_result * G, gsl_sf_result * Gp, double * exp_F, double * exp_G)
  fun gsl_sf_coulomb_wave_FG_e: double * double * double * int * &gsl_sf_result * &gsl_sf_result * &gsl_sf_result * &gsl_sf_result * &double * &double -> int = 'gsl_sf_coulomb_wave_FG_e($a)';
// Function: int gsl_sf_coulomb_wave_F_array (double L_min, int kmax, double eta, double x, double fc_array[], double * F_exponent)
  fun gsl_sf_coulomb_wave_F_array: double * int * double * double * +double * &double -> int = 'gsl_sf_coulomb_wave_F_array($a)';
// Function: int gsl_sf_coulomb_wave_FG_array (double L_min, int kmax, double eta, double x, double fc_array[], double gc_array[], double * F_exponent, double * G_exponent)
  fun gsl_sf_coulomb_wave_FG_array: double * int * double * double * +double * +double * &double * &double -> int = 'gsl_sf_coulomb_wave_FG_array($a)';
// Function: int gsl_sf_coulomb_wave_FGp_array (double L_min, int kmax, double eta, double x, double fc_array[], double fcp_array[], double gc_array[], double gcp_array[], double * F_exponent, double * G_exponent)
  fun gsl_sf_coulomb_wave_FGp_array: double * int * double * double * +double * +double * +double * +double * &double * &double -> int = 'gsl_sf_coulomb_wave_FGp_array($a)';
// Function: int gsl_sf_coulomb_wave_sphF_array (double L_min, int kmax, double eta, double x, double fc_array[], double F_exponent[])
  fun gsl_sf_coulomb_wave_sphF_array: double * int * double * double * +double * +double -> int = 'gsl_sf_coulomb_wave_sphF_array($a)';
//*****
// 07.07.03 Coulomb-Wave-Function-Normalization-Constant.
// Function: int gsl_sf_coulomb_CL_e (double L, double eta, gsl_sf_result * result)
  fun gsl_sf_coulomb_CL_e: double * double * &gsl_sf_result -> int = 'gsl_sf_coulomb_CL_e($a)';
// Function: int gsl_sf_coulomb_CL_array (double Lmin, int kmax, double eta, double cl[])
  fun gsl_sf_coulomb_CL_array: double * int * double * +double -> int = 'gsl_sf_coulomb_CL_array($a)';
//*****
// 07.08.00 Coupling-Coefficients.
//*****
// 07.08.01 3-j-Symbols.
// Function: double gsl_sf_coupling_3j (int two_ja, int two_jb, int two_jc, int two_ma, int two_mb, int two_mc)
  fun gsl_sf_coupling_3j: int * int * int * int * int * int -> double = 'gsl_sf_coupling_3j($a)';
// Function: int gsl_sf_coupling_3j_e (int two_ja, int two_jb, int two_jc, int two_ma, int two_mb, int two_mc, gsl_sf_result * result)
  fun gsl_sf_coupling_3j_e: int * int * int * int * int * int * &gsl_sf_result -> int = 'gsl_sf_coupling_3j_e($a)';
//*****
// 07.08.02 6-j-Symbols.
// Function: double gsl_sf_coupling_6j (int two_ja, int two_jb, int two_jc, int two_jd, int two_je, int two_jf)
  fun gsl_sf_coupling_6j: int * int * int * int * int * int -> double = 'gsl_sf_coupling_6j($a)';
// Function: int gsl_sf_coupling_6j_e (int two_ja, int two_jb, int two_jc, int two_jd, int two_je, int two_jf, gsl_sf_result * result)
  fun gsl_sf_coupling_6j_e: int * int * int * int * int * int * &gsl_sf_result -> int = 'gsl_sf_coupling_6j_e($a)';
//*****
// 07.08.03 9-j-Symbols.
// Function: double gsl_sf_coupling_9j (int two_ja, int two_jb, int two_jc, int two_jd, int two_je, int two_jf, int two_jg, int two_jh, int two_ji)
  fun gsl_sf_coupling_9j: int * int * int * int * int * int * int * int * int -> double = 'gsl_sf_coupling_9j($a)';
// Function: int gsl_sf_coupling_9j_e (int two_ja, int two_jb, int two_jc, int two_jd, int two_je, int two_jf, int two_jg, int two_jh, int two_ji, gsl_sf_result * result)
  fun gsl_sf_coupling_9j_e: int * int * int * int * int * int * int * int * int * &gsl_sf_result -> int = 'gsl_sf_coupling_9j_e($a)';
//*****
// 07.09.00 Dawson-Function.
// Function: double gsl_sf_dawson (double x)
  fun gsl_sf_dawson: double -> double = 'gsl_sf_dawson($a)';
// Function: int gsl_sf_dawson_e (double x, gsl_sf_result * result)
  fun gsl_sf_dawson_e: double * &gsl_sf_result -> int = 'gsl_sf_dawson_e($a)';
//*****
// 07.10.00 Debye-Functions.
// Function: double gsl_sf_debye_1 (double x)
  fun gsl_sf_debye_1: double -> double = 'gsl_sf_debye_1($a)';
// Function: int gsl_sf_debye_1_e (double x, gsl_sf_result * result)
  fun gsl_sf_debye_1_e: double * &gsl_sf_result -> int = 'gsl_sf_debye_1_e($a)';
// Function: double gsl_sf_debye_2 (double x)
  fun gsl_sf_debye_2: double -> double = 'gsl_sf_debye_2($a)';
// Function: int gsl_sf_debye_2_e (double x, gsl_sf_result * result)
  fun gsl_sf_debye_2_e: double * &gsl_sf_result -> int = 'gsl_sf_debye_2_e($a)';
// Function: double gsl_sf_debye_3 (double x)
  fun gsl_sf_debye_3: double -> double = 'gsl_sf_debye_3($a)';
// Function: int gsl_sf_debye_3_e (double x, gsl_sf_result * result)
  fun gsl_sf_debye_3_e: double * &gsl_sf_result -> int = 'gsl_sf_debye_3_e($a)';
// Function: double gsl_sf_debye_4 (double x)
  fun gsl_sf_debye_4: double -> double = 'gsl_sf_debye_4($a)';
// Function: int gsl_sf_debye_4_e (double x, gsl_sf_result * result)
  fun gsl_sf_debye_4_e: double * &gsl_sf_result -> int = 'gsl_sf_debye_4_e($a)';
// Function: double gsl_sf_debye_5 (double x)
  fun gsl_sf_debye_5: double -> double = 'gsl_sf_debye_5($a)';
// Function: int gsl_sf_debye_5_e (double x, gsl_sf_result * result)
  fun gsl_sf_debye_5_e: double * &gsl_sf_result -> int = 'gsl_sf_debye_5_e($a)';
// Function: double gsl_sf_debye_6 (double x)
  fun gsl_sf_debye_6: double -> double = 'gsl_sf_debye_6($a)';
// Function: int gsl_sf_debye_6_e (double x, gsl_sf_result * result)
  fun gsl_sf_debye_6_e: double * &gsl_sf_result -> int = 'gsl_sf_debye_6_e($a)';
//*****
// 07.11.00 Dilogarithm.
//*****
// 07.11.01 Real-Argument.
// Function: double gsl_sf_dilog (double x)
  fun gsl_sf_dilog: double -> double = 'gsl_sf_dilog($a)';
// Function: int gsl_sf_dilog_e (double x, gsl_sf_result * result)
  fun gsl_sf_dilog_e: double * &gsl_sf_result -> int = 'gsl_sf_dilog_e($a)';
//*****
// 07.11.02 Complex-Argument.
// Function: int gsl_sf_complex_dilog_e (double r, double theta, gsl_sf_result * result_re, gsl_sf_result * result_im)
  fun gsl_sf_complex_dilog_e: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_complex_dilog_e($a)';
//*****
// 07.12.00 Elementary-Operations.
// Function: int gsl_sf_multiply_e (double x, double y, gsl_sf_result * result)
  fun gsl_sf_multiply_e: double * double * &gsl_sf_result -> int = 'gsl_sf_multiply_e($a)';
// Function: int gsl_sf_multiply_err_e (double x, double dx, double y, double dy, gsl_sf_result * result)
  fun gsl_sf_multiply_err_e: double * double * double * double * &gsl_sf_result -> int = 'gsl_sf_multiply_err_e($a)';
//*****
// 07.13.00 Elliptic-Integrals.
//*****
// 07.13.01 Definition-of-Legedre-Forms.
//*****
// 07.13.02 Definition-of-Carlson-Forms.
//*****
// 07.13.03 Legendre-Form-of-Complete-Elliptic-Integrals.
// Function: double gsl_sf_ellint_Kcomp (double k, gsl_mode_t mode)
  fun gsl_sf_ellint_Kcomp: double * gsl_mode_t -> double = 'gsl_sf_ellint_Kcomp($a)';
// Function: int gsl_sf_ellint_Kcomp_e (double k, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_Kcomp_e: double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_Kcomp_e($a)';
// Function: double gsl_sf_ellint_Ecomp (double k, gsl_mode_t mode)
  fun gsl_sf_ellint_Ecomp: double * gsl_mode_t -> double = 'gsl_sf_ellint_Ecomp($a)';
// Function: int gsl_sf_ellint_Ecomp_e (double k, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_Ecomp_e: double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_Ecomp_e($a)';
// Function: double gsl_sf_ellint_Pcomp (double k, double n, gsl_mode_t mode)
  fun gsl_sf_ellint_Pcomp: double * double * gsl_mode_t -> double = 'gsl_sf_ellint_Pcomp($a)';
// Function: int gsl_sf_ellint_Pcomp_e (double k, double n, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_Pcomp_e: double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_Pcomp_e($a)';
//*****
// 07.13.04 Legendre-Form-of-Incomplete-Elliptic-Integrals.
// Function: double gsl_sf_ellint_F (double phi, double k, gsl_mode_t mode)
  fun gsl_sf_ellint_F: double * double * gsl_mode_t -> double = 'gsl_sf_ellint_F($a)';
// Function: int gsl_sf_ellint_F_e (double phi, double k, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_F_e: double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_F_e($a)';
// Function: double gsl_sf_ellint_E (double phi, double k, gsl_mode_t mode)
  fun gsl_sf_ellint_E: double * double * gsl_mode_t -> double = 'gsl_sf_ellint_E($a)';
// Function: int gsl_sf_ellint_E_e (double phi, double k, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_E_e: double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_E_e($a)';
// Function: double gsl_sf_ellint_P (double phi, double k, double n, gsl_mode_t mode)
  fun gsl_sf_ellint_P: double * double * double * gsl_mode_t -> double = 'gsl_sf_ellint_P($a)';
// Function: int gsl_sf_ellint_P_e (double phi, double k, double n, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_P_e: double * double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_P_e($a)';
// Function: double gsl_sf_ellint_D (double phi, double k, double n, gsl_mode_t mode)
  fun gsl_sf_ellint_D: double * double * double * gsl_mode_t -> double = 'gsl_sf_ellint_D($a)';
// Function: int gsl_sf_ellint_D_e (double phi, double k, double n, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_D_e: double * double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_D_e($a)';
//*****
// 07.13.05 Carlson-Forms.
// Function: double gsl_sf_ellint_RC (double x, double y, gsl_mode_t mode)
  fun gsl_sf_ellint_RC: double * double * gsl_mode_t -> double = 'gsl_sf_ellint_RC($a)';
// Function: int gsl_sf_ellint_RC_e (double x, double y, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_RC_e: double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_RC_e($a)';
// Function: double gsl_sf_ellint_RD (double x, double y, double z, gsl_mode_t mode)
  fun gsl_sf_ellint_RD: double * double * double * gsl_mode_t -> double = 'gsl_sf_ellint_RD($a)';
// Function: int gsl_sf_ellint_RD_e (double x, double y, double z, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_RD_e: double * double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_RD_e($a)';
// Function: double gsl_sf_ellint_RF (double x, double y, double z, gsl_mode_t mode)
  fun gsl_sf_ellint_RF: double * double * double * gsl_mode_t -> double = 'gsl_sf_ellint_RF($a)';
// Function: int gsl_sf_ellint_RF_e (double x, double y, double z, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_RF_e: double * double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_RF_e($a)';
// Function: double gsl_sf_ellint_RJ (double x, double y, double z, double p, gsl_mode_t mode)
  fun gsl_sf_ellint_RJ: double * double * double * double * gsl_mode_t -> double = 'gsl_sf_ellint_RJ($a)';
// Function: int gsl_sf_ellint_RJ_e (double x, double y, double z, double p, gsl_mode_t mode, gsl_sf_result * result)
  fun gsl_sf_ellint_RJ_e: double * double * double * double * gsl_mode_t * &gsl_sf_result -> int = 'gsl_sf_ellint_RJ_e($a)';
//*****
// 07.15.00 Error-Functions.
//*****
// 07.15.01 Error-Function.
// Function: double gsl_sf_erf (double x)
  fun gsl_sf_erf: double -> double = 'gsl_sf_erf($a)';
// Function: int gsl_sf_erf_e (double x, gsl_sf_result * result)
  fun gsl_sf_erf_e: double * &gsl_sf_result -> int = 'gsl_sf_erf_e($a)';
//*****
// 07.15.02 Complementary-Error-Function.
// Function: double gsl_sf_erfc (double x)
  fun gsl_sf_erfc: double -> double = 'gsl_sf_erfc($a)';
// Function: int gsl_sf_erfc_e (double x, gsl_sf_result * result)
  fun gsl_sf_erfc_e: double * &gsl_sf_result -> int = 'gsl_sf_erfc_e($a)';
//*****
// 07.15.03 Log-Complementary-Error-Function.
// Function: double gsl_sf_log_erfc (double x)
  fun gsl_sf_log_erfc: double -> double = 'gsl_sf_log_erfc($a)';
// Function: int gsl_sf_log_erfc_e (double x, gsl_sf_result * result)
  fun gsl_sf_log_erfc_e: double * &gsl_sf_result -> int = 'gsl_sf_log_erfc_e($a)';
//*****
// 07.15.04 Probability-Functions.
// Function: double gsl_sf_erf_Z (double x)
  fun gsl_sf_erf_Z: double -> double = 'gsl_sf_erf_Z($a)';
// Function: int gsl_sf_erf_Z_e (double x, gsl_sf_result * result)
  fun gsl_sf_erf_Z_e: double * &gsl_sf_result -> int = 'gsl_sf_erf_Z_e($a)';
// Function: double gsl_sf_erf_Q (double x)
  fun gsl_sf_erf_Q: double -> double = 'gsl_sf_erf_Q($a)';
// Function: int gsl_sf_erf_Q_e (double x, gsl_sf_result * result)
  fun gsl_sf_erf_Q_e: double * &gsl_sf_result -> int = 'gsl_sf_erf_Q_e($a)';
// Function: double gsl_sf_hazard (double x)
  fun gsl_sf_hazard: double -> double = 'gsl_sf_hazard($a)';
// Function: int gsl_sf_hazard_e (double x, gsl_sf_result * result)
  fun gsl_sf_hazard_e: double * &gsl_sf_result -> int = 'gsl_sf_hazard_e($a)';
//*****
// 07.16.00 Exponential-Functions.
//*****
// 07.16.01 Exponential-Function.
// Function: double gsl_sf_exp (double x)
  fun gsl_sf_exp: double -> double = 'gsl_sf_exp($a)';
// Function: int gsl_sf_exp_e (double x, gsl_sf_result * result)
  fun gsl_sf_exp_e: double * &gsl_sf_result -> int = 'gsl_sf_exp_e($a)';
// Function: int gsl_sf_exp_e10_e (double x, gsl_sf_result_e10 * result)
  fun gsl_sf_exp_e10_e: double * &gsl_sf_result_e10 -> int = 'gsl_sf_exp_e10_e($a)';
// Function: double gsl_sf_exp_mult (double x, double y)
  fun gsl_sf_exp_mult: double * double -> double = 'gsl_sf_exp_mult($a)';
// Function: int gsl_sf_exp_mult_e (double x, double y, gsl_sf_result * result)
  fun gsl_sf_exp_mult_e: double * double * &gsl_sf_result -> int = 'gsl_sf_exp_mult_e($a)';
// Function: int gsl_sf_exp_mult_e10_e (const double x, const double y, gsl_sf_result_e10 * result)
  fun gsl_sf_exp_mult_e10_e: double * double * &gsl_sf_result_e10 -> int = 'gsl_sf_exp_mult_e10_e($a)';
//*****
// 07.16.02 Relative-Exponential-Functions.
// Function: double gsl_sf_expm1 (double x)
  fun gsl_sf_expm1: double -> double = 'gsl_sf_expm1($a)';
// Function: int gsl_sf_expm1_e (double x, gsl_sf_result * result)
  fun gsl_sf_expm1_e: double * &gsl_sf_result -> int = 'gsl_sf_expm1_e($a)';
// Function: double gsl_sf_exprel (double x)
  fun gsl_sf_exprel: double -> double = 'gsl_sf_exprel($a)';
// Function: int gsl_sf_exprel_e (double x, gsl_sf_result * result)
  fun gsl_sf_exprel_e: double * &gsl_sf_result -> int = 'gsl_sf_exprel_e($a)';
// Function: double gsl_sf_exprel_2 (double x)
  fun gsl_sf_exprel_2: double -> double = 'gsl_sf_exprel_2($a)';
// Function: int gsl_sf_exprel_2_e (double x, gsl_sf_result * result)
  fun gsl_sf_exprel_2_e: double * &gsl_sf_result -> int = 'gsl_sf_exprel_2_e($a)';
// Function: double gsl_sf_exprel_n (int n, double x)
  fun gsl_sf_exprel_n: int * double -> double = 'gsl_sf_exprel_n($a)';
// Function: int gsl_sf_exprel_n_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_exprel_n_e: int * double * &gsl_sf_result -> int = 'gsl_sf_exprel_n_e($a)';
//*****
// 07.16.03 Exponentiation-With-Error-Estimate.
// Function: int gsl_sf_exp_err_e (double x, double dx, gsl_sf_result * result)
  fun gsl_sf_exp_err_e: double * double * &gsl_sf_result -> int = 'gsl_sf_exp_err_e($a)';
// Function: int gsl_sf_exp_err_e10_e (double x, double dx, gsl_sf_result_e10 * result)
  fun gsl_sf_exp_err_e10_e: double * double * &gsl_sf_result_e10 -> int = 'gsl_sf_exp_err_e10_e($a)';
// Function: int gsl_sf_exp_mult_err_e (double x, double dx, double y, double dy, gsl_sf_result * result)
  fun gsl_sf_exp_mult_err_e: double * double * double * double * &gsl_sf_result -> int = 'gsl_sf_exp_mult_err_e($a)';
// Function: int gsl_sf_exp_mult_err_e10_e (double x, double dx, double y, double dy, gsl_sf_result_e10 * result)
  fun gsl_sf_exp_mult_err_e10_e: double * double * double * double * &gsl_sf_result_e10 -> int = 'gsl_sf_exp_mult_err_e10_e($a)';
//*****
// 07.17.00 Exponential-Integrals.
//*****
// 07.17.01 Exponential-Integral.
// Function: double gsl_sf_expint_E1 (double x)
  fun gsl_sf_expint_E1: double -> double = 'gsl_sf_expint_E1($a)';
// Function: int gsl_sf_expint_E1_e (double x, gsl_sf_result * result)
  fun gsl_sf_expint_E1_e: double * &gsl_sf_result -> int = 'gsl_sf_expint_E1_e($a)';
// Function: double gsl_sf_expint_E2 (double x)
  fun gsl_sf_expint_E2: double -> double = 'gsl_sf_expint_E2($a)';
// Function: int gsl_sf_expint_E2_e (double x, gsl_sf_result * result)
  fun gsl_sf_expint_E2_e: double * &gsl_sf_result -> int = 'gsl_sf_expint_E2_e($a)';
// Function: double gsl_sf_expint_En (int n, double x)
  fun gsl_sf_expint_En: int * double -> double = 'gsl_sf_expint_En($a)';
// Function: int gsl_sf_expint_En_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_expint_En_e: int * double * &gsl_sf_result -> int = 'gsl_sf_expint_En_e($a)';
//*****
// 07.17.02 Ei(x).
// Function: double gsl_sf_expint_Ei (double x)
  fun gsl_sf_expint_Ei: double -> double = 'gsl_sf_expint_Ei($a)';
// Function: int gsl_sf_expint_Ei_e (double x, gsl_sf_result * result)
  fun gsl_sf_expint_Ei_e: double * &gsl_sf_result -> int = 'gsl_sf_expint_Ei_e($a)';
//*****
// 07.17.03 Hyperbolic-Integrals.
// Function: double gsl_sf_Shi (double x)
  fun gsl_sf_Shi: double -> double = 'gsl_sf_Shi($a)';
// Function: int gsl_sf_Shi_e (double x, gsl_sf_result * result)
  fun gsl_sf_Shi_e: double * &gsl_sf_result -> int = 'gsl_sf_Shi_e($a)';
// Function: double gsl_sf_Chi (double x)
  fun gsl_sf_Chi: double -> double = 'gsl_sf_Chi($a)';
// Function: int gsl_sf_Chi_e (double x, gsl_sf_result * result)
  fun gsl_sf_Chi_e: double * &gsl_sf_result -> int = 'gsl_sf_Chi_e($a)';
//*****
// 07.17.04 Ei_3(x).
// Function: double gsl_sf_expint_3 (double x)
  fun gsl_sf_expint_3: double -> double = 'gsl_sf_expint_3($a)';
// Function: int gsl_sf_expint_3_e (double x, gsl_sf_result * result)
  fun gsl_sf_expint_3_e: double * &gsl_sf_result -> int = 'gsl_sf_expint_3_e($a)';
//*****
// 07.17.05 Trigonometric-Integrals.
// Function: double gsl_sf_Si (const double x)
  fun gsl_sf_Si: double -> double = 'gsl_sf_Si($a)';
// Function: int gsl_sf_Si_e (double x, gsl_sf_result * result)
  fun gsl_sf_Si_e: double * &gsl_sf_result -> int = 'gsl_sf_Si_e($a)';
// Function: double gsl_sf_Ci (const double x)
  fun gsl_sf_Ci: double -> double = 'gsl_sf_Ci($a)';
// Function: int gsl_sf_Ci_e (double x, gsl_sf_result * result)
  fun gsl_sf_Ci_e: double * &gsl_sf_result -> int = 'gsl_sf_Ci_e($a)';
//*****
// 07.17.06 Arctangent-Integral.
// Function: double gsl_sf_atanint (double x)
  fun gsl_sf_atanint: double -> double = 'gsl_sf_atanint($a)';
// Function: int gsl_sf_atanint_e (double x, gsl_sf_result * result)
  fun gsl_sf_atanint_e: double * &gsl_sf_result -> int = 'gsl_sf_atanint_e($a)';
//*****
// 07.18.00 Fermi-Dirac-Function.
//*****
// 07.18.01 Complete-Fermi-Dirac-Integrals.
// Function: double gsl_sf_fermi_dirac_m1 (double x)
  fun gsl_sf_fermi_dirac_m1: double -> double = 'gsl_sf_fermi_dirac_m1($a)';
// Function: int gsl_sf_fermi_dirac_m1_e (double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_m1_e: double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_m1_e($a)';
// Function: double gsl_sf_fermi_dirac_0 (double x)
  fun gsl_sf_fermi_dirac_0: double -> double = 'gsl_sf_fermi_dirac_0($a)';
// Function: int gsl_sf_fermi_dirac_0_e (double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_0_e: double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_0_e($a)';
// Function: double gsl_sf_fermi_dirac_1 (double x)
  fun gsl_sf_fermi_dirac_1: double -> double = 'gsl_sf_fermi_dirac_1($a)';
// Function: int gsl_sf_fermi_dirac_1_e (double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_1_e: double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_1_e($a)';
// Function: double gsl_sf_fermi_dirac_2 (double x)
  fun gsl_sf_fermi_dirac_2: double -> double = 'gsl_sf_fermi_dirac_2($a)';
// Function: int gsl_sf_fermi_dirac_2_e (double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_2_e: double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_2_e($a)';
// Function: double gsl_sf_fermi_dirac_int (int j, double x)
  fun gsl_sf_fermi_dirac_int: int * double -> double = 'gsl_sf_fermi_dirac_int($a)';
// Function: int gsl_sf_fermi_dirac_int_e (int j, double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_int_e: int * double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_int_e($a)';
// Function: double gsl_sf_fermi_dirac_mhalf (double x)
  fun gsl_sf_fermi_dirac_mhalf: double -> double = 'gsl_sf_fermi_dirac_mhalf($a)';
// Function: int gsl_sf_fermi_dirac_mhalf_e (double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_mhalf_e: double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_mhalf_e($a)';
// Function: double gsl_sf_fermi_dirac_half (double x)
  fun gsl_sf_fermi_dirac_half: double -> double = 'gsl_sf_fermi_dirac_half($a)';
// Function: int gsl_sf_fermi_dirac_half_e (double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_half_e: double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_half_e($a)';
// Function: double gsl_sf_fermi_dirac_3half (double x)
  fun gsl_sf_fermi_dirac_3half: double -> double = 'gsl_sf_fermi_dirac_3half($a)';
// Function: int gsl_sf_fermi_dirac_3half_e (double x, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_3half_e: double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_3half_e($a)';
//*****
// 07.18.02 Incomplete-Fermi-Dirac-Integrals.
// Function: double gsl_sf_fermi_dirac_inc_0 (double x, double b)
  fun gsl_sf_fermi_dirac_inc_0: double * double -> double = 'gsl_sf_fermi_dirac_inc_0($a)';
// Function: int gsl_sf_fermi_dirac_inc_0_e (double x, double b, gsl_sf_result * result)
  fun gsl_sf_fermi_dirac_inc_0_e: double * double * &gsl_sf_result -> int = 'gsl_sf_fermi_dirac_inc_0_e($a)';
//*****
// 07.19.00 Gamma-and-Beta-Functions.
//*****
// 07.19.01 Gamma-Functions.
// Function: double gsl_sf_gamma (double x)
  fun gsl_sf_gamma: double -> double = 'gsl_sf_gamma($a)';
// Function: int gsl_sf_gamma_e (double x, gsl_sf_result * result)
  fun gsl_sf_gamma_e: double * &gsl_sf_result -> int = 'gsl_sf_gamma_e($a)';
// Function: double gsl_sf_lngamma (double x)
  fun gsl_sf_lngamma: double -> double = 'gsl_sf_lngamma($a)';
// Function: int gsl_sf_lngamma_e (double x, gsl_sf_result * result)
  fun gsl_sf_lngamma_e: double * &gsl_sf_result -> int = 'gsl_sf_lngamma_e($a)';
// Function: int gsl_sf_lngamma_sgn_e (double x, gsl_sf_result * result_lg, double * sgn)
  fun gsl_sf_lngamma_sgn_e: double * &gsl_sf_result * &double -> int = 'gsl_sf_lngamma_sgn_e($a)';
// Function: double gsl_sf_gammastar (double x)
  fun gsl_sf_gammastar: double -> double = 'gsl_sf_gammastar($a)';
// Function: int gsl_sf_gammastar_e (double x, gsl_sf_result * result)
  fun gsl_sf_gammastar_e: double * &gsl_sf_result -> int = 'gsl_sf_gammastar_e($a)';
// Function: double gsl_sf_gammainv (double x)
  fun gsl_sf_gammainv: double -> double = 'gsl_sf_gammainv($a)';
// Function: int gsl_sf_gammainv_e (double x, gsl_sf_result * result)
  fun gsl_sf_gammainv_e: double * &gsl_sf_result -> int = 'gsl_sf_gammainv_e($a)';
// Function: int gsl_sf_lngamma_complex_e (double zr, double zi, gsl_sf_result * lnr, gsl_sf_result * arg)
  fun gsl_sf_lngamma_complex_e: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_lngamma_complex_e($a)';
//*****
// 07.19.02 Factorials.
// Function: double gsl_sf_fact (unsigned int n)
  fun gsl_sf_fact: uint -> double = 'gsl_sf_fact($a)';
// Function: int gsl_sf_fact_e (unsigned int n, gsl_sf_result * result)
  fun gsl_sf_fact_e: uint * &gsl_sf_result -> int = 'gsl_sf_fact_e($a)';
// Function: double gsl_sf_doublefact (unsigned int n)
  fun gsl_sf_doublefact: uint -> double = 'gsl_sf_doublefact($a)';
// Function: int gsl_sf_doublefact_e (unsigned int n, gsl_sf_result * result)
  fun gsl_sf_doublefact_e: uint * &gsl_sf_result -> int = 'gsl_sf_doublefact_e($a)';
// Function: double gsl_sf_lnfact (unsigned int n)
  fun gsl_sf_lnfact: uint -> double = 'gsl_sf_lnfact($a)';
// Function: int gsl_sf_lnfact_e (unsigned int n, gsl_sf_result * result)
  fun gsl_sf_lnfact_e: uint * &gsl_sf_result -> int = 'gsl_sf_lnfact_e($a)';
// Function: double gsl_sf_lndoublefact (unsigned int n)
  fun gsl_sf_lndoublefact: uint -> double = 'gsl_sf_lndoublefact($a)';
// Function: int gsl_sf_lndoublefact_e (unsigned int n, gsl_sf_result * result)
  fun gsl_sf_lndoublefact_e: uint * &gsl_sf_result -> int = 'gsl_sf_lndoublefact_e($a)';
// Function: double gsl_sf_choose (unsigned int n, unsigned int m)
  fun gsl_sf_choose: uint * uint -> double = 'gsl_sf_choose($a)';
// Function: int gsl_sf_choose_e (unsigned int n, unsigned int m, gsl_sf_result * result)
  fun gsl_sf_choose_e: uint * uint * &gsl_sf_result -> int = 'gsl_sf_choose_e($a)';
// Function: double gsl_sf_lnchoose (unsigned int n, unsigned int m)
  fun gsl_sf_lnchoose: uint * uint -> double = 'gsl_sf_lnchoose($a)';
// Function: int gsl_sf_lnchoose_e (unsigned int n, unsigned int m, gsl_sf_result * result)
  fun gsl_sf_lnchoose_e: uint * uint * &gsl_sf_result -> int = 'gsl_sf_lnchoose_e($a)';
// Function: double gsl_sf_taylorcoeff (int n, double x)
  fun gsl_sf_taylorcoeff: int * double -> double = 'gsl_sf_taylorcoeff($a)';
// Function: int gsl_sf_taylorcoeff_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_taylorcoeff_e: int * double * &gsl_sf_result -> int = 'gsl_sf_taylorcoeff_e($a)';
//*****
// 07.19.03 Pochhammer-Symbol.
// Function: double gsl_sf_poch (double a, double x)
  fun gsl_sf_poch: double * double -> double = 'gsl_sf_poch($a)';
// Function: int gsl_sf_poch_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_poch_e: double * double * &gsl_sf_result -> int = 'gsl_sf_poch_e($a)';
// Function: double gsl_sf_lnpoch (double a, double x)
  fun gsl_sf_lnpoch: double * double -> double = 'gsl_sf_lnpoch($a)';
// Function: int gsl_sf_lnpoch_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_lnpoch_e: double * double * &gsl_sf_result -> int = 'gsl_sf_lnpoch_e($a)';
// Function: int gsl_sf_lnpoch_sgn_e (double a, double x, gsl_sf_result * result, double * sgn)
  fun gsl_sf_lnpoch_sgn_e: double * double * &gsl_sf_result * &double -> int = 'gsl_sf_lnpoch_sgn_e($a)';
// Function: double gsl_sf_pochrel (double a, double x)
  fun gsl_sf_pochrel: double * double -> double = 'gsl_sf_pochrel($a)';
// Function: int gsl_sf_pochrel_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_pochrel_e: double * double * &gsl_sf_result -> int = 'gsl_sf_pochrel_e($a)';
//*****
// 07.19.04 Incomplete-Gamma-Functions.
// Function: double gsl_sf_gamma_inc (double a, double x)
  fun gsl_sf_gamma_inc: double * double -> double = 'gsl_sf_gamma_inc($a)';
// Function: int gsl_sf_gamma_inc_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_gamma_inc_e: double * double * &gsl_sf_result -> int = 'gsl_sf_gamma_inc_e($a)';
// Function: double gsl_sf_gamma_inc_Q (double a, double x)
  fun gsl_sf_gamma_inc_Q: double * double -> double = 'gsl_sf_gamma_inc_Q($a)';
// Function: int gsl_sf_gamma_inc_Q_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_gamma_inc_Q_e: double * double * &gsl_sf_result -> int = 'gsl_sf_gamma_inc_Q_e($a)';
// Function: double gsl_sf_gamma_inc_P (double a, double x)
  fun gsl_sf_gamma_inc_P: double * double -> double = 'gsl_sf_gamma_inc_P($a)';
// Function: int gsl_sf_gamma_inc_P_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_gamma_inc_P_e: double * double * &gsl_sf_result -> int = 'gsl_sf_gamma_inc_P_e($a)';
//*****
// 07.19.05 Beta-Functions.
// Function: double gsl_sf_beta (double a, double b)
  fun gsl_sf_beta: double * double -> double = 'gsl_sf_beta($a)';
// Function: int gsl_sf_beta_e (double a, double b, gsl_sf_result * result)
  fun gsl_sf_beta_e: double * double * &gsl_sf_result -> int = 'gsl_sf_beta_e($a)';
// Function: double gsl_sf_lnbeta (double a, double b)
  fun gsl_sf_lnbeta: double * double -> double = 'gsl_sf_lnbeta($a)';
// Function: int gsl_sf_lnbeta_e (double a, double b, gsl_sf_result * result)
  fun gsl_sf_lnbeta_e: double * double * &gsl_sf_result -> int = 'gsl_sf_lnbeta_e($a)';
//*****
// 07.19.06 Incomplete-Beta-Function.
// Function: double gsl_sf_beta_inc (double a, double b, double x)
  fun gsl_sf_beta_inc: double * double * double -> double = 'gsl_sf_beta_inc($a)';
// Function: int gsl_sf_beta_inc_e (double a, double b, double x, gsl_sf_result * result)
  fun gsl_sf_beta_inc_e: double * double * double * &gsl_sf_result -> int = 'gsl_sf_beta_inc_e($a)';
//*****
// 07.20.00 Gegenbauer-Functions.
// Function: double gsl_sf_gegenpoly_1 (double lambda, double x)
  fun gsl_sf_gegenpoly_1: double * double -> double = 'gsl_sf_gegenpoly_1($a)';
// Function: double gsl_sf_gegenpoly_2 (double lambda, double x)
  fun gsl_sf_gegenpoly_2: double * double -> double = 'gsl_sf_gegenpoly_2($a)';
// Function: double gsl_sf_gegenpoly_3 (double lambda, double x)
  fun gsl_sf_gegenpoly_3: double * double -> double = 'gsl_sf_gegenpoly_3($a)';
// Function: int gsl_sf_gegenpoly_1_e (double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_gegenpoly_1_e: double * double * &gsl_sf_result -> int = 'gsl_sf_gegenpoly_1_e($a)';
// Function: int gsl_sf_gegenpoly_2_e (double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_gegenpoly_2_e: double * double * &gsl_sf_result -> int = 'gsl_sf_gegenpoly_2_e($a)';
// Function: int gsl_sf_gegenpoly_3_e (double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_gegenpoly_3_e: double * double * &gsl_sf_result -> int = 'gsl_sf_gegenpoly_3_e($a)';
// Function: double gsl_sf_gegenpoly_n (int n, double lambda, double x)
  fun gsl_sf_gegenpoly_n: int * double * double -> double = 'gsl_sf_gegenpoly_n($a)';
// Function: int gsl_sf_gegenpoly_n_e (int n, double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_gegenpoly_n_e: int * double * double * &gsl_sf_result -> int = 'gsl_sf_gegenpoly_n_e($a)';
// Function: int gsl_sf_gegenpoly_array (int nmax, double lambda, double x, double result_array[])
  fun gsl_sf_gegenpoly_array: int * double * double * +double -> int = 'gsl_sf_gegenpoly_array($a)';
//*****
// 07.21.00 Hypergeometric-Functions.
// Function: double gsl_sf_hyperg_0F1 (double c, double x)
  fun gsl_sf_hyperg_0F1: double * double -> double = 'gsl_sf_hyperg_0F1($a)';
// Function: int gsl_sf_hyperg_0F1_e (double c, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_0F1_e: double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_0F1_e($a)';
// Function: double gsl_sf_hyperg_1F1_int (int m, int n, double x)
  fun gsl_sf_hyperg_1F1_int: int * int * double -> double = 'gsl_sf_hyperg_1F1_int($a)';
// Function: int gsl_sf_hyperg_1F1_int_e (int m, int n, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_1F1_int_e: int * int * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_1F1_int_e($a)';
// Function: double gsl_sf_hyperg_1F1 (double a, double b, double x)
  fun gsl_sf_hyperg_1F1: double * double * double -> double = 'gsl_sf_hyperg_1F1($a)';
// Function: int gsl_sf_hyperg_1F1_e (double a, double b, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_1F1_e: double * double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_1F1_e($a)';
// Function: double gsl_sf_hyperg_U_int (int m, int n, double x)
  fun gsl_sf_hyperg_U_int: int * int * double -> double = 'gsl_sf_hyperg_U_int($a)';
// Function: int gsl_sf_hyperg_U_int_e (int m, int n, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_U_int_e: int * int * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_U_int_e($a)';
// Function: int gsl_sf_hyperg_U_int_e10_e (int m, int n, double x, gsl_sf_result_e10 * result)
  fun gsl_sf_hyperg_U_int_e10_e: int * int * double * &gsl_sf_result_e10 -> int = 'gsl_sf_hyperg_U_int_e10_e($a)';
// Function: double gsl_sf_hyperg_U (double a, double b, double x)
  fun gsl_sf_hyperg_U: double * double * double -> double = 'gsl_sf_hyperg_U($a)';
// Function: int gsl_sf_hyperg_U_e (double a, double b, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_U_e: double * double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_U_e($a)';
// Function: int gsl_sf_hyperg_U_e10_e (double a, double b, double x, gsl_sf_result_e10 * result)
  fun gsl_sf_hyperg_U_e10_e: double * double * double * &gsl_sf_result_e10 -> int = 'gsl_sf_hyperg_U_e10_e($a)';
// Function: double gsl_sf_hyperg_2F1 (double a, double b, double c, double x)
  fun gsl_sf_hyperg_2F1: double * double * double * double -> double = 'gsl_sf_hyperg_2F1($a)';
// Function: int gsl_sf_hyperg_2F1_e (double a, double b, double c, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_2F1_e: double * double * double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_2F1_e($a)';
// Function: double gsl_sf_hyperg_2F1_conj (double aR, double aI, double c, double x)
  fun gsl_sf_hyperg_2F1_conj: double * double * double * double -> double = 'gsl_sf_hyperg_2F1_conj($a)';
// Function: int gsl_sf_hyperg_2F1_conj_e (double aR, double aI, double c, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_2F1_conj_e: double * double * double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_2F1_conj_e($a)';
// Function: double gsl_sf_hyperg_2F1_renorm (double a, double b, double c, double x)
  fun gsl_sf_hyperg_2F1_renorm: double * double * double * double -> double = 'gsl_sf_hyperg_2F1_renorm($a)';
// Function: int gsl_sf_hyperg_2F1_renorm_e (double a, double b, double c, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_2F1_renorm_e: double * double * double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_2F1_renorm_e($a)';
// Function: double gsl_sf_hyperg_2F1_conj_renorm (double aR, double aI, double c, double x)
  fun gsl_sf_hyperg_2F1_conj_renorm: double * double * double * double -> double = 'gsl_sf_hyperg_2F1_conj_renorm($a)';
// Function: int gsl_sf_hyperg_2F1_conj_renorm_e (double aR, double aI, double c, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_2F1_conj_renorm_e: double * double * double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_2F1_conj_renorm_e($a)';
// Function: double gsl_sf_hyperg_2F0 (double a, double b, double x)
  fun gsl_sf_hyperg_2F0: double * double * double -> double = 'gsl_sf_hyperg_2F0($a)';
// Function: int gsl_sf_hyperg_2F0_e (double a, double b, double x, gsl_sf_result * result)
  fun gsl_sf_hyperg_2F0_e: double * double * double * &gsl_sf_result -> int = 'gsl_sf_hyperg_2F0_e($a)';
//*****
// 07.22.00 Laguerre-Functions.
// Function: double gsl_sf_laguerre_1 (double a, double x)
  fun gsl_sf_laguerre_1: double * double -> double = 'gsl_sf_laguerre_1($a)';
// Function: double gsl_sf_laguerre_2 (double a, double x)
  fun gsl_sf_laguerre_2: double * double -> double = 'gsl_sf_laguerre_2($a)';
// Function: double gsl_sf_laguerre_3 (double a, double x)
  fun gsl_sf_laguerre_3: double * double -> double = 'gsl_sf_laguerre_3($a)';
// Function: int gsl_sf_laguerre_1_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_laguerre_1_e: double * double * &gsl_sf_result -> int = 'gsl_sf_laguerre_1_e($a)';
// Function: int gsl_sf_laguerre_2_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_laguerre_2_e: double * double * &gsl_sf_result -> int = 'gsl_sf_laguerre_2_e($a)';
// Function: int gsl_sf_laguerre_3_e (double a, double x, gsl_sf_result * result)
  fun gsl_sf_laguerre_3_e: double * double * &gsl_sf_result -> int = 'gsl_sf_laguerre_3_e($a)';
// Function: double gsl_sf_laguerre_n (const int n, const double a, const double x)
  fun gsl_sf_laguerre_n: int * double * double -> double = 'gsl_sf_laguerre_n($a)';
// Function: int gsl_sf_laguerre_n_e (int n, double a, double x, gsl_sf_result * result)
  fun gsl_sf_laguerre_n_e: int * double * double * &gsl_sf_result -> int = 'gsl_sf_laguerre_n_e($a)';
//*****
// 07.23.00 Lambert-W-Functions.
// Function: double gsl_sf_lambert_W0 (double x)
  fun gsl_sf_lambert_W0: double -> double = 'gsl_sf_lambert_W0($a)';
// Function: int gsl_sf_lambert_W0_e (double x, gsl_sf_result * result)
  fun gsl_sf_lambert_W0_e: double * &gsl_sf_result -> int = 'gsl_sf_lambert_W0_e($a)';
// Function: double gsl_sf_lambert_Wm1 (double x)
  fun gsl_sf_lambert_Wm1: double -> double = 'gsl_sf_lambert_Wm1($a)';
// Function: int gsl_sf_lambert_Wm1_e (double x, gsl_sf_result * result)
  fun gsl_sf_lambert_Wm1_e: double * &gsl_sf_result -> int = 'gsl_sf_lambert_Wm1_e($a)';
//*****
// 07.24.00 Legendre-Functions-and-Spherical-Harmonics.
//*****
// 07.24.01 Legendre-Polynomials.
// Function: double gsl_sf_legendre_P1 (double x)
  fun gsl_sf_legendre_P1: double -> double = 'gsl_sf_legendre_P1($a)';
// Function: double gsl_sf_legendre_P2 (double x)
  fun gsl_sf_legendre_P2: double -> double = 'gsl_sf_legendre_P2($a)';
// Function: double gsl_sf_legendre_P3 (double x)
  fun gsl_sf_legendre_P3: double -> double = 'gsl_sf_legendre_P3($a)';
// Function: int gsl_sf_legendre_P1_e (double x, gsl_sf_result * result)
  fun gsl_sf_legendre_P1_e: double * &gsl_sf_result -> int = 'gsl_sf_legendre_P1_e($a)';
// Function: int gsl_sf_legendre_P2_e (double x, gsl_sf_result * result)
  fun gsl_sf_legendre_P2_e: double * &gsl_sf_result -> int = 'gsl_sf_legendre_P2_e($a)';
// Function: int gsl_sf_legendre_P3_e (double x, gsl_sf_result * result)
  fun gsl_sf_legendre_P3_e: double * &gsl_sf_result -> int = 'gsl_sf_legendre_P3_e($a)';
// Function: double gsl_sf_legendre_Pl (int l, double x)
  fun gsl_sf_legendre_Pl: int * double -> double = 'gsl_sf_legendre_Pl($a)';
// Function: int gsl_sf_legendre_Pl_e (int l, double x, gsl_sf_result * result)
  fun gsl_sf_legendre_Pl_e: int * double * &gsl_sf_result -> int = 'gsl_sf_legendre_Pl_e($a)';
// Function: int gsl_sf_legendre_Pl_array (int lmax, double x, double result_array[])
  fun gsl_sf_legendre_Pl_array: int * double * +double -> int = 'gsl_sf_legendre_Pl_array($a)';
// Function: int gsl_sf_legendre_Pl_deriv_array (int lmax, double x, double result_array[], double result_deriv_array[])
  fun gsl_sf_legendre_Pl_deriv_array: int * double * +double * +double -> int = 'gsl_sf_legendre_Pl_deriv_array($a)';
// Function: double gsl_sf_legendre_Q0 (double x)
  fun gsl_sf_legendre_Q0: double -> double = 'gsl_sf_legendre_Q0($a)';
// Function: int gsl_sf_legendre_Q0_e (double x, gsl_sf_result * result)
  fun gsl_sf_legendre_Q0_e: double * &gsl_sf_result -> int = 'gsl_sf_legendre_Q0_e($a)';
// Function: double gsl_sf_legendre_Q1 (double x)
  fun gsl_sf_legendre_Q1: double -> double = 'gsl_sf_legendre_Q1($a)';
// Function: int gsl_sf_legendre_Q1_e (double x, gsl_sf_result * result)
  fun gsl_sf_legendre_Q1_e: double * &gsl_sf_result -> int = 'gsl_sf_legendre_Q1_e($a)';
// Function: double gsl_sf_legendre_Ql (int l, double x)
  fun gsl_sf_legendre_Ql: int * double -> double = 'gsl_sf_legendre_Ql($a)';
// Function: int gsl_sf_legendre_Ql_e (int l, double x, gsl_sf_result * result)
  fun gsl_sf_legendre_Ql_e: int * double * &gsl_sf_result -> int = 'gsl_sf_legendre_Ql_e($a)';
//*****
// 07.24.02 Associated-Legendre-Polynomials-and-Spherical-Harmonics.
// Function: double gsl_sf_legendre_Plm (int l, int m, double x)
  fun gsl_sf_legendre_Plm: int * int * double -> double = 'gsl_sf_legendre_Plm($a)';
// Function: int gsl_sf_legendre_Plm_e (int l, int m, double x, gsl_sf_result * result)
  fun gsl_sf_legendre_Plm_e: int * int * double * &gsl_sf_result -> int = 'gsl_sf_legendre_Plm_e($a)';
// Function: int gsl_sf_legendre_Plm_array (int lmax, int m, double x, double result_array[])
  fun gsl_sf_legendre_Plm_array: int * int * double * +double -> int = 'gsl_sf_legendre_Plm_array($a)';
// Function: int gsl_sf_legendre_Plm_deriv_array (int lmax, int m, double x, double result_array[], double result_deriv_array[])
  fun gsl_sf_legendre_Plm_deriv_array: int * int * double * +double * +double -> int = 'gsl_sf_legendre_Plm_deriv_array($a)';
// Function: double gsl_sf_legendre_sphPlm (int l, int m, double x)
  fun gsl_sf_legendre_sphPlm: int * int * double -> double = 'gsl_sf_legendre_sphPlm($a)';
// Function: int gsl_sf_legendre_sphPlm_e (int l, int m, double x, gsl_sf_result * result)
  fun gsl_sf_legendre_sphPlm_e: int * int * double * &gsl_sf_result -> int = 'gsl_sf_legendre_sphPlm_e($a)';
// Function: int gsl_sf_legendre_sphPlm_array (int lmax, int m, double x, double result_array[])
  fun gsl_sf_legendre_sphPlm_array: int * int * double * +double -> int = 'gsl_sf_legendre_sphPlm_array($a)';
// Function: int gsl_sf_legendre_sphPlm_deriv_array (int lmax, int m, double x, double result_array[], double result_deriv_array[])
  fun gsl_sf_legendre_sphPlm_deriv_array: int * int * double * +double * +double -> int = 'gsl_sf_legendre_sphPlm_deriv_array($a)';
// Function: int gsl_sf_legendre_array_size (const int lmax, const int m)
  fun gsl_sf_legendre_array_size: int * int -> int = 'gsl_sf_legendre_array_size($a)';
//*****
// 07.24.03 Conical-Functions.
// Function: double gsl_sf_conicalP_half (double lambda, double x)
  fun gsl_sf_conicalP_half: double * double -> double = 'gsl_sf_conicalP_half($a)';
// Function: int gsl_sf_conicalP_half_e (double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_conicalP_half_e: double * double * &gsl_sf_result -> int = 'gsl_sf_conicalP_half_e($a)';
// Function: double gsl_sf_conicalP_mhalf (double lambda, double x)
  fun gsl_sf_conicalP_mhalf: double * double -> double = 'gsl_sf_conicalP_mhalf($a)';
// Function: int gsl_sf_conicalP_mhalf_e (double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_conicalP_mhalf_e: double * double * &gsl_sf_result -> int = 'gsl_sf_conicalP_mhalf_e($a)';
// Function: double gsl_sf_conicalP_0 (double lambda, double x)
  fun gsl_sf_conicalP_0: double * double -> double = 'gsl_sf_conicalP_0($a)';
// Function: int gsl_sf_conicalP_0_e (double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_conicalP_0_e: double * double * &gsl_sf_result -> int = 'gsl_sf_conicalP_0_e($a)';
// Function: double gsl_sf_conicalP_1 (double lambda, double x)
  fun gsl_sf_conicalP_1: double * double -> double = 'gsl_sf_conicalP_1($a)';
// Function: int gsl_sf_conicalP_1_e (double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_conicalP_1_e: double * double * &gsl_sf_result -> int = 'gsl_sf_conicalP_1_e($a)';
// Function: double gsl_sf_conicalP_sph_reg (int l, double lambda, double x)
  fun gsl_sf_conicalP_sph_reg: int * double * double -> double = 'gsl_sf_conicalP_sph_reg($a)';
// Function: int gsl_sf_conicalP_sph_reg_e (int l, double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_conicalP_sph_reg_e: int * double * double * &gsl_sf_result -> int = 'gsl_sf_conicalP_sph_reg_e($a)';
// Function: double gsl_sf_conicalP_cyl_reg (int m, double lambda, double x)
  fun gsl_sf_conicalP_cyl_reg: int * double * double -> double = 'gsl_sf_conicalP_cyl_reg($a)';
// Function: int gsl_sf_conicalP_cyl_reg_e (int m, double lambda, double x, gsl_sf_result * result)
  fun gsl_sf_conicalP_cyl_reg_e: int * double * double * &gsl_sf_result -> int = 'gsl_sf_conicalP_cyl_reg_e($a)';
//*****
// 07.24.04 Radial-Functions-for-Hyperbolic-Space.
// Function: double gsl_sf_legendre_H3d_0 (double lambda, double eta)
  fun gsl_sf_legendre_H3d_0: double * double -> double = 'gsl_sf_legendre_H3d_0($a)';
// Function: int gsl_sf_legendre_H3d_0_e (double lambda, double eta, gsl_sf_result * result)
  fun gsl_sf_legendre_H3d_0_e: double * double * &gsl_sf_result -> int = 'gsl_sf_legendre_H3d_0_e($a)';
// Function: double gsl_sf_legendre_H3d_1 (double lambda, double eta)
  fun gsl_sf_legendre_H3d_1: double * double -> double = 'gsl_sf_legendre_H3d_1($a)';
// Function: int gsl_sf_legendre_H3d_1_e (double lambda, double eta, gsl_sf_result * result)
  fun gsl_sf_legendre_H3d_1_e: double * double * &gsl_sf_result -> int = 'gsl_sf_legendre_H3d_1_e($a)';
// Function: double gsl_sf_legendre_H3d (int l, double lambda, double eta)
  fun gsl_sf_legendre_H3d: int * double * double -> double = 'gsl_sf_legendre_H3d($a)';
// Function: int gsl_sf_legendre_H3d_e (int l, double lambda, double eta, gsl_sf_result * result)
  fun gsl_sf_legendre_H3d_e: int * double * double * &gsl_sf_result -> int = 'gsl_sf_legendre_H3d_e($a)';
// Function: int gsl_sf_legendre_H3d_array (int lmax, double lambda, double eta, double result_array[])
  fun gsl_sf_legendre_H3d_array: int * double * double * +double -> int = 'gsl_sf_legendre_H3d_array($a)';
//*****
// 07.25.00 Logarithm-and-Related-Functions.
// Function: double gsl_sf_log (double x)
  fun gsl_sf_log: double -> double = 'gsl_sf_log($a)';
// Function: int gsl_sf_log_e (double x, gsl_sf_result * result)
  fun gsl_sf_log_e: double * &gsl_sf_result -> int = 'gsl_sf_log_e($a)';
// Function: double gsl_sf_log_abs (double x)
  fun gsl_sf_log_abs: double -> double = 'gsl_sf_log_abs($a)';
// Function: int gsl_sf_log_abs_e (double x, gsl_sf_result * result)
  fun gsl_sf_log_abs_e: double * &gsl_sf_result -> int = 'gsl_sf_log_abs_e($a)';
// Function: int gsl_sf_complex_log_e (double zr, double zi, gsl_sf_result * lnr, gsl_sf_result * theta)
  fun gsl_sf_complex_log_e: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_complex_log_e($a)';
// Function: double gsl_sf_log_1plusx (double x)
  fun gsl_sf_log_1plusx: double -> double = 'gsl_sf_log_1plusx($a)';
// Function: int gsl_sf_log_1plusx_e (double x, gsl_sf_result * result)
  fun gsl_sf_log_1plusx_e: double * &gsl_sf_result -> int = 'gsl_sf_log_1plusx_e($a)';
// Function: double gsl_sf_log_1plusx_mx (double x)
  fun gsl_sf_log_1plusx_mx: double -> double = 'gsl_sf_log_1plusx_mx($a)';
// Function: int gsl_sf_log_1plusx_mx_e (double x, gsl_sf_result * result)
  fun gsl_sf_log_1plusx_mx_e: double * &gsl_sf_result -> int = 'gsl_sf_log_1plusx_mx_e($a)';
//*****
// 07.26.00 Mathieu-Functions.
//*****
// 07.26.01 Mathieu-Function-Workspace.
// Function: gsl_sf_mathieu_workspace * gsl_sf_mathieu_alloc (size_t n, double qmax)
  fun gsl_sf_mathieu_alloc: size * double -> &gsl_sf_mathieu_workspace = 'gsl_sf_mathieu_alloc($a)';
// Function: void gsl_sf_mathieu_free (gsl_sf_mathieu_workspace * work)
  proc gsl_sf_mathieu_free: &gsl_sf_mathieu_workspace = 'gsl_sf_mathieu_free($a);';
//*****
// 07.26.02 Mathieu-Function-Characteristic-Values.
// Function: int gsl_sf_mathieu_a (int n, double q, gsl_sf_result * result)
  fun gsl_sf_mathieu_a: int * double * &gsl_sf_result -> int = 'gsl_sf_mathieu_a($a)';
// Function: int gsl_sf_mathieu_b (int n, double q, gsl_sf_result * result)
  fun gsl_sf_mathieu_b: int * double * &gsl_sf_result -> int = 'gsl_sf_mathieu_b($a)';
// Function: int gsl_sf_mathieu_a_array (int order_min, int order_max, double q, gsl_sf_mathieu_workspace * work, double result_array[])
  fun gsl_sf_mathieu_a_array: int * int * double * &gsl_sf_mathieu_workspace * +double -> int = 'gsl_sf_mathieu_a_array($a)';
// Function: int gsl_sf_mathieu_b_array (int order_min, int order_max, double q, gsl_sf_mathieu_workspace * work, double result_array[])
  fun gsl_sf_mathieu_b_array: int * int * double * &gsl_sf_mathieu_workspace * +double -> int = 'gsl_sf_mathieu_b_array($a)';
//*****
// 07.26.03 Angular-Mathieu-Functions.
// Function: int gsl_sf_mathieu_ce (int n, double q, double x, gsl_sf_result * result)
  fun gsl_sf_mathieu_ce: int * double * double * &gsl_sf_result -> int = 'gsl_sf_mathieu_ce($a)';
// Function: int gsl_sf_mathieu_se (int n, double q, double x, gsl_sf_result * result)
  fun gsl_sf_mathieu_se: int * double * double * &gsl_sf_result -> int = 'gsl_sf_mathieu_se($a)';
// Function: int gsl_sf_mathieu_ce_array (int nmin, int nmax, double q, double x, gsl_sf_mathieu_workspace * work, double result_array[])
  fun gsl_sf_mathieu_ce_array: int * int * double * double * &gsl_sf_mathieu_workspace * +double -> int = 'gsl_sf_mathieu_ce_array($a)';
// Function: int gsl_sf_mathieu_se_array (int nmin, int nmax, double q, double x, gsl_sf_mathieu_workspace * work, double result_array[])
  fun gsl_sf_mathieu_se_array: int * int * double * double * &gsl_sf_mathieu_workspace * +double -> int = 'gsl_sf_mathieu_se_array($a)';
//*****
// 07.26.04 Radial-Mathieu-Functions.
// Function: int gsl_sf_mathieu_Mc (int j, int n, double q, double x, gsl_sf_result * result)
  fun gsl_sf_mathieu_Mc: int * int * double * double * &gsl_sf_result -> int = 'gsl_sf_mathieu_Mc($a)';
// Function: int gsl_sf_mathieu_Ms (int j, int n, double q, double x, gsl_sf_result * result)
  fun gsl_sf_mathieu_Ms: int * int * double * double * &gsl_sf_result -> int = 'gsl_sf_mathieu_Ms($a)';
// Function: int gsl_sf_mathieu_Mc_array (int j, int nmin, int nmax, double q, double x, gsl_sf_mathieu_workspace * work, double result_array[])
  fun gsl_sf_mathieu_Mc_array: int * int * int * double * double * &gsl_sf_mathieu_workspace * +double -> int = 'gsl_sf_mathieu_Mc_array($a)';
// Function: int gsl_sf_mathieu_Ms_array (int j, int nmin, int nmax, double q, double x, gsl_sf_mathieu_workspace * work, double result_array[])
  fun gsl_sf_mathieu_Ms_array: int * int * int * double * double * &gsl_sf_mathieu_workspace * +double -> int = 'gsl_sf_mathieu_Ms_array($a)';
//*****
// 07.27.00 Power-Function.
// Function: double gsl_sf_pow_int (double x, int n)
  fun gsl_sf_pow_int: double * int -> double = 'gsl_sf_pow_int($a)';
// Function: int gsl_sf_pow_int_e (double x, int n, gsl_sf_result * result)
  fun gsl_sf_pow_int_e: double * int * &gsl_sf_result -> int = 'gsl_sf_pow_int_e($a)';
//*****
// 07.28.00 Psi-(Digamma)-Function.
//*****
// 07.28.01 Digamma-Function.
// Function: double gsl_sf_psi_int (int n)
  fun gsl_sf_psi_int: int -> double = 'gsl_sf_psi_int($a)';
// Function: int gsl_sf_psi_int_e (int n, gsl_sf_result * result)
  fun gsl_sf_psi_int_e: int * &gsl_sf_result -> int = 'gsl_sf_psi_int_e($a)';
// Function: double gsl_sf_psi (double x)
  fun gsl_sf_psi: double -> double = 'gsl_sf_psi($a)';
// Function: int gsl_sf_psi_e (double x, gsl_sf_result * result)
  fun gsl_sf_psi_e: double * &gsl_sf_result -> int = 'gsl_sf_psi_e($a)';
// Function: double gsl_sf_psi_1piy (double y)
  fun gsl_sf_psi_1piy: double -> double = 'gsl_sf_psi_1piy($a)';
// Function: int gsl_sf_psi_1piy_e (double y, gsl_sf_result * result)
  fun gsl_sf_psi_1piy_e: double * &gsl_sf_result -> int = 'gsl_sf_psi_1piy_e($a)';
//*****
// 07.28.02 Trigamma-Function.
// Function: double gsl_sf_psi_1_int (int n)
  fun gsl_sf_psi_1_int: int -> double = 'gsl_sf_psi_1_int($a)';
// Function: int gsl_sf_psi_1_int_e (int n, gsl_sf_result * result)
  fun gsl_sf_psi_1_int_e: int * &gsl_sf_result -> int = 'gsl_sf_psi_1_int_e($a)';
// Function: double gsl_sf_psi_1 (double x)
  fun gsl_sf_psi_1: double -> double = 'gsl_sf_psi_1($a)';
// Function: int gsl_sf_psi_1_e (double x, gsl_sf_result * result)
  fun gsl_sf_psi_1_e: double * &gsl_sf_result -> int = 'gsl_sf_psi_1_e($a)';
//*****
// 07.28.03 Polygamma-Function.
// Function: double gsl_sf_psi_n (int n, double x)
  fun gsl_sf_psi_n: int * double -> double = 'gsl_sf_psi_n($a)';
// Function: int gsl_sf_psi_n_e (int n, double x, gsl_sf_result * result)
  fun gsl_sf_psi_n_e: int * double * &gsl_sf_result -> int = 'gsl_sf_psi_n_e($a)';
//*****
// 07.29.00 Synchrotron-Functions.
// Function: double gsl_sf_synchrotron_1 (double x)
  fun gsl_sf_synchrotron_1: double -> double = 'gsl_sf_synchrotron_1($a)';
// Function: int gsl_sf_synchrotron_1_e (double x, gsl_sf_result * result)
  fun gsl_sf_synchrotron_1_e: double * &gsl_sf_result -> int = 'gsl_sf_synchrotron_1_e($a)';
// Function: double gsl_sf_synchrotron_2 (double x)
  fun gsl_sf_synchrotron_2: double -> double = 'gsl_sf_synchrotron_2($a)';
// Function: int gsl_sf_synchrotron_2_e (double x, gsl_sf_result * result)
  fun gsl_sf_synchrotron_2_e: double * &gsl_sf_result -> int = 'gsl_sf_synchrotron_2_e($a)';
//*****
// 07.30.00 Transport-Functions.
// Function: double gsl_sf_transport_2 (double x)
  fun gsl_sf_transport_2: double -> double = 'gsl_sf_transport_2($a)';
// Function: int gsl_sf_transport_2_e (double x, gsl_sf_result * result)
  fun gsl_sf_transport_2_e: double * &gsl_sf_result -> int = 'gsl_sf_transport_2_e($a)';
// Function: double gsl_sf_transport_3 (double x)
  fun gsl_sf_transport_3: double -> double = 'gsl_sf_transport_3($a)';
// Function: int gsl_sf_transport_3_e (double x, gsl_sf_result * result)
  fun gsl_sf_transport_3_e: double * &gsl_sf_result -> int = 'gsl_sf_transport_3_e($a)';
// Function: double gsl_sf_transport_4 (double x)
  fun gsl_sf_transport_4: double -> double = 'gsl_sf_transport_4($a)';
// Function: int gsl_sf_transport_4_e (double x, gsl_sf_result * result)
  fun gsl_sf_transport_4_e: double * &gsl_sf_result -> int = 'gsl_sf_transport_4_e($a)';
// Function: double gsl_sf_transport_5 (double x)
  fun gsl_sf_transport_5: double -> double = 'gsl_sf_transport_5($a)';
// Function: int gsl_sf_transport_5_e (double x, gsl_sf_result * result)
  fun gsl_sf_transport_5_e: double * &gsl_sf_result -> int = 'gsl_sf_transport_5_e($a)';
//*****
// 07.31.00 Trigonometric-Functions.
//*****
// 07.31.01 Circular-Trigonometric-Functions.
// Function: double gsl_sf_sin (double x)
  fun gsl_sf_sin: double -> double = 'gsl_sf_sin($a)';
// Function: int gsl_sf_sin_e (double x, gsl_sf_result * result)
  fun gsl_sf_sin_e: double * &gsl_sf_result -> int = 'gsl_sf_sin_e($a)';
// Function: double gsl_sf_cos (double x)
  fun gsl_sf_cos: double -> double = 'gsl_sf_cos($a)';
// Function: int gsl_sf_cos_e (double x, gsl_sf_result * result)
  fun gsl_sf_cos_e: double * &gsl_sf_result -> int = 'gsl_sf_cos_e($a)';
// Function: double gsl_sf_hypot (double x, double y)
  fun gsl_sf_hypot: double * double -> double = 'gsl_sf_hypot($a)';
// Function: int gsl_sf_hypot_e (double x, double y, gsl_sf_result * result)
  fun gsl_sf_hypot_e: double * double * &gsl_sf_result -> int = 'gsl_sf_hypot_e($a)';
// Function: double gsl_sf_sinc (double x)
  fun gsl_sf_sinc: double -> double = 'gsl_sf_sinc($a)';
// Function: int gsl_sf_sinc_e (double x, gsl_sf_result * result)
  fun gsl_sf_sinc_e: double * &gsl_sf_result -> int = 'gsl_sf_sinc_e($a)';
//*****
// 07.31.02 Trigonometric-Functions-for-Complex-Arguments.
// Function: int gsl_sf_complex_sin_e (double zr, double zi, gsl_sf_result * szr, gsl_sf_result * szi)
  fun gsl_sf_complex_sin_e: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_complex_sin_e($a)';
// Function: int gsl_sf_complex_cos_e (double zr, double zi, gsl_sf_result * czr, gsl_sf_result * czi)
  fun gsl_sf_complex_cos_e: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_complex_cos_e($a)';
// Function: int gsl_sf_complex_logsin_e (double zr, double zi, gsl_sf_result * lszr, gsl_sf_result * lszi)
  fun gsl_sf_complex_logsin_e: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_complex_logsin_e($a)';
//*****
// 07.31.03 Hyperbolic-Trigonometric-Functions.
// Function: double gsl_sf_lnsinh (double x)
  fun gsl_sf_lnsinh: double -> double = 'gsl_sf_lnsinh($a)';
// Function: int gsl_sf_lnsinh_e (double x, gsl_sf_result * result)
  fun gsl_sf_lnsinh_e: double * &gsl_sf_result -> int = 'gsl_sf_lnsinh_e($a)';
// Function: double gsl_sf_lncosh (double x)
  fun gsl_sf_lncosh: double -> double = 'gsl_sf_lncosh($a)';
// Function: int gsl_sf_lncosh_e (double x, gsl_sf_result * result)
  fun gsl_sf_lncosh_e: double * &gsl_sf_result -> int = 'gsl_sf_lncosh_e($a)';
//*****
// 07.31.04 Conversion-Functions.
// Function: int gsl_sf_polar_to_rect (double r, double theta, gsl_sf_result * x, gsl_sf_result * y);
  fun gsl_sf_polar_to_rect: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_polar_to_rect($a)';
// Function: int gsl_sf_rect_to_polar (double x, double y, gsl_sf_result * r, gsl_sf_result * theta)
  fun gsl_sf_rect_to_polar: double * double * &gsl_sf_result * &gsl_sf_result -> int = 'gsl_sf_rect_to_polar($a)';
//*****
// 07.31.05 Restriction-Functions.
// Function: double gsl_sf_angle_restrict_symm (double theta)
  fun gsl_sf_angle_restrict_symm: double -> double = 'gsl_sf_angle_restrict_symm($a)';
// Function: int gsl_sf_angle_restrict_symm_e (double * theta)
  fun gsl_sf_angle_restrict_symm_e: &double -> int = 'gsl_sf_angle_restrict_symm_e($a)';
// Function: double gsl_sf_angle_restrict_pos (double theta)
  fun gsl_sf_angle_restrict_pos: double -> double = 'gsl_sf_angle_restrict_pos($a)';
// Function: int gsl_sf_angle_restrict_pos_e (double * theta)
  fun gsl_sf_angle_restrict_pos_e: &double -> int = 'gsl_sf_angle_restrict_pos_e($a)';
//*****
// 07.31.06 Trigonometric-Functions-With-Error-Estimates.
// Function: int gsl_sf_sin_err_e (double x, double dx, gsl_sf_result * result)
  fun gsl_sf_sin_err_e: double * double * &gsl_sf_result -> int = 'gsl_sf_sin_err_e($a)';
// Function: int gsl_sf_cos_err_e (double x, double dx, gsl_sf_result * result)
  fun gsl_sf_cos_err_e: double * double * &gsl_sf_result -> int = 'gsl_sf_cos_err_e($a)';
//*****
// 07.32.00 Zeta-Functions.
//*****
// 07.32.01 Riemann-Zeta-Function.
// Function: double gsl_sf_zeta_int (int n)
  fun gsl_sf_zeta_int: int -> double = 'gsl_sf_zeta_int($a)';
// Function: int gsl_sf_zeta_int_e (int n, gsl_sf_result * result)
  fun gsl_sf_zeta_int_e: int * &gsl_sf_result -> int = 'gsl_sf_zeta_int_e($a)';
// Function: double gsl_sf_zeta (double s)
  fun gsl_sf_zeta: double -> double = 'gsl_sf_zeta($a)';
// Function: int gsl_sf_zeta_e (double s, gsl_sf_result * result)
  fun gsl_sf_zeta_e: double * &gsl_sf_result -> int = 'gsl_sf_zeta_e($a)';
//*****
// 07.32.02 Riemann-Zeta-Function-Minus-One.
// Function: double gsl_sf_zetam1_int (int n)
  fun gsl_sf_zetam1_int: int -> double = 'gsl_sf_zetam1_int($a)';
// Function: int gsl_sf_zetam1_int_e (int n, gsl_sf_result * result)
  fun gsl_sf_zetam1_int_e: int * &gsl_sf_result -> int = 'gsl_sf_zetam1_int_e($a)';
// Function: double gsl_sf_zetam1 (double s)
  fun gsl_sf_zetam1: double -> double = 'gsl_sf_zetam1($a)';
// Function: int gsl_sf_zetam1_e (double s, gsl_sf_result * result)
  fun gsl_sf_zetam1_e: double * &gsl_sf_result -> int = 'gsl_sf_zetam1_e($a)';
//*****
// 07.32.03 Hurwitz-Zeta-Function.
// Function: double gsl_sf_hzeta (double s, double q)
  fun gsl_sf_hzeta: double * double -> double = 'gsl_sf_hzeta($a)';
// Function: int gsl_sf_hzeta_e (double s, double q, gsl_sf_result * result)
  fun gsl_sf_hzeta_e: double * double * &gsl_sf_result -> int = 'gsl_sf_hzeta_e($a)';
//*****
// 07.32.04 Eta-Function.
// Function: double gsl_sf_eta_int (int n)
  fun gsl_sf_eta_int: int -> double = 'gsl_sf_eta_int($a)';
// Function: int gsl_sf_eta_int_e (int n, gsl_sf_result * result)
  fun gsl_sf_eta_int_e: int * &gsl_sf_result -> int = 'gsl_sf_eta_int_e($a)';
// Function: double gsl_sf_eta (double s)
  fun gsl_sf_eta: double -> double = 'gsl_sf_eta($a)';
// Function: int gsl_sf_eta_e (double s, gsl_sf_result * result)
  fun gsl_sf_eta_e: double * &gsl_sf_result -> int = 'gsl_sf_eta_e($a)';
//*****
// 08.00.00 Vectors-and-Matrices.
//*****
// 08.01.00 Data-types.
//*****
// 08.02.00 Blocks.
//*****
// 08.02.01 Block-allocation.
// Function: gsl_block * gsl_block_alloc (size_t n)
  fun gsl_block_alloc: size -> &gsl_block = 'gsl_block_alloc($a)';
// Function: gsl_block * gsl_block_calloc (size_t n)
  fun gsl_block_calloc: size -> &gsl_block = 'gsl_block_calloc($a)';
// Function: void gsl_block_free (gsl_block * b)
  proc gsl_block_free: &gsl_block = 'gsl_block_free($a);';
//*****
// 08.02.02 Reading-and-writing-blocks.
// Function: int gsl_block_fwrite (FILE * stream, const gsl_block * b)
  fun gsl_block_fwrite: &FILE * &gsl_block -> int = 'gsl_block_fwrite($a)';
// Function: int gsl_block_fread (FILE * stream, gsl_block * b)
  fun gsl_block_fread: &FILE * &gsl_block -> int = 'gsl_block_fread($a)';
// Function: int gsl_block_fprintf (FILE * stream, const gsl_block * b, const char * format)
  fun gsl_block_fprintf: &FILE * &gsl_block * &char -> int = 'gsl_block_fprintf($a)';
// Function: int gsl_block_fscanf (FILE * stream, gsl_block * b)
  fun gsl_block_fscanf: &FILE * &gsl_block -> int = 'gsl_block_fscanf($a)';
//*****
// 08.03.00 Vectors.
//*****
// 08.03.01 Vector-allocation.
// Function: gsl_vector * gsl_vector_alloc (size_t n)
  fun gsl_vector_alloc: size -> &gsl_vector = 'gsl_vector_alloc($a)';
// Function: gsl_vector * gsl_vector_calloc (size_t n)
  fun gsl_vector_calloc: size -> &gsl_vector = 'gsl_vector_calloc($a)';
// Function: void gsl_vector_free (gsl_vector * v)
  proc gsl_vector_free: &gsl_vector = 'gsl_vector_free($a);';
//*****
// 08.03.02 Accessing-vector-elements.
// Function: double gsl_vector_get (const gsl_vector * v, size_t i)
  fun gsl_vector_get: &gsl_vector * size -> double = 'gsl_vector_get($a)';
// Function: void gsl_vector_set (gsl_vector * v, size_t i, double x)
  proc gsl_vector_set: &gsl_vector * size * double = 'gsl_vector_set($a);';
// Function: double * gsl_vector_ptr (gsl_vector * v, size_t i)
  fun gsl_vector_ptr: &gsl_vector * size -> &double = 'gsl_vector_ptr($a)';
// Function: const double * gsl_vector_const_ptr (const gsl_vector * v, size_t i)
  fun gsl_vector_const_ptr: &gsl_vector * size -> &double = 'gsl_vector_const_ptr($a)';
//*****
// 08.03.03 Initialising-vector-elements.
// Function: void gsl_vector_set_all (gsl_vector * v, double x)
  proc gsl_vector_set_all: &gsl_vector * double = 'gsl_vector_set_all($a);';
// Function: void gsl_vector_set_zero (gsl_vector * v)
  proc gsl_vector_set_zero: &gsl_vector = 'gsl_vector_set_zero($a);';
// Function: int gsl_vector_set_basis (gsl_vector * v, size_t i)
  fun gsl_vector_set_basis: &gsl_vector * size -> int = 'gsl_vector_set_basis($a)';
//*****
// 08.03.04 Reading-and-writing-vectors.
// Function: int gsl_vector_fwrite (FILE * stream, const gsl_vector * v)
  fun gsl_vector_fwrite: &FILE * &gsl_vector -> int = 'gsl_vector_fwrite($a)';
// Function: int gsl_vector_fread (FILE * stream, gsl_vector * v)
  fun gsl_vector_fread: &FILE * &gsl_vector -> int = 'gsl_vector_fread($a)';
// Function: int gsl_vector_fprintf (FILE * stream, const gsl_vector * v, const char * format)
  fun gsl_vector_fprintf: &FILE * &gsl_vector * &char -> int = 'gsl_vector_fprintf($a)';
// Function: int gsl_vector_fscanf (FILE * stream, gsl_vector * v)
  fun gsl_vector_fscanf: &FILE * &gsl_vector -> int = 'gsl_vector_fscanf($a)';
//*****
// 08.03.05 Vector-views.
// Function: gsl_vector_view gsl_vector_subvector (gsl_vector * v, size_t offset, size_t n)
  fun gsl_vector_subvector: &gsl_vector * size * size -> gsl_vector_view = 'gsl_vector_subvector($a)';
// Function: gsl_vector_const_view gsl_vector_const_subvector (const gsl_vector * v, size_t offset, size_t n)
  fun gsl_vector_const_subvector: &gsl_vector * size * size -> gsl_vector_const_view = 'gsl_vector_const_subvector($a)';
// Function: gsl_vector_view gsl_vector_subvector_with_stride (gsl_vector * v, size_t offset, size_t stride, size_t n)
  fun gsl_vector_subvector_with_stride: &gsl_vector * size * size * size -> gsl_vector_view = 'gsl_vector_subvector_with_stride($a)';
// Function: gsl_vector_const_view gsl_vector_const_subvector_with_stride (const gsl_vector * v, size_t offset, size_t stride, size_t n)
  fun gsl_vector_const_subvector_with_stride: &gsl_vector * size * size * size -> gsl_vector_const_view = 'gsl_vector_const_subvector_with_stride($a)';
// Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex * v)
  fun gsl_vector_complex_real: &gsl_vector_complex -> gsl_vector_view = 'gsl_vector_complex_real($a)';
// Function: gsl_vector_const_view gsl_vector_complex_const_real (const gsl_vector_complex * v)
  fun gsl_vector_complex_const_real: &gsl_vector_complex -> gsl_vector_const_view = 'gsl_vector_complex_const_real($a)';
// Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex * v)
  fun gsl_vector_complex_imag: &gsl_vector_complex -> gsl_vector_view = 'gsl_vector_complex_imag($a)';
// Function: gsl_vector_const_view gsl_vector_complex_const_imag (const gsl_vector_complex * v)
  fun gsl_vector_complex_const_imag: &gsl_vector_complex -> gsl_vector_const_view = 'gsl_vector_complex_const_imag($a)';
// Function: gsl_vector_view gsl_vector_view_array (double * base, size_t n)
  fun gsl_vector_view_array: &double * size -> gsl_vector_view = 'gsl_vector_view_array($a)';
// Function: gsl_vector_const_view gsl_vector_const_view_array (const double * base, size_t n)
  fun gsl_vector_const_view_array: &double * size -> gsl_vector_const_view = 'gsl_vector_const_view_array($a)';
// Function: gsl_vector_view gsl_vector_view_array_with_stride (double * base, size_t stride, size_t n)
  fun gsl_vector_view_array_with_stride: &double * size * size -> gsl_vector_view = 'gsl_vector_view_array_with_stride($a)';
// Function: gsl_vector_const_view gsl_vector_const_view_array_with_stride (const double * base, size_t stride, size_t n)
  fun gsl_vector_const_view_array_with_stride: &double * size * size -> gsl_vector_const_view = 'gsl_vector_const_view_array_with_stride($a)';
//*****
// 08.03.06 Copying-vectors.
// Function: int gsl_vector_memcpy (gsl_vector * dest, const gsl_vector * src)
  fun gsl_vector_memcpy: &gsl_vector * &gsl_vector -> int = 'gsl_vector_memcpy($a)';
// Function: int gsl_vector_swap (gsl_vector * v, gsl_vector * w)
  fun gsl_vector_swap: &gsl_vector * &gsl_vector -> int = 'gsl_vector_swap($a)';
//*****
// 08.03.07 Exchanging-elements.
// Function: int gsl_vector_swap_elements (gsl_vector * v, size_t i, size_t j)
  fun gsl_vector_swap_elements: &gsl_vector * size * size -> int = 'gsl_vector_swap_elements($a)';
// Function: int gsl_vector_reverse (gsl_vector * v)
  fun gsl_vector_reverse: &gsl_vector -> int = 'gsl_vector_reverse($a)';
//*****
// 08.03.08 Vector-operations.
// Function: int gsl_vector_add (gsl_vector * a, const gsl_vector * b)
  fun gsl_vector_add: &gsl_vector * &gsl_vector -> int = 'gsl_vector_add($a)';
// Function: int gsl_vector_sub (gsl_vector * a, const gsl_vector * b)
  fun gsl_vector_sub: &gsl_vector * &gsl_vector -> int = 'gsl_vector_sub($a)';
// Function: int gsl_vector_mul (gsl_vector * a, const gsl_vector * b)
  fun gsl_vector_mul: &gsl_vector * &gsl_vector -> int = 'gsl_vector_mul($a)';
// Function: int gsl_vector_div (gsl_vector * a, const gsl_vector * b)
  fun gsl_vector_div: &gsl_vector * &gsl_vector -> int = 'gsl_vector_div($a)';
// Function: int gsl_vector_scale (gsl_vector * a, const double x)
  fun gsl_vector_scale: &gsl_vector * double -> int = 'gsl_vector_scale($a)';
// Function: int gsl_vector_add_constant (gsl_vector * a, const double x)
  fun gsl_vector_add_constant: &gsl_vector * double -> int = 'gsl_vector_add_constant($a)';
//*****
// 08.03.09 Finding-maximum-and-minimum-elemnts-of-vectors.
// Function: double gsl_vector_max (const gsl_vector * v)
  fun gsl_vector_max: &gsl_vector -> double = 'gsl_vector_max($a)';
// Function: double gsl_vector_min (const gsl_vector * v)
  fun gsl_vector_min: &gsl_vector -> double = 'gsl_vector_min($a)';
// Function: void gsl_vector_minmax (const gsl_vector * v, double * min_out, double * max_out)
  proc gsl_vector_minmax: &gsl_vector * &double * &double = 'gsl_vector_minmax($a);';
// Function: size_t gsl_vector_max_index (const gsl_vector * v)
  fun gsl_vector_max_index: &gsl_vector -> size = 'gsl_vector_max_index($a)';
// Function: size_t gsl_vector_min_index (const gsl_vector * v)
  fun gsl_vector_min_index: &gsl_vector -> size = 'gsl_vector_min_index($a)';
// Function: void gsl_vector_minmax_index (const gsl_vector * v, size_t * imin, size_t * imax)
  proc gsl_vector_minmax_index: &gsl_vector * &size * &size = 'gsl_vector_minmax_index($a);';
//*****
// 08.03.10 vector-properties.
// Function: int gsl_vector_isnull (const gsl_vector * v)
  fun gsl_vector_isnull: &gsl_vector -> int = 'gsl_vector_isnull($a)';
// Function: int gsl_vector_ispos (const gsl_vector * v)
  fun gsl_vector_ispos: &gsl_vector -> int = 'gsl_vector_ispos($a)';
// Function: int gsl_vector_isneg (const gsl_vector * v)
  fun gsl_vector_isneg: &gsl_vector -> int = 'gsl_vector_isneg($a)';
// Function: int gsl_vector_isnonneg (const gsl_vector * v)
  fun gsl_vector_isnonneg: &gsl_vector -> int = 'gsl_vector_isnonneg($a)';
// Function: int gsl_vector_equal (const gsl_vector * u, const gsl_vector * v)
  fun gsl_vector_equal: &gsl_vector * &gsl_vector -> int = 'gsl_vector_equal($a)';
//*****
// 08.04.00 Matrices.
//*****
// 08.04.01 Matrix-allocation.
// Function: gsl_matrix * gsl_matrix_alloc (size_t n1, size_t n2)
  fun gsl_matrix_alloc: size * size -> &gsl_matrix = 'gsl_matrix_alloc($a)';
// Function: gsl_matrix * gsl_matrix_calloc (size_t n1, size_t n2)
  fun gsl_matrix_calloc: size * size -> &gsl_matrix = 'gsl_matrix_calloc($a)';
// Function: void gsl_matrix_free (gsl_matrix * m)
  proc gsl_matrix_free: &gsl_matrix = 'gsl_matrix_free($a);';
//*****
// 08.04.02 Accessing-matrix-elements.
// Function: double gsl_matrix_get (const gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_get: &gsl_matrix * size * size -> double = 'gsl_matrix_get($a)';
// Function: void gsl_matrix_set (gsl_matrix * m, size_t i, size_t j, double x)
  proc gsl_matrix_set: &gsl_matrix * size * size * double = 'gsl_matrix_set($a);';
// Function: double * gsl_matrix_ptr (gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_ptr: &gsl_matrix * size * size -> &double = 'gsl_matrix_ptr($a)';
// Function: const double * gsl_matrix_const_ptr (const gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_const_ptr: &gsl_matrix * size * size -> &double = 'gsl_matrix_const_ptr($a)';
//*****
// 08.04.02 Initialising-matrix-elements.
// Function: double gsl_matrix_get (const gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_get: &gsl_matrix * size * size -> double = 'gsl_matrix_get($a)';
// Function: void gsl_matrix_set (gsl_matrix * m, size_t i, size_t j, double x)
  proc gsl_matrix_set: &gsl_matrix * size * size * double = 'gsl_matrix_set($a);';
// Function: double * gsl_matrix_ptr (gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_ptr: &gsl_matrix * size * size -> &double = 'gsl_matrix_ptr($a)';
// Function: const double * gsl_matrix_const_ptr (const gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_const_ptr: &gsl_matrix * size * size -> &double = 'gsl_matrix_const_ptr($a)';
//*****
// 08.04.04 Reading-and-writing-matrices.
// Function: int gsl_matrix_fwrite (FILE * stream, const gsl_matrix * m)
  fun gsl_matrix_fwrite: &FILE * &gsl_matrix -> int = 'gsl_matrix_fwrite($a)';
// Function: int gsl_matrix_fread (FILE * stream, gsl_matrix * m)
  fun gsl_matrix_fread: &FILE * &gsl_matrix -> int = 'gsl_matrix_fread($a)';
// Function: int gsl_matrix_fprintf (FILE * stream, const gsl_matrix * m, const char * format)
  fun gsl_matrix_fprintf: &FILE * &gsl_matrix * &char -> int = 'gsl_matrix_fprintf($a)';
// Function: int gsl_matrix_fscanf (FILE * stream, gsl_matrix * m)
  fun gsl_matrix_fscanf: &FILE * &gsl_matrix -> int = 'gsl_matrix_fscanf($a)';
//*****
// 08.04.05 Matrix-views.
// Function: gsl_matrix_view gsl_matrix_submatrix (gsl_matrix * m, size_t k1, size_t k2, size_t n1, size_t n2)
  fun gsl_matrix_submatrix: &gsl_matrix * size * size * size * size -> gsl_matrix_view = 'gsl_matrix_submatrix($a)';
// Function: gsl_matrix_const_view gsl_matrix_const_submatrix (const gsl_matrix * m, size_t k1, size_t k2, size_t n1, size_t n2)
  fun gsl_matrix_const_submatrix: &gsl_matrix * size * size * size * size -> gsl_matrix_const_view = 'gsl_matrix_const_submatrix($a)';
// Function: gsl_matrix_view gsl_matrix_view_array (double * base, size_t n1, size_t n2)
  fun gsl_matrix_view_array: &double * size * size -> gsl_matrix_view = 'gsl_matrix_view_array($a)';
// Function: gsl_matrix_const_view gsl_matrix_const_view_array (const double * base, size_t n1, size_t n2)
  fun gsl_matrix_const_view_array: &double * size * size -> gsl_matrix_const_view = 'gsl_matrix_const_view_array($a)';
// Function: gsl_matrix_view gsl_matrix_view_array_with_tda (double * base, size_t n1, size_t n2, size_t tda)
  fun gsl_matrix_view_array_with_tda: &double * size * size * size -> gsl_matrix_view = 'gsl_matrix_view_array_with_tda($a)';
// Function: gsl_matrix_const_view gsl_matrix_const_view_array_with_tda (const double * base, size_t n1, size_t n2, size_t tda)
  fun gsl_matrix_const_view_array_with_tda: &double * size * size * size -> gsl_matrix_const_view = 'gsl_matrix_const_view_array_with_tda($a)';
// Function: gsl_matrix_view gsl_matrix_view_vector (gsl_vector * v, size_t n1, size_t n2)
  fun gsl_matrix_view_vector: &gsl_vector * size * size -> gsl_matrix_view = 'gsl_matrix_view_vector($a)';
// Function: gsl_matrix_const_view gsl_matrix_const_view_vector (const gsl_vector * v, size_t n1, size_t n2)
  fun gsl_matrix_const_view_vector: &gsl_vector * size * size -> gsl_matrix_const_view = 'gsl_matrix_const_view_vector($a)';
// Function: gsl_matrix_view gsl_matrix_view_vector_with_tda (gsl_vector * v, size_t n1, size_t n2, size_t tda)
  fun gsl_matrix_view_vector_with_tda: &gsl_vector * size * size * size -> gsl_matrix_view = 'gsl_matrix_view_vector_with_tda($a)';
// Function: gsl_matrix_const_view gsl_matrix_const_view_vector_with_tda (const gsl_vector * v, size_t n1, size_t n2, size_t tda)
  fun gsl_matrix_const_view_vector_with_tda: &gsl_vector * size * size * size -> gsl_matrix_const_view = 'gsl_matrix_const_view_vector_with_tda($a)';
//*****
// 08.04.06 Creating-row-and-column-views.
// Function: gsl_vector_view gsl_matrix_row (gsl_matrix * m, size_t i)
  fun gsl_matrix_row: &gsl_matrix * size -> gsl_vector_view = 'gsl_matrix_row($a)';
// Function: gsl_vector_const_view gsl_matrix_const_row (const gsl_matrix * m, size_t i)
  fun gsl_matrix_const_row: &gsl_matrix * size -> gsl_vector_const_view = 'gsl_matrix_const_row($a)';
// Function: gsl_vector_view gsl_matrix_column (gsl_matrix * m, size_t j)
  fun gsl_matrix_column: &gsl_matrix * size -> gsl_vector_view = 'gsl_matrix_column($a)';
// Function: gsl_vector_const_view gsl_matrix_const_column (const gsl_matrix * m, size_t j)
  fun gsl_matrix_const_column: &gsl_matrix * size -> gsl_vector_const_view = 'gsl_matrix_const_column($a)';
// Function: gsl_vector_view gsl_matrix_subrow (gsl_matrix * m, size_t i, size_t offset, size_t n)
  fun gsl_matrix_subrow: &gsl_matrix * size * size * size -> gsl_vector_view = 'gsl_matrix_subrow($a)';
// Function: gsl_vector_const_view gsl_matrix_const_subrow (const gsl_matrix * m, size_t i, size_t offset, size_t n)
  fun gsl_matrix_const_subrow: &gsl_matrix * size * size * size -> gsl_vector_const_view = 'gsl_matrix_const_subrow($a)';
// Function: gsl_vector_view gsl_matrix_subcolumn (gsl_matrix * m, size_t j, size_t offset, size_t n)
  fun gsl_matrix_subcolumn: &gsl_matrix * size * size * size -> gsl_vector_view = 'gsl_matrix_subcolumn($a)';
// Function: gsl_vector_const_view gsl_matrix_const_subcolumn (const gsl_matrix * m, size_t j, size_t offset, size_t n)
  fun gsl_matrix_const_subcolumn: &gsl_matrix * size * size * size -> gsl_vector_const_view = 'gsl_matrix_const_subcolumn($a)';
// Function: gsl_vector_view gsl_matrix_diagonal (gsl_matrix * m)
  fun gsl_matrix_diagonal: &gsl_matrix -> gsl_vector_view = 'gsl_matrix_diagonal($a)';
// Function: gsl_vector_const_view gsl_matrix_const_diagonal (const gsl_matrix * m)
  fun gsl_matrix_const_diagonal: &gsl_matrix -> gsl_vector_const_view = 'gsl_matrix_const_diagonal($a)';
// Function: gsl_vector_view gsl_matrix_subdiagonal (gsl_matrix * m, size_t k)
  fun gsl_matrix_subdiagonal: &gsl_matrix * size -> gsl_vector_view = 'gsl_matrix_subdiagonal($a)';
// Function: gsl_vector_const_view gsl_matrix_const_subdiagonal (const gsl_matrix * m, size_t k)
  fun gsl_matrix_const_subdiagonal: &gsl_matrix * size -> gsl_vector_const_view = 'gsl_matrix_const_subdiagonal($a)';
// Function: gsl_vector_view gsl_matrix_superdiagonal (gsl_matrix * m, size_t k)
  fun gsl_matrix_superdiagonal: &gsl_matrix * size -> gsl_vector_view = 'gsl_matrix_superdiagonal($a)';
// Function: gsl_vector_const_view gsl_matrix_const_superdiagonal (const gsl_matrix * m, size_t k)
  fun gsl_matrix_const_superdiagonal: &gsl_matrix * size -> gsl_vector_const_view = 'gsl_matrix_const_superdiagonal($a)';
//*****
// 08.04.07 Copying-matrices.
// Function: int gsl_matrix_memcpy (gsl_matrix * dest, const gsl_matrix * src)
  fun gsl_matrix_memcpy: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_memcpy($a)';
// Function: int gsl_matrix_swap (gsl_matrix * m1, gsl_matrix * m2)
  fun gsl_matrix_swap: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_swap($a)';
//*****
// 08.04.08 Copying-rows-and-columns.
// Function: int gsl_matrix_get_row (gsl_vector * v, const gsl_matrix * m, size_t i)
  fun gsl_matrix_get_row: &gsl_vector * &gsl_matrix * size -> int = 'gsl_matrix_get_row($a)';
// Function: int gsl_matrix_get_col (gsl_vector * v, const gsl_matrix * m, size_t j)
  fun gsl_matrix_get_col: &gsl_vector * &gsl_matrix * size -> int = 'gsl_matrix_get_col($a)';
// Function: int gsl_matrix_set_row (gsl_matrix * m, size_t i, const gsl_vector * v)
  fun gsl_matrix_set_row: &gsl_matrix * size * &gsl_vector -> int = 'gsl_matrix_set_row($a)';
// Function: int gsl_matrix_set_col (gsl_matrix * m, size_t j, const gsl_vector * v)
  fun gsl_matrix_set_col: &gsl_matrix * size * &gsl_vector -> int = 'gsl_matrix_set_col($a)';
//*****
// 08.04.09 Exchanging-rows-and-columns.
// Function: int gsl_matrix_swap_rows (gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_swap_rows: &gsl_matrix * size * size -> int = 'gsl_matrix_swap_rows($a)';
// Function: int gsl_matrix_swap_columns (gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_swap_columns: &gsl_matrix * size * size -> int = 'gsl_matrix_swap_columns($a)';
// Function: int gsl_matrix_swap_rowcol (gsl_matrix * m, size_t i, size_t j)
  fun gsl_matrix_swap_rowcol: &gsl_matrix * size * size -> int = 'gsl_matrix_swap_rowcol($a)';
// Function: int gsl_matrix_transpose_memcpy (gsl_matrix * dest, const gsl_matrix * src)
  fun gsl_matrix_transpose_memcpy: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_transpose_memcpy($a)';
// Function: int gsl_matrix_transpose (gsl_matrix * m)
  fun gsl_matrix_transpose: &gsl_matrix -> int = 'gsl_matrix_transpose($a)';
//*****
// 08.04.10 Matrix-operations.
// Function: int gsl_matrix_add (gsl_matrix * a, const gsl_matrix * b)
  fun gsl_matrix_add: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_add($a)';
// Function: int gsl_matrix_sub (gsl_matrix * a, const gsl_matrix * b)
  fun gsl_matrix_sub: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_sub($a)';
// Function: int gsl_matrix_mul_elements (gsl_matrix * a, const gsl_matrix * b)
  fun gsl_matrix_mul_elements: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_mul_elements($a)';
// Function: int gsl_matrix_div_elements (gsl_matrix * a, const gsl_matrix * b)
  fun gsl_matrix_div_elements: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_div_elements($a)';
// Function: int gsl_matrix_scale (gsl_matrix * a, const double x)
  fun gsl_matrix_scale: &gsl_matrix * double -> int = 'gsl_matrix_scale($a)';
// Function: int gsl_matrix_add_constant (gsl_matrix * a, const double x)
  fun gsl_matrix_add_constant: &gsl_matrix * double -> int = 'gsl_matrix_add_constant($a)';
//*****
// 08.04.11 Finding-maximum-and-minimum-elements-of-matrices.
// Function: double gsl_matrix_max (const gsl_matrix * m)
  fun gsl_matrix_max: &gsl_matrix -> double = 'gsl_matrix_max($a)';
// Function: double gsl_matrix_min (const gsl_matrix * m)
  fun gsl_matrix_min: &gsl_matrix -> double = 'gsl_matrix_min($a)';
// Function: void gsl_matrix_minmax (const gsl_matrix * m, double * min_out, double * max_out)
  proc gsl_matrix_minmax: &gsl_matrix * &double * &double = 'gsl_matrix_minmax($a);';
// Function: void gsl_matrix_max_index (const gsl_matrix * m, size_t * imax, size_t * jmax)
  proc gsl_matrix_max_index: &gsl_matrix * &size * &size = 'gsl_matrix_max_index($a);';
// Function: void gsl_matrix_min_index (const gsl_matrix * m, size_t * imin, size_t * jmin)
  proc gsl_matrix_min_index: &gsl_matrix * &size * &size = 'gsl_matrix_min_index($a);';
// Function: void gsl_matrix_minmax_index (const gsl_matrix * m, size_t * imin, size_t * jmin, size_t * imax, size_t * jmax)
  proc gsl_matrix_minmax_index: &gsl_matrix * &size * &size * &size * &size = 'gsl_matrix_minmax_index($a);';
//*****
// 08.04.12 Matrix-properties.
// Function: int gsl_matrix_isnull (const gsl_matrix * m)
  fun gsl_matrix_isnull: &gsl_matrix -> int = 'gsl_matrix_isnull($a)';
// Function: int gsl_matrix_ispos (const gsl_matrix * m)
  fun gsl_matrix_ispos: &gsl_matrix -> int = 'gsl_matrix_ispos($a)';
// Function: int gsl_matrix_isneg (const gsl_matrix * m)
  fun gsl_matrix_isneg: &gsl_matrix -> int = 'gsl_matrix_isneg($a)';
// Function: int gsl_matrix_isnonneg (const gsl_matrix * m)
  fun gsl_matrix_isnonneg: &gsl_matrix -> int = 'gsl_matrix_isnonneg($a)';
// Function: int gsl_matrix_equal (const gsl_matrix * a, const gsl_matrix * b)
  fun gsl_matrix_equal: &gsl_matrix * &gsl_matrix -> int = 'gsl_matrix_equal($a)';
//*****
// 09.00.00 Permutations.
//*****
// 09.01.00 The-Permutation-struct.
//*****
// 09.02.00 Permutation-allocation.
// Function: gsl_permutation * gsl_permutation_alloc (size_t n)
  fun gsl_permutation_alloc: size -> &gsl_permutation = 'gsl_permutation_alloc($a)';
// Function: gsl_permutation * gsl_permutation_calloc (size_t n)
  fun gsl_permutation_calloc: size -> &gsl_permutation = 'gsl_permutation_calloc($a)';
// Function: void gsl_permutation_init (gsl_permutation * p)
  proc gsl_permutation_init: &gsl_permutation = 'gsl_permutation_init($a);';
// Function: void gsl_permutation_free (gsl_permutation * p)
  proc gsl_permutation_free: &gsl_permutation = 'gsl_permutation_free($a);';
// Function: int gsl_permutation_memcpy (gsl_permutation * dest, const gsl_permutation * src)
  fun gsl_permutation_memcpy: &gsl_permutation * &gsl_permutation -> int = 'gsl_permutation_memcpy($a)';
//*****
// 09.03.00 Accessing-permutation-elements.
// Function: size_t gsl_permutation_get (const gsl_permutation * p, const size_t i)
  fun gsl_permutation_get: &gsl_permutation * size -> size = 'gsl_permutation_get($a)';
// Function: int gsl_permutation_swap (gsl_permutation * p, const size_t i, const size_t j)
  fun gsl_permutation_swap: &gsl_permutation * size * size -> int = 'gsl_permutation_swap($a)';
//*****
// 09.04.00 Permutation-properties.
// Function: size_t gsl_permutation_size (const gsl_permutation * p)
  fun gsl_permutation_size: &gsl_permutation -> size = 'gsl_permutation_size($a)';
// Function: size_t * gsl_permutation_data (const gsl_permutation * p)
  fun gsl_permutation_data: &gsl_permutation -> &size = 'gsl_permutation_data($a)';
// Function: int gsl_permutation_valid (const gsl_permutation * p)
  fun gsl_permutation_valid: &gsl_permutation -> int = 'gsl_permutation_valid($a)';
//*****
// 09.05.00 Permutation-functions.
// Function: void gsl_permutation_reverse (gsl_permutation * p)
  proc gsl_permutation_reverse: &gsl_permutation = 'gsl_permutation_reverse($a);';
// Function: int gsl_permutation_inverse (gsl_permutation * inv, const gsl_permutation * p)
  fun gsl_permutation_inverse: &gsl_permutation * &gsl_permutation -> int = 'gsl_permutation_inverse($a)';
// Function: int gsl_permutation_next (gsl_permutation * p)
  fun gsl_permutation_next: &gsl_permutation -> int = 'gsl_permutation_next($a)';
// Function: int gsl_permutation_prev (gsl_permutation * p)
  fun gsl_permutation_prev: &gsl_permutation -> int = 'gsl_permutation_prev($a)';
//*****
// 09.06.00 Applying-Permutations.
// Function: int gsl_permute (const size_t * p, double * data, size_t stride, size_t n)
  fun gsl_permute: &size * &double * size * size -> int = 'gsl_permute($a)';
// Function: int gsl_permute_inverse (const size_t * p, double * data, size_t stride, size_t n)
  fun gsl_permute_inverse: &size * &double * size * size -> int = 'gsl_permute_inverse($a)';
// Function: int gsl_permute_vector (const gsl_permutation * p, gsl_vector * v)
  fun gsl_permute_vector: &gsl_permutation * &gsl_vector -> int = 'gsl_permute_vector($a)';
// Function: int gsl_permute_vector_inverse (const gsl_permutation * p, gsl_vector * v)
  fun gsl_permute_vector_inverse: &gsl_permutation * &gsl_vector -> int = 'gsl_permute_vector_inverse($a)';
// Function: int gsl_permutation_mul (gsl_permutation * p, const gsl_permutation * pa, const gsl_permutation * pb)
  fun gsl_permutation_mul: &gsl_permutation * &gsl_permutation * &gsl_permutation -> int = 'gsl_permutation_mul($a)';
//*****
// 09.07.00 Reading-and-writing-permutations.
// Function: int gsl_permutation_fwrite (FILE * stream, const gsl_permutation * p)
  fun gsl_permutation_fwrite: &FILE * &gsl_permutation -> int = 'gsl_permutation_fwrite($a)';
// Function: int gsl_permutation_fread (FILE * stream, gsl_permutation * p)
  fun gsl_permutation_fread: &FILE * &gsl_permutation -> int = 'gsl_permutation_fread($a)';
// Function: int gsl_permutation_fprintf (FILE * stream, const gsl_permutation * p, const char * format)
  fun gsl_permutation_fprintf: &FILE * &gsl_permutation * &char -> int = 'gsl_permutation_fprintf($a)';
// Function: int gsl_permutation_fscanf (FILE * stream, gsl_permutation * p)
  fun gsl_permutation_fscanf: &FILE * &gsl_permutation -> int = 'gsl_permutation_fscanf($a)';
//*****
// 09.08.00 Permutations-in-cyclic-form.
// Function: int gsl_permutation_linear_to_canonical (gsl_permutation * q, const gsl_permutation * p)
  fun gsl_permutation_linear_to_canonical: &gsl_permutation * &gsl_permutation -> int = 'gsl_permutation_linear_to_canonical($a)';
// Function: int gsl_permutation_canonical_to_linear (gsl_permutation * p, const gsl_permutation * q)
  fun gsl_permutation_canonical_to_linear: &gsl_permutation * &gsl_permutation -> int = 'gsl_permutation_canonical_to_linear($a)';
// Function: size_t gsl_permutation_inversions (const gsl_permutation * p)
  fun gsl_permutation_inversions: &gsl_permutation -> size = 'gsl_permutation_inversions($a)';
// Function: size_t gsl_permutation_linear_cycles (const gsl_permutation * p)
  fun gsl_permutation_linear_cycles: &gsl_permutation -> size = 'gsl_permutation_linear_cycles($a)';
// Function: size_t gsl_permutation_canonical_cycles (const gsl_permutation * q)
  fun gsl_permutation_canonical_cycles: &gsl_permutation -> size = 'gsl_permutation_canonical_cycles($a)';
//*****
// 10.00.00 Combinations.
//*****
// 10.01.00 The-Combination-struct.
//*****
// 10.02.00 Combination-allocation.
// Function: gsl_combination * gsl_combination_alloc (size_t n, size_t k)
  fun gsl_combination_alloc: size * size -> &gsl_combination = 'gsl_combination_alloc($a)';
// Function: gsl_combination * gsl_combination_calloc (size_t n, size_t k)
  fun gsl_combination_calloc: size * size -> &gsl_combination = 'gsl_combination_calloc($a)';
// Function: void gsl_combination_init_first (gsl_combination * c)
  proc gsl_combination_init_first: &gsl_combination = 'gsl_combination_init_first($a);';
// Function: void gsl_combination_init_last (gsl_combination * c)
  proc gsl_combination_init_last: &gsl_combination = 'gsl_combination_init_last($a);';
// Function: void gsl_combination_free (gsl_combination * c)
  proc gsl_combination_free: &gsl_combination = 'gsl_combination_free($a);';
// Function: int gsl_combination_memcpy (gsl_combination * dest, const gsl_combination * src)
  fun gsl_combination_memcpy: &gsl_combination * &gsl_combination -> int = 'gsl_combination_memcpy($a)';
//*****
// 10.03.00 Accessing-combination-elements.
// Function: size_t gsl_combination_get (const gsl_combination * c, const size_t i)
  fun gsl_combination_get: &gsl_combination * size -> size = 'gsl_combination_get($a)';
//*****
// 10.04.00 Combination-properties.
// Function: size_t gsl_combination_n (const gsl_combination * c)
  fun gsl_combination_n: &gsl_combination -> size = 'gsl_combination_n($a)';
// Function: size_t gsl_combination_k (const gsl_combination * c)
  fun gsl_combination_k: &gsl_combination -> size = 'gsl_combination_k($a)';
// Function: size_t * gsl_combination_data (const gsl_combination * c)
  fun gsl_combination_data: &gsl_combination -> &size = 'gsl_combination_data($a)';
// Function: int gsl_combination_valid (gsl_combination * c)
  fun gsl_combination_valid: &gsl_combination -> int = 'gsl_combination_valid($a)';
//*****
// 10.05.00 Combination-functions.
// Function: int gsl_combination_next (gsl_combination * c)
  fun gsl_combination_next: &gsl_combination -> int = 'gsl_combination_next($a)';
// Function: int gsl_combination_prev (gsl_combination * c)
  fun gsl_combination_prev: &gsl_combination -> int = 'gsl_combination_prev($a)';
//*****
// 10.06.00 Reading-and-writing-combinations.
// Function: int gsl_combination_fwrite (FILE * stream, const gsl_combination * c)
  fun gsl_combination_fwrite: &FILE * &gsl_combination -> int = 'gsl_combination_fwrite($a)';
// Function: int gsl_combination_fread (FILE * stream, gsl_combination * c)
  fun gsl_combination_fread: &FILE * &gsl_combination -> int = 'gsl_combination_fread($a)';
// Function: int gsl_combination_fprintf (FILE * stream, const gsl_combination * c, const char * format)
  fun gsl_combination_fprintf: &FILE * &gsl_combination * &char -> int = 'gsl_combination_fprintf($a)';
// Function: int gsl_combination_fscanf (FILE * stream, gsl_combination * c)
  fun gsl_combination_fscanf: &FILE * &gsl_combination -> int = 'gsl_combination_fscanf($a)';
//*****
// 11.00.00 Multisets.
//*****
// 11.01.00 The-Multiset-struct.
//*****
// 11.02.00 Multiset-allocation.
// Function: gsl_multiset * gsl_multiset_alloc (size_t n, size_t k)
  fun gsl_multiset_alloc: size * size -> &gsl_multiset = 'gsl_multiset_alloc($a)';
// Function: gsl_multiset * gsl_multiset_calloc (size_t n, size_t k)
  fun gsl_multiset_calloc: size * size -> &gsl_multiset = 'gsl_multiset_calloc($a)';
// Function: void gsl_multiset_init_first (gsl_multiset * c)
  proc gsl_multiset_init_first: &gsl_multiset = 'gsl_multiset_init_first($a);';
// Function: void gsl_multiset_init_last (gsl_multiset * c)
  proc gsl_multiset_init_last: &gsl_multiset = 'gsl_multiset_init_last($a);';
// Function: void gsl_multiset_free (gsl_multiset * c)
  proc gsl_multiset_free: &gsl_multiset = 'gsl_multiset_free($a);';
// Function: int gsl_multiset_memcpy (gsl_multiset * dest, const gsl_multiset * src)
  fun gsl_multiset_memcpy: &gsl_multiset * &gsl_multiset -> int = 'gsl_multiset_memcpy($a)';
//*****
// 11.03.00 Accessing-multiset-elements.
// Function: size_t gsl_multiset_get (const gsl_multiset * c, const size_t i)
  fun gsl_multiset_get: &gsl_multiset * size -> size = 'gsl_multiset_get($a)';
//*****
// 11.04.00 Multiset-properties.
// Function: size_t gsl_multiset_n (const gsl_multiset * c)
  fun gsl_multiset_n: &gsl_multiset -> size = 'gsl_multiset_n($a)';
// Function: size_t gsl_multiset_k (const gsl_multiset * c)
  fun gsl_multiset_k: &gsl_multiset -> size = 'gsl_multiset_k($a)';
// Function: size_t * gsl_multiset_data (const gsl_multiset * c)
  fun gsl_multiset_data: &gsl_multiset -> &size = 'gsl_multiset_data($a)';
// Function: int gsl_multiset_valid (gsl_multiset * c)
  fun gsl_multiset_valid: &gsl_multiset -> int = 'gsl_multiset_valid($a)';
//*****
// 11.05.00 Multiset-functions.
// Function: int gsl_multiset_next (gsl_multiset * c)
  fun gsl_multiset_next: &gsl_multiset -> int = 'gsl_multiset_next($a)';
// Function: int gsl_multiset_prev (gsl_multiset * c)
  fun gsl_multiset_prev: &gsl_multiset -> int = 'gsl_multiset_prev($a)';
//*****
// 11.06.00 Reading-and-writing-multisets.
// Function: int gsl_multiset_fwrite (FILE * stream, const gsl_multiset * c)
  fun gsl_multiset_fwrite: &FILE * &gsl_multiset -> int = 'gsl_multiset_fwrite($a)';
// Function: int gsl_multiset_fread (FILE * stream, gsl_multiset * c)
  fun gsl_multiset_fread: &FILE * &gsl_multiset -> int = 'gsl_multiset_fread($a)';
// Function: int gsl_multiset_fprintf (FILE * stream, const gsl_multiset * c, const char * format)
  fun gsl_multiset_fprintf: &FILE * &gsl_multiset * &char -> int = 'gsl_multiset_fprintf($a)';
// Function: int gsl_multiset_fscanf (FILE * stream, gsl_multiset * c)
  fun gsl_multiset_fscanf: &FILE * &gsl_multiset -> int = 'gsl_multiset_fscanf($a)';
//*****
// 12.00.00 Sorting.
//*****
// 12.01.00 Sorting-objects.
// Function: void gsl_heapsort (void * array, size_t count, size_t size, gsl_comparison_fn_t compare)
  proc gsl_heapsort: &void * size * size * gsl_comparison_fn_t = 'gsl_heapsort($a);';
// Function: int gsl_heapsort_index (size_t * p, const void * array, size_t count, size_t size, gsl_comparison_fn_t compare)
  fun gsl_heapsort_index: &size * &void * size * size * gsl_comparison_fn_t -> int = 'gsl_heapsort_index($a)';
//*****
// 12.02.00 Sorting-vectors.
// Function: void gsl_sort (double * data, const size_t stride, size_t n)
  proc gsl_sort: &double * size * size = 'gsl_sort($a);';
// Function: void gsl_sort2 (double * data1, const size_t stride1, double * data2, const size_t stride2, size_t n)
  proc gsl_sort2: &double * size * &double * size * size = 'gsl_sort2($a);';
// Function: void gsl_sort_vector (gsl_vector * v)
  proc gsl_sort_vector: &gsl_vector = 'gsl_sort_vector($a);';
// Function: void gsl_sort_vector2 (gsl_vector * v1, gsl_vector * v2)
  proc gsl_sort_vector2: &gsl_vector * &gsl_vector = 'gsl_sort_vector2($a);';
// Function: void gsl_sort_index (size_t * p, const double * data, size_t stride, size_t n)
  proc gsl_sort_index: &size * &double * size * size = 'gsl_sort_index($a);';
// Function: int gsl_sort_vector_index (gsl_permutation * p, const gsl_vector * v)
  fun gsl_sort_vector_index: &gsl_permutation * &gsl_vector -> int = 'gsl_sort_vector_index($a)';
//*****
// 12.03.00 Selecting-the-k-smallest-or-largest-elements.
// Function: int gsl_sort_smallest (double * dest, size_t k, const double * src, size_t stride, size_t n)
  fun gsl_sort_smallest: &double * size * &double * size * size -> int = 'gsl_sort_smallest($a)';
// Function: int gsl_sort_largest (double * dest, size_t k, const double * src, size_t stride, size_t n)
  fun gsl_sort_largest: &double * size * &double * size * size -> int = 'gsl_sort_largest($a)';
// Function: int gsl_sort_vector_smallest (double * dest, size_t k, const gsl_vector * v)
  fun gsl_sort_vector_smallest: &double * size * &gsl_vector -> int = 'gsl_sort_vector_smallest($a)';
// Function: int gsl_sort_vector_largest (double * dest, size_t k, const gsl_vector * v)
  fun gsl_sort_vector_largest: &double * size * &gsl_vector -> int = 'gsl_sort_vector_largest($a)';
// Function: int gsl_sort_smallest_index (size_t * p, size_t k, const double * src, size_t stride, size_t n)
  fun gsl_sort_smallest_index: &size * size * &double * size * size -> int = 'gsl_sort_smallest_index($a)';
// Function: int gsl_sort_largest_index (size_t * p, size_t k, const double * src, size_t stride, size_t n)
  fun gsl_sort_largest_index: &size * size * &double * size * size -> int = 'gsl_sort_largest_index($a)';
// Function: int gsl_sort_vector_smallest_index (size_t * p, size_t k, const gsl_vector * v)
  fun gsl_sort_vector_smallest_index: &size * size * &gsl_vector -> int = 'gsl_sort_vector_smallest_index($a)';
// Function: int gsl_sort_vector_largest_index (size_t * p, size_t k, const gsl_vector * v)
  fun gsl_sort_vector_largest_index: &size * size * &gsl_vector -> int = 'gsl_sort_vector_largest_index($a)';
//*****
// 13.00.00 BLAS-Support.
//*****
// 13.01.00 GSL-BLAS-Interface.
//*****
// 13.01.01 GSL-BLAS-Level-1.
// Function: int gsl_blas_sdsdot (float alpha, const gsl_vector_float * x, const gsl_vector_float * y, float * result)
  fun gsl_blas_sdsdot: float * &gsl_vector_float * &gsl_vector_float * &float -> int = 'gsl_blas_sdsdot($a)';
// Function: int gsl_blas_sdot (const gsl_vector_float * x, const gsl_vector_float * y, float * result)
  fun gsl_blas_sdot: &gsl_vector_float * &gsl_vector_float * &float -> int = 'gsl_blas_sdot($a)';
// Function: int gsl_blas_dsdot (const gsl_vector_float * x, const gsl_vector_float * y, double * result)
  fun gsl_blas_dsdot: &gsl_vector_float * &gsl_vector_float * &double -> int = 'gsl_blas_dsdot($a)';
// Function: int gsl_blas_ddot (const gsl_vector * x, const gsl_vector * y, double * result)
  fun gsl_blas_ddot: &gsl_vector * &gsl_vector * &double -> int = 'gsl_blas_ddot($a)';
// Function: int gsl_blas_cdotu (const gsl_vector_complex_float * x, const gsl_vector_complex_float * y, gsl_complex_float * dotu)
  fun gsl_blas_cdotu: &gsl_vector_complex_float * &gsl_vector_complex_float * &gsl_complex_float -> int = 'gsl_blas_cdotu($a)';
// Function: int gsl_blas_zdotu (const gsl_vector_complex * x, const gsl_vector_complex * y, gsl_complex * dotu)
  fun gsl_blas_zdotu: &gsl_vector_complex * &gsl_vector_complex * &gsl_complex -> int = 'gsl_blas_zdotu($a)';
// Function: int gsl_blas_cdotc (const gsl_vector_complex_float * x, const gsl_vector_complex_float * y, gsl_complex_float * dotc)
  fun gsl_blas_cdotc: &gsl_vector_complex_float * &gsl_vector_complex_float * &gsl_complex_float -> int = 'gsl_blas_cdotc($a)';
// Function: int gsl_blas_zdotc (const gsl_vector_complex * x, const gsl_vector_complex * y, gsl_complex * dotc)
  fun gsl_blas_zdotc: &gsl_vector_complex * &gsl_vector_complex * &gsl_complex -> int = 'gsl_blas_zdotc($a)';
// Function: float gsl_blas_snrm2 (const gsl_vector_float * x)
  fun gsl_blas_snrm2: &gsl_vector_float -> float = 'gsl_blas_snrm2($a)';
// Function: double gsl_blas_dnrm2 (const gsl_vector * x)
  fun gsl_blas_dnrm2: &gsl_vector -> double = 'gsl_blas_dnrm2($a)';
// Function: float gsl_blas_scnrm2 (const gsl_vector_complex_float * x)
  fun gsl_blas_scnrm2: &gsl_vector_complex_float -> float = 'gsl_blas_scnrm2($a)';
// Function: double gsl_blas_dznrm2 (const gsl_vector_complex * x)
  fun gsl_blas_dznrm2: &gsl_vector_complex -> double = 'gsl_blas_dznrm2($a)';
// Function: float gsl_blas_sasum (const gsl_vector_float * x)
  fun gsl_blas_sasum: &gsl_vector_float -> float = 'gsl_blas_sasum($a)';
// Function: double gsl_blas_dasum (const gsl_vector * x)
  fun gsl_blas_dasum: &gsl_vector -> double = 'gsl_blas_dasum($a)';
// Function: float gsl_blas_scasum (const gsl_vector_complex_float * x)
  fun gsl_blas_scasum: &gsl_vector_complex_float -> float = 'gsl_blas_scasum($a)';
// Function: double gsl_blas_dzasum (const gsl_vector_complex * x)
  fun gsl_blas_dzasum: &gsl_vector_complex -> double = 'gsl_blas_dzasum($a)';
// Function: CBLAS_INDEX_t gsl_blas_isamax (const gsl_vector_float * x)
  fun gsl_blas_isamax: &gsl_vector_float -> CBLAS_INDEX_t = 'gsl_blas_isamax($a)';
// Function: CBLAS_INDEX_t gsl_blas_idamax (const gsl_vector * x)
  fun gsl_blas_idamax: &gsl_vector -> CBLAS_INDEX_t = 'gsl_blas_idamax($a)';
// Function: CBLAS_INDEX_t gsl_blas_icamax (const gsl_vector_complex_float * x)
  fun gsl_blas_icamax: &gsl_vector_complex_float -> CBLAS_INDEX_t = 'gsl_blas_icamax($a)';
// Function: CBLAS_INDEX_t gsl_blas_izamax (const gsl_vector_complex * x)
  fun gsl_blas_izamax: &gsl_vector_complex -> CBLAS_INDEX_t = 'gsl_blas_izamax($a)';
// Function: int gsl_blas_sswap (gsl_vector_float * x, gsl_vector_float * y)
  fun gsl_blas_sswap: &gsl_vector_float * &gsl_vector_float -> int = 'gsl_blas_sswap($a)';
// Function: int gsl_blas_dswap (gsl_vector * x, gsl_vector * y)
  fun gsl_blas_dswap: &gsl_vector * &gsl_vector -> int = 'gsl_blas_dswap($a)';
// Function: int gsl_blas_cswap (gsl_vector_complex_float * x, gsl_vector_complex_float * y)
  fun gsl_blas_cswap: &gsl_vector_complex_float * &gsl_vector_complex_float -> int = 'gsl_blas_cswap($a)';
// Function: int gsl_blas_zswap (gsl_vector_complex * x, gsl_vector_complex * y)
  fun gsl_blas_zswap: &gsl_vector_complex * &gsl_vector_complex -> int = 'gsl_blas_zswap($a)';
// Function: int gsl_blas_scopy (const gsl_vector_float * x, gsl_vector_float * y)
  fun gsl_blas_scopy: &gsl_vector_float * &gsl_vector_float -> int = 'gsl_blas_scopy($a)';
// Function: int gsl_blas_dcopy (const gsl_vector * x, gsl_vector * y)
  fun gsl_blas_dcopy: &gsl_vector * &gsl_vector -> int = 'gsl_blas_dcopy($a)';
// Function: int gsl_blas_ccopy (const gsl_vector_complex_float * x, gsl_vector_complex_float * y)
  fun gsl_blas_ccopy: &gsl_vector_complex_float * &gsl_vector_complex_float -> int = 'gsl_blas_ccopy($a)';
// Function: int gsl_blas_zcopy (const gsl_vector_complex * x, gsl_vector_complex * y)
  fun gsl_blas_zcopy: &gsl_vector_complex * &gsl_vector_complex -> int = 'gsl_blas_zcopy($a)';
// Function: int gsl_blas_saxpy (float alpha, const gsl_vector_float * x, gsl_vector_float * y)
  fun gsl_blas_saxpy: float * &gsl_vector_float * &gsl_vector_float -> int = 'gsl_blas_saxpy($a)';
// Function: int gsl_blas_daxpy (double alpha, const gsl_vector * x, gsl_vector * y)
  fun gsl_blas_daxpy: double * &gsl_vector * &gsl_vector -> int = 'gsl_blas_daxpy($a)';
// Function: int gsl_blas_caxpy (const gsl_complex_float alpha, const gsl_vector_complex_float * x, gsl_vector_complex_float * y)
  fun gsl_blas_caxpy: gsl_complex_float * &gsl_vector_complex_float * &gsl_vector_complex_float -> int = 'gsl_blas_caxpy($a)';
// Function: int gsl_blas_zaxpy (const gsl_complex alpha, const gsl_vector_complex * x, gsl_vector_complex * y)
  fun gsl_blas_zaxpy: gsl_complex * &gsl_vector_complex * &gsl_vector_complex -> int = 'gsl_blas_zaxpy($a)';
// Function: void gsl_blas_sscal (float alpha, gsl_vector_float * x)
  proc gsl_blas_sscal: float * &gsl_vector_float = 'gsl_blas_sscal($a);';
// Function: void gsl_blas_dscal (double alpha, gsl_vector * x)
  proc gsl_blas_dscal: double * &gsl_vector = 'gsl_blas_dscal($a);';
// Function: void gsl_blas_cscal (const gsl_complex_float alpha, gsl_vector_complex_float * x)
  proc gsl_blas_cscal: gsl_complex_float * &gsl_vector_complex_float = 'gsl_blas_cscal($a);';
// Function: void gsl_blas_zscal (const gsl_complex alpha, gsl_vector_complex * x)
  proc gsl_blas_zscal: gsl_complex * &gsl_vector_complex = 'gsl_blas_zscal($a);';
// Function: void gsl_blas_csscal (float alpha, gsl_vector_complex_float * x)
  proc gsl_blas_csscal: float * &gsl_vector_complex_float = 'gsl_blas_csscal($a);';
// Function: void gsl_blas_zdscal (double alpha, gsl_vector_complex * x)
  proc gsl_blas_zdscal: double * &gsl_vector_complex = 'gsl_blas_zdscal($a);';
// Function: int gsl_blas_srotg (float a[], float b[], float c[], float s[])
  fun gsl_blas_srotg: +float * +float * +float * +float -> int = 'gsl_blas_srotg($a)';
// Function: int gsl_blas_drotg (double a[], double b[], double c[], double s[])
  fun gsl_blas_drotg: +double * +double * +double * +double -> int = 'gsl_blas_drotg($a)';
// Function: int gsl_blas_srot (gsl_vector_float * x, gsl_vector_float * y, float c, float s)
  fun gsl_blas_srot: &gsl_vector_float * &gsl_vector_float * float * float -> int = 'gsl_blas_srot($a)';
// Function: int gsl_blas_drot (gsl_vector * x, gsl_vector * y, const double c, const double s)
  fun gsl_blas_drot: &gsl_vector * &gsl_vector * double * double -> int = 'gsl_blas_drot($a)';
// Function: int gsl_blas_srotmg (float d1[], float d2[], float b1[], float b2, float P[])
  fun gsl_blas_srotmg: +float * +float * +float * float * +float -> int = 'gsl_blas_srotmg($a)';
// Function: int gsl_blas_drotmg (double d1[], double d2[], double b1[], double b2, double P[])
  fun gsl_blas_drotmg: +double * +double * +double * double * +double -> int = 'gsl_blas_drotmg($a)';
// Function: int gsl_blas_srotm (gsl_vector_float * x, gsl_vector_float * y, const float P[])
  fun gsl_blas_srotm: &gsl_vector_float * &gsl_vector_float * +float -> int = 'gsl_blas_srotm($a)';
// Function: int gsl_blas_drotm (gsl_vector * x, gsl_vector * y, const double P[])
  fun gsl_blas_drotm: &gsl_vector * &gsl_vector * +double -> int = 'gsl_blas_drotm($a)';
//*****
// 13.01.02 GSL-BLAS-Level-2.
// Function: int gsl_blas_sgemv (CBLAS_TRANSPOSE_t TransA, float alpha, const gsl_matrix_float * A, const gsl_vector_float * x, float beta, gsl_vector_float * y)
  fun gsl_blas_sgemv: CBLAS_TRANSPOSE_t * float * &gsl_matrix_float * &gsl_vector_float * float * &gsl_vector_float -> int = 'gsl_blas_sgemv($a)';
// Function: int gsl_blas_dgemv (CBLAS_TRANSPOSE_t TransA, double alpha, const gsl_matrix * A, const gsl_vector * x, double beta, gsl_vector * y)
  fun gsl_blas_dgemv: CBLAS_TRANSPOSE_t * double * &gsl_matrix * &gsl_vector * double * &gsl_vector -> int = 'gsl_blas_dgemv($a)';
// Function: int gsl_blas_cgemv (CBLAS_TRANSPOSE_t TransA, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_vector_complex_float * x, const gsl_complex_float beta, gsl_vector_complex_float * y)
  fun gsl_blas_cgemv: CBLAS_TRANSPOSE_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_vector_complex_float * gsl_complex_float * &gsl_vector_complex_float -> int = 'gsl_blas_cgemv($a)';
// Function: int gsl_blas_zgemv (CBLAS_TRANSPOSE_t TransA, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_vector_complex * x, const gsl_complex beta, gsl_vector_complex * y)
  fun gsl_blas_zgemv: CBLAS_TRANSPOSE_t * gsl_complex * &gsl_matrix_complex * &gsl_vector_complex * gsl_complex * &gsl_vector_complex -> int = 'gsl_blas_zgemv($a)';
// Function: int gsl_blas_strmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix_float * A, gsl_vector_float * x)
  fun gsl_blas_strmv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix_float * &gsl_vector_float -> int = 'gsl_blas_strmv($a)';
// Function: int gsl_blas_dtrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix * A, gsl_vector * x)
  fun gsl_blas_dtrmv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix * &gsl_vector -> int = 'gsl_blas_dtrmv($a)';
// Function: int gsl_blas_ctrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix_complex_float * A, gsl_vector_complex_float * x)
  fun gsl_blas_ctrmv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix_complex_float * &gsl_vector_complex_float -> int = 'gsl_blas_ctrmv($a)';
// Function: int gsl_blas_ztrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix_complex * A, gsl_vector_complex * x)
  fun gsl_blas_ztrmv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix_complex * &gsl_vector_complex -> int = 'gsl_blas_ztrmv($a)';
// Function: int gsl_blas_strsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix_float * A, gsl_vector_float * x)
  fun gsl_blas_strsv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix_float * &gsl_vector_float -> int = 'gsl_blas_strsv($a)';
// Function: int gsl_blas_dtrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix * A, gsl_vector * x)
  fun gsl_blas_dtrsv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix * &gsl_vector -> int = 'gsl_blas_dtrsv($a)';
// Function: int gsl_blas_ctrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix_complex_float * A, gsl_vector_complex_float * x)
  fun gsl_blas_ctrsv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix_complex_float * &gsl_vector_complex_float -> int = 'gsl_blas_ctrsv($a)';
// Function: int gsl_blas_ztrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_matrix_complex * A, gsl_vector_complex * x)
  fun gsl_blas_ztrsv: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * &gsl_matrix_complex * &gsl_vector_complex -> int = 'gsl_blas_ztrsv($a)';
// Function: int gsl_blas_ssymv (CBLAS_UPLO_t Uplo, float alpha, const gsl_matrix_float * A, const gsl_vector_float * x, float beta, gsl_vector_float * y)
  fun gsl_blas_ssymv: CBLAS_UPLO_t * float * &gsl_matrix_float * &gsl_vector_float * float * &gsl_vector_float -> int = 'gsl_blas_ssymv($a)';
// Function: int gsl_blas_dsymv (CBLAS_UPLO_t Uplo, double alpha, const gsl_matrix * A, const gsl_vector * x, double beta, gsl_vector * y)
  fun gsl_blas_dsymv: CBLAS_UPLO_t * double * &gsl_matrix * &gsl_vector * double * &gsl_vector -> int = 'gsl_blas_dsymv($a)';
// Function: int gsl_blas_chemv (CBLAS_UPLO_t Uplo, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_vector_complex_float * x, const gsl_complex_float beta, gsl_vector_complex_float * y)
  fun gsl_blas_chemv: CBLAS_UPLO_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_vector_complex_float * gsl_complex_float * &gsl_vector_complex_float -> int = 'gsl_blas_chemv($a)';
// Function: int gsl_blas_zhemv (CBLAS_UPLO_t Uplo, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_vector_complex * x, const gsl_complex beta, gsl_vector_complex * y)
  fun gsl_blas_zhemv: CBLAS_UPLO_t * gsl_complex * &gsl_matrix_complex * &gsl_vector_complex * gsl_complex * &gsl_vector_complex -> int = 'gsl_blas_zhemv($a)';
// Function: int gsl_blas_sger (float alpha, const gsl_vector_float * x, const gsl_vector_float * y, gsl_matrix_float * A)
  fun gsl_blas_sger: float * &gsl_vector_float * &gsl_vector_float * &gsl_matrix_float -> int = 'gsl_blas_sger($a)';
// Function: int gsl_blas_dger (double alpha, const gsl_vector * x, const gsl_vector * y, gsl_matrix * A)
  fun gsl_blas_dger: double * &gsl_vector * &gsl_vector * &gsl_matrix -> int = 'gsl_blas_dger($a)';
// Function: int gsl_blas_cgeru (const gsl_complex_float alpha, const gsl_vector_complex_float * x, const gsl_vector_complex_float * y, gsl_matrix_complex_float * A)
  fun gsl_blas_cgeru: gsl_complex_float * &gsl_vector_complex_float * &gsl_vector_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_cgeru($a)';
// Function: int gsl_blas_zgeru (const gsl_complex alpha, const gsl_vector_complex * x, const gsl_vector_complex * y, gsl_matrix_complex * A)
  fun gsl_blas_zgeru: gsl_complex * &gsl_vector_complex * &gsl_vector_complex * &gsl_matrix_complex -> int = 'gsl_blas_zgeru($a)';
// Function: int gsl_blas_cgerc (const gsl_complex_float alpha, const gsl_vector_complex_float * x, const gsl_vector_complex_float * y, gsl_matrix_complex_float * A)
  fun gsl_blas_cgerc: gsl_complex_float * &gsl_vector_complex_float * &gsl_vector_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_cgerc($a)';
// Function: int gsl_blas_zgerc (const gsl_complex alpha, const gsl_vector_complex * x, const gsl_vector_complex * y, gsl_matrix_complex * A)
  fun gsl_blas_zgerc: gsl_complex * &gsl_vector_complex * &gsl_vector_complex * &gsl_matrix_complex -> int = 'gsl_blas_zgerc($a)';
// Function: int gsl_blas_ssyr (CBLAS_UPLO_t Uplo, float alpha, const gsl_vector_float * x, gsl_matrix_float * A)
  fun gsl_blas_ssyr: CBLAS_UPLO_t * float * &gsl_vector_float * &gsl_matrix_float -> int = 'gsl_blas_ssyr($a)';
// Function: int gsl_blas_dsyr (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector * x, gsl_matrix * A)
  fun gsl_blas_dsyr: CBLAS_UPLO_t * double * &gsl_vector * &gsl_matrix -> int = 'gsl_blas_dsyr($a)';
// Function: int gsl_blas_cher (CBLAS_UPLO_t Uplo, float alpha, const gsl_vector_complex_float * x, gsl_matrix_complex_float * A)
  fun gsl_blas_cher: CBLAS_UPLO_t * float * &gsl_vector_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_cher($a)';
// Function: int gsl_blas_zher (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector_complex * x, gsl_matrix_complex * A)
  fun gsl_blas_zher: CBLAS_UPLO_t * double * &gsl_vector_complex * &gsl_matrix_complex -> int = 'gsl_blas_zher($a)';
// Function: int gsl_blas_ssyr2 (CBLAS_UPLO_t Uplo, float alpha, const gsl_vector_float * x, const gsl_vector_float * y, gsl_matrix_float * A)
  fun gsl_blas_ssyr2: CBLAS_UPLO_t * float * &gsl_vector_float * &gsl_vector_float * &gsl_matrix_float -> int = 'gsl_blas_ssyr2($a)';
// Function: int gsl_blas_dsyr2 (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector * x, const gsl_vector * y, gsl_matrix * A)
  fun gsl_blas_dsyr2: CBLAS_UPLO_t * double * &gsl_vector * &gsl_vector * &gsl_matrix -> int = 'gsl_blas_dsyr2($a)';
// Function: int gsl_blas_cher2 (CBLAS_UPLO_t Uplo, const gsl_complex_float alpha, const gsl_vector_complex_float * x, const gsl_vector_complex_float * y, gsl_matrix_complex_float * A)
  fun gsl_blas_cher2: CBLAS_UPLO_t * gsl_complex_float * &gsl_vector_complex_float * &gsl_vector_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_cher2($a)';
// Function: int gsl_blas_zher2 (CBLAS_UPLO_t Uplo, const gsl_complex alpha, const gsl_vector_complex * x, const gsl_vector_complex * y, gsl_matrix_complex * A)
  fun gsl_blas_zher2: CBLAS_UPLO_t * gsl_complex * &gsl_vector_complex * &gsl_vector_complex * &gsl_matrix_complex -> int = 'gsl_blas_zher2($a)';
//*****
// 13.01.03 GSL-BLAS-Level-3.
// Function: int gsl_blas_sgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, float alpha, const gsl_matrix_float * A, const gsl_matrix_float * B, float beta, gsl_matrix_float * C)
  fun gsl_blas_sgemm: CBLAS_TRANSPOSE_t * CBLAS_TRANSPOSE_t * float * &gsl_matrix_float * &gsl_matrix_float * float * &gsl_matrix_float -> int = 'gsl_blas_sgemm($a)';
// Function: int gsl_blas_dgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, double alpha, const gsl_matrix * A, const gsl_matrix * B, double beta, gsl_matrix * C)
  fun gsl_blas_dgemm: CBLAS_TRANSPOSE_t * CBLAS_TRANSPOSE_t * double * &gsl_matrix * &gsl_matrix * double * &gsl_matrix -> int = 'gsl_blas_dgemm($a)';
// Function: int gsl_blas_cgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_matrix_complex_float * B, const gsl_complex_float beta, gsl_matrix_complex_float * C)
  fun gsl_blas_cgemm: CBLAS_TRANSPOSE_t * CBLAS_TRANSPOSE_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_matrix_complex_float * gsl_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_cgemm($a)';
// Function: int gsl_blas_zgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_matrix_complex * B, const gsl_complex beta, gsl_matrix_complex * C)
  fun gsl_blas_zgemm: CBLAS_TRANSPOSE_t * CBLAS_TRANSPOSE_t * gsl_complex * &gsl_matrix_complex * &gsl_matrix_complex * gsl_complex * &gsl_matrix_complex -> int = 'gsl_blas_zgemm($a)';
// Function: int gsl_blas_ssymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, float alpha, const gsl_matrix_float * A, const gsl_matrix_float * B, float beta, gsl_matrix_float * C)
  fun gsl_blas_ssymm: CBLAS_SIDE_t * CBLAS_UPLO_t * float * &gsl_matrix_float * &gsl_matrix_float * float * &gsl_matrix_float -> int = 'gsl_blas_ssymm($a)';
// Function: int gsl_blas_dsymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, double alpha, const gsl_matrix * A, const gsl_matrix * B, double beta, gsl_matrix * C)
  fun gsl_blas_dsymm: CBLAS_SIDE_t * CBLAS_UPLO_t * double * &gsl_matrix * &gsl_matrix * double * &gsl_matrix -> int = 'gsl_blas_dsymm($a)';
// Function: int gsl_blas_csymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_matrix_complex_float * B, const gsl_complex_float beta, gsl_matrix_complex_float * C)
  fun gsl_blas_csymm: CBLAS_SIDE_t * CBLAS_UPLO_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_matrix_complex_float * gsl_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_csymm($a)';
// Function: int gsl_blas_zsymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_matrix_complex * B, const gsl_complex beta, gsl_matrix_complex * C)
  fun gsl_blas_zsymm: CBLAS_SIDE_t * CBLAS_UPLO_t * gsl_complex * &gsl_matrix_complex * &gsl_matrix_complex * gsl_complex * &gsl_matrix_complex -> int = 'gsl_blas_zsymm($a)';
// Function: int gsl_blas_chemm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_matrix_complex_float * B, const gsl_complex_float beta, gsl_matrix_complex_float * C)
  fun gsl_blas_chemm: CBLAS_SIDE_t * CBLAS_UPLO_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_matrix_complex_float * gsl_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_chemm($a)';
// Function: int gsl_blas_zhemm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_matrix_complex * B, const gsl_complex beta, gsl_matrix_complex * C)
  fun gsl_blas_zhemm: CBLAS_SIDE_t * CBLAS_UPLO_t * gsl_complex * &gsl_matrix_complex * &gsl_matrix_complex * gsl_complex * &gsl_matrix_complex -> int = 'gsl_blas_zhemm($a)';
// Function: int gsl_blas_strmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, float alpha, const gsl_matrix_float * A, gsl_matrix_float * B)
  fun gsl_blas_strmm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * float * &gsl_matrix_float * &gsl_matrix_float -> int = 'gsl_blas_strmm($a)';
// Function: int gsl_blas_dtrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, double alpha, const gsl_matrix * A, gsl_matrix * B)
  fun gsl_blas_dtrmm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * double * &gsl_matrix * &gsl_matrix -> int = 'gsl_blas_dtrmm($a)';
// Function: int gsl_blas_ctrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, gsl_matrix_complex_float * B)
  fun gsl_blas_ctrmm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_ctrmm($a)';
// Function: int gsl_blas_ztrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_complex alpha, const gsl_matrix_complex * A, gsl_matrix_complex * B)
  fun gsl_blas_ztrmm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * gsl_complex * &gsl_matrix_complex * &gsl_matrix_complex -> int = 'gsl_blas_ztrmm($a)';
// Function: int gsl_blas_strsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, float alpha, const gsl_matrix_float * A, gsl_matrix_float * B)
  fun gsl_blas_strsm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * float * &gsl_matrix_float * &gsl_matrix_float -> int = 'gsl_blas_strsm($a)';
// Function: int gsl_blas_dtrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, double alpha, const gsl_matrix * A, gsl_matrix * B)
  fun gsl_blas_dtrsm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * double * &gsl_matrix * &gsl_matrix -> int = 'gsl_blas_dtrsm($a)';
// Function: int gsl_blas_ctrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, gsl_matrix_complex_float * B)
  fun gsl_blas_ctrsm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_ctrsm($a)';
// Function: int gsl_blas_ztrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, const gsl_complex alpha, const gsl_matrix_complex * A, gsl_matrix_complex * B)
  fun gsl_blas_ztrsm: CBLAS_SIDE_t * CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * CBLAS_DIAG_t * gsl_complex * &gsl_matrix_complex * &gsl_matrix_complex -> int = 'gsl_blas_ztrsm($a)';
// Function: int gsl_blas_ssyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha, const gsl_matrix_float * A, float beta, gsl_matrix_float * C)
  fun gsl_blas_ssyrk: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * float * &gsl_matrix_float * float * &gsl_matrix_float -> int = 'gsl_blas_ssyrk($a)';
// Function: int gsl_blas_dsyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha, const gsl_matrix * A, double beta, gsl_matrix * C)
  fun gsl_blas_dsyrk: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * double * &gsl_matrix * double * &gsl_matrix -> int = 'gsl_blas_dsyrk($a)';
// Function: int gsl_blas_csyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_complex_float beta, gsl_matrix_complex_float * C)
  fun gsl_blas_csyrk: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * gsl_complex_float * &gsl_matrix_complex_float * gsl_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_csyrk($a)';
// Function: int gsl_blas_zsyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_complex beta, gsl_matrix_complex * C)
  fun gsl_blas_zsyrk: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * gsl_complex * &gsl_matrix_complex * gsl_complex * &gsl_matrix_complex -> int = 'gsl_blas_zsyrk($a)';
// Function: int gsl_blas_cherk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha, const gsl_matrix_complex_float * A, float beta, gsl_matrix_complex_float * C)
  fun gsl_blas_cherk: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * float * &gsl_matrix_complex_float * float * &gsl_matrix_complex_float -> int = 'gsl_blas_cherk($a)';
// Function: int gsl_blas_zherk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha, const gsl_matrix_complex * A, double beta, gsl_matrix_complex * C)
  fun gsl_blas_zherk: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * double * &gsl_matrix_complex * double * &gsl_matrix_complex -> int = 'gsl_blas_zherk($a)';
// Function: int gsl_blas_ssyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha, const gsl_matrix_float * A, const gsl_matrix_float * B, float beta, gsl_matrix_float * C)
  fun gsl_blas_ssyr2k: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * float * &gsl_matrix_float * &gsl_matrix_float * float * &gsl_matrix_float -> int = 'gsl_blas_ssyr2k($a)';
// Function: int gsl_blas_dsyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha, const gsl_matrix * A, const gsl_matrix * B, double beta, gsl_matrix * C)
  fun gsl_blas_dsyr2k: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * double * &gsl_matrix * &gsl_matrix * double * &gsl_matrix -> int = 'gsl_blas_dsyr2k($a)';
// Function: int gsl_blas_csyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_matrix_complex_float * B, const gsl_complex_float beta, gsl_matrix_complex_float * C)
  fun gsl_blas_csyr2k: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_matrix_complex_float * gsl_complex_float * &gsl_matrix_complex_float -> int = 'gsl_blas_csyr2k($a)';
// Function: int gsl_blas_zsyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_matrix_complex * B, const gsl_complex beta, gsl_matrix_complex * C)
  fun gsl_blas_zsyr2k: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * gsl_complex * &gsl_matrix_complex * &gsl_matrix_complex * gsl_complex * &gsl_matrix_complex -> int = 'gsl_blas_zsyr2k($a)';
// Function: int gsl_blas_cher2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, const gsl_complex_float alpha, const gsl_matrix_complex_float * A, const gsl_matrix_complex_float * B, float beta, gsl_matrix_complex_float * C)
  fun gsl_blas_cher2k: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * gsl_complex_float * &gsl_matrix_complex_float * &gsl_matrix_complex_float * float * &gsl_matrix_complex_float -> int = 'gsl_blas_cher2k($a)';
// Function: int gsl_blas_zher2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, const gsl_complex alpha, const gsl_matrix_complex * A, const gsl_matrix_complex * B, double beta, gsl_matrix_complex * C)
  fun gsl_blas_zher2k: CBLAS_UPLO_t * CBLAS_TRANSPOSE_t * gsl_complex * &gsl_matrix_complex * &gsl_matrix_complex * double * &gsl_matrix_complex -> int = 'gsl_blas_zher2k($a)';
//*****
// 14.00.00 Linear-Algebra.
//*****
// 14.01.00 LU-Decomposition.
// Function: int gsl_linalg_LU_decomp (gsl_matrix * A, gsl_permutation * p, int * signum)
  fun gsl_linalg_LU_decomp: &gsl_matrix * &gsl_permutation * &int -> int = 'gsl_linalg_LU_decomp($a)';
// Function: int gsl_linalg_complex_LU_decomp (gsl_matrix_complex * A, gsl_permutation * p, int * signum)
  fun gsl_linalg_complex_LU_decomp: &gsl_matrix_complex * &gsl_permutation * &int -> int = 'gsl_linalg_complex_LU_decomp($a)';
// Function: int gsl_linalg_LU_solve (const gsl_matrix * LU, const gsl_permutation * p, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_LU_solve: &gsl_matrix * &gsl_permutation * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_LU_solve($a)';
// Function: int gsl_linalg_complex_LU_solve (const gsl_matrix_complex * LU, const gsl_permutation * p, const gsl_vector_complex * b, gsl_vector_complex * x)
  fun gsl_linalg_complex_LU_solve: &gsl_matrix_complex * &gsl_permutation * &gsl_vector_complex * &gsl_vector_complex -> int = 'gsl_linalg_complex_LU_solve($a)';
// Function: int gsl_linalg_LU_svx (const gsl_matrix * LU, const gsl_permutation * p, gsl_vector * x)
  fun gsl_linalg_LU_svx: &gsl_matrix * &gsl_permutation * &gsl_vector -> int = 'gsl_linalg_LU_svx($a)';
// Function: int gsl_linalg_complex_LU_svx (const gsl_matrix_complex * LU, const gsl_permutation * p, gsl_vector_complex * x)
  fun gsl_linalg_complex_LU_svx: &gsl_matrix_complex * &gsl_permutation * &gsl_vector_complex -> int = 'gsl_linalg_complex_LU_svx($a)';
// Function: int gsl_linalg_LU_refine (const gsl_matrix * A, const gsl_matrix * LU, const gsl_permutation * p, const gsl_vector * b, gsl_vector * x, gsl_vector * residual)
  fun gsl_linalg_LU_refine: &gsl_matrix * &gsl_matrix * &gsl_permutation * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_LU_refine($a)';
// Function: int gsl_linalg_complex_LU_refine (const gsl_matrix_complex * A, const gsl_matrix_complex * LU, const gsl_permutation * p, const gsl_vector_complex * b, gsl_vector_complex * x, gsl_vector_complex * residual)
  fun gsl_linalg_complex_LU_refine: &gsl_matrix_complex * &gsl_matrix_complex * &gsl_permutation * &gsl_vector_complex * &gsl_vector_complex * &gsl_vector_complex -> int = 'gsl_linalg_complex_LU_refine($a)';
// Function: int gsl_linalg_LU_invert (const gsl_matrix * LU, const gsl_permutation * p, gsl_matrix * inverse)
  fun gsl_linalg_LU_invert: &gsl_matrix * &gsl_permutation * &gsl_matrix -> int = 'gsl_linalg_LU_invert($a)';
// Function: int gsl_linalg_complex_LU_invert (const gsl_matrix_complex * LU, const gsl_permutation * p, gsl_matrix_complex * inverse)
  fun gsl_linalg_complex_LU_invert: &gsl_matrix_complex * &gsl_permutation * &gsl_matrix_complex -> int = 'gsl_linalg_complex_LU_invert($a)';
// Function: double gsl_linalg_LU_det (gsl_matrix * LU, int signum)
  fun gsl_linalg_LU_det: &gsl_matrix * int -> double = 'gsl_linalg_LU_det($a)';
// Function: gsl_complex gsl_linalg_complex_LU_det (gsl_matrix_complex * LU, int signum)
  fun gsl_linalg_complex_LU_det: &gsl_matrix_complex * int -> gsl_complex = 'gsl_linalg_complex_LU_det($a)';
// Function: double gsl_linalg_LU_lndet (gsl_matrix * LU)
  fun gsl_linalg_LU_lndet: &gsl_matrix -> double = 'gsl_linalg_LU_lndet($a)';
// Function: double gsl_linalg_complex_LU_lndet (gsl_matrix_complex * LU)
  fun gsl_linalg_complex_LU_lndet: &gsl_matrix_complex -> double = 'gsl_linalg_complex_LU_lndet($a)';
// Function: int gsl_linalg_LU_sgndet (gsl_matrix * LU, int signum)
  fun gsl_linalg_LU_sgndet: &gsl_matrix * int -> int = 'gsl_linalg_LU_sgndet($a)';
// Function: gsl_complex gsl_linalg_complex_LU_sgndet (gsl_matrix_complex * LU, int signum)
  fun gsl_linalg_complex_LU_sgndet: &gsl_matrix_complex * int -> gsl_complex = 'gsl_linalg_complex_LU_sgndet($a)';
//*****
// 14.02.00 QR-Decomposition.
// Function: int gsl_linalg_QR_decomp (gsl_matrix * A, gsl_vector * tau)
  fun gsl_linalg_QR_decomp: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_QR_decomp($a)';
// Function: int gsl_linalg_QR_solve (const gsl_matrix * QR, const gsl_vector * tau, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_QR_solve: &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_solve($a)';
// Function: int gsl_linalg_QR_svx (const gsl_matrix * QR, const gsl_vector * tau, gsl_vector * x)
  fun gsl_linalg_QR_svx: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_svx($a)';
// Function: int gsl_linalg_QR_lssolve (const gsl_matrix * QR, const gsl_vector * tau, const gsl_vector * b, gsl_vector * x, gsl_vector * residual)
  fun gsl_linalg_QR_lssolve: &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_lssolve($a)';
// Function: int gsl_linalg_QR_QTvec (const gsl_matrix * QR, const gsl_vector * tau, gsl_vector * v)
  fun gsl_linalg_QR_QTvec: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_QTvec($a)';
// Function: int gsl_linalg_QR_Qvec (const gsl_matrix * QR, const gsl_vector * tau, gsl_vector * v)
  fun gsl_linalg_QR_Qvec: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_Qvec($a)';
// Function: int gsl_linalg_QR_QTmat (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * A)
  fun gsl_linalg_QR_QTmat: &gsl_matrix * &gsl_vector * &gsl_matrix -> int = 'gsl_linalg_QR_QTmat($a)';
// Function: int gsl_linalg_QR_Rsolve (const gsl_matrix * QR, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_QR_Rsolve: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_Rsolve($a)';
// Function: int gsl_linalg_QR_Rsvx (const gsl_matrix * QR, gsl_vector * x)
  fun gsl_linalg_QR_Rsvx: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_QR_Rsvx($a)';
// Function: int gsl_linalg_QR_unpack (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * Q, gsl_matrix * R)
  fun gsl_linalg_QR_unpack: &gsl_matrix * &gsl_vector * &gsl_matrix * &gsl_matrix -> int = 'gsl_linalg_QR_unpack($a)';
// Function: int gsl_linalg_QR_QRsolve (gsl_matrix * Q, gsl_matrix * R, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_QR_QRsolve: &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_QRsolve($a)';
// Function: int gsl_linalg_QR_update (gsl_matrix * Q, gsl_matrix * R, gsl_vector * w, const gsl_vector * v)
  fun gsl_linalg_QR_update: &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QR_update($a)';
// Function: int gsl_linalg_R_solve (const gsl_matrix * R, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_R_solve: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_R_solve($a)';
// Function: int gsl_linalg_R_svx (const gsl_matrix * R, gsl_vector * x)
  fun gsl_linalg_R_svx: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_R_svx($a)';
//*****
// 14.03.00 QR-Decomposition-with-Column-Pivoting.
// Function: int gsl_linalg_QRPT_decomp (gsl_matrix * A, gsl_vector * tau, gsl_permutation * p, int * signum, gsl_vector * norm)
  fun gsl_linalg_QRPT_decomp: &gsl_matrix * &gsl_vector * &gsl_permutation * &int * &gsl_vector -> int = 'gsl_linalg_QRPT_decomp($a)';
// Function: int gsl_linalg_QRPT_decomp2 (const gsl_matrix * A, gsl_matrix * q, gsl_matrix * r, gsl_vector * tau, gsl_permutation * p, int * signum, gsl_vector * norm)
  fun gsl_linalg_QRPT_decomp2: &gsl_matrix * &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_permutation * &int * &gsl_vector -> int = 'gsl_linalg_QRPT_decomp2($a)';
// Function: int gsl_linalg_QRPT_solve (const gsl_matrix * QR, const gsl_vector * tau, const gsl_permutation * p, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_QRPT_solve: &gsl_matrix * &gsl_vector * &gsl_permutation * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QRPT_solve($a)';
// Function: int gsl_linalg_QRPT_svx (const gsl_matrix * QR, const gsl_vector * tau, const gsl_permutation * p, gsl_vector * x)
  fun gsl_linalg_QRPT_svx: &gsl_matrix * &gsl_vector * &gsl_permutation * &gsl_vector -> int = 'gsl_linalg_QRPT_svx($a)';
// Function: int gsl_linalg_QRPT_QRsolve (const gsl_matrix * Q, const gsl_matrix * R, const gsl_permutation * p, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_QRPT_QRsolve: &gsl_matrix * &gsl_matrix * &gsl_permutation * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QRPT_QRsolve($a)';
// Function: int gsl_linalg_QRPT_update (gsl_matrix * Q, gsl_matrix * R, const gsl_permutation * p, gsl_vector * w, const gsl_vector * v)
  fun gsl_linalg_QRPT_update: &gsl_matrix * &gsl_matrix * &gsl_permutation * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QRPT_update($a)';
// Function: int gsl_linalg_QRPT_Rsolve (const gsl_matrix * QR, const gsl_permutation * p, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_QRPT_Rsolve: &gsl_matrix * &gsl_permutation * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_QRPT_Rsolve($a)';
// Function: int gsl_linalg_QRPT_Rsvx (const gsl_matrix * QR, const gsl_permutation * p, gsl_vector * x)
  fun gsl_linalg_QRPT_Rsvx: &gsl_matrix * &gsl_permutation * &gsl_vector -> int = 'gsl_linalg_QRPT_Rsvx($a)';
//*****
// 14.04.00 Singular-Value-Decomposition.
// Function: int gsl_linalg_SV_decomp (gsl_matrix * A, gsl_matrix * V, gsl_vector * S, gsl_vector * work)
  fun gsl_linalg_SV_decomp: &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_SV_decomp($a)';
// Function: int gsl_linalg_SV_decomp_mod (gsl_matrix * A, gsl_matrix * X, gsl_matrix * V, gsl_vector * S, gsl_vector * work)
  fun gsl_linalg_SV_decomp_mod: &gsl_matrix * &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_SV_decomp_mod($a)';
// Function: int gsl_linalg_SV_decomp_jacobi (gsl_matrix * A, gsl_matrix * V, gsl_vector * S)
  fun gsl_linalg_SV_decomp_jacobi: &gsl_matrix * &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_SV_decomp_jacobi($a)';
// Function: int gsl_linalg_SV_solve (const gsl_matrix * U, const gsl_matrix * V, const gsl_vector * S, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_SV_solve: &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_SV_solve($a)';
// Function: int gsl_linalg_SV_leverage (const gsl_matrix * U, gsl_vector * h)
  fun gsl_linalg_SV_leverage: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_SV_leverage($a)';
//*****
// 14.05.00 Cholesky-Decomposition.
// Function: int gsl_linalg_cholesky_decomp (gsl_matrix * A)
  fun gsl_linalg_cholesky_decomp: &gsl_matrix -> int = 'gsl_linalg_cholesky_decomp($a)';
// Function: int gsl_linalg_complex_cholesky_decomp (gsl_matrix_complex * A)
  fun gsl_linalg_complex_cholesky_decomp: &gsl_matrix_complex -> int = 'gsl_linalg_complex_cholesky_decomp($a)';
// Function: int gsl_linalg_cholesky_solve (const gsl_matrix * cholesky, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_cholesky_solve: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_cholesky_solve($a)';
// Function: int gsl_linalg_complex_cholesky_solve (const gsl_matrix_complex * cholesky, const gsl_vector_complex * b, gsl_vector_complex * x)
  fun gsl_linalg_complex_cholesky_solve: &gsl_matrix_complex * &gsl_vector_complex * &gsl_vector_complex -> int = 'gsl_linalg_complex_cholesky_solve($a)';
// Function: int gsl_linalg_cholesky_svx (const gsl_matrix * cholesky, gsl_vector * x)
  fun gsl_linalg_cholesky_svx: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_cholesky_svx($a)';
// Function: int gsl_linalg_complex_cholesky_svx (const gsl_matrix_complex * cholesky, gsl_vector_complex * x)
  fun gsl_linalg_complex_cholesky_svx: &gsl_matrix_complex * &gsl_vector_complex -> int = 'gsl_linalg_complex_cholesky_svx($a)';
// Function: int gsl_linalg_cholesky_invert (gsl_matrix * cholesky)
  fun gsl_linalg_cholesky_invert: &gsl_matrix -> int = 'gsl_linalg_cholesky_invert($a)';
// Function: int gsl_linalg_complex_cholesky_invert (gsl_matrix_complex * cholesky)
  fun gsl_linalg_complex_cholesky_invert: &gsl_matrix_complex -> int = 'gsl_linalg_complex_cholesky_invert($a)';
//*****
// 14.06.00 Tridiagonal-Decomposition-of-Hermitian-Matrics.
// Function: int gsl_linalg_symmtd_decomp (gsl_matrix * A, gsl_vector * tau)
  fun gsl_linalg_symmtd_decomp: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_symmtd_decomp($a)';
// Function: int gsl_linalg_symmtd_unpack (const gsl_matrix * A, const gsl_vector * tau, gsl_matrix * Q, gsl_vector * diag, gsl_vector * subdiag)
  fun gsl_linalg_symmtd_unpack: &gsl_matrix * &gsl_vector * &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_symmtd_unpack($a)';
// Function: int gsl_linalg_symmtd_unpack_T (const gsl_matrix * A, gsl_vector * diag, gsl_vector * subdiag)
  fun gsl_linalg_symmtd_unpack_T: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_symmtd_unpack_T($a)';
//*****
// 14.06.00 Tridiagonal-Decomposition-of-Real-Symmetric-Matrics.
// Function: int gsl_linalg_symmtd_decomp (gsl_matrix * A, gsl_vector * tau)
  fun gsl_linalg_symmtd_decomp: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_symmtd_decomp($a)';
// Function: int gsl_linalg_symmtd_unpack (const gsl_matrix * A, const gsl_vector * tau, gsl_matrix * Q, gsl_vector * diag, gsl_vector * subdiag)
  fun gsl_linalg_symmtd_unpack: &gsl_matrix * &gsl_vector * &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_symmtd_unpack($a)';
// Function: int gsl_linalg_symmtd_unpack_T (const gsl_matrix * A, gsl_vector * diag, gsl_vector * subdiag)
  fun gsl_linalg_symmtd_unpack_T: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_symmtd_unpack_T($a)';
//*****
// 14.08.00 Hessenberg-Decomposiion-of-Real-Matrices.
// Function: int gsl_linalg_hessenberg_decomp (gsl_matrix * A, gsl_vector * tau)
  fun gsl_linalg_hessenberg_decomp: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_hessenberg_decomp($a)';
// Function: int gsl_linalg_hessenberg_unpack (gsl_matrix * H, gsl_vector * tau, gsl_matrix * U)
  fun gsl_linalg_hessenberg_unpack: &gsl_matrix * &gsl_vector * &gsl_matrix -> int = 'gsl_linalg_hessenberg_unpack($a)';
// Function: int gsl_linalg_hessenberg_unpack_accum (gsl_matrix * H, gsl_vector * tau, gsl_matrix * V)
  fun gsl_linalg_hessenberg_unpack_accum: &gsl_matrix * &gsl_vector * &gsl_matrix -> int = 'gsl_linalg_hessenberg_unpack_accum($a)';
// Function: int gsl_linalg_hessenberg_set_zero (gsl_matrix * H)
  fun gsl_linalg_hessenberg_set_zero: &gsl_matrix -> int = 'gsl_linalg_hessenberg_set_zero($a)';
//*****
// 14.09.00 Hessenberg-Triangular-Decomposiion-of-Real-Matrices.
// Function: int gsl_linalg_hesstri_decomp (gsl_matrix * A, gsl_matrix * B, gsl_matrix * U, gsl_matrix * V, gsl_vector * work)
  fun gsl_linalg_hesstri_decomp: &gsl_matrix * &gsl_matrix * &gsl_matrix * &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_hesstri_decomp($a)';
//*****
// 14.10.00 Bidiagonalisation.
// Function: int gsl_linalg_bidiag_decomp (gsl_matrix * A, gsl_vector * tau_U, gsl_vector * tau_V)
  fun gsl_linalg_bidiag_decomp: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_bidiag_decomp($a)';
// Function: int gsl_linalg_bidiag_unpack (const gsl_matrix * A, const gsl_vector * tau_U, gsl_matrix * U, const gsl_vector * tau_V, gsl_matrix * V, gsl_vector * diag, gsl_vector * superdiag)
  fun gsl_linalg_bidiag_unpack: &gsl_matrix * &gsl_vector * &gsl_matrix * &gsl_vector * &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_bidiag_unpack($a)';
// Function: int gsl_linalg_bidiag_unpack2 (gsl_matrix * A, gsl_vector * tau_U, gsl_vector * tau_V, gsl_matrix * V)
  fun gsl_linalg_bidiag_unpack2: &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_matrix -> int = 'gsl_linalg_bidiag_unpack2($a)';
// Function: int gsl_linalg_bidiag_unpack_B (const gsl_matrix * A, gsl_vector * diag, gsl_vector * superdiag)
  fun gsl_linalg_bidiag_unpack_B: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_bidiag_unpack_B($a)';
//*****
// 14.11.00 Householder-Transformations.
// Function: double gsl_linalg_householder_transform (gsl_vector * v)
  fun gsl_linalg_householder_transform: &gsl_vector -> double = 'gsl_linalg_householder_transform($a)';
// Function: gsl_complex gsl_linalg_complex_householder_transform (gsl_vector_complex * v)
  fun gsl_linalg_complex_householder_transform: &gsl_vector_complex -> gsl_complex = 'gsl_linalg_complex_householder_transform($a)';
// Function: int gsl_linalg_householder_hm (double tau, const gsl_vector * v, gsl_matrix * A)
  fun gsl_linalg_householder_hm: double * &gsl_vector * &gsl_matrix -> int = 'gsl_linalg_householder_hm($a)';
// Function: int gsl_linalg_complex_householder_hm (gsl_complex tau, const gsl_vector_complex * v, gsl_matrix_complex * A)
  fun gsl_linalg_complex_householder_hm: gsl_complex * &gsl_vector_complex * &gsl_matrix_complex -> int = 'gsl_linalg_complex_householder_hm($a)';
// Function: int gsl_linalg_householder_mh (double tau, const gsl_vector * v, gsl_matrix * A)
  fun gsl_linalg_householder_mh: double * &gsl_vector * &gsl_matrix -> int = 'gsl_linalg_householder_mh($a)';
// Function: int gsl_linalg_complex_householder_mh (gsl_complex tau, const gsl_vector_complex * v, gsl_matrix_complex * A)
  fun gsl_linalg_complex_householder_mh: gsl_complex * &gsl_vector_complex * &gsl_matrix_complex -> int = 'gsl_linalg_complex_householder_mh($a)';
// Function: int gsl_linalg_householder_hv (double tau, const gsl_vector * v, gsl_vector * w)
  fun gsl_linalg_householder_hv: double * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_householder_hv($a)';
// Function: int gsl_linalg_complex_householder_hv (gsl_complex tau, const gsl_vector_complex * v, gsl_vector_complex * w)
  fun gsl_linalg_complex_householder_hv: gsl_complex * &gsl_vector_complex * &gsl_vector_complex -> int = 'gsl_linalg_complex_householder_hv($a)';
//*****
// 14.12.00 Householder-solver-for-linear-systems.
// Function: int gsl_linalg_HH_solve (gsl_matrix * A, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_HH_solve: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_HH_solve($a)';
// Function: int gsl_linalg_HH_svx (gsl_matrix * A, gsl_vector * x)
  fun gsl_linalg_HH_svx: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_HH_svx($a)';
//*****
// 14.13.00 Tridiagonal-Systems.
// Function: int gsl_linalg_solve_tridiag (const gsl_vector * diag, const gsl_vector * e, const gsl_vector * f, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_solve_tridiag: &gsl_vector * &gsl_vector * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_solve_tridiag($a)';
// Function: int gsl_linalg_solve_symm_tridiag (const gsl_vector * diag, const gsl_vector * e, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_solve_symm_tridiag: &gsl_vector * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_solve_symm_tridiag($a)';
// Function: int gsl_linalg_solve_cyc_tridiag (const gsl_vector * diag, const gsl_vector * e, const gsl_vector * f, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_solve_cyc_tridiag: &gsl_vector * &gsl_vector * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_solve_cyc_tridiag($a)';
// Function: int gsl_linalg_solve_symm_cyc_tridiag (const gsl_vector * diag, const gsl_vector * e, const gsl_vector * b, gsl_vector * x)
  fun gsl_linalg_solve_symm_cyc_tridiag: &gsl_vector * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_linalg_solve_symm_cyc_tridiag($a)';
//*****
// 14.14.00 Balancing.
// Function: int gsl_linalg_balance_matrix (gsl_matrix * A, gsl_vector * D)
  fun gsl_linalg_balance_matrix: &gsl_matrix * &gsl_vector -> int = 'gsl_linalg_balance_matrix($a)';
//*****
// 15.00.00 Eigensystems.
//*****
// 15.01.00 Real-Symmetric-Matrics.
// Function: gsl_eigen_symm_workspace * gsl_eigen_symm_alloc (const size_t n)
  fun gsl_eigen_symm_alloc: size -> &gsl_eigen_symm_workspace = 'gsl_eigen_symm_alloc($a)';
// Function: void gsl_eigen_symm_free (gsl_eigen_symm_workspace * w)
  proc gsl_eigen_symm_free: &gsl_eigen_symm_workspace = 'gsl_eigen_symm_free($a);';
// Function: int gsl_eigen_symm (gsl_matrix * A, gsl_vector * eval, gsl_eigen_symm_workspace * w)
  fun gsl_eigen_symm: &gsl_matrix * &gsl_vector * &gsl_eigen_symm_workspace -> int = 'gsl_eigen_symm($a)';
// Function: gsl_eigen_symmv_workspace * gsl_eigen_symmv_alloc (const size_t n)
  fun gsl_eigen_symmv_alloc: size -> &gsl_eigen_symmv_workspace = 'gsl_eigen_symmv_alloc($a)';
// Function: void gsl_eigen_symmv_free (gsl_eigen_symmv_workspace * w)
  proc gsl_eigen_symmv_free: &gsl_eigen_symmv_workspace = 'gsl_eigen_symmv_free($a);';
// Function: int gsl_eigen_symmv (gsl_matrix * A, gsl_vector * eval, gsl_matrix * evec, gsl_eigen_symmv_workspace * w)
  fun gsl_eigen_symmv: &gsl_matrix * &gsl_vector * &gsl_matrix * &gsl_eigen_symmv_workspace -> int = 'gsl_eigen_symmv($a)';
//*****
// 15.02.00 Complex-Hermitian-Matrics.
// Function: gsl_eigen_herm_workspace * gsl_eigen_herm_alloc (const size_t n)
  fun gsl_eigen_herm_alloc: size -> &gsl_eigen_herm_workspace = 'gsl_eigen_herm_alloc($a)';
// Function: void gsl_eigen_herm_free (gsl_eigen_herm_workspace * w)
  proc gsl_eigen_herm_free: &gsl_eigen_herm_workspace = 'gsl_eigen_herm_free($a);';
// Function: int gsl_eigen_herm (gsl_matrix_complex * A, gsl_vector * eval, gsl_eigen_herm_workspace * w)
  fun gsl_eigen_herm: &gsl_matrix_complex * &gsl_vector * &gsl_eigen_herm_workspace -> int = 'gsl_eigen_herm($a)';
// Function: gsl_eigen_hermv_workspace * gsl_eigen_hermv_alloc (const size_t n)
  fun gsl_eigen_hermv_alloc: size -> &gsl_eigen_hermv_workspace = 'gsl_eigen_hermv_alloc($a)';
// Function: void gsl_eigen_hermv_free (gsl_eigen_hermv_workspace * w)
  proc gsl_eigen_hermv_free: &gsl_eigen_hermv_workspace = 'gsl_eigen_hermv_free($a);';
// Function: int gsl_eigen_hermv (gsl_matrix_complex * A, gsl_vector * eval, gsl_matrix_complex * evec, gsl_eigen_hermv_workspace * w)
  fun gsl_eigen_hermv: &gsl_matrix_complex * &gsl_vector * &gsl_matrix_complex * &gsl_eigen_hermv_workspace -> int = 'gsl_eigen_hermv($a)';
//*****
// 15.03.00 Real-Nonsymmetric-Matrics.
// Function: gsl_eigen_nonsymm_workspace * gsl_eigen_nonsymm_alloc (const size_t n)
  fun gsl_eigen_nonsymm_alloc: size -> &gsl_eigen_nonsymm_workspace = 'gsl_eigen_nonsymm_alloc($a)';
// Function: void gsl_eigen_nonsymm_free (gsl_eigen_nonsymm_workspace * w)
  proc gsl_eigen_nonsymm_free: &gsl_eigen_nonsymm_workspace = 'gsl_eigen_nonsymm_free($a);';
// Function: void gsl_eigen_nonsymm_params (const int compute_t, const int balance, gsl_eigen_nonsymm_workspace * w)
  proc gsl_eigen_nonsymm_params: int * int * &gsl_eigen_nonsymm_workspace = 'gsl_eigen_nonsymm_params($a);';
// Function: int gsl_eigen_nonsymm (gsl_matrix * A, gsl_vector_complex * eval, gsl_eigen_nonsymm_workspace * w)
  fun gsl_eigen_nonsymm: &gsl_matrix * &gsl_vector_complex * &gsl_eigen_nonsymm_workspace -> int = 'gsl_eigen_nonsymm($a)';
// Function: int gsl_eigen_nonsymm_Z (gsl_matrix * A, gsl_vector_complex * eval, gsl_matrix * Z, gsl_eigen_nonsymm_workspace * w)
  fun gsl_eigen_nonsymm_Z: &gsl_matrix * &gsl_vector_complex * &gsl_matrix * &gsl_eigen_nonsymm_workspace -> int = 'gsl_eigen_nonsymm_Z($a)';
// Function: gsl_eigen_nonsymmv_workspace * gsl_eigen_nonsymmv_alloc (const size_t n)
  fun gsl_eigen_nonsymmv_alloc: size -> &gsl_eigen_nonsymmv_workspace = 'gsl_eigen_nonsymmv_alloc($a)';
// Function: void gsl_eigen_nonsymmv_free (gsl_eigen_nonsymmv_workspace * w)
  proc gsl_eigen_nonsymmv_free: &gsl_eigen_nonsymmv_workspace = 'gsl_eigen_nonsymmv_free($a);';
// Function: void gsl_eigen_nonsymmv_params (const int balance, gsl_eigen_nonsymm_workspace * w)
  proc gsl_eigen_nonsymmv_params: int * &gsl_eigen_nonsymm_workspace = 'gsl_eigen_nonsymmv_params($a);';
// Function: int gsl_eigen_nonsymmv (gsl_matrix * A, gsl_vector_complex * eval, gsl_matrix_complex * evec, gsl_eigen_nonsymmv_workspace * w)
  fun gsl_eigen_nonsymmv: &gsl_matrix * &gsl_vector_complex * &gsl_matrix_complex * &gsl_eigen_nonsymmv_workspace -> int = 'gsl_eigen_nonsymmv($a)';
// Function: int gsl_eigen_nonsymmv_Z (gsl_matrix * A, gsl_vector_complex * eval, gsl_matrix_complex * evec, gsl_matrix * Z, gsl_eigen_nonsymmv_workspace * w)
  fun gsl_eigen_nonsymmv_Z: &gsl_matrix * &gsl_vector_complex * &gsl_matrix_complex * &gsl_matrix * &gsl_eigen_nonsymmv_workspace -> int = 'gsl_eigen_nonsymmv_Z($a)';
//*****
// 15.04.00 Real-Generalized-Symmetric-Definite-Eigensystems.
// Function: gsl_eigen_gensymm_workspace * gsl_eigen_gensymm_alloc (const size_t n)
  fun gsl_eigen_gensymm_alloc: size -> &gsl_eigen_gensymm_workspace = 'gsl_eigen_gensymm_alloc($a)';
// Function: void gsl_eigen_gensymm_free (gsl_eigen_gensymm_workspace * w)
  proc gsl_eigen_gensymm_free: &gsl_eigen_gensymm_workspace = 'gsl_eigen_gensymm_free($a);';
// Function: int gsl_eigen_gensymm (gsl_matrix * A, gsl_matrix * B, gsl_vector * eval, gsl_eigen_gensymm_workspace * w)
  fun gsl_eigen_gensymm: &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_eigen_gensymm_workspace -> int = 'gsl_eigen_gensymm($a)';
// Function: gsl_eigen_gensymmv_workspace * gsl_eigen_gensymmv_alloc (const size_t n)
  fun gsl_eigen_gensymmv_alloc: size -> &gsl_eigen_gensymmv_workspace = 'gsl_eigen_gensymmv_alloc($a)';
// Function: void gsl_eigen_gensymmv_free (gsl_eigen_gensymmv_workspace * w)
  proc gsl_eigen_gensymmv_free: &gsl_eigen_gensymmv_workspace = 'gsl_eigen_gensymmv_free($a);';
// Function: int gsl_eigen_gensymmv (gsl_matrix * A, gsl_matrix * B, gsl_vector * eval, gsl_matrix * evec, gsl_eigen_gensymmv_workspace * w)
  fun gsl_eigen_gensymmv: &gsl_matrix * &gsl_matrix * &gsl_vector * &gsl_matrix * &gsl_eigen_gensymmv_workspace -> int = 'gsl_eigen_gensymmv($a)';
//*****
// 15.05.00 Complex-Generalized-Hermitian-Definite-Eigensystems.
// Function: gsl_eigen_genherm_workspace * gsl_eigen_genherm_alloc (const size_t n)
  fun gsl_eigen_genherm_alloc: size -> &gsl_eigen_genherm_workspace = 'gsl_eigen_genherm_alloc($a)';
// Function: void gsl_eigen_genherm_free (gsl_eigen_genherm_workspace * w)
  proc gsl_eigen_genherm_free: &gsl_eigen_genherm_workspace = 'gsl_eigen_genherm_free($a);';
// Function: int gsl_eigen_genherm (gsl_matrix_complex * A, gsl_matrix_complex * B, gsl_vector * eval, gsl_eigen_genherm_workspace * w)
  fun gsl_eigen_genherm: &gsl_matrix_complex * &gsl_matrix_complex * &gsl_vector * &gsl_eigen_genherm_workspace -> int = 'gsl_eigen_genherm($a)';
// Function: gsl_eigen_genhermv_workspace * gsl_eigen_genhermv_alloc (const size_t n)
  fun gsl_eigen_genhermv_alloc: size -> &gsl_eigen_genhermv_workspace = 'gsl_eigen_genhermv_alloc($a)';
// Function: void gsl_eigen_genhermv_free (gsl_eigen_genhermv_workspace * w)
  proc gsl_eigen_genhermv_free: &gsl_eigen_genhermv_workspace = 'gsl_eigen_genhermv_free($a);';
// Function: int gsl_eigen_genhermv (gsl_matrix_complex * A, gsl_matrix_complex * B, gsl_vector * eval, gsl_matrix_complex * evec, gsl_eigen_genhermv_workspace * w)
  fun gsl_eigen_genhermv: &gsl_matrix_complex * &gsl_matrix_complex * &gsl_vector * &gsl_matrix_complex * &gsl_eigen_genhermv_workspace -> int = 'gsl_eigen_genhermv($a)';
//*****
// 15.06.00 Real-Generalized-Nonsymmetric-Eigensystems.
// Function: gsl_eigen_gen_workspace * gsl_eigen_gen_alloc (const size_t n)
  fun gsl_eigen_gen_alloc: size -> &gsl_eigen_gen_workspace = 'gsl_eigen_gen_alloc($a)';
// Function: void gsl_eigen_gen_free (gsl_eigen_gen_workspace * w)
  proc gsl_eigen_gen_free: &gsl_eigen_gen_workspace = 'gsl_eigen_gen_free($a);';
// Function: void gsl_eigen_gen_params (const int compute_s, const int compute_t, const int balance, gsl_eigen_gen_workspace * w)
  proc gsl_eigen_gen_params: int * int * int * &gsl_eigen_gen_workspace = 'gsl_eigen_gen_params($a);';
// Function: int gsl_eigen_gen (gsl_matrix * A, gsl_matrix * B, gsl_vector_complex * alpha, gsl_vector * beta, gsl_eigen_gen_workspace * w)
  fun gsl_eigen_gen: &gsl_matrix * &gsl_matrix * &gsl_vector_complex * &gsl_vector * &gsl_eigen_gen_workspace -> int = 'gsl_eigen_gen($a)';
// Function: int gsl_eigen_gen_QZ (gsl_matrix * A, gsl_matrix * B, gsl_vector_complex * alpha, gsl_vector * beta, gsl_matrix * Q, gsl_matrix * Z, gsl_eigen_gen_workspace * w)
  fun gsl_eigen_gen_QZ: &gsl_matrix * &gsl_matrix * &gsl_vector_complex * &gsl_vector * &gsl_matrix * &gsl_matrix * &gsl_eigen_gen_workspace -> int = 'gsl_eigen_gen_QZ($a)';
// Function: gsl_eigen_genv_workspace * gsl_eigen_genv_alloc (const size_t n)
  fun gsl_eigen_genv_alloc: size -> &gsl_eigen_genv_workspace = 'gsl_eigen_genv_alloc($a)';
// Function: void gsl_eigen_genv_free (gsl_eigen_genv_workspace * w)
  proc gsl_eigen_genv_free: &gsl_eigen_genv_workspace = 'gsl_eigen_genv_free($a);';
// Function: int gsl_eigen_genv (gsl_matrix * A, gsl_matrix * B, gsl_vector_complex * alpha, gsl_vector * beta, gsl_matrix_complex * evec, gsl_eigen_genv_workspace * w)
  fun gsl_eigen_genv: &gsl_matrix * &gsl_matrix * &gsl_vector_complex * &gsl_vector * &gsl_matrix_complex * &gsl_eigen_genv_workspace -> int = 'gsl_eigen_genv($a)';
// Function: int gsl_eigen_genv_QZ (gsl_matrix * A, gsl_matrix * B, gsl_vector_complex * alpha, gsl_vector * beta, gsl_matrix_complex * evec, gsl_matrix * Q, gsl_matrix * Z, gsl_eigen_genv_workspace * w)
  fun gsl_eigen_genv_QZ: &gsl_matrix * &gsl_matrix * &gsl_vector_complex * &gsl_vector * &gsl_matrix_complex * &gsl_matrix * &gsl_matrix * &gsl_eigen_genv_workspace -> int = 'gsl_eigen_genv_QZ($a)';
//*****
// 15.07.00 Sorting-Eigenvalues-and-Eigenvectors.
// Function: int gsl_eigen_symmv_sort (gsl_vector * eval, gsl_matrix * evec, gsl_eigen_sort_t sort_type)
  fun gsl_eigen_symmv_sort: &gsl_vector * &gsl_matrix * gsl_eigen_sort_t -> int = 'gsl_eigen_symmv_sort($a)';
// Function: int gsl_eigen_hermv_sort (gsl_vector * eval, gsl_matrix_complex * evec, gsl_eigen_sort_t sort_type)
  fun gsl_eigen_hermv_sort: &gsl_vector * &gsl_matrix_complex * gsl_eigen_sort_t -> int = 'gsl_eigen_hermv_sort($a)';
// Function: int gsl_eigen_nonsymmv_sort (gsl_vector_complex * eval, gsl_matrix_complex * evec, gsl_eigen_sort_t sort_type)
  fun gsl_eigen_nonsymmv_sort: &gsl_vector_complex * &gsl_matrix_complex * gsl_eigen_sort_t -> int = 'gsl_eigen_nonsymmv_sort($a)';
// Function: int gsl_eigen_gensymmv_sort (gsl_vector * eval, gsl_matrix * evec, gsl_eigen_sort_t sort_type)
  fun gsl_eigen_gensymmv_sort: &gsl_vector * &gsl_matrix * gsl_eigen_sort_t -> int = 'gsl_eigen_gensymmv_sort($a)';
// Function: int gsl_eigen_genhermv_sort (gsl_vector * eval, gsl_matrix_complex * evec, gsl_eigen_sort_t sort_type)
  fun gsl_eigen_genhermv_sort: &gsl_vector * &gsl_matrix_complex * gsl_eigen_sort_t -> int = 'gsl_eigen_genhermv_sort($a)';
// Function: int gsl_eigen_genv_sort (gsl_vector_complex * alpha, gsl_vector * beta, gsl_matrix_complex * evec, gsl_eigen_sort_t sort_type)
  fun gsl_eigen_genv_sort: &gsl_vector_complex * &gsl_vector * &gsl_matrix_complex * gsl_eigen_sort_t -> int = 'gsl_eigen_genv_sort($a)';
//*****
// 16.00.00 Fast-Fourier-Transforms-(FFTs).
//*****
// 16.01.00 Mathematical-Definitions.
//*****
// 16.02.00 Overview-of-complex-data-FFTs.
//*****
// 16.03.00 Radix-2-FFT-routines-for-complex-data.
// Function: int gsl_fft_complex_radix2_forward (gsl_complex_packed_array data, size_t stride, size_t n)
  fun gsl_fft_complex_radix2_forward: gsl_complex_packed_array * size * size -> int = 'gsl_fft_complex_radix2_forward($a)';
// Function: int gsl_fft_complex_radix2_transform (gsl_complex_packed_array data, size_t stride, size_t n, gsl_fft_direction sign)
  fun gsl_fft_complex_radix2_transform: gsl_complex_packed_array * size * size * gsl_fft_direction -> int = 'gsl_fft_complex_radix2_transform($a)';
// Function: int gsl_fft_complex_radix2_backward (gsl_complex_packed_array data, size_t stride, size_t n)
  fun gsl_fft_complex_radix2_backward: gsl_complex_packed_array * size * size -> int = 'gsl_fft_complex_radix2_backward($a)';
// Function: int gsl_fft_complex_radix2_inverse (gsl_complex_packed_array data, size_t stride, size_t n)
  fun gsl_fft_complex_radix2_inverse: gsl_complex_packed_array * size * size -> int = 'gsl_fft_complex_radix2_inverse($a)';
// Function: int gsl_fft_complex_radix2_dif_forward (gsl_complex_packed_array data, size_t stride, size_t n)
  fun gsl_fft_complex_radix2_dif_forward: gsl_complex_packed_array * size * size -> int = 'gsl_fft_complex_radix2_dif_forward($a)';
// Function: int gsl_fft_complex_radix2_dif_transform (gsl_complex_packed_array data, size_t stride, size_t n, gsl_fft_direction sign)
  fun gsl_fft_complex_radix2_dif_transform: gsl_complex_packed_array * size * size * gsl_fft_direction -> int = 'gsl_fft_complex_radix2_dif_transform($a)';
// Function: int gsl_fft_complex_radix2_dif_backward (gsl_complex_packed_array data, size_t stride, size_t n)
  fun gsl_fft_complex_radix2_dif_backward: gsl_complex_packed_array * size * size -> int = 'gsl_fft_complex_radix2_dif_backward($a)';
// Function: int gsl_fft_complex_radix2_dif_inverse (gsl_complex_packed_array data, size_t stride, size_t n)
  fun gsl_fft_complex_radix2_dif_inverse: gsl_complex_packed_array * size * size -> int = 'gsl_fft_complex_radix2_dif_inverse($a)';
//*****
// 16.04.00 Mixed-radix-FFT-routines-for-complex-data.
// Function: gsl_fft_complex_wavetable * gsl_fft_complex_wavetable_alloc (size_t n)
  fun gsl_fft_complex_wavetable_alloc: size -> &gsl_fft_complex_wavetable = 'gsl_fft_complex_wavetable_alloc($a)';
// Function: void gsl_fft_complex_wavetable_free (gsl_fft_complex_wavetable * wavetable)
  proc gsl_fft_complex_wavetable_free: &gsl_fft_complex_wavetable = 'gsl_fft_complex_wavetable_free($a);';
// Function: gsl_fft_complex_workspace * gsl_fft_complex_workspace_alloc (size_t n)
  fun gsl_fft_complex_workspace_alloc: size -> &gsl_fft_complex_workspace = 'gsl_fft_complex_workspace_alloc($a)';
// Function: void gsl_fft_complex_workspace_free (gsl_fft_complex_workspace * workspace)
  proc gsl_fft_complex_workspace_free: &gsl_fft_complex_workspace = 'gsl_fft_complex_workspace_free($a);';
// Function: int gsl_fft_complex_forward (gsl_complex_packed_array data, size_t stride, size_t n, const gsl_fft_complex_wavetable * wavetable, gsl_fft_complex_workspace * work)
  fun gsl_fft_complex_forward: gsl_complex_packed_array * size * size * &gsl_fft_complex_wavetable * &gsl_fft_complex_workspace -> int = 'gsl_fft_complex_forward($a)';
// Function: int gsl_fft_complex_transform (gsl_complex_packed_array data, size_t stride, size_t n, const gsl_fft_complex_wavetable * wavetable, gsl_fft_complex_workspace * work, gsl_fft_direction sign)
  fun gsl_fft_complex_transform: gsl_complex_packed_array * size * size * &gsl_fft_complex_wavetable * &gsl_fft_complex_workspace * gsl_fft_direction -> int = 'gsl_fft_complex_transform($a)';
// Function: int gsl_fft_complex_backward (gsl_complex_packed_array data, size_t stride, size_t n, const gsl_fft_complex_wavetable * wavetable, gsl_fft_complex_workspace * work)
  fun gsl_fft_complex_backward: gsl_complex_packed_array * size * size * &gsl_fft_complex_wavetable * &gsl_fft_complex_workspace -> int = 'gsl_fft_complex_backward($a)';
// Function: int gsl_fft_complex_inverse (gsl_complex_packed_array data, size_t stride, size_t n, const gsl_fft_complex_wavetable * wavetable, gsl_fft_complex_workspace * work)
  fun gsl_fft_complex_inverse: gsl_complex_packed_array * size * size * &gsl_fft_complex_wavetable * &gsl_fft_complex_workspace -> int = 'gsl_fft_complex_inverse($a)';
//*****
// 16.05.00 Overview-of-real-data-FFTs.
//*****
// 16.06.00 Radix-2-FFT-routines-for-real-data.
// Function: int gsl_fft_real_radix2_transform (double data[], size_t stride, size_t n)
  fun gsl_fft_real_radix2_transform: +double * size * size -> int = 'gsl_fft_real_radix2_transform($a)';
// Function: int gsl_fft_halfcomplex_radix2_inverse (double data[], size_t stride, size_t n)
  fun gsl_fft_halfcomplex_radix2_inverse: +double * size * size -> int = 'gsl_fft_halfcomplex_radix2_inverse($a)';
// Function: int gsl_fft_halfcomplex_radix2_backward (double data[], size_t stride, size_t n)
  fun gsl_fft_halfcomplex_radix2_backward: +double * size * size -> int = 'gsl_fft_halfcomplex_radix2_backward($a)';
// Function: int gsl_fft_halfcomplex_radix2_unpack (const double halfcomplex_coefficient[], gsl_complex_packed_array complex_coefficient, size_t stride, size_t n)
  fun gsl_fft_halfcomplex_radix2_unpack: +double * gsl_complex_packed_array * size * size -> int = 'gsl_fft_halfcomplex_radix2_unpack($a)';
//*****
// 16.07.00 Mixed-radix-FFT-routines-for-real-data.
// Function: gsl_fft_real_wavetable * gsl_fft_real_wavetable_alloc (size_t n)
  fun gsl_fft_real_wavetable_alloc: size -> &gsl_fft_real_wavetable = 'gsl_fft_real_wavetable_alloc($a)';
// Function: gsl_fft_halfcomplex_wavetable * gsl_fft_halfcomplex_wavetable_alloc (size_t n)
  fun gsl_fft_halfcomplex_wavetable_alloc: size -> &gsl_fft_halfcomplex_wavetable = 'gsl_fft_halfcomplex_wavetable_alloc($a)';
// Function: void gsl_fft_real_wavetable_free (gsl_fft_real_wavetable * wavetable)
  proc gsl_fft_real_wavetable_free: &gsl_fft_real_wavetable = 'gsl_fft_real_wavetable_free($a);';
// Function: void gsl_fft_halfcomplex_wavetable_free (gsl_fft_halfcomplex_wavetable * wavetable)
  proc gsl_fft_halfcomplex_wavetable_free: &gsl_fft_halfcomplex_wavetable = 'gsl_fft_halfcomplex_wavetable_free($a);';
// Function: gsl_fft_real_workspace * gsl_fft_real_workspace_alloc (size_t n)
  fun gsl_fft_real_workspace_alloc: size -> &gsl_fft_real_workspace = 'gsl_fft_real_workspace_alloc($a)';
// Function: void gsl_fft_real_workspace_free (gsl_fft_real_workspace * workspace)
  proc gsl_fft_real_workspace_free: &gsl_fft_real_workspace = 'gsl_fft_real_workspace_free($a);';
// Function: int gsl_fft_real_transform (double data[], size_t stride, size_t n, const gsl_fft_real_wavetable * wavetable, gsl_fft_real_workspace * work)
  fun gsl_fft_real_transform: +double * size * size * &gsl_fft_real_wavetable * &gsl_fft_real_workspace -> int = 'gsl_fft_real_transform($a)';
// Function: int gsl_fft_halfcomplex_transform (double data[], size_t stride, size_t n, const gsl_fft_halfcomplex_wavetable * wavetable, gsl_fft_real_workspace * work)
  fun gsl_fft_halfcomplex_transform: +double * size * size * &gsl_fft_halfcomplex_wavetable * &gsl_fft_real_workspace -> int = 'gsl_fft_halfcomplex_transform($a)';
// Function: int gsl_fft_real_unpack (const double real_coefficient[], gsl_complex_packed_array complex_coefficient, size_t stride, size_t n)
  fun gsl_fft_real_unpack: +double * gsl_complex_packed_array * size * size -> int = 'gsl_fft_real_unpack($a)';
// Function: int gsl_fft_halfcomplex_unpack (const double halfcomplex_coefficient[], gsl_complex_packed_array complex_coefficient, size_t stride, size_t n)
  fun gsl_fft_halfcomplex_unpack: +double * gsl_complex_packed_array * size * size -> int = 'gsl_fft_halfcomplex_unpack($a)';
//*****
// 17.00.00 Numerical-Integration.
//*****
// 17.01.00 Introduction.
//*****
// 17.02.00 QNG-non-adaptive-Gauss-Kronrod-integration.
// Function: int gsl_integration_qng (const gsl_function * f, double a, double b, double epsabs, double epsrel, double * result, double * abserr, size_t * neval)
  fun gsl_integration_qng: &gsl_function * double * double * double * double * &double * &double * &size -> int = 'gsl_integration_qng($a)';
//*****
// 17.03.00 QAG-adaptive-integration.
// Function: gsl_integration_workspace * gsl_integration_workspace_alloc (size_t n)
  fun gsl_integration_workspace_alloc: size -> &gsl_integration_workspace = 'gsl_integration_workspace_alloc($a)';
// Function: void gsl_integration_workspace_free (gsl_integration_workspace * w)
  proc gsl_integration_workspace_free: &gsl_integration_workspace = 'gsl_integration_workspace_free($a);';
// Function: int gsl_integration_qag (const gsl_function * f, double a, double b, double epsabs, double epsrel, size_t limit, int key, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qag: &gsl_function * double * double * double * double * size * int * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qag($a)';
//*****
// 17.04.00 QAGS-adaptive-integration-with-singularities.
// Function: int gsl_integration_qags (const gsl_function * f, double a, double b, double epsabs, double epsrel, size_t limit, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qags: &gsl_function * double * double * double * double * size * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qags($a)';
//*****
// 17.05.00 QAGP-adaptive-integration-with-known-singular-points.
// Function: int gsl_integration_qagp (const gsl_function * f, double * pts, size_t npts, double epsabs, double epsrel, size_t limit, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qagp: &gsl_function * &double * size * double * double * size * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qagp($a)';
//*****
// 17.06.00 QAGI-adaptive-integration-on-infinite-intervals.
// Function: int gsl_integration_qagi (gsl_function * f, double epsabs, double epsrel, size_t limit, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qagi: &gsl_function * double * double * size * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qagi($a)';
// Function: int gsl_integration_qagiu (gsl_function * f, double a, double epsabs, double epsrel, size_t limit, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qagiu: &gsl_function * double * double * double * size * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qagiu($a)';
// Function: int gsl_integration_qagil (gsl_function * f, double b, double epsabs, double epsrel, size_t limit, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qagil: &gsl_function * double * double * double * size * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qagil($a)';
//*****
// 17.07.00 QAWC-adaptive-integration-for-Cauchy-principal-values.
// Function: int gsl_integration_qawc (gsl_function * f, double a, double b, double c, double epsabs, double epsrel, size_t limit, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qawc: &gsl_function * double * double * double * double * double * size * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qawc($a)';
//*****
// 17.08.00 QAWS-adaptive-integration-for-singular-functions.
// Function: gsl_integration_qaws_table * gsl_integration_qaws_table_alloc (double alpha, double beta, int mu, int nu)
  fun gsl_integration_qaws_table_alloc: double * double * int * int -> &gsl_integration_qaws_table = 'gsl_integration_qaws_table_alloc($a)';
// Function: int gsl_integration_qaws_table_set (gsl_integration_qaws_table * t, double alpha, double beta, int mu, int nu)
  fun gsl_integration_qaws_table_set: &gsl_integration_qaws_table * double * double * int * int -> int = 'gsl_integration_qaws_table_set($a)';
// Function: void gsl_integration_qaws_table_free (gsl_integration_qaws_table * t)
  proc gsl_integration_qaws_table_free: &gsl_integration_qaws_table = 'gsl_integration_qaws_table_free($a);';
// Function: int gsl_integration_qaws (gsl_function * f, const double a, const double b, gsl_integration_qaws_table * t, const double epsabs, const double epsrel, const size_t limit, gsl_integration_workspace * workspace, double * result, double * abserr)
  fun gsl_integration_qaws: &gsl_function * double * double * &gsl_integration_qaws_table * double * double * size * &gsl_integration_workspace * &double * &double -> int = 'gsl_integration_qaws($a)';
//*****
// 17.09.00 QAWS-adaptive-integration-for-oscillatory-functions.
// Function: gsl_integration_qawo_table * gsl_integration_qawo_table_alloc (double omega, double L, enum gsl_integration_qawo_enum sine, size_t n)
  fun gsl_integration_qawo_table_alloc: double * double * gsl_integration_qawo_enum * size -> &gsl_integration_qawo_table = 'gsl_integration_qawo_table_alloc($a)';
// Function: int gsl_integration_qawo_table_set (gsl_integration_qawo_table * t, double omega, double L, enum gsl_integration_qawo_enum sine)
  fun gsl_integration_qawo_table_set: &gsl_integration_qawo_table * double * double * gsl_integration_qawo_enum -> int = 'gsl_integration_qawo_table_set($a)';
// Function: int gsl_integration_qawo_table_set_length (gsl_integration_qawo_table * t, double L)
  fun gsl_integration_qawo_table_set_length: &gsl_integration_qawo_table * double -> int = 'gsl_integration_qawo_table_set_length($a)';
// Function: void gsl_integration_qawo_table_free (gsl_integration_qawo_table * t)
  proc gsl_integration_qawo_table_free: &gsl_integration_qawo_table = 'gsl_integration_qawo_table_free($a);';
// Function: int gsl_integration_qawo (gsl_function * f, const double a, const double epsabs, const double epsrel, const size_t limit, gsl_integration_workspace * workspace, gsl_integration_qawo_table * wf, double * result, double * abserr)
  fun gsl_integration_qawo: &gsl_function * double * double * double * size * &gsl_integration_workspace * &gsl_integration_qawo_table * &double * &double -> int = 'gsl_integration_qawo($a)';
//*****
// 17.10.00 QAWS-adaptive-integration-for-Fourier-integrals.
// Function: int gsl_integration_qawf (gsl_function * f, const double a, const double epsabs, const size_t limit, gsl_integration_workspace * workspace, gsl_integration_workspace * cycle_workspace, gsl_integration_qawo_table * wf, double * result, double * abserr)
  fun gsl_integration_qawf: &gsl_function * double * double * size * &gsl_integration_workspace * &gsl_integration_workspace * &gsl_integration_qawo_table * &double * &double -> int = 'gsl_integration_qawf($a)';
//*****
// 17.11.00 CQUAD-doubly-adaptive-integration.
// Function: gsl_integration_cquad_workspace * gsl_integration_cquad_workspace_alloc (size_t n)
  fun gsl_integration_cquad_workspace_alloc: size -> &gsl_integration_cquad_workspace = 'gsl_integration_cquad_workspace_alloc($a)';
// Function: void gsl_integration_cquad_workspace_free (gsl_integration_cquad_workspace * w)
  proc gsl_integration_cquad_workspace_free: &gsl_integration_cquad_workspace = 'gsl_integration_cquad_workspace_free($a);';
// Function: int gsl_integration_cquad (const gsl_function * f, double a, double b, double epsabs, double epsrel, gsl_integration_cquad_workspace * workspace, double * result, double * abserr, size_t * nevals)
  fun gsl_integration_cquad: &gsl_function * double * double * double * double * &gsl_integration_cquad_workspace * &double * &double * &size -> int = 'gsl_integration_cquad($a)';
//*****
// 17.12.00 Gauss-Legendre-integration.
// Function: gsl_integration_glfixed_table * gsl_integration_glfixed_table_alloc (size_t n)
  fun gsl_integration_glfixed_table_alloc: size -> &gsl_integration_glfixed_table = 'gsl_integration_glfixed_table_alloc($a)';
// Function: double gsl_integration_glfixed (const gsl_function * f, double a, double b, const gsl_integration_glfixed_table * t)
  fun gsl_integration_glfixed: &gsl_function * double * double * &gsl_integration_glfixed_table -> double = 'gsl_integration_glfixed($a)';
// Function: int gsl_integration_glfixed_point (double a, double b, size_t i, double * xi, double * wi, const gsl_integration_glfixed_table * t)
  fun gsl_integration_glfixed_point: double * double * size * &double * &double * &gsl_integration_glfixed_table -> int = 'gsl_integration_glfixed_point($a)';
// Function: void gsl_integration_glfixed_table_free (gsl_integration_glfixed_table * t)
  proc gsl_integration_glfixed_table_free: &gsl_integration_glfixed_table = 'gsl_integration_glfixed_table_free($a);';
//*****
// 17.13.00 Error-codes.
//*****
// 18.00.00 Random-Number-Generation.
//*****
// 18.01.00 General-comments-on-random-numbers.
//*****
// 18.02.00 The-Random-Number-Generator-Interface.
//*****
// 18.03.00 Random-number-generator-initialisation.
// Function: gsl_rng * gsl_rng_alloc (const gsl_rng_type * T)
  fun gsl_rng_alloc: &gsl_rng_type -> &gsl_rng = 'gsl_rng_alloc($a)';
// Function: void gsl_rng_set (const gsl_rng * r, unsigned long int s)
  proc gsl_rng_set: &gsl_rng * ulong = 'gsl_rng_set($a);';
// Function: void gsl_rng_free (gsl_rng * r)
  proc gsl_rng_free: &gsl_rng = 'gsl_rng_free($a);';
//*****
// 18.04.00 Sampling-from-a-random-number-generator.
// Function: unsigned long int gsl_rng_get (const gsl_rng * r)
  fun gsl_rng_get: &gsl_rng -> ulong = 'gsl_rng_get($a)';
// Function: double gsl_rng_uniform (const gsl_rng * r)
  fun gsl_rng_uniform: &gsl_rng -> double = 'gsl_rng_uniform($a)';
// Function: double gsl_rng_uniform_pos (const gsl_rng * r)
  fun gsl_rng_uniform_pos: &gsl_rng -> double = 'gsl_rng_uniform_pos($a)';
// Function: unsigned long int gsl_rng_uniform_int (const gsl_rng * r, unsigned long int n)
  fun gsl_rng_uniform_int: &gsl_rng * ulong -> ulong = 'gsl_rng_uniform_int($a)';
//*****
// 18.05.00 Auxilliary-random-number-generator-functions.
// Function: const char * gsl_rng_name (const gsl_rng * r)
  fun gsl_rng_name: &gsl_rng -> &char = 'gsl_rng_name($a)';
// Function: unsigned long int gsl_rng_max (const gsl_rng * r)
  fun gsl_rng_max: &gsl_rng -> ulong = 'gsl_rng_max($a)';
// Function: unsigned long int gsl_rng_min (const gsl_rng * r)
  fun gsl_rng_min: &gsl_rng -> ulong = 'gsl_rng_min($a)';
// Function: void * gsl_rng_state (const gsl_rng * r)
  fun gsl_rng_state: &gsl_rng -> &void = 'gsl_rng_state($a)';
// Function: size_t gsl_rng_size (const gsl_rng * r)
  fun gsl_rng_size: &gsl_rng -> size = 'gsl_rng_size($a)';
// Function: const gsl_rng_type ** gsl_rng_types_setup (void)
  fun gsl_rng_types_setup: unit -> &&gsl_rng_type = 'gsl_rng_types_setup($a)';
//*****
// 18.06.00 Random-number-environment-variables.
// Function: const gsl_rng_type * gsl_rng_env_setup (void)
  fun gsl_rng_env_setup: unit -> &gsl_rng_type = 'gsl_rng_env_setup($a)';
//*****
// 18.07.00 Copying-random-number-generator-state.
// Function: int gsl_rng_memcpy (gsl_rng * dest, const gsl_rng * src)
  fun gsl_rng_memcpy: &gsl_rng * &gsl_rng -> int = 'gsl_rng_memcpy($a)';
// Function: gsl_rng * gsl_rng_clone (const gsl_rng * r)
  fun gsl_rng_clone: &gsl_rng -> &gsl_rng = 'gsl_rng_clone($a)';
//*****
// 18.08.00 Reading-and-writing-random-number-generator-state.
// Function: int gsl_rng_fwrite (FILE * stream, const gsl_rng * r)
  fun gsl_rng_fwrite: &FILE * &gsl_rng -> int = 'gsl_rng_fwrite($a)';
// Function: int gsl_rng_fread (FILE * stream, gsl_rng * r)
  fun gsl_rng_fread: &FILE * &gsl_rng -> int = 'gsl_rng_fread($a)';
//*****
// 18.09.00 Random-number-generator-algorithms.
//*****
// 18.10.00 Unix-random-number-generators.
//*****
// 18.11.00 Other-random-number-generators.
//*****
// 19.00.00 Quasi-Random-Sequences.
//*****
// 19.01.00 Quasi-random-number-generator-initialisation.
// Function: gsl_qrng * gsl_qrng_alloc (const gsl_qrng_type * T, unsigned int d)
  fun gsl_qrng_alloc: &gsl_qrng_type * uint -> &gsl_qrng = 'gsl_qrng_alloc($a)';
// Function: void gsl_qrng_free (gsl_qrng * q)
  proc gsl_qrng_free: &gsl_qrng = 'gsl_qrng_free($a);';
// Function: void gsl_qrng_init (gsl_qrng * q)
  proc gsl_qrng_init: &gsl_qrng = 'gsl_qrng_init($a);';
//*****
// 19.02.00 Sampling-from-a-quasi-random-number-generator.
// Function: int gsl_qrng_get (const gsl_qrng * q, double x[])
  fun gsl_qrng_get: &gsl_qrng * +double -> int = 'gsl_qrng_get($a)';
//*****
// 19.03.00 Auxilliary-quasi-random-number-generator-functions.
// Function: const char * gsl_qrng_name (const gsl_qrng * q)
  fun gsl_qrng_name: &gsl_qrng -> &char = 'gsl_qrng_name($a)';
// Function: size_t gsl_qrng_size (const gsl_qrng * q)
  fun gsl_qrng_size: &gsl_qrng -> size = 'gsl_qrng_size($a)';
// Function: void * gsl_qrng_state (const gsl_qrng * q)
  fun gsl_qrng_state: &gsl_qrng -> &void = 'gsl_qrng_state($a)';
//*****
// 19.04.00 Saving-and-resorting-quasi-random-number-generator-state.
// Function: int gsl_qrng_memcpy (gsl_qrng * dest, const gsl_qrng * src)
  fun gsl_qrng_memcpy: &gsl_qrng * &gsl_qrng -> int = 'gsl_qrng_memcpy($a)';
// Function: gsl_qrng * gsl_qrng_clone (const gsl_qrng * q)
  fun gsl_qrng_clone: &gsl_qrng -> &gsl_qrng = 'gsl_qrng_clone($a)';
//*****
// 19.05.00 Quasi-random-number-generator-algorithms.
//*****
// 21.00.00 Statistics.
//*****
// 21.01.00 Mean-and-standard-deviation-and-variance.
// Function: double gsl_stats_mean (const double data[], size_t stride, size_t n)
  fun gsl_stats_mean: +double * size * size -> double = 'gsl_stats_mean($a)';
// Function: double gsl_stats_variance (const double data[], size_t stride, size_t n)
  fun gsl_stats_variance: +double * size * size -> double = 'gsl_stats_variance($a)';
// Function: double gsl_stats_variance_m (const double data[], size_t stride, size_t n, double mean)
  fun gsl_stats_variance_m: +double * size * size * double -> double = 'gsl_stats_variance_m($a)';
// Function: double gsl_stats_sd (const double data[], size_t stride, size_t n)
  fun gsl_stats_sd: +double * size * size -> double = 'gsl_stats_sd($a)';
// Function: double gsl_stats_sd_m (const double data[], size_t stride, size_t n, double mean)
  fun gsl_stats_sd_m: +double * size * size * double -> double = 'gsl_stats_sd_m($a)';
// Function: double gsl_stats_tss (const double data[], size_t stride, size_t n)
  fun gsl_stats_tss: +double * size * size -> double = 'gsl_stats_tss($a)';
// Function: double gsl_stats_tss_m (const double data[], size_t stride, size_t n, double mean)
  fun gsl_stats_tss_m: +double * size * size * double -> double = 'gsl_stats_tss_m($a)';
// Function: double gsl_stats_variance_with_fixed_mean (const double data[], size_t stride, size_t n, double mean)
  fun gsl_stats_variance_with_fixed_mean: +double * size * size * double -> double = 'gsl_stats_variance_with_fixed_mean($a)';
// Function: double gsl_stats_sd_with_fixed_mean (const double data[], size_t stride, size_t n, double mean)
  fun gsl_stats_sd_with_fixed_mean: +double * size * size * double -> double = 'gsl_stats_sd_with_fixed_mean($a)';
//*****
// 21.02.00 Absolute-deviation.
// Function: double gsl_stats_absdev (const double data[], size_t stride, size_t n)
  fun gsl_stats_absdev: +double * size * size -> double = 'gsl_stats_absdev($a)';
// Function: double gsl_stats_absdev_m (const double data[], size_t stride, size_t n, double mean)
  fun gsl_stats_absdev_m: +double * size * size * double -> double = 'gsl_stats_absdev_m($a)';
//*****
// 21.03.00 Higher-moments-(skew-and-kurtosis).
// Function: double gsl_stats_skew (const double data[], size_t stride, size_t n)
  fun gsl_stats_skew: +double * size * size -> double = 'gsl_stats_skew($a)';
// Function: double gsl_stats_skew_m_sd (const double data[], size_t stride, size_t n, double mean, double sd)
  fun gsl_stats_skew_m_sd: +double * size * size * double * double -> double = 'gsl_stats_skew_m_sd($a)';
// Function: double gsl_stats_kurtosis (const double data[], size_t stride, size_t n)
  fun gsl_stats_kurtosis: +double * size * size -> double = 'gsl_stats_kurtosis($a)';
// Function: double gsl_stats_kurtosis_m_sd (const double data[], size_t stride, size_t n, double mean, double sd)
  fun gsl_stats_kurtosis_m_sd: +double * size * size * double * double -> double = 'gsl_stats_kurtosis_m_sd($a)';
//*****
// 21.04.00 Autocorrelation.
// Function: double gsl_stats_lag1_autocorrelation (const double data[], const size_t stride, const size_t n)
  fun gsl_stats_lag1_autocorrelation: +double * size * size -> double = 'gsl_stats_lag1_autocorrelation($a)';
// Function: double gsl_stats_lag1_autocorrelation_m (const double data[], const size_t stride, const size_t n, const double mean)
  fun gsl_stats_lag1_autocorrelation_m: +double * size * size * double -> double = 'gsl_stats_lag1_autocorrelation_m($a)';
//*****
// 21.05.00 Covariance.
// Function: double gsl_stats_covariance (const double data1[], const size_t stride1, const double data2[], const size_t stride2, const size_t n)
  fun gsl_stats_covariance: +double * size * +double * size * size -> double = 'gsl_stats_covariance($a)';
// Function: double gsl_stats_covariance_m (const double data1[], const size_t stride1, const double data2[], const size_t stride2, const size_t n, const double mean1, const double mean2)
  fun gsl_stats_covariance_m: +double * size * +double * size * size * double * double -> double = 'gsl_stats_covariance_m($a)';
//*****
// 21.06.00 Correlation.
// Function: double gsl_stats_correlation (const double data1[], const size_t stride1, const double data2[], const size_t stride2, const size_t n)
  fun gsl_stats_correlation: +double * size * +double * size * size -> double = 'gsl_stats_correlation($a)';
// Function: double gsl_stats_spearman (const double data1[], const size_t stride1, const double data2[], const size_t stride2, const size_t n, double work[])
  fun gsl_stats_spearman: +double * size * +double * size * size * +double -> double = 'gsl_stats_spearman($a)';
//*****
// 21.07.00 Weighted-Samples.
// Function: double gsl_stats_wmean (const double w[], size_t wstride, const double data[], size_t stride, size_t n)
  fun gsl_stats_wmean: +double * size * +double * size * size -> double = 'gsl_stats_wmean($a)';
// Function: double gsl_stats_wvariance (const double w[], size_t wstride, const double data[], size_t stride, size_t n)
  fun gsl_stats_wvariance: +double * size * +double * size * size -> double = 'gsl_stats_wvariance($a)';
// Function: double gsl_stats_wvariance_m (const double w[], size_t wstride, const double data[], size_t stride, size_t n, double wmean)
  fun gsl_stats_wvariance_m: +double * size * +double * size * size * double -> double = 'gsl_stats_wvariance_m($a)';
// Function: double gsl_stats_wsd (const double w[], size_t wstride, const double data[], size_t stride, size_t n)
  fun gsl_stats_wsd: +double * size * +double * size * size -> double = 'gsl_stats_wsd($a)';
// Function: double gsl_stats_wsd_m (const double w[], size_t wstride, const double data[], size_t stride, size_t n, double wmean)
  fun gsl_stats_wsd_m: +double * size * +double * size * size * double -> double = 'gsl_stats_wsd_m($a)';
// Function: double gsl_stats_wvariance_with_fixed_mean (const double w[], size_t wstride, const double data[], size_t stride, size_t n, const double mean)
  fun gsl_stats_wvariance_with_fixed_mean: +double * size * +double * size * size * double -> double = 'gsl_stats_wvariance_with_fixed_mean($a)';
// Function: double gsl_stats_wsd_with_fixed_mean (const double w[], size_t wstride, const double data[], size_t stride, size_t n, const double mean)
  fun gsl_stats_wsd_with_fixed_mean: +double * size * +double * size * size * double -> double = 'gsl_stats_wsd_with_fixed_mean($a)';
// Function: double gsl_stats_wtss (const double w[], const size_t wstride, const double data[], size_t stride, size_t n)
  fun gsl_stats_wtss: +double * size * +double * size * size -> double = 'gsl_stats_wtss($a)';
// Function: double gsl_stats_wtss_m (const double w[], const size_t wstride, const double data[], size_t stride, size_t n, double wmean)
  fun gsl_stats_wtss_m: +double * size * +double * size * size * double -> double = 'gsl_stats_wtss_m($a)';
// Function: double gsl_stats_wabsdev (const double w[], size_t wstride, const double data[], size_t stride, size_t n)
  fun gsl_stats_wabsdev: +double * size * +double * size * size -> double = 'gsl_stats_wabsdev($a)';
// Function: double gsl_stats_wabsdev_m (const double w[], size_t wstride, const double data[], size_t stride, size_t n, double wmean)
  fun gsl_stats_wabsdev_m: +double * size * +double * size * size * double -> double = 'gsl_stats_wabsdev_m($a)';
// Function: double gsl_stats_wskew (const double w[], size_t wstride, const double data[], size_t stride, size_t n)
  fun gsl_stats_wskew: +double * size * +double * size * size -> double = 'gsl_stats_wskew($a)';
// Function: double gsl_stats_wskew_m_sd (const double w[], size_t wstride, const double data[], size_t stride, size_t n, double wmean, double wsd)
  fun gsl_stats_wskew_m_sd: +double * size * +double * size * size * double * double -> double = 'gsl_stats_wskew_m_sd($a)';
// Function: double gsl_stats_wkurtosis (const double w[], size_t wstride, const double data[], size_t stride, size_t n)
  fun gsl_stats_wkurtosis: +double * size * +double * size * size -> double = 'gsl_stats_wkurtosis($a)';
// Function: double gsl_stats_wkurtosis_m_sd (const double w[], size_t wstride, const double data[], size_t stride, size_t n, double wmean, double wsd)
  fun gsl_stats_wkurtosis_m_sd: +double * size * +double * size * size * double * double -> double = 'gsl_stats_wkurtosis_m_sd($a)';
//*****
// 21.08.00 Maximum-and-Minimum-values.
// Function: double gsl_stats_max (const double data[], size_t stride, size_t n)
  fun gsl_stats_max: +double * size * size -> double = 'gsl_stats_max($a)';
// Function: double gsl_stats_min (const double data[], size_t stride, size_t n)
  fun gsl_stats_min: +double * size * size -> double = 'gsl_stats_min($a)';
// Function: void gsl_stats_minmax (double * min, double * max, const double data[], size_t stride, size_t n)
  proc gsl_stats_minmax: &double * &double * +double * size * size = 'gsl_stats_minmax($a);';
// Function: size_t gsl_stats_max_index (const double data[], size_t stride, size_t n)
  fun gsl_stats_max_index: +double * size * size -> size = 'gsl_stats_max_index($a)';
// Function: size_t gsl_stats_min_index (const double data[], size_t stride, size_t n)
  fun gsl_stats_min_index: +double * size * size -> size = 'gsl_stats_min_index($a)';
// Function: void gsl_stats_minmax_index (size_t * min_index, size_t * max_index, const double data[], size_t stride, size_t n)
  proc gsl_stats_minmax_index: &size * &size * +double * size * size = 'gsl_stats_minmax_index($a);';
//*****
// 21.09.00 Median-and-Percentiles.
// Function: double gsl_stats_median_from_sorted_data (const double sorted_data[], size_t stride, size_t n)
  fun gsl_stats_median_from_sorted_data: +double * size * size -> double = 'gsl_stats_median_from_sorted_data($a)';
// Function: double gsl_stats_quantile_from_sorted_data (const double sorted_data[], size_t stride, size_t n, double f)
  fun gsl_stats_quantile_from_sorted_data: +double * size * size * double -> double = 'gsl_stats_quantile_from_sorted_data($a)';
//*****
// 22.00.00 Histograms.
//*****
// 22.01.00 The-histogram-struct.
//*****
// 22.02.00 Histogram-allocation.
// Function: gsl_histogram * gsl_histogram_alloc (size_t n)
  fun gsl_histogram_alloc: size -> &gsl_histogram = 'gsl_histogram_alloc($a)';
// Function: int gsl_histogram_set_ranges (gsl_histogram * h, const double range[], size_t size)
  fun gsl_histogram_set_ranges: &gsl_histogram * +double * size -> int = 'gsl_histogram_set_ranges($a)';
// Function: int gsl_histogram_set_ranges_uniform (gsl_histogram * h, double xmin, double xmax)
  fun gsl_histogram_set_ranges_uniform: &gsl_histogram * double * double -> int = 'gsl_histogram_set_ranges_uniform($a)';
// Function: void gsl_histogram_free (gsl_histogram * h)
  proc gsl_histogram_free: &gsl_histogram = 'gsl_histogram_free($a);';
//*****
// 22.03.00 Copying-Histograms.
// Function: int gsl_histogram_memcpy (gsl_histogram * dest, const gsl_histogram * src)
  fun gsl_histogram_memcpy: &gsl_histogram * &gsl_histogram -> int = 'gsl_histogram_memcpy($a)';
// Function: gsl_histogram * gsl_histogram_clone (const gsl_histogram * src)
  fun gsl_histogram_clone: &gsl_histogram -> &gsl_histogram = 'gsl_histogram_clone($a)';
//*****
// 22.04.00 Updating-and-accessing-histogram-elements.
// Function: int gsl_histogram_increment (gsl_histogram * h, double x)
  fun gsl_histogram_increment: &gsl_histogram * double -> int = 'gsl_histogram_increment($a)';
// Function: int gsl_histogram_accumulate (gsl_histogram * h, double x, double weight)
  fun gsl_histogram_accumulate: &gsl_histogram * double * double -> int = 'gsl_histogram_accumulate($a)';
// Function: double gsl_histogram_get (const gsl_histogram * h, size_t i)
  fun gsl_histogram_get: &gsl_histogram * size -> double = 'gsl_histogram_get($a)';
// Function: int gsl_histogram_get_range (const gsl_histogram * h, size_t i, double * lower, double * upper)
  fun gsl_histogram_get_range: &gsl_histogram * size * &double * &double -> int = 'gsl_histogram_get_range($a)';
// Function: double gsl_histogram_max (const gsl_histogram * h)
  fun gsl_histogram_max: &gsl_histogram -> double = 'gsl_histogram_max($a)';
// Function: double gsl_histogram_min (const gsl_histogram * h)
  fun gsl_histogram_min: &gsl_histogram -> double = 'gsl_histogram_min($a)';
// Function: size_t gsl_histogram_bins (const gsl_histogram * h)
  fun gsl_histogram_bins: &gsl_histogram -> size = 'gsl_histogram_bins($a)';
// Function: void gsl_histogram_reset (gsl_histogram * h)
  proc gsl_histogram_reset: &gsl_histogram = 'gsl_histogram_reset($a);';
//*****
// 22.05.00 Searching-historgram-ranges.
// Function: int gsl_histogram_find (const gsl_histogram * h, double x, size_t * i)
  fun gsl_histogram_find: &gsl_histogram * double * &size -> int = 'gsl_histogram_find($a)';
//*****
// 22.06.00 Histogram-Statistics.
// Function: double gsl_histogram_max_val (const gsl_histogram * h)
  fun gsl_histogram_max_val: &gsl_histogram -> double = 'gsl_histogram_max_val($a)';
// Function: size_t gsl_histogram_max_bin (const gsl_histogram * h)
  fun gsl_histogram_max_bin: &gsl_histogram -> size = 'gsl_histogram_max_bin($a)';
// Function: double gsl_histogram_min_val (const gsl_histogram * h)
  fun gsl_histogram_min_val: &gsl_histogram -> double = 'gsl_histogram_min_val($a)';
// Function: size_t gsl_histogram_min_bin (const gsl_histogram * h)
  fun gsl_histogram_min_bin: &gsl_histogram -> size = 'gsl_histogram_min_bin($a)';
// Function: double gsl_histogram_mean (const gsl_histogram * h)
  fun gsl_histogram_mean: &gsl_histogram -> double = 'gsl_histogram_mean($a)';
// Function: double gsl_histogram_sigma (const gsl_histogram * h)
  fun gsl_histogram_sigma: &gsl_histogram -> double = 'gsl_histogram_sigma($a)';
// Function: double gsl_histogram_sum (const gsl_histogram * h)
  fun gsl_histogram_sum: &gsl_histogram -> double = 'gsl_histogram_sum($a)';
//*****
// 22.07.00 Histogram-Operations.
// Function: int gsl_histogram_equal_bins_p (const gsl_histogram * h1, const gsl_histogram * h2)
  fun gsl_histogram_equal_bins_p: &gsl_histogram * &gsl_histogram -> int = 'gsl_histogram_equal_bins_p($a)';
// Function: int gsl_histogram_add (gsl_histogram * h1, const gsl_histogram * h2)
  fun gsl_histogram_add: &gsl_histogram * &gsl_histogram -> int = 'gsl_histogram_add($a)';
// Function: int gsl_histogram_sub (gsl_histogram * h1, const gsl_histogram * h2)
  fun gsl_histogram_sub: &gsl_histogram * &gsl_histogram -> int = 'gsl_histogram_sub($a)';
// Function: int gsl_histogram_mul (gsl_histogram * h1, const gsl_histogram * h2)
  fun gsl_histogram_mul: &gsl_histogram * &gsl_histogram -> int = 'gsl_histogram_mul($a)';
// Function: int gsl_histogram_div (gsl_histogram * h1, const gsl_histogram * h2)
  fun gsl_histogram_div: &gsl_histogram * &gsl_histogram -> int = 'gsl_histogram_div($a)';
// Function: int gsl_histogram_scale (gsl_histogram * h, double scale)
  fun gsl_histogram_scale: &gsl_histogram * double -> int = 'gsl_histogram_scale($a)';
// Function: int gsl_histogram_shift (gsl_histogram * h, double offset)
  fun gsl_histogram_shift: &gsl_histogram * double -> int = 'gsl_histogram_shift($a)';
//*****
// 22.08.00 Reading-and-writing-histograms.
// Function: int gsl_histogram_fwrite (FILE * stream, const gsl_histogram * h)
  fun gsl_histogram_fwrite: &FILE * &gsl_histogram -> int = 'gsl_histogram_fwrite($a)';
// Function: int gsl_histogram_fread (FILE * stream, gsl_histogram * h)
  fun gsl_histogram_fread: &FILE * &gsl_histogram -> int = 'gsl_histogram_fread($a)';
// Function: int gsl_histogram_fprintf (FILE * stream, const gsl_histogram * h, const char * range_format, const char * bin_format)
  fun gsl_histogram_fprintf: &FILE * &gsl_histogram * &char * &char -> int = 'gsl_histogram_fprintf($a)';
// Function: int gsl_histogram_fscanf (FILE * stream, gsl_histogram * h)
  fun gsl_histogram_fscanf: &FILE * &gsl_histogram -> int = 'gsl_histogram_fscanf($a)';
//*****
// 22.09.00 Resampling-from-histograms.
//*****
// 22.10.00 The-histogram-probability-distribution-struct.
// Function: gsl_histogram_pdf * gsl_histogram_pdf_alloc (size_t n)
  fun gsl_histogram_pdf_alloc: size -> &gsl_histogram_pdf = 'gsl_histogram_pdf_alloc($a)';
// Function: int gsl_histogram_pdf_init (gsl_histogram_pdf * p, const gsl_histogram * h)
  fun gsl_histogram_pdf_init: &gsl_histogram_pdf * &gsl_histogram -> int = 'gsl_histogram_pdf_init($a)';
// Function: void gsl_histogram_pdf_free (gsl_histogram_pdf * p)
  proc gsl_histogram_pdf_free: &gsl_histogram_pdf = 'gsl_histogram_pdf_free($a);';
// Function: double gsl_histogram_pdf_sample (const gsl_histogram_pdf * p, double r)
  fun gsl_histogram_pdf_sample: &gsl_histogram_pdf * double -> double = 'gsl_histogram_pdf_sample($a)';
//*****
// 22.12.00 Two-dimensional-histograms.
//*****
// 22.13.00 The-2D-histogram-struct.
//*****
// 22.14.00 2D-histogram-allocation.
// Function: gsl_histogram2d * gsl_histogram2d_alloc (size_t nx, size_t ny)
  fun gsl_histogram2d_alloc: size * size -> &gsl_histogram2d = 'gsl_histogram2d_alloc($a)';
// Function: int gsl_histogram2d_set_ranges (gsl_histogram2d * h, const double xrange[], size_t xsize, const double yrange[], size_t ysize)
  fun gsl_histogram2d_set_ranges: &gsl_histogram2d * +double * size * +double * size -> int = 'gsl_histogram2d_set_ranges($a)';
// Function: int gsl_histogram2d_set_ranges_uniform (gsl_histogram2d * h, double xmin, double xmax, double ymin, double ymax)
  fun gsl_histogram2d_set_ranges_uniform: &gsl_histogram2d * double * double * double * double -> int = 'gsl_histogram2d_set_ranges_uniform($a)';
// Function: void gsl_histogram2d_free (gsl_histogram2d * h)
  proc gsl_histogram2d_free: &gsl_histogram2d = 'gsl_histogram2d_free($a);';
//*****
// 22.15.00 Copying-2D-Histograms.
// Function: int gsl_histogram2d_memcpy (gsl_histogram2d * dest, const gsl_histogram2d * src)
  fun gsl_histogram2d_memcpy: &gsl_histogram2d * &gsl_histogram2d -> int = 'gsl_histogram2d_memcpy($a)';
// Function: gsl_histogram2d * gsl_histogram2d_clone (const gsl_histogram2d * src)
  fun gsl_histogram2d_clone: &gsl_histogram2d -> &gsl_histogram2d = 'gsl_histogram2d_clone($a)';
//*****
// 22.16.00 Updating-and-accessing-2D-histogram-elements.
// Function: int gsl_histogram2d_increment (gsl_histogram2d * h, double x, double y)
  fun gsl_histogram2d_increment: &gsl_histogram2d * double * double -> int = 'gsl_histogram2d_increment($a)';
// Function: int gsl_histogram2d_accumulate (gsl_histogram2d * h, double x, double y, double weight)
  fun gsl_histogram2d_accumulate: &gsl_histogram2d * double * double * double -> int = 'gsl_histogram2d_accumulate($a)';
// Function: double gsl_histogram2d_get (const gsl_histogram2d * h, size_t i, size_t j)
  fun gsl_histogram2d_get: &gsl_histogram2d * size * size -> double = 'gsl_histogram2d_get($a)';
// Function: int gsl_histogram2d_get_xrange (const gsl_histogram2d * h, size_t i, double * xlower, double * xupper)
  fun gsl_histogram2d_get_xrange: &gsl_histogram2d * size * &double * &double -> int = 'gsl_histogram2d_get_xrange($a)';
// Function: int gsl_histogram2d_get_yrange (const gsl_histogram2d * h, size_t j, double * ylower, double * yupper)
  fun gsl_histogram2d_get_yrange: &gsl_histogram2d * size * &double * &double -> int = 'gsl_histogram2d_get_yrange($a)';
// Function: double gsl_histogram2d_xmax (const gsl_histogram2d * h)
  fun gsl_histogram2d_xmax: &gsl_histogram2d -> double = 'gsl_histogram2d_xmax($a)';
// Function: double gsl_histogram2d_xmin (const gsl_histogram2d * h)
  fun gsl_histogram2d_xmin: &gsl_histogram2d -> double = 'gsl_histogram2d_xmin($a)';
// Function: size_t gsl_histogram2d_nx (const gsl_histogram2d * h)
  fun gsl_histogram2d_nx: &gsl_histogram2d -> size = 'gsl_histogram2d_nx($a)';
// Function: double gsl_histogram2d_ymax (const gsl_histogram2d * h)
  fun gsl_histogram2d_ymax: &gsl_histogram2d -> double = 'gsl_histogram2d_ymax($a)';
// Function: double gsl_histogram2d_ymin (const gsl_histogram2d * h)
  fun gsl_histogram2d_ymin: &gsl_histogram2d -> double = 'gsl_histogram2d_ymin($a)';
// Function: size_t gsl_histogram2d_ny (const gsl_histogram2d * h)
  fun gsl_histogram2d_ny: &gsl_histogram2d -> size = 'gsl_histogram2d_ny($a)';
// Function: void gsl_histogram2d_reset (gsl_histogram2d * h)
  proc gsl_histogram2d_reset: &gsl_histogram2d = 'gsl_histogram2d_reset($a);';
//*****
// 22.17.00 Searching-2D-histogram-ranges.
// Function: int gsl_histogram2d_find (const gsl_histogram2d * h, double x, double y, size_t * i, size_t * j)
  fun gsl_histogram2d_find: &gsl_histogram2d * double * double * &size * &size -> int = 'gsl_histogram2d_find($a)';
//*****
// 22.18.00 2D-Histogram-Statistics.
// Function: double gsl_histogram2d_max_val (const gsl_histogram2d * h)
  fun gsl_histogram2d_max_val: &gsl_histogram2d -> double = 'gsl_histogram2d_max_val($a)';
// Function: void gsl_histogram2d_max_bin (const gsl_histogram2d * h, size_t * i, size_t * j)
  proc gsl_histogram2d_max_bin: &gsl_histogram2d * &size * &size = 'gsl_histogram2d_max_bin($a);';
// Function: double gsl_histogram2d_min_val (const gsl_histogram2d * h)
  fun gsl_histogram2d_min_val: &gsl_histogram2d -> double = 'gsl_histogram2d_min_val($a)';
// Function: void gsl_histogram2d_min_bin (const gsl_histogram2d * h, size_t * i, size_t * j)
  proc gsl_histogram2d_min_bin: &gsl_histogram2d * &size * &size = 'gsl_histogram2d_min_bin($a);';
// Function: double gsl_histogram2d_xmean (const gsl_histogram2d * h)
  fun gsl_histogram2d_xmean: &gsl_histogram2d -> double = 'gsl_histogram2d_xmean($a)';
// Function: double gsl_histogram2d_ymean (const gsl_histogram2d * h)
  fun gsl_histogram2d_ymean: &gsl_histogram2d -> double = 'gsl_histogram2d_ymean($a)';
// Function: double gsl_histogram2d_xsigma (const gsl_histogram2d * h)
  fun gsl_histogram2d_xsigma: &gsl_histogram2d -> double = 'gsl_histogram2d_xsigma($a)';
// Function: double gsl_histogram2d_ysigma (const gsl_histogram2d * h)
  fun gsl_histogram2d_ysigma: &gsl_histogram2d -> double = 'gsl_histogram2d_ysigma($a)';
// Function: double gsl_histogram2d_cov (const gsl_histogram2d * h)
  fun gsl_histogram2d_cov: &gsl_histogram2d -> double = 'gsl_histogram2d_cov($a)';
// Function: double gsl_histogram2d_sum (const gsl_histogram2d * h)
  fun gsl_histogram2d_sum: &gsl_histogram2d -> double = 'gsl_histogram2d_sum($a)';
//*****
// 22.19.00 2D-Histogram-Operations.
// Function: int gsl_histogram2d_equal_bins_p (const gsl_histogram2d * h1, const gsl_histogram2d * h2)
  fun gsl_histogram2d_equal_bins_p: &gsl_histogram2d * &gsl_histogram2d -> int = 'gsl_histogram2d_equal_bins_p($a)';
// Function: int gsl_histogram2d_add (gsl_histogram2d * h1, const gsl_histogram2d * h2)
  fun gsl_histogram2d_add: &gsl_histogram2d * &gsl_histogram2d -> int = 'gsl_histogram2d_add($a)';
// Function: int gsl_histogram2d_sub (gsl_histogram2d * h1, const gsl_histogram2d * h2)
  fun gsl_histogram2d_sub: &gsl_histogram2d * &gsl_histogram2d -> int = 'gsl_histogram2d_sub($a)';
// Function: int gsl_histogram2d_mul (gsl_histogram2d * h1, const gsl_histogram2d * h2)
  fun gsl_histogram2d_mul: &gsl_histogram2d * &gsl_histogram2d -> int = 'gsl_histogram2d_mul($a)';
// Function: int gsl_histogram2d_div (gsl_histogram2d * h1, const gsl_histogram2d * h2)
  fun gsl_histogram2d_div: &gsl_histogram2d * &gsl_histogram2d -> int = 'gsl_histogram2d_div($a)';
// Function: int gsl_histogram2d_scale (gsl_histogram2d * h, double scale)
  fun gsl_histogram2d_scale: &gsl_histogram2d * double -> int = 'gsl_histogram2d_scale($a)';
// Function: int gsl_histogram2d_shift (gsl_histogram2d * h, double offset)
  fun gsl_histogram2d_shift: &gsl_histogram2d * double -> int = 'gsl_histogram2d_shift($a)';
//*****
// 22.20.00 Reading-and-writing-2D-histograms.
// Function: int gsl_histogram2d_fwrite (FILE * stream, const gsl_histogram2d * h)
  fun gsl_histogram2d_fwrite: &FILE * &gsl_histogram2d -> int = 'gsl_histogram2d_fwrite($a)';
// Function: int gsl_histogram2d_fread (FILE * stream, gsl_histogram2d * h)
  fun gsl_histogram2d_fread: &FILE * &gsl_histogram2d -> int = 'gsl_histogram2d_fread($a)';
// Function: int gsl_histogram2d_fprintf (FILE * stream, const gsl_histogram2d * h, const char * range_format, const char * bin_format)
  fun gsl_histogram2d_fprintf: &FILE * &gsl_histogram2d * &char * &char -> int = 'gsl_histogram2d_fprintf($a)';
// Function: int gsl_histogram2d_fscanf (FILE * stream, gsl_histogram2d * h)
  fun gsl_histogram2d_fscanf: &FILE * &gsl_histogram2d -> int = 'gsl_histogram2d_fscanf($a)';
//*****
// 22.21.00 Resampling-from-2D-histograms.
// Function: gsl_histogram2d_pdf * gsl_histogram2d_pdf_alloc (size_t nx, size_t ny)
  fun gsl_histogram2d_pdf_alloc: size * size -> &gsl_histogram2d_pdf = 'gsl_histogram2d_pdf_alloc($a)';
// Function: int gsl_histogram2d_pdf_init (gsl_histogram2d_pdf * p, const gsl_histogram2d * h)
  fun gsl_histogram2d_pdf_init: &gsl_histogram2d_pdf * &gsl_histogram2d -> int = 'gsl_histogram2d_pdf_init($a)';
// Function: void gsl_histogram2d_pdf_free (gsl_histogram2d_pdf * p)
  proc gsl_histogram2d_pdf_free: &gsl_histogram2d_pdf = 'gsl_histogram2d_pdf_free($a);';
// Function: int gsl_histogram2d_pdf_sample (const gsl_histogram2d_pdf * p, double r1, double r2, double * x, double * y)
  fun gsl_histogram2d_pdf_sample: &gsl_histogram2d_pdf * double * double * &double * &double -> int = 'gsl_histogram2d_pdf_sample($a)';
//*****
// 23.00.00 N-tuples.
//*****
// 23.01.00 The-ntuple-struct.
//*****
// 23.02.00 Creating-ntuples.
// Function: gsl_ntuple * gsl_ntuple_create (char * filename, void * ntuple_data, size_t size)
  fun gsl_ntuple_create: &char * &void * size -> &gsl_ntuple = 'gsl_ntuple_create($a)';
//*****
// 23.03.00 Opening-an-existing-ntuple-file.
// Function: gsl_ntuple * gsl_ntuple_open (char * filename, void * ntuple_data, size_t size)
  fun gsl_ntuple_open: &char * &void * size -> &gsl_ntuple = 'gsl_ntuple_open($a)';
//*****
// 23.04.00 Writing-ntuples.
// Function: int gsl_ntuple_write (gsl_ntuple * ntuple)
  fun gsl_ntuple_write: &gsl_ntuple -> int = 'gsl_ntuple_write($a)';
// Function: int gsl_ntuple_bookdata (gsl_ntuple * ntuple)
  fun gsl_ntuple_bookdata: &gsl_ntuple -> int = 'gsl_ntuple_bookdata($a)';
//*****
// 23.05.00 Reading-ntuples.
// Function: int gsl_ntuple_read (gsl_ntuple * ntuple)
  fun gsl_ntuple_read: &gsl_ntuple -> int = 'gsl_ntuple_read($a)';
//*****
// 23.06.00 Closing-an-ntuple-file.
// Function: int gsl_ntuple_close (gsl_ntuple * ntuple)
  fun gsl_ntuple_close: &gsl_ntuple -> int = 'gsl_ntuple_close($a)';
//*****
// 23.07.00 Histogramming-ntuple-values.
// Function: int gsl_ntuple_project (gsl_histogram * h, gsl_ntuple * ntuple, gsl_ntuple_value_fn * value_func, gsl_ntuple_select_fn * select_func)
  fun gsl_ntuple_project: &gsl_histogram * &gsl_ntuple * &gsl_ntuple_value_fn * &gsl_ntuple_select_fn -> int = 'gsl_ntuple_project($a)';
//*****
// 24.00.00 Monte-Carlo-Integration.
//*****
// 24.01.00 Interface.
//*****
// 24.02.00 PLAIN-Monte-Carlo.
// Function: gsl_monte_plain_state * gsl_monte_plain_alloc (size_t dim)
  fun gsl_monte_plain_alloc: size -> &gsl_monte_plain_state = 'gsl_monte_plain_alloc($a)';
// Function: int gsl_monte_plain_init (gsl_monte_plain_state* s)
  fun gsl_monte_plain_init: &gsl_monte_plain_state -> int = 'gsl_monte_plain_init($a)';
// Function: int gsl_monte_plain_integrate (gsl_monte_function * f, const double xl[], const double xu[], size_t dim, size_t calls, gsl_rng * r, gsl_monte_plain_state * s, double * result, double * abserr)
  fun gsl_monte_plain_integrate: &gsl_monte_function * +double * +double * size * size * &gsl_rng * &gsl_monte_plain_state * &double * &double -> int = 'gsl_monte_plain_integrate($a)';
// Function: void gsl_monte_plain_free (gsl_monte_plain_state * s)
  proc gsl_monte_plain_free: &gsl_monte_plain_state = 'gsl_monte_plain_free($a);';
//*****
// 24.03.00 MISER.
// Function: gsl_monte_miser_state * gsl_monte_miser_alloc (size_t dim)
  fun gsl_monte_miser_alloc: size -> &gsl_monte_miser_state = 'gsl_monte_miser_alloc($a)';
// Function: int gsl_monte_miser_init (gsl_monte_miser_state* s)
  fun gsl_monte_miser_init: &gsl_monte_miser_state -> int = 'gsl_monte_miser_init($a)';
// Function: int gsl_monte_miser_integrate (gsl_monte_function * f, const double xl[], const double xu[], size_t dim, size_t calls, gsl_rng * r, gsl_monte_miser_state * s, double * result, double * abserr)
  fun gsl_monte_miser_integrate: &gsl_monte_function * +double * +double * size * size * &gsl_rng * &gsl_monte_miser_state * &double * &double -> int = 'gsl_monte_miser_integrate($a)';
// Function: void gsl_monte_miser_free (gsl_monte_miser_state * s)
  proc gsl_monte_miser_free: &gsl_monte_miser_state = 'gsl_monte_miser_free($a);';
// Function: void gsl_monte_miser_params_get (const gsl_monte_miser_state * s, gsl_monte_miser_params * params)
  proc gsl_monte_miser_params_get: &gsl_monte_miser_state * &gsl_monte_miser_params = 'gsl_monte_miser_params_get($a);';
// Function: void gsl_monte_miser_params_set (gsl_monte_miser_state * s, const gsl_monte_miser_params * params)
  proc gsl_monte_miser_params_set: &gsl_monte_miser_state * &gsl_monte_miser_params = 'gsl_monte_miser_params_set($a);';
//*****
// 24.04.00 VEGAS.
// Function: gsl_monte_vegas_state * gsl_monte_vegas_alloc (size_t dim)
  fun gsl_monte_vegas_alloc: size -> &gsl_monte_vegas_state = 'gsl_monte_vegas_alloc($a)';
// Function: int gsl_monte_vegas_init (gsl_monte_vegas_state* s)
  fun gsl_monte_vegas_init: &gsl_monte_vegas_state -> int = 'gsl_monte_vegas_init($a)';
// Function: int gsl_monte_vegas_integrate (gsl_monte_function * f, double xl[], double xu[], size_t dim, size_t calls, gsl_rng * r, gsl_monte_vegas_state * s, double * result, double * abserr)
  fun gsl_monte_vegas_integrate: &gsl_monte_function * +double * +double * size * size * &gsl_rng * &gsl_monte_vegas_state * &double * &double -> int = 'gsl_monte_vegas_integrate($a)';
// Function: void gsl_monte_vegas_free (gsl_monte_vegas_state * s)
  proc gsl_monte_vegas_free: &gsl_monte_vegas_state = 'gsl_monte_vegas_free($a);';
// Function: double gsl_monte_vegas_chisq (const gsl_monte_vegas_state * s)
  fun gsl_monte_vegas_chisq: &gsl_monte_vegas_state -> double = 'gsl_monte_vegas_chisq($a)';
// Function: void gsl_monte_vegas_runval (const gsl_monte_vegas_state * s, double * result, double * sigma)
  proc gsl_monte_vegas_runval: &gsl_monte_vegas_state * &double * &double = 'gsl_monte_vegas_runval($a);';
// Function: void gsl_monte_vegas_params_get (const gsl_monte_vegas_state * s, gsl_monte_vegas_params * params)
  proc gsl_monte_vegas_params_get: &gsl_monte_vegas_state * &gsl_monte_vegas_params = 'gsl_monte_vegas_params_get($a);';
// Function: void gsl_monte_vegas_params_set (gsl_monte_vegas_state * s, const gsl_monte_vegas_params * params)
  proc gsl_monte_vegas_params_set: &gsl_monte_vegas_state * &gsl_monte_vegas_params = 'gsl_monte_vegas_params_set($a);';
//*****
// 25.00.00 Simulated-Annealing.
//*****
// 25.01.00 Simulated-Annealing-algorithm.
//*****
// 25.02.00 Simulated-Annealing-functions.
// Function: void gsl_siman_solve (const gsl_rng * r, void * x0_p, gsl_siman_Efunc_t Ef, gsl_siman_step_t take_step, gsl_siman_metric_t distance, gsl_siman_print_t print_position, gsl_siman_copy_t copyfunc, gsl_siman_copy_construct_t copy_constructor, gsl_siman_destroy_t destructor, size_t element_size, gsl_siman_params_t params)
  proc gsl_siman_solve: &gsl_rng * &void * gsl_siman_Efunc_t * gsl_siman_step_t * gsl_siman_metric_t * gsl_siman_print_t * gsl_siman_copy_t * gsl_siman_copy_construct_t * gsl_siman_destroy_t * size * gsl_siman_params_t = 'gsl_siman_solve($a);';
//*****
// 26.00.00 Orindary-Differential-Equations.
//*****
// 26.01.00 Defining-the-ODE-System.
//*****
// 26.02.00 Stepping-Functions.
// Function: gsl_odeiv2_step * gsl_odeiv2_step_alloc (const gsl_odeiv2_step_type * T, size_t dim)
  fun gsl_odeiv2_step_alloc: &gsl_odeiv2_step_type * size -> &gsl_odeiv2_step = 'gsl_odeiv2_step_alloc($a)';
// Function: int gsl_odeiv2_step_reset (gsl_odeiv2_step * s)
  fun gsl_odeiv2_step_reset: &gsl_odeiv2_step -> int = 'gsl_odeiv2_step_reset($a)';
// Function: void gsl_odeiv2_step_free (gsl_odeiv2_step * s)
  proc gsl_odeiv2_step_free: &gsl_odeiv2_step = 'gsl_odeiv2_step_free($a);';
// Function: const char * gsl_odeiv2_step_name (const gsl_odeiv2_step * s)
  fun gsl_odeiv2_step_name: &gsl_odeiv2_step -> &char = 'gsl_odeiv2_step_name($a)';
// Function: unsigned int gsl_odeiv2_step_order (const gsl_odeiv2_step * s)
  fun gsl_odeiv2_step_order: &gsl_odeiv2_step -> uint = 'gsl_odeiv2_step_order($a)';
// Function: int gsl_odeiv2_step_set_driver (gsl_odeiv2_step * s, const gsl_odeiv2_driver * d)
  fun gsl_odeiv2_step_set_driver: &gsl_odeiv2_step * &gsl_odeiv2_driver -> int = 'gsl_odeiv2_step_set_driver($a)';
// Function: int gsl_odeiv2_step_apply (gsl_odeiv2_step * s, double t, double h, double y[], double yerr[], const double dydt_in[], double dydt_out[], const gsl_odeiv2_system * sys)
  fun gsl_odeiv2_step_apply: &gsl_odeiv2_step * double * double * +double * +double * +double * +double * &gsl_odeiv2_system -> int = 'gsl_odeiv2_step_apply($a)';
//*****
// 26.03.00 Adaptive-Step-size-Control.
// Function: gsl_odeiv2_control * gsl_odeiv2_control_standard_new (double eps_abs, double eps_rel, double a_y, double a_dydt)
  fun gsl_odeiv2_control_standard_new: double * double * double * double -> &gsl_odeiv2_control = 'gsl_odeiv2_control_standard_new($a)';
// Function: gsl_odeiv2_control * gsl_odeiv2_control_y_new (double eps_abs, double eps_rel)
  fun gsl_odeiv2_control_y_new: double * double -> &gsl_odeiv2_control = 'gsl_odeiv2_control_y_new($a)';
// Function: gsl_odeiv2_control * gsl_odeiv2_control_yp_new (double eps_abs, double eps_rel)
  fun gsl_odeiv2_control_yp_new: double * double -> &gsl_odeiv2_control = 'gsl_odeiv2_control_yp_new($a)';
// Function: gsl_odeiv2_control * gsl_odeiv2_control_scaled_new (double eps_abs, double eps_rel, double a_y, double a_dydt, const double scale_abs[], size_t dim)
  fun gsl_odeiv2_control_scaled_new: double * double * double * double * +double * size -> &gsl_odeiv2_control = 'gsl_odeiv2_control_scaled_new($a)';
// Function: gsl_odeiv2_control * gsl_odeiv2_control_alloc (const gsl_odeiv2_control_type * T)
  fun gsl_odeiv2_control_alloc: &gsl_odeiv2_control_type -> &gsl_odeiv2_control = 'gsl_odeiv2_control_alloc($a)';
// Function: int gsl_odeiv2_control_init (gsl_odeiv2_control * c, double eps_abs, double eps_rel, double a_y, double a_dydt)
  fun gsl_odeiv2_control_init: &gsl_odeiv2_control * double * double * double * double -> int = 'gsl_odeiv2_control_init($a)';
// Function: void gsl_odeiv2_control_free (gsl_odeiv2_control * c)
  proc gsl_odeiv2_control_free: &gsl_odeiv2_control = 'gsl_odeiv2_control_free($a);';
// Function: int gsl_odeiv2_control_hadjust (gsl_odeiv2_control * c, gsl_odeiv2_step * s, const double y[], const double yerr[], const double dydt[], double * h)
  fun gsl_odeiv2_control_hadjust: &gsl_odeiv2_control * &gsl_odeiv2_step * +double * +double * +double * &double -> int = 'gsl_odeiv2_control_hadjust($a)';
// Function: const char * gsl_odeiv2_control_name (const gsl_odeiv2_control * c)
  fun gsl_odeiv2_control_name: &gsl_odeiv2_control -> &char = 'gsl_odeiv2_control_name($a)';
// Function: int gsl_odeiv2_control_errlevel (gsl_odeiv2_control * c, const double y, const double dydt, const double h, const size_t ind, double * errlev)
  fun gsl_odeiv2_control_errlevel: &gsl_odeiv2_control * double * double * double * size * &double -> int = 'gsl_odeiv2_control_errlevel($a)';
// Function: int gsl_odeiv2_control_set_driver (gsl_odeiv2_control * c, const gsl_odeiv2_driver * d)
  fun gsl_odeiv2_control_set_driver: &gsl_odeiv2_control * &gsl_odeiv2_driver -> int = 'gsl_odeiv2_control_set_driver($a)';
//*****
// 26.04.00 Evolution.
// Function: gsl_odeiv2_evolve * gsl_odeiv2_evolve_alloc (size_t dim)
  fun gsl_odeiv2_evolve_alloc: size -> &gsl_odeiv2_evolve = 'gsl_odeiv2_evolve_alloc($a)';
// Function: int gsl_odeiv2_evolve_apply (gsl_odeiv2_evolve * e, gsl_odeiv2_control * con, gsl_odeiv2_step * step, const gsl_odeiv2_system * sys, double * t, double t1, double * h, double y[])
  fun gsl_odeiv2_evolve_apply: &gsl_odeiv2_evolve * &gsl_odeiv2_control * &gsl_odeiv2_step * &gsl_odeiv2_system * &double * double * &double * +double -> int = 'gsl_odeiv2_evolve_apply($a)';
// Function: int gsl_odeiv2_evolve_apply_fixed_step (gsl_odeiv2_evolve * e, gsl_odeiv2_control * con, gsl_odeiv2_step * step, const gsl_odeiv2_system * sys, double * t, const double h, double y[])
  fun gsl_odeiv2_evolve_apply_fixed_step: &gsl_odeiv2_evolve * &gsl_odeiv2_control * &gsl_odeiv2_step * &gsl_odeiv2_system * &double * double * +double -> int = 'gsl_odeiv2_evolve_apply_fixed_step($a)';
// Function: int gsl_odeiv2_evolve_reset (gsl_odeiv2_evolve * e)
  fun gsl_odeiv2_evolve_reset: &gsl_odeiv2_evolve -> int = 'gsl_odeiv2_evolve_reset($a)';
// Function: void gsl_odeiv2_evolve_free (gsl_odeiv2_evolve * e)
  proc gsl_odeiv2_evolve_free: &gsl_odeiv2_evolve = 'gsl_odeiv2_evolve_free($a);';
// Function: int gsl_odeiv2_evolve_set_driver (gsl_odeiv2_evolve * e, const gsl_odeiv2_driver * d)
  fun gsl_odeiv2_evolve_set_driver: &gsl_odeiv2_evolve * &gsl_odeiv2_driver -> int = 'gsl_odeiv2_evolve_set_driver($a)';
//*****
// 26.05.00 Driver.
// Function: gsl_odeiv2_driver * gsl_odeiv2_driver_alloc_y_new (const gsl_odeiv2_system * sys, const gsl_odeiv2_step_type * T, const double hstart, const double epsabs, const double epsrel)
  fun gsl_odeiv2_driver_alloc_y_new: &gsl_odeiv2_system * &gsl_odeiv2_step_type * double * double * double -> &gsl_odeiv2_driver = 'gsl_odeiv2_driver_alloc_y_new($a)';
// Function: gsl_odeiv2_driver * gsl_odeiv2_driver_alloc_yp_new (const gsl_odeiv2_system * sys, const gsl_odeiv2_step_type * T, const double hstart, const double epsabs, const double epsrel)
  fun gsl_odeiv2_driver_alloc_yp_new: &gsl_odeiv2_system * &gsl_odeiv2_step_type * double * double * double -> &gsl_odeiv2_driver = 'gsl_odeiv2_driver_alloc_yp_new($a)';
// Function: gsl_odeiv2_driver * gsl_odeiv2_driver_alloc_standard_new (const gsl_odeiv2_system * sys, const gsl_odeiv2_step_type * T, const double hstart, const double epsabs, const double epsrel, const double a_y, const double a_dydt)
  fun gsl_odeiv2_driver_alloc_standard_new: &gsl_odeiv2_system * &gsl_odeiv2_step_type * double * double * double * double * double -> &gsl_odeiv2_driver = 'gsl_odeiv2_driver_alloc_standard_new($a)';
// Function: gsl_odeiv2_driver * gsl_odeiv2_driver_alloc_scaled_new (const gsl_odeiv2_system * sys, const gsl_odeiv2_step_type * T, const double hstart, const double epsabs, const double epsrel, const double a_y, const double a_dydt, const double scale_abs[])
  fun gsl_odeiv2_driver_alloc_scaled_new: &gsl_odeiv2_system * &gsl_odeiv2_step_type * double * double * double * double * double * +double -> &gsl_odeiv2_driver = 'gsl_odeiv2_driver_alloc_scaled_new($a)';
// Function: int gsl_odeiv2_driver_set_hmin (gsl_odeiv2_driver * d, const double hmin)
  fun gsl_odeiv2_driver_set_hmin: &gsl_odeiv2_driver * double -> int = 'gsl_odeiv2_driver_set_hmin($a)';
// Function: int gsl_odeiv2_driver_set_hmax (gsl_odeiv2_driver * d, const double hmax)
  fun gsl_odeiv2_driver_set_hmax: &gsl_odeiv2_driver * double -> int = 'gsl_odeiv2_driver_set_hmax($a)';
// Function: int gsl_odeiv2_driver_set_nmax (gsl_odeiv2_driver * d, const unsigned long int nmax)
  fun gsl_odeiv2_driver_set_nmax: &gsl_odeiv2_driver * ulong -> int = 'gsl_odeiv2_driver_set_nmax($a)';
// Function: int gsl_odeiv2_driver_apply (gsl_odeiv2_driver * d, double * t, const double t1, double y[])
  fun gsl_odeiv2_driver_apply: &gsl_odeiv2_driver * &double * double * +double -> int = 'gsl_odeiv2_driver_apply($a)';
// Function: int gsl_odeiv2_driver_apply_fixed_step (gsl_odeiv2_driver * d, double * t, const double h, const unsigned long int n, double y[])
  fun gsl_odeiv2_driver_apply_fixed_step: &gsl_odeiv2_driver * &double * double * ulong * +double -> int = 'gsl_odeiv2_driver_apply_fixed_step($a)';
// Function: int gsl_odeiv2_driver_reset (gsl_odeiv2_driver * d)
  fun gsl_odeiv2_driver_reset: &gsl_odeiv2_driver -> int = 'gsl_odeiv2_driver_reset($a)';
// Function: int gsl_odeiv2_driver_reset_hstart (gsl_odeiv2_driver * d, const double hstart)
  fun gsl_odeiv2_driver_reset_hstart: &gsl_odeiv2_driver * double -> int = 'gsl_odeiv2_driver_reset_hstart($a)';
// Function: int gsl_odeiv2_driver_free (gsl_odeiv2_driver * d)
  fun gsl_odeiv2_driver_free: &gsl_odeiv2_driver -> int = 'gsl_odeiv2_driver_free($a)';
//*****
// 27.00.00 Interpolation.
//*****
// 27.01.00 Introduction-Interpolation.
//*****
// 27.02.00 Interpolation-Functions.
// Function: gsl_interp * gsl_interp_alloc (const gsl_interp_type * T, size_t size)
  fun gsl_interp_alloc: &gsl_interp_type * size -> &gsl_interp = 'gsl_interp_alloc($a)';
// Function: int gsl_interp_init (gsl_interp * interp, const double xa[], const double ya[], size_t size)
  fun gsl_interp_init: &gsl_interp * +double * +double * size -> int = 'gsl_interp_init($a)';
// Function: void gsl_interp_free (gsl_interp * interp)
  proc gsl_interp_free: &gsl_interp = 'gsl_interp_free($a);';
//*****
// 27.03.00 Interpolation-Types.
// Function: const char * gsl_interp_name (const gsl_interp * interp)
  fun gsl_interp_name: &gsl_interp -> &char = 'gsl_interp_name($a)';
// Function: unsigned int gsl_interp_min_size (const gsl_interp * interp)
  fun gsl_interp_min_size: &gsl_interp -> uint = 'gsl_interp_min_size($a)';
// Function: unsigned int gsl_interp_type_min_size (const gsl_interp_type * T)
  fun gsl_interp_type_min_size: &gsl_interp_type -> uint = 'gsl_interp_type_min_size($a)';
//*****
// 27.04.00 Index-Loo-up-and-Acceleration.
// Function: size_t gsl_interp_bsearch (const double x_array[], double x, size_t index_lo, size_t index_hi)
  fun gsl_interp_bsearch: +double * double * size * size -> size = 'gsl_interp_bsearch($a)';
// Function: gsl_interp_accel * gsl_interp_accel_alloc (void)
  fun gsl_interp_accel_alloc: unit -> &gsl_interp_accel = 'gsl_interp_accel_alloc($a)';
// Function: size_t gsl_interp_accel_find (gsl_interp_accel * a, const double x_array[], size_t size, double x)
  fun gsl_interp_accel_find: &gsl_interp_accel * +double * size * double -> size = 'gsl_interp_accel_find($a)';
// Function: int gsl_interp_accel_reset (gsl_interp_accel * acc);
  fun gsl_interp_accel_reset: &gsl_interp_accel -> int = 'gsl_interp_accel_reset($a)';
// Function: void gsl_interp_accel_free (gsl_interp_accel* acc)
  proc gsl_interp_accel_free: &gsl_interp_accel = 'gsl_interp_accel_free($a);';
//*****
// 27.05.00 Evaluation-of-Interpolation-Functions.
// Function: double gsl_interp_eval (const gsl_interp * interp, const double xa[], const double ya[], double x, gsl_interp_accel * acc)
  fun gsl_interp_eval: &gsl_interp * +double * +double * double * &gsl_interp_accel -> double = 'gsl_interp_eval($a)';
// Function: int gsl_interp_eval_e (const gsl_interp * interp, const double xa[], const double ya[], double x, gsl_interp_accel * acc, double * y)
  fun gsl_interp_eval_e: &gsl_interp * +double * +double * double * &gsl_interp_accel * &double -> int = 'gsl_interp_eval_e($a)';
// Function: double gsl_interp_eval_deriv (const gsl_interp * interp, const double xa[], const double ya[], double x, gsl_interp_accel * acc)
  fun gsl_interp_eval_deriv: &gsl_interp * +double * +double * double * &gsl_interp_accel -> double = 'gsl_interp_eval_deriv($a)';
// Function: int gsl_interp_eval_deriv_e (const gsl_interp * interp, const double xa[], const double ya[], double x, gsl_interp_accel * acc, double * d)
  fun gsl_interp_eval_deriv_e: &gsl_interp * +double * +double * double * &gsl_interp_accel * &double -> int = 'gsl_interp_eval_deriv_e($a)';
// Function: double gsl_interp_eval_deriv2 (const gsl_interp * interp, const double xa[], const double ya[], double x, gsl_interp_accel * acc)
  fun gsl_interp_eval_deriv2: &gsl_interp * +double * +double * double * &gsl_interp_accel -> double = 'gsl_interp_eval_deriv2($a)';
// Function: int gsl_interp_eval_deriv2_e (const gsl_interp * interp, const double xa[], const double ya[], double x, gsl_interp_accel * acc, double * d2)
  fun gsl_interp_eval_deriv2_e: &gsl_interp * +double * +double * double * &gsl_interp_accel * &double -> int = 'gsl_interp_eval_deriv2_e($a)';
// Function: double gsl_interp_eval_integ (const gsl_interp * interp, const double xa[], const double ya[], double a, double b, gsl_interp_accel * acc)
  fun gsl_interp_eval_integ: &gsl_interp * +double * +double * double * double * &gsl_interp_accel -> double = 'gsl_interp_eval_integ($a)';
// Function: int gsl_interp_eval_integ_e (const gsl_interp * interp, const double xa[], const double ya[], double a, double b, gsl_interp_accel * acc, double * result)
  fun gsl_interp_eval_integ_e: &gsl_interp * +double * +double * double * double * &gsl_interp_accel * &double -> int = 'gsl_interp_eval_integ_e($a)';
//*****
// 27.06.00 Higher-level-Interface.
// Function: gsl_spline * gsl_spline_alloc (const gsl_interp_type * T, size_t size)
  fun gsl_spline_alloc: &gsl_interp_type * size -> &gsl_spline = 'gsl_spline_alloc($a)';
// Function: int gsl_spline_init (gsl_spline * spline, const double xa[], const double ya[], size_t size)
  fun gsl_spline_init: &gsl_spline * +double * +double * size -> int = 'gsl_spline_init($a)';
// Function: void gsl_spline_free (gsl_spline * spline)
  proc gsl_spline_free: &gsl_spline = 'gsl_spline_free($a);';
// Function: const char * gsl_spline_name (const gsl_spline * spline)
  fun gsl_spline_name: &gsl_spline -> &char = 'gsl_spline_name($a)';
// Function: unsigned int gsl_spline_min_size (const gsl_spline * spline)
  fun gsl_spline_min_size: &gsl_spline -> uint = 'gsl_spline_min_size($a)';
// Function: double gsl_spline_eval (const gsl_spline * spline, double x, gsl_interp_accel * acc)
  fun gsl_spline_eval: &gsl_spline * double * &gsl_interp_accel -> double = 'gsl_spline_eval($a)';
// Function: int gsl_spline_eval_e (const gsl_spline * spline, double x, gsl_interp_accel * acc, double * y)
  fun gsl_spline_eval_e: &gsl_spline * double * &gsl_interp_accel * &double -> int = 'gsl_spline_eval_e($a)';
// Function: double gsl_spline_eval_deriv (const gsl_spline * spline, double x, gsl_interp_accel * acc)
  fun gsl_spline_eval_deriv: &gsl_spline * double * &gsl_interp_accel -> double = 'gsl_spline_eval_deriv($a)';
// Function: int gsl_spline_eval_deriv_e (const gsl_spline * spline, double x, gsl_interp_accel * acc, double * d)
  fun gsl_spline_eval_deriv_e: &gsl_spline * double * &gsl_interp_accel * &double -> int = 'gsl_spline_eval_deriv_e($a)';
// Function: double gsl_spline_eval_deriv2 (const gsl_spline * spline, double x, gsl_interp_accel * acc)
  fun gsl_spline_eval_deriv2: &gsl_spline * double * &gsl_interp_accel -> double = 'gsl_spline_eval_deriv2($a)';
// Function: int gsl_spline_eval_deriv2_e (const gsl_spline * spline, double x, gsl_interp_accel * acc, double * d2)
  fun gsl_spline_eval_deriv2_e: &gsl_spline * double * &gsl_interp_accel * &double -> int = 'gsl_spline_eval_deriv2_e($a)';
// Function: double gsl_spline_eval_integ (const gsl_spline * spline, double a, double b, gsl_interp_accel * acc)
  fun gsl_spline_eval_integ: &gsl_spline * double * double * &gsl_interp_accel -> double = 'gsl_spline_eval_integ($a)';
// Function: int gsl_spline_eval_integ_e (const gsl_spline * spline, double a, double b, gsl_interp_accel * acc, double * result)
  fun gsl_spline_eval_integ_e: &gsl_spline * double * double * &gsl_interp_accel * &double -> int = 'gsl_spline_eval_integ_e($a)';
//*****
// 28.00.00 Numerical-Differentiation.
//*****
// 28.01.00 Numerical-Differentiation-Functions.
// Function: int gsl_deriv_central (const gsl_function * f, double x, double h, double * result, double * abserr)
  fun gsl_deriv_central: &gsl_function * double * double * &double * &double -> int = 'gsl_deriv_central($a)';
// Function: int gsl_deriv_forward (const gsl_function * f, double x, double h, double * result, double * abserr)
  fun gsl_deriv_forward: &gsl_function * double * double * &double * &double -> int = 'gsl_deriv_forward($a)';
// Function: int gsl_deriv_backward (const gsl_function * f, double x, double h, double * result, double * abserr)
  fun gsl_deriv_backward: &gsl_function * double * double * &double * &double -> int = 'gsl_deriv_backward($a)';
//*****
// 29.00.00 Chebyshev-Approximations.
//*****
// 29.01.00 Chebyshev-Definitions.
//*****
// 29.02.00 Creation-and-Calculation-of-Chebyshev-Series.
// Function: gsl_cheb_series * gsl_cheb_alloc (const size_t n)
  fun gsl_cheb_alloc: size -> &gsl_cheb_series = 'gsl_cheb_alloc($a)';
// Function: void gsl_cheb_free (gsl_cheb_series * cs)
  proc gsl_cheb_free: &gsl_cheb_series = 'gsl_cheb_free($a);';
// Function: int gsl_cheb_init (gsl_cheb_series * cs, const gsl_function * f, const double a, const double b)
  fun gsl_cheb_init: &gsl_cheb_series * &gsl_function * double * double -> int = 'gsl_cheb_init($a)';
//*****
// 29.03.00 Chebyshev-Auxilliary-Functions.
// Function: size_t gsl_cheb_order (const gsl_cheb_series * cs)
  fun gsl_cheb_order: &gsl_cheb_series -> size = 'gsl_cheb_order($a)';
// Function: size_t gsl_cheb_size (const gsl_cheb_series * cs)
  fun gsl_cheb_size: &gsl_cheb_series -> size = 'gsl_cheb_size($a)';
// Function: double * gsl_cheb_coeffs (const gsl_cheb_series * cs)
  fun gsl_cheb_coeffs: &gsl_cheb_series -> &double = 'gsl_cheb_coeffs($a)';
//*****
// 29.04.00 Chebyshev-Series-Evaluation.
// Function: double gsl_cheb_eval (const gsl_cheb_series * cs, double x)
  fun gsl_cheb_eval: &gsl_cheb_series * double -> double = 'gsl_cheb_eval($a)';
// Function: int gsl_cheb_eval_err (const gsl_cheb_series * cs, const double x, double * result, double * abserr)
  fun gsl_cheb_eval_err: &gsl_cheb_series * double * &double * &double -> int = 'gsl_cheb_eval_err($a)';
// Function: double gsl_cheb_eval_n (const gsl_cheb_series * cs, size_t order, double x)
  fun gsl_cheb_eval_n: &gsl_cheb_series * size * double -> double = 'gsl_cheb_eval_n($a)';
// Function: int gsl_cheb_eval_n_err (const gsl_cheb_series * cs, const size_t order, const double x, double * result, double * abserr)
  fun gsl_cheb_eval_n_err: &gsl_cheb_series * size * double * &double * &double -> int = 'gsl_cheb_eval_n_err($a)';
//*****
// 29.05.00 Chebyshev-Derivatives-and-Integrals.
// Function: int gsl_cheb_calc_deriv (gsl_cheb_series * deriv, const gsl_cheb_series * cs)
  fun gsl_cheb_calc_deriv: &gsl_cheb_series * &gsl_cheb_series -> int = 'gsl_cheb_calc_deriv($a)';
// Function: int gsl_cheb_calc_integ (gsl_cheb_series * integ, const gsl_cheb_series * cs)
  fun gsl_cheb_calc_integ: &gsl_cheb_series * &gsl_cheb_series -> int = 'gsl_cheb_calc_integ($a)';
//*****
// 30.00.00 Series-Acceleration.
//*****
// 30.01.00 Series-Acceleration-Functions.
// Function: gsl_sum_levin_u_workspace * gsl_sum_levin_u_alloc (size_t n)
  fun gsl_sum_levin_u_alloc: size -> &gsl_sum_levin_u_workspace = 'gsl_sum_levin_u_alloc($a)';
// Function: void gsl_sum_levin_u_free (gsl_sum_levin_u_workspace * w)
  proc gsl_sum_levin_u_free: &gsl_sum_levin_u_workspace = 'gsl_sum_levin_u_free($a);';
// Function: int gsl_sum_levin_u_accel (const double * array, size_t array_size, gsl_sum_levin_u_workspace * w, double * sum_accel, double * abserr)
  fun gsl_sum_levin_u_accel: &double * size * &gsl_sum_levin_u_workspace * &double * &double -> int = 'gsl_sum_levin_u_accel($a)';
//*****
// 30.02.00 Acceleration-functions-with-error-estimates.
// Function: gsl_sum_levin_utrunc_workspace * gsl_sum_levin_utrunc_alloc (size_t n)
  fun gsl_sum_levin_utrunc_alloc: size -> &gsl_sum_levin_utrunc_workspace = 'gsl_sum_levin_utrunc_alloc($a)';
// Function: void gsl_sum_levin_utrunc_free (gsl_sum_levin_utrunc_workspace * w)
  proc gsl_sum_levin_utrunc_free: &gsl_sum_levin_utrunc_workspace = 'gsl_sum_levin_utrunc_free($a);';
// Function: int gsl_sum_levin_utrunc_accel (const double * array, size_t array_size, gsl_sum_levin_utrunc_workspace * w, double * sum_accel, double * abserr_trunc)
  fun gsl_sum_levin_utrunc_accel: &double * size * &gsl_sum_levin_utrunc_workspace * &double * &double -> int = 'gsl_sum_levin_utrunc_accel($a)';
//*****
// 31.00.00 Wavelet-Transforms.
//*****
// 31.01.00 Wavelet-Transforms-Definitions.
//*****
// 31.02.00 DWT-Initialisation.
// Function: gsl_wavelet * gsl_wavelet_alloc (const gsl_wavelet_type * T, size_t k)
  fun gsl_wavelet_alloc: &gsl_wavelet_type * size -> &gsl_wavelet = 'gsl_wavelet_alloc($a)';
// Function: const char * gsl_wavelet_name (const gsl_wavelet * w)
  fun gsl_wavelet_name: &gsl_wavelet -> &char = 'gsl_wavelet_name($a)';
// Function: void gsl_wavelet_free (gsl_wavelet * w)
  proc gsl_wavelet_free: &gsl_wavelet = 'gsl_wavelet_free($a);';
// Function: gsl_wavelet_workspace * gsl_wavelet_workspace_alloc (size_t n)
  fun gsl_wavelet_workspace_alloc: size -> &gsl_wavelet_workspace = 'gsl_wavelet_workspace_alloc($a)';
// Function: void gsl_wavelet_workspace_free (gsl_wavelet_workspace * work)
  proc gsl_wavelet_workspace_free: &gsl_wavelet_workspace = 'gsl_wavelet_workspace_free($a);';
//*****
// 31.03.00 DWT-Transform-Functions.
//*****
// 31.03.01 DWT-Transforms-in-one-dimension.
// Function: int gsl_wavelet_transform (const gsl_wavelet * w, double * data, size_t stride, size_t n, gsl_wavelet_direction dir, gsl_wavelet_workspace * work)
  fun gsl_wavelet_transform: &gsl_wavelet * &double * size * size * gsl_wavelet_direction * &gsl_wavelet_workspace -> int = 'gsl_wavelet_transform($a)';
// Function: int gsl_wavelet_transform_forward (const gsl_wavelet * w, double * data, size_t stride, size_t n, gsl_wavelet_workspace * work)
  fun gsl_wavelet_transform_forward: &gsl_wavelet * &double * size * size * &gsl_wavelet_workspace -> int = 'gsl_wavelet_transform_forward($a)';
// Function: int gsl_wavelet_transform_inverse (const gsl_wavelet * w, double * data, size_t stride, size_t n, gsl_wavelet_workspace * work)
  fun gsl_wavelet_transform_inverse: &gsl_wavelet * &double * size * size * &gsl_wavelet_workspace -> int = 'gsl_wavelet_transform_inverse($a)';
//*****
// 31.03.02 DWT-Transforms-in-two-dimensions.
// Function: int gsl_wavelet2d_transform (const gsl_wavelet * w, double * data, size_t tda, size_t size1, size_t size2, gsl_wavelet_direction dir, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_transform: &gsl_wavelet * &double * size * size * size * gsl_wavelet_direction * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_transform($a)';
// Function: int gsl_wavelet2d_transform_forward (const gsl_wavelet * w, double * data, size_t tda, size_t size1, size_t size2, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_transform_forward: &gsl_wavelet * &double * size * size * size * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_transform_forward($a)';
// Function: int gsl_wavelet2d_transform_inverse (const gsl_wavelet * w, double * data, size_t tda, size_t size1, size_t size2, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_transform_inverse: &gsl_wavelet * &double * size * size * size * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_transform_inverse($a)';
// Function: int gsl_wavelet2d_transform_matrix (const gsl_wavelet * w, gsl_matrix * m, gsl_wavelet_direction dir, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_transform_matrix: &gsl_wavelet * &gsl_matrix * gsl_wavelet_direction * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_transform_matrix($a)';
// Function: int gsl_wavelet2d_transform_matrix_forward (const gsl_wavelet * w, gsl_matrix * m, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_transform_matrix_forward: &gsl_wavelet * &gsl_matrix * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_transform_matrix_forward($a)';
// Function: int gsl_wavelet2d_transform_matrix_inverse (const gsl_wavelet * w, gsl_matrix * m, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_transform_matrix_inverse: &gsl_wavelet * &gsl_matrix * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_transform_matrix_inverse($a)';
// Function: int gsl_wavelet2d_nstransform (const gsl_wavelet * w, double * data, size_t tda, size_t size1, size_t size2, gsl_wavelet_direction dir, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_nstransform: &gsl_wavelet * &double * size * size * size * gsl_wavelet_direction * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_nstransform($a)';
// Function: int gsl_wavelet2d_nstransform_forward (const gsl_wavelet * w, double * data, size_t tda, size_t size1, size_t size2, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_nstransform_forward: &gsl_wavelet * &double * size * size * size * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_nstransform_forward($a)';
// Function: int gsl_wavelet2d_nstransform_inverse (const gsl_wavelet * w, double * data, size_t tda, size_t size1, size_t size2, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_nstransform_inverse: &gsl_wavelet * &double * size * size * size * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_nstransform_inverse($a)';
// Function: int gsl_wavelet2d_nstransform_matrix (const gsl_wavelet * w, gsl_matrix * m, gsl_wavelet_direction dir, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_nstransform_matrix: &gsl_wavelet * &gsl_matrix * gsl_wavelet_direction * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_nstransform_matrix($a)';
// Function: int gsl_wavelet2d_nstransform_matrix_forward (const gsl_wavelet * w, gsl_matrix * m, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_nstransform_matrix_forward: &gsl_wavelet * &gsl_matrix * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_nstransform_matrix_forward($a)';
// Function: int gsl_wavelet2d_nstransform_matrix_inverse (const gsl_wavelet * w, gsl_matrix * m, gsl_wavelet_workspace * work)
  fun gsl_wavelet2d_nstransform_matrix_inverse: &gsl_wavelet * &gsl_matrix * &gsl_wavelet_workspace -> int = 'gsl_wavelet2d_nstransform_matrix_inverse($a)';
//*****
// 32.00.00 Discrete-Hankel-Transforms.
//*****
// 32.01.00 Discrete-Hankel-Definition.
//*****
// 32.02.00 Discrete-Hankel-Functions.
// Function: gsl_dht * gsl_dht_alloc (size_t size)
  fun gsl_dht_alloc: size -> &gsl_dht = 'gsl_dht_alloc($a)';
// Function: int gsl_dht_init (gsl_dht * t, double nu, double xmax)
  fun gsl_dht_init: &gsl_dht * double * double -> int = 'gsl_dht_init($a)';
// Function: gsl_dht * gsl_dht_new (size_t size, double nu, double xmax)
  fun gsl_dht_new: size * double * double -> &gsl_dht = 'gsl_dht_new($a)';
// Function: void gsl_dht_free (gsl_dht * t)
  proc gsl_dht_free: &gsl_dht = 'gsl_dht_free($a);';
// Function: int gsl_dht_apply (const gsl_dht * t, double * f_in, double * f_out)
  fun gsl_dht_apply: &gsl_dht * &double * &double -> int = 'gsl_dht_apply($a)';
// Function: double gsl_dht_x_sample (const gsl_dht * t, int n)
  fun gsl_dht_x_sample: &gsl_dht * int -> double = 'gsl_dht_x_sample($a)';
// Function: double gsl_dht_k_sample (const gsl_dht * t, int n)
  fun gsl_dht_k_sample: &gsl_dht * int -> double = 'gsl_dht_k_sample($a)';
//*****
// 33.00.00 One-Dimensional-Root-Finding.
//*****
// 33.01.00 One-Dimensional-Root-Finding-Overview.
//*****
// 33.02.00 One-Dimensional-Root-Finding-Caveats.
//*****
// 33.03.00 Initialising-the-Solver.
// Function: gsl_root_fsolver * gsl_root_fsolver_alloc (const gsl_root_fsolver_type * T)
  fun gsl_root_fsolver_alloc: &gsl_root_fsolver_type -> &gsl_root_fsolver = 'gsl_root_fsolver_alloc($a)';
// Function: gsl_root_fdfsolver * gsl_root_fdfsolver_alloc (const gsl_root_fdfsolver_type * T)
  fun gsl_root_fdfsolver_alloc: &gsl_root_fdfsolver_type -> &gsl_root_fdfsolver = 'gsl_root_fdfsolver_alloc($a)';
// Function: int gsl_root_fsolver_set (gsl_root_fsolver * s, gsl_function * f, double x_lower, double x_upper)
  fun gsl_root_fsolver_set: &gsl_root_fsolver * &gsl_function * double * double -> int = 'gsl_root_fsolver_set($a)';
// Function: int gsl_root_fdfsolver_set (gsl_root_fdfsolver * s, gsl_function_fdf * fdf, double root)
  fun gsl_root_fdfsolver_set: &gsl_root_fdfsolver * &gsl_function_fdf * double -> int = 'gsl_root_fdfsolver_set($a)';
// Function: void gsl_root_fsolver_free (gsl_root_fsolver * s)
  proc gsl_root_fsolver_free: &gsl_root_fsolver = 'gsl_root_fsolver_free($a);';
// Function: void gsl_root_fdfsolver_free (gsl_root_fdfsolver * s)
  proc gsl_root_fdfsolver_free: &gsl_root_fdfsolver = 'gsl_root_fdfsolver_free($a);';
// Function: const char * gsl_root_fsolver_name (const gsl_root_fsolver * s)
  fun gsl_root_fsolver_name: &gsl_root_fsolver -> &char = 'gsl_root_fsolver_name($a)';
// Function: const char * gsl_root_fdfsolver_name (const gsl_root_fdfsolver * s)
  fun gsl_root_fdfsolver_name: &gsl_root_fdfsolver -> &char = 'gsl_root_fdfsolver_name($a)';
//*****
// 33.04.00 Providing-the-function-to-solve.
//*****
// 33.05.00 Search-Bounds-and-Guesses.
//*****
// 33.06.00 Iteration.
// Function: int gsl_root_fsolver_iterate (gsl_root_fsolver * s)
  fun gsl_root_fsolver_iterate: &gsl_root_fsolver -> int = 'gsl_root_fsolver_iterate($a)';
// Function: int gsl_root_fdfsolver_iterate (gsl_root_fdfsolver * s)
  fun gsl_root_fdfsolver_iterate: &gsl_root_fdfsolver -> int = 'gsl_root_fdfsolver_iterate($a)';
// Function: double gsl_root_fsolver_root (const gsl_root_fsolver * s)
  fun gsl_root_fsolver_root: &gsl_root_fsolver -> double = 'gsl_root_fsolver_root($a)';
// Function: double gsl_root_fdfsolver_root (const gsl_root_fdfsolver * s)
  fun gsl_root_fdfsolver_root: &gsl_root_fdfsolver -> double = 'gsl_root_fdfsolver_root($a)';
// Function: double gsl_root_fsolver_x_lower (const gsl_root_fsolver * s)
  fun gsl_root_fsolver_x_lower: &gsl_root_fsolver -> double = 'gsl_root_fsolver_x_lower($a)';
// Function: double gsl_root_fsolver_x_upper (const gsl_root_fsolver * s)
  fun gsl_root_fsolver_x_upper: &gsl_root_fsolver -> double = 'gsl_root_fsolver_x_upper($a)';
//*****
// 33.07.00 Search-Stopping-Parameters.
// Function: int gsl_root_test_interval (double x_lower, double x_upper, double epsabs, double epsrel)
  fun gsl_root_test_interval: double * double * double * double -> int = 'gsl_root_test_interval($a)';
// Function: int gsl_root_test_delta (double x1, double x0, double epsabs, double epsrel)
  fun gsl_root_test_delta: double * double * double * double -> int = 'gsl_root_test_delta($a)';
// Function: int gsl_root_test_residual (double f, double epsabs)
  fun gsl_root_test_residual: double * double -> int = 'gsl_root_test_residual($a)';
//*****
// 33.08.00 Root-Bracketing-Algorithms.
//*****
// 33.09.00 Root-Finding-Algorithms-using-Derivaties.
//*****
// 34.00.00 One-Dimensional-Minimisation.
//*****
// 34.01.00 One-Dimensional-Minimisation-Overview.
//*****
// 34.02.00 One-Dimensional-Minimisation-Caveats.
//*****
// 34.03.00 Initialising-the-Minimiser.
// Function: gsl_min_fminimizer * gsl_min_fminimizer_alloc (const gsl_min_fminimizer_type * T)
  fun gsl_min_fminimizer_alloc: &gsl_min_fminimizer_type -> &gsl_min_fminimizer = 'gsl_min_fminimizer_alloc($a)';
// Function: int gsl_min_fminimizer_set (gsl_min_fminimizer * s, gsl_function * f, double x_minimum, double x_lower, double x_upper)
  fun gsl_min_fminimizer_set: &gsl_min_fminimizer * &gsl_function * double * double * double -> int = 'gsl_min_fminimizer_set($a)';
// Function: int gsl_min_fminimizer_set_with_values (gsl_min_fminimizer * s, gsl_function * f, double x_minimum, double f_minimum, double x_lower, double f_lower, double x_upper, double f_upper)
  fun gsl_min_fminimizer_set_with_values: &gsl_min_fminimizer * &gsl_function * double * double * double * double * double * double -> int = 'gsl_min_fminimizer_set_with_values($a)';
// Function: void gsl_min_fminimizer_free (gsl_min_fminimizer * s)
  proc gsl_min_fminimizer_free: &gsl_min_fminimizer = 'gsl_min_fminimizer_free($a);';
// Function: const char * gsl_min_fminimizer_name (const gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_name: &gsl_min_fminimizer -> &char = 'gsl_min_fminimizer_name($a)';
//*****
// 34.04.00 Providing-the-function-to-minimise.
//*****
// 34.05.00 Minimiser-Iteration.
// Function: int gsl_min_fminimizer_iterate (gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_iterate: &gsl_min_fminimizer -> int = 'gsl_min_fminimizer_iterate($a)';
// Function: double gsl_min_fminimizer_x_minimum (const gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_x_minimum: &gsl_min_fminimizer -> double = 'gsl_min_fminimizer_x_minimum($a)';
// Function: double gsl_min_fminimizer_x_upper (const gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_x_upper: &gsl_min_fminimizer -> double = 'gsl_min_fminimizer_x_upper($a)';
// Function: double gsl_min_fminimizer_x_lower (const gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_x_lower: &gsl_min_fminimizer -> double = 'gsl_min_fminimizer_x_lower($a)';
// Function: double gsl_min_fminimizer_f_minimum (const gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_f_minimum: &gsl_min_fminimizer -> double = 'gsl_min_fminimizer_f_minimum($a)';
// Function: double gsl_min_fminimizer_f_upper (const gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_f_upper: &gsl_min_fminimizer -> double = 'gsl_min_fminimizer_f_upper($a)';
// Function: double gsl_min_fminimizer_f_lower (const gsl_min_fminimizer * s)
  fun gsl_min_fminimizer_f_lower: &gsl_min_fminimizer -> double = 'gsl_min_fminimizer_f_lower($a)';
//*****
// 34.06.00 Minimiser-Stopping-Parameters.
// Function: int gsl_min_test_interval (double x_lower, double x_upper, double epsabs, double epsrel)
  fun gsl_min_test_interval: double * double * double * double -> int = 'gsl_min_test_interval($a)';
//*****
// 34.07.00 Minimisation-Algorithms.
//*****
// 35.00.00 Multidimensional-Root-Finding.
//*****
// 35.01.00 Multidimensional-Root-Finding-Overview.
//*****
// 35.02.00 Multidimensional-Root-Finding-Initialising-the-Solver.
// Function: gsl_multiroot_fsolver * gsl_multiroot_fsolver_alloc (const gsl_multiroot_fsolver_type * T, size_t n)
  fun gsl_multiroot_fsolver_alloc: &gsl_multiroot_fsolver_type * size -> &gsl_multiroot_fsolver = 'gsl_multiroot_fsolver_alloc($a)';
// Function: gsl_multiroot_fdfsolver * gsl_multiroot_fdfsolver_alloc (const gsl_multiroot_fdfsolver_type * T, size_t n)
  fun gsl_multiroot_fdfsolver_alloc: &gsl_multiroot_fdfsolver_type * size -> &gsl_multiroot_fdfsolver = 'gsl_multiroot_fdfsolver_alloc($a)';
// Function: int gsl_multiroot_fsolver_set (gsl_multiroot_fsolver * s, gsl_multiroot_function * f, const gsl_vector * x)
  fun gsl_multiroot_fsolver_set: &gsl_multiroot_fsolver * &gsl_multiroot_function * &gsl_vector -> int = 'gsl_multiroot_fsolver_set($a)';
// Function: int gsl_multiroot_fdfsolver_set (gsl_multiroot_fdfsolver * s, gsl_multiroot_function_fdf * fdf, const gsl_vector * x)
  fun gsl_multiroot_fdfsolver_set: &gsl_multiroot_fdfsolver * &gsl_multiroot_function_fdf * &gsl_vector -> int = 'gsl_multiroot_fdfsolver_set($a)';
// Function: void gsl_multiroot_fsolver_free (gsl_multiroot_fsolver * s)
  proc gsl_multiroot_fsolver_free: &gsl_multiroot_fsolver = 'gsl_multiroot_fsolver_free($a);';
// Function: void gsl_multiroot_fdfsolver_free (gsl_multiroot_fdfsolver * s)
  proc gsl_multiroot_fdfsolver_free: &gsl_multiroot_fdfsolver = 'gsl_multiroot_fdfsolver_free($a);';
// Function: const char * gsl_multiroot_fsolver_name (const gsl_multiroot_fsolver * s)
  fun gsl_multiroot_fsolver_name: &gsl_multiroot_fsolver -> &char = 'gsl_multiroot_fsolver_name($a)';
// Function: const char * gsl_multiroot_fdfsolver_name (const gsl_multiroot_fdfsolver * s)
  fun gsl_multiroot_fdfsolver_name: &gsl_multiroot_fdfsolver -> &char = 'gsl_multiroot_fdfsolver_name($a)';
//*****
// 35.03.00 Multidimensional-Root-Finding-Providing-the-function-to-solve.
//*****
// 35.04.00 Multidimensional-Root-Finding-Iteration.
// Function: int gsl_multiroot_fsolver_iterate (gsl_multiroot_fsolver * s)
  fun gsl_multiroot_fsolver_iterate: &gsl_multiroot_fsolver -> int = 'gsl_multiroot_fsolver_iterate($a)';
// Function: int gsl_multiroot_fdfsolver_iterate (gsl_multiroot_fdfsolver * s)
  fun gsl_multiroot_fdfsolver_iterate: &gsl_multiroot_fdfsolver -> int = 'gsl_multiroot_fdfsolver_iterate($a)';
// Function: gsl_vector * gsl_multiroot_fsolver_root (const gsl_multiroot_fsolver * s)
  fun gsl_multiroot_fsolver_root: &gsl_multiroot_fsolver -> &gsl_vector = 'gsl_multiroot_fsolver_root($a)';
// Function: gsl_vector * gsl_multiroot_fdfsolver_root (const gsl_multiroot_fdfsolver * s)
  fun gsl_multiroot_fdfsolver_root: &gsl_multiroot_fdfsolver -> &gsl_vector = 'gsl_multiroot_fdfsolver_root($a)';
// Function: gsl_vector * gsl_multiroot_fsolver_f (const gsl_multiroot_fsolver * s)
  fun gsl_multiroot_fsolver_f: &gsl_multiroot_fsolver -> &gsl_vector = 'gsl_multiroot_fsolver_f($a)';
// Function: gsl_vector * gsl_multiroot_fdfsolver_f (const gsl_multiroot_fdfsolver * s)
  fun gsl_multiroot_fdfsolver_f: &gsl_multiroot_fdfsolver -> &gsl_vector = 'gsl_multiroot_fdfsolver_f($a)';
// Function: gsl_vector * gsl_multiroot_fsolver_dx (const gsl_multiroot_fsolver * s)
  fun gsl_multiroot_fsolver_dx: &gsl_multiroot_fsolver -> &gsl_vector = 'gsl_multiroot_fsolver_dx($a)';
// Function: gsl_vector * gsl_multiroot_fdfsolver_dx (const gsl_multiroot_fdfsolver * s)
  fun gsl_multiroot_fdfsolver_dx: &gsl_multiroot_fdfsolver -> &gsl_vector = 'gsl_multiroot_fdfsolver_dx($a)';
//*****
// 35.05.00 Multidimensional-Root-Finding-Stopping-Parameters.
// Function: int gsl_multiroot_test_delta (const gsl_vector * dx, const gsl_vector * x, double epsabs, double epsrel)
  fun gsl_multiroot_test_delta: &gsl_vector * &gsl_vector * double * double -> int = 'gsl_multiroot_test_delta($a)';
// Function: int gsl_multiroot_test_residual (const gsl_vector * f, double epsabs)
  fun gsl_multiroot_test_residual: &gsl_vector * double -> int = 'gsl_multiroot_test_residual($a)';
//*****
// 35.06.00 Multidimensional-Root-Finding-Algorithms-using-Derivatives.
//*****
// 35.07.00 Multidimensional-Root-Finding-Algorithms-without-Derivatives.
//*****
// 36.00.00 Multidimensional-Minimisation.
//*****
// 36.01.00 Multidimensional-Minimisation-Overview.
//*****
// 36.02.00 Multidimensional-Minimisation-Caveats.
//*****
// 36.03.00 Multidimensional-Minimisation-Initialisation.
// Function: gsl_multimin_fdfminimizer * gsl_multimin_fdfminimizer_alloc (const gsl_multimin_fdfminimizer_type * T, size_t n)
  fun gsl_multimin_fdfminimizer_alloc: &gsl_multimin_fdfminimizer_type * size -> &gsl_multimin_fdfminimizer = 'gsl_multimin_fdfminimizer_alloc($a)';
// Function: gsl_multimin_fminimizer * gsl_multimin_fminimizer_alloc (const gsl_multimin_fminimizer_type * T, size_t n)
  fun gsl_multimin_fminimizer_alloc: &gsl_multimin_fminimizer_type * size -> &gsl_multimin_fminimizer = 'gsl_multimin_fminimizer_alloc($a)';
// Function: int gsl_multimin_fdfminimizer_set (gsl_multimin_fdfminimizer * s, gsl_multimin_function_fdf * fdf, const gsl_vector * x, double step_size, double tol)
  fun gsl_multimin_fdfminimizer_set: &gsl_multimin_fdfminimizer * &gsl_multimin_function_fdf * &gsl_vector * double * double -> int = 'gsl_multimin_fdfminimizer_set($a)';
// Function: int gsl_multimin_fminimizer_set (gsl_multimin_fminimizer * s, gsl_multimin_function * f, const gsl_vector * x, const gsl_vector * step_size)
  fun gsl_multimin_fminimizer_set: &gsl_multimin_fminimizer * &gsl_multimin_function * &gsl_vector * &gsl_vector -> int = 'gsl_multimin_fminimizer_set($a)';
// Function: void gsl_multimin_fdfminimizer_free (gsl_multimin_fdfminimizer * s)
  proc gsl_multimin_fdfminimizer_free: &gsl_multimin_fdfminimizer = 'gsl_multimin_fdfminimizer_free($a);';
// Function: void gsl_multimin_fminimizer_free (gsl_multimin_fminimizer * s)
  proc gsl_multimin_fminimizer_free: &gsl_multimin_fminimizer = 'gsl_multimin_fminimizer_free($a);';
// Function: const char * gsl_multimin_fdfminimizer_name (const gsl_multimin_fdfminimizer * s)
  fun gsl_multimin_fdfminimizer_name: &gsl_multimin_fdfminimizer -> &char = 'gsl_multimin_fdfminimizer_name($a)';
// Function: const char * gsl_multimin_fminimizer_name (const gsl_multimin_fminimizer * s)
  fun gsl_multimin_fminimizer_name: &gsl_multimin_fminimizer -> &char = 'gsl_multimin_fminimizer_name($a)';
//*****
// 36.04.00 Multidimensional-Minimisation-Providing-function-to-minimise.
//*****
// 36.05.00 Multidimensional-Minimisation-Iteration.
// Function: int gsl_multimin_fdfminimizer_iterate (gsl_multimin_fdfminimizer * s)
  fun gsl_multimin_fdfminimizer_iterate: &gsl_multimin_fdfminimizer -> int = 'gsl_multimin_fdfminimizer_iterate($a)';
// Function: int gsl_multimin_fminimizer_iterate (gsl_multimin_fminimizer * s)
  fun gsl_multimin_fminimizer_iterate: &gsl_multimin_fminimizer -> int = 'gsl_multimin_fminimizer_iterate($a)';
// Function: gsl_vector * gsl_multimin_fdfminimizer_x (const gsl_multimin_fdfminimizer * s)
  fun gsl_multimin_fdfminimizer_x: &gsl_multimin_fdfminimizer -> &gsl_vector = 'gsl_multimin_fdfminimizer_x($a)';
// Function: gsl_vector * gsl_multimin_fminimizer_x (const gsl_multimin_fminimizer * s)
  fun gsl_multimin_fminimizer_x: &gsl_multimin_fminimizer -> &gsl_vector = 'gsl_multimin_fminimizer_x($a)';
// Function: double gsl_multimin_fdfminimizer_minimum (const gsl_multimin_fdfminimizer * s)
  fun gsl_multimin_fdfminimizer_minimum: &gsl_multimin_fdfminimizer -> double = 'gsl_multimin_fdfminimizer_minimum($a)';
// Function: double gsl_multimin_fminimizer_minimum (const gsl_multimin_fminimizer * s)
  fun gsl_multimin_fminimizer_minimum: &gsl_multimin_fminimizer -> double = 'gsl_multimin_fminimizer_minimum($a)';
// Function: gsl_vector * gsl_multimin_fdfminimizer_gradient (const gsl_multimin_fdfminimizer * s)
  fun gsl_multimin_fdfminimizer_gradient: &gsl_multimin_fdfminimizer -> &gsl_vector = 'gsl_multimin_fdfminimizer_gradient($a)';
// Function: double gsl_multimin_fminimizer_size (const gsl_multimin_fminimizer * s)
  fun gsl_multimin_fminimizer_size: &gsl_multimin_fminimizer -> double = 'gsl_multimin_fminimizer_size($a)';
// Function: int gsl_multimin_fdfminimizer_restart (gsl_multimin_fdfminimizer * s)
  fun gsl_multimin_fdfminimizer_restart: &gsl_multimin_fdfminimizer -> int = 'gsl_multimin_fdfminimizer_restart($a)';
//*****
// 36.06.00 Multidimensional-Minimisation-Stopping.
// Function: int gsl_multimin_test_gradient (const gsl_vector * g, double epsabs)
  fun gsl_multimin_test_gradient: &gsl_vector * double -> int = 'gsl_multimin_test_gradient($a)';
// Function: int gsl_multimin_test_size (const double size, double epsabs)
  fun gsl_multimin_test_size: double * double -> int = 'gsl_multimin_test_size($a)';
//*****
// 36.07.00 Multidimensional-Minimisation-Algorithms-with-Derivatives.
//*****
// 36.08.00 Multidimensional-Minimisation-Algorithms-without-Derivatives.
//*****
// 37.00.00 Least-Squres-Fitting.
//*****
// 37.01.00 Least-Squres-Fitting-Overview.
//*****
// 37.02.00 Least-Squres-Fitting-Linear-Regression.
// Function: int gsl_fit_linear (const double * x, const size_t xstride, const double * y, const size_t ystride, size_t n, double * c0, double * c1, double * cov00, double * cov01, double * cov11, double * sumsq)
  fun gsl_fit_linear: &double * size * &double * size * size * &double * &double * &double * &double * &double * &double -> int = 'gsl_fit_linear($a)';
// Function: int gsl_fit_wlinear (const double * x, const size_t xstride, const double * w, const size_t wstride, const double * y, const size_t ystride, size_t n, double * c0, double * c1, double * cov00, double * cov01, double * cov11, double * chisq)
  fun gsl_fit_wlinear: &double * size * &double * size * &double * size * size * &double * &double * &double * &double * &double * &double -> int = 'gsl_fit_wlinear($a)';
// Function: int gsl_fit_linear_est (double x, double c0, double c1, double cov00, double cov01, double cov11, double * y, double * y_err)
  fun gsl_fit_linear_est: double * double * double * double * double * double * &double * &double -> int = 'gsl_fit_linear_est($a)';
//*****
// 37.03.00 Least-Squres-Fitting-Linear-fitting-without-a-constant-term.
// Function: int gsl_fit_mul (const double * x, const size_t xstride, const double * y, const size_t ystride, size_t n, double * c1, double * cov11, double * sumsq)
  fun gsl_fit_mul: &double * size * &double * size * size * &double * &double * &double -> int = 'gsl_fit_mul($a)';
// Function: int gsl_fit_wmul (const double * x, const size_t xstride, const double * w, const size_t wstride, const double * y, const size_t ystride, size_t n, double * c1, double * cov11, double * sumsq)
  fun gsl_fit_wmul: &double * size * &double * size * &double * size * size * &double * &double * &double -> int = 'gsl_fit_wmul($a)';
// Function: int gsl_fit_mul_est (double x, double c1, double cov11, double * y, double * y_err)
  fun gsl_fit_mul_est: double * double * double * &double * &double -> int = 'gsl_fit_mul_est($a)';
//*****
// 37.04.00 Multi-parameter-fitting.
// Function: gsl_multifit_linear_workspace * gsl_multifit_linear_alloc (size_t n, size_t p)
  fun gsl_multifit_linear_alloc: size * size -> &gsl_multifit_linear_workspace = 'gsl_multifit_linear_alloc($a)';
// Function: void gsl_multifit_linear_free (gsl_multifit_linear_workspace * work)
  proc gsl_multifit_linear_free: &gsl_multifit_linear_workspace = 'gsl_multifit_linear_free($a);';
// Function: int gsl_multifit_linear (const gsl_matrix * X, const gsl_vector * y, gsl_vector * c, gsl_matrix * cov, double * chisq, gsl_multifit_linear_workspace * work)
  fun gsl_multifit_linear: &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_matrix * &double * &gsl_multifit_linear_workspace -> int = 'gsl_multifit_linear($a)';
// Function: int gsl_multifit_wlinear (const gsl_matrix * X, const gsl_vector * w, const gsl_vector * y, gsl_vector * c, gsl_matrix * cov, double * chisq, gsl_multifit_linear_workspace * work)
  fun gsl_multifit_wlinear: &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_vector * &gsl_matrix * &double * &gsl_multifit_linear_workspace -> int = 'gsl_multifit_wlinear($a)';
// Function: int gsl_multifit_linear_svd (const gsl_matrix * X, const gsl_vector * y, double tol, size_t * rank, gsl_vector * c, gsl_matrix * cov, double * chisq, gsl_multifit_linear_workspace * work)
  fun gsl_multifit_linear_svd: &gsl_matrix * &gsl_vector * double * &size * &gsl_vector * &gsl_matrix * &double * &gsl_multifit_linear_workspace -> int = 'gsl_multifit_linear_svd($a)';
// Function: int gsl_multifit_wlinear_svd (const gsl_matrix * X, const gsl_vector * w, const gsl_vector * y, double tol, size_t * rank, gsl_vector * c, gsl_matrix * cov, double * chisq, gsl_multifit_linear_workspace * work)
  fun gsl_multifit_wlinear_svd: &gsl_matrix * &gsl_vector * &gsl_vector * double * &size * &gsl_vector * &gsl_matrix * &double * &gsl_multifit_linear_workspace -> int = 'gsl_multifit_wlinear_svd($a)';
// Function: int gsl_multifit_linear_usvd (const gsl_matrix * X, const gsl_vector * y, double tol, size_t * rank, gsl_vector * c, gsl_matrix * cov, double * chisq, gsl_multifit_linear_workspace * work)
  fun gsl_multifit_linear_usvd: &gsl_matrix * &gsl_vector * double * &size * &gsl_vector * &gsl_matrix * &double * &gsl_multifit_linear_workspace -> int = 'gsl_multifit_linear_usvd($a)';
// Function: int gsl_multifit_wlinear_usvd (const gsl_matrix * X, const gsl_vector * w, const gsl_vector * y, double tol, size_t * rank, gsl_vector * c, gsl_matrix * cov, double * chisq, gsl_multifit_linear_workspace * work)
  fun gsl_multifit_wlinear_usvd: &gsl_matrix * &gsl_vector * &gsl_vector * double * &size * &gsl_vector * &gsl_matrix * &double * &gsl_multifit_linear_workspace -> int = 'gsl_multifit_wlinear_usvd($a)';
// Function: int gsl_multifit_linear_est (const gsl_vector * x, const gsl_vector * c, const gsl_matrix * cov, double * y, double * y_err)
  fun gsl_multifit_linear_est: &gsl_vector * &gsl_vector * &gsl_matrix * &double * &double -> int = 'gsl_multifit_linear_est($a)';
// Function: int gsl_multifit_linear_residuals (const gsl_matrix * X, const gsl_vector * y, const gsl_vector * c, gsl_vector * r)
  fun gsl_multifit_linear_residuals: &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_vector -> int = 'gsl_multifit_linear_residuals($a)';
//*****
// 37.05.00 Robust-Linear-Regression.
// Function: gsl_multifit_robust_workspace * gsl_multifit_robust_alloc (const gsl_multifit_robust_type * T, const size_t n, const size_t p)
  fun gsl_multifit_robust_alloc: &gsl_multifit_robust_type * size * size -> &gsl_multifit_robust_workspace = 'gsl_multifit_robust_alloc($a)';
// Function: void gsl_multifit_robust_free (gsl_multifit_robust_workspace * w)
  proc gsl_multifit_robust_free: &gsl_multifit_robust_workspace = 'gsl_multifit_robust_free($a);';
// Function: const char * gsl_multifit_robust_name (const gsl_multifit_robust_workspace * w)
  fun gsl_multifit_robust_name: &gsl_multifit_robust_workspace -> &char = 'gsl_multifit_robust_name($a)';
// Function: int gsl_multifit_robust_tune (const double tune, gsl_multifit_robust_workspace * w)
  fun gsl_multifit_robust_tune: double * &gsl_multifit_robust_workspace -> int = 'gsl_multifit_robust_tune($a)';
// Function: int gsl_multifit_robust (const gsl_matrix * X, const gsl_vector * y, gsl_vector * c, gsl_matrix * cov, gsl_multifit_robust_workspace * w)
  fun gsl_multifit_robust: &gsl_matrix * &gsl_vector * &gsl_vector * &gsl_matrix * &gsl_multifit_robust_workspace -> int = 'gsl_multifit_robust($a)';
// Function: int gsl_multifit_robust_est (const gsl_vector * x, const gsl_vector * c, const gsl_matrix * cov, double * y, double * y_err)
  fun gsl_multifit_robust_est: &gsl_vector * &gsl_vector * &gsl_matrix * &double * &double -> int = 'gsl_multifit_robust_est($a)';
// Function: gsl_multifit_robust_stats gsl_multifit_robust_statistics (const gsl_multifit_robust_workspace * w)
  fun gsl_multifit_robust_statistics: &gsl_multifit_robust_workspace -> gsl_multifit_robust_stats = 'gsl_multifit_robust_statistics($a)';
//*****
// 38.00.00 Nonlinear-Least-Squares-Fitting.
//*****
// 38.01.00 Nonlinear-Least-Squares-Fitting-Overview.
//*****
// 38.02.00 Nonlinear-Least-Squares-Fitting-Initialisation.
// Function: gsl_multifit_fsolver * gsl_multifit_fsolver_alloc (const gsl_multifit_fsolver_type * T, size_t n, size_t p)
  fun gsl_multifit_fsolver_alloc: &gsl_multifit_fsolver_type * size * size -> &gsl_multifit_fsolver = 'gsl_multifit_fsolver_alloc($a)';
// Function: gsl_multifit_fdfsolver * gsl_multifit_fdfsolver_alloc (const gsl_multifit_fdfsolver_type * T, size_t n, size_t p)
  fun gsl_multifit_fdfsolver_alloc: &gsl_multifit_fdfsolver_type * size * size -> &gsl_multifit_fdfsolver = 'gsl_multifit_fdfsolver_alloc($a)';
// Function: int gsl_multifit_fsolver_set (gsl_multifit_fsolver * s, gsl_multifit_function * f, const gsl_vector * x)
  fun gsl_multifit_fsolver_set: &gsl_multifit_fsolver * &gsl_multifit_function * &gsl_vector -> int = 'gsl_multifit_fsolver_set($a)';
// Function: int gsl_multifit_fdfsolver_set (gsl_multifit_fdfsolver * s, gsl_multifit_function_fdf * fdf, const gsl_vector * x)
  fun gsl_multifit_fdfsolver_set: &gsl_multifit_fdfsolver * &gsl_multifit_function_fdf * &gsl_vector -> int = 'gsl_multifit_fdfsolver_set($a)';
// Function: void gsl_multifit_fsolver_free (gsl_multifit_fsolver * s)
  proc gsl_multifit_fsolver_free: &gsl_multifit_fsolver = 'gsl_multifit_fsolver_free($a);';
// Function: void gsl_multifit_fdfsolver_free (gsl_multifit_fdfsolver * s)
  proc gsl_multifit_fdfsolver_free: &gsl_multifit_fdfsolver = 'gsl_multifit_fdfsolver_free($a);';
// Function: const char * gsl_multifit_fsolver_name (const gsl_multifit_fsolver * s)
  fun gsl_multifit_fsolver_name: &gsl_multifit_fsolver -> &char = 'gsl_multifit_fsolver_name($a)';
// Function: const char * gsl_multifit_fdfsolver_name (const gsl_multifit_fdfsolver * s)
  fun gsl_multifit_fdfsolver_name: &gsl_multifit_fdfsolver -> &char = 'gsl_multifit_fdfsolver_name($a)';
//*****
// 38.03.00 Nonlinear-Least-Squares-Fitting-Providing-the-Functon-to-be-Minimised.
//*****
// 38.04.00 Nonlinear-Least-Squares-Fitting-Finite-Difference-Jacobian.
// Function: int gsl_multifit_fdfsolver_dif_df (const gsl_vector * x, gsl_multifit_function_fdf * fdf, const gsl_vector * f, gsl_matrix * J)
  fun gsl_multifit_fdfsolver_dif_df: &gsl_vector * &gsl_multifit_function_fdf * &gsl_vector * &gsl_matrix -> int = 'gsl_multifit_fdfsolver_dif_df($a)';
// Function: int gsl_multifit_fdfsolver_dif_fdf (const gsl_vector * x, gsl_multifit_function_fdf * fdf, gsl_vector * f, gsl_matrix * J)
  fun gsl_multifit_fdfsolver_dif_fdf: &gsl_vector * &gsl_multifit_function_fdf * &gsl_vector * &gsl_matrix -> int = 'gsl_multifit_fdfsolver_dif_fdf($a)';
//*****
// 38.05.00 Nonlinear-Least-Squares-Fitting-Iteration.
// Function: int gsl_multifit_fsolver_iterate (gsl_multifit_fsolver * s)
  fun gsl_multifit_fsolver_iterate: &gsl_multifit_fsolver -> int = 'gsl_multifit_fsolver_iterate($a)';
// Function: int gsl_multifit_fdfsolver_iterate (gsl_multifit_fdfsolver * s)
  fun gsl_multifit_fdfsolver_iterate: &gsl_multifit_fdfsolver -> int = 'gsl_multifit_fdfsolver_iterate($a)';
// Function: gsl_vector * gsl_multifit_fsolver_position (const gsl_multifit_fsolver * s)
  fun gsl_multifit_fsolver_position: &gsl_multifit_fsolver -> &gsl_vector = 'gsl_multifit_fsolver_position($a)';
// Function: gsl_vector * gsl_multifit_fdfsolver_position (const gsl_multifit_fdfsolver * s)
  fun gsl_multifit_fdfsolver_position: &gsl_multifit_fdfsolver -> &gsl_vector = 'gsl_multifit_fdfsolver_position($a)';
//*****
// 38.06.00 Nonlinear-Least-Squares-Fitting-Stopping.
// Function: int gsl_multifit_test_delta (const gsl_vector * dx, const gsl_vector * x, double epsabs, double epsrel)
  fun gsl_multifit_test_delta: &gsl_vector * &gsl_vector * double * double -> int = 'gsl_multifit_test_delta($a)';
// Function: int gsl_multifit_test_gradient (const gsl_vector * g, double epsabs)
  fun gsl_multifit_test_gradient: &gsl_vector * double -> int = 'gsl_multifit_test_gradient($a)';
// Function: int gsl_multifit_gradient (const gsl_matrix * J, const gsl_vector * f, gsl_vector * g)
  fun gsl_multifit_gradient: &gsl_matrix * &gsl_vector * &gsl_vector -> int = 'gsl_multifit_gradient($a)';
//*****
// 38.07.00 Nonlinear-Least-Squares-Fitting-Driver.
// Function: int gsl_multifit_fsolver_driver (gsl_multifit_fsolver * s, const size_t maxiter, const double epsabs, const double epsrel)
  fun gsl_multifit_fsolver_driver: &gsl_multifit_fsolver * size * double * double -> int = 'gsl_multifit_fsolver_driver($a)';
// Function: int gsl_multifit_fdfsolver_driver (gsl_multifit_fdfsolver * s, const size_t maxiter, const double epsabs, const double epsrel)
  fun gsl_multifit_fdfsolver_driver: &gsl_multifit_fdfsolver * size * double * double -> int = 'gsl_multifit_fdfsolver_driver($a)';
//*****
// 38.08.00 Nonlinear-Least-Squares-Fitting-Minimisation-using-Derivatives.
//*****
// 38.09.00 Nonlinear-Least-Squares-Fitting-Minimisation-without-Derivatives.
//*****
// 38.10.00 Nonlinear-Least-Squares-Fitting-Computing-the-covariance-matrix-of-best-fit-parameters.
// Function: int gsl_multifit_covar (const gsl_matrix * J, double epsrel, gsl_matrix * covar)
  fun gsl_multifit_covar: &gsl_matrix * double * &gsl_matrix -> int = 'gsl_multifit_covar($a)';
//*****
// 39.00.00 Basis-Splines.
//*****
// 39.01.00 Basis-Splines-Overview.
//*****
// 39.02.00 Basis-Splines-Initialisation.
// Function: gsl_bspline_workspace * gsl_bspline_alloc (const size_t k, const size_t nbreak)
  fun gsl_bspline_alloc: size * size -> &gsl_bspline_workspace = 'gsl_bspline_alloc($a)';
// Function: void gsl_bspline_free (gsl_bspline_workspace * w)
  proc gsl_bspline_free: &gsl_bspline_workspace = 'gsl_bspline_free($a);';
// Function: gsl_bspline_deriv_workspace * gsl_bspline_deriv_alloc (const size_t k)
  fun gsl_bspline_deriv_alloc: size -> &gsl_bspline_deriv_workspace = 'gsl_bspline_deriv_alloc($a)';
// Function: void gsl_bspline_deriv_free (gsl_bspline_deriv_workspace * w)
  proc gsl_bspline_deriv_free: &gsl_bspline_deriv_workspace = 'gsl_bspline_deriv_free($a);';
//*****
// 39.03.00 Basis-Splines-Constructing-the-knots-vector.
// Function: int gsl_bspline_knots (const gsl_vector * breakpts, gsl_bspline_workspace * w)
  fun gsl_bspline_knots: &gsl_vector * &gsl_bspline_workspace -> int = 'gsl_bspline_knots($a)';
// Function: int gsl_bspline_knots_uniform (const double a, const double b, gsl_bspline_workspace * w)
  fun gsl_bspline_knots_uniform: double * double * &gsl_bspline_workspace -> int = 'gsl_bspline_knots_uniform($a)';
//*****
// 39.04.00 Basis-Splines-Evaluation.
// Function: int gsl_bspline_eval (const double x, gsl_vector * B, gsl_bspline_workspace * w)
  fun gsl_bspline_eval: double * &gsl_vector * &gsl_bspline_workspace -> int = 'gsl_bspline_eval($a)';
// Function: int gsl_bspline_eval_nonzero (const double x, gsl_vector * Bk, size_t * istart, size_t * iend, gsl_bspline_workspace * w)
  fun gsl_bspline_eval_nonzero: double * &gsl_vector * &size * &size * &gsl_bspline_workspace -> int = 'gsl_bspline_eval_nonzero($a)';
// Function: size_t gsl_bspline_ncoeffs (gsl_bspline_workspace * w)
  fun gsl_bspline_ncoeffs: &gsl_bspline_workspace -> size = 'gsl_bspline_ncoeffs($a)';
//*****
// 39.05.00 Basis-Splines-Evaluation-Derivatives.
// Function: int gsl_bspline_deriv_eval (const double x, const size_t nderiv, gsl_matrix * dB, gsl_bspline_workspace * w, gsl_bspline_deriv_workspace * dw)
  fun gsl_bspline_deriv_eval: double * size * &gsl_matrix * &gsl_bspline_workspace * &gsl_bspline_deriv_workspace -> int = 'gsl_bspline_deriv_eval($a)';
// Function: int gsl_bspline_deriv_eval_nonzero (const double x, const size_t nderiv, gsl_matrix * dB, size_t * istart, size_t * iend, gsl_bspline_workspace * w, gsl_bspline_deriv_workspace * dw)
  fun gsl_bspline_deriv_eval_nonzero: double * size * &gsl_matrix * &size * &size * &gsl_bspline_workspace * &gsl_bspline_deriv_workspace -> int = 'gsl_bspline_deriv_eval_nonzero($a)';
//*****
// 39.06.00 Basis-Splines-Greville-abscissae.
// Function: double gsl_bspline_greville_abscissa (size_t i, gsl_bspline_workspace *w);
  fun gsl_bspline_greville_abscissa: size * gsl_bspline_workspace -> double = 'gsl_bspline_greville_abscissa($a)';
//*****
// 40.00.00 Physical-Constants.
//*****
// 40.01.00 Physical-Constants-Fundamental.
//*****
// 40.02.00 Physical-Constants-Astronomy.
//*****
// 40.03.00 Physical-Constants-Nuclear.
//*****
// 40.04.00 Physical-Constants-Time.
//*****
// 40.05.00 Physical-Constants-Imperial.
//*****
// 40.06.00 Physical-Constants-Nautical.
//*****
// 40.07.00 Physical-Constants-Printer.
//*****
// 40.08.00 Physical-Constants-Spatial.
//*****
// 40.09.00 Physical-Constants-Mass.
//*****
// 40.10.00 Physical-Constants-Thermal-Energy.
//*****
// 40.11.00 Physical-Constants-Pressure.
//*****
// 40.12.00 Physical-Constants-Viscosity.
//*****
// 40.13.00 Physical-Constants-Light.
//*****
// 40.14.00 Physical-Constants-Radioactivity.
//*****
// 40.15.00 Physical-Constants-Force.
//*****
// 40.16.00 Physical-Constants-Prefixes.
//*****
// 41.00.00 IEEE-floats.
//*****
// 41.01.00 IEEE-floats-representation.
// Function: void gsl_ieee_fprintf_float (FILE * stream, const float * x)
  proc gsl_ieee_fprintf_float: &FILE * &float = 'gsl_ieee_fprintf_float($a);';
// Function: void gsl_ieee_fprintf_double (FILE * stream, const double * x)
  proc gsl_ieee_fprintf_double: &FILE * &double = 'gsl_ieee_fprintf_double($a);';
// Function: void gsl_ieee_printf_float (const float * x)
  proc gsl_ieee_printf_float: &float = 'gsl_ieee_printf_float($a);';
// Function: void gsl_ieee_printf_double (const double * x)
  proc gsl_ieee_printf_double: &double = 'gsl_ieee_printf_double($a);';
//*****
// 41.02.00 IEEE-floats-environment.
// Function: void gsl_ieee_env_setup ()
  proc gsl_ieee_env_setup: unit = 'gsl_ieee_env_setup($a);';

CBLAS interface

To be moved, since it doesn’t really belong inside GSL.

//[cblas.flx]

//*****
// D .00.00 GSL-CBLAS.
//*****
// D .01.00 GSL-CBLAS-Level-1.
// Function: float cblas_sdsdot (const int N, const float alpha, const float * x, const int incx, const float * y, const int incy)
  fun cblas_sdsdot: int * float * &float * int * &float * int -> float = 'cblas_sdsdot($a)';
// Function: double cblas_dsdot (const int N, const float * x, const int incx, const float * y, const int incy)
  fun cblas_dsdot: int * &float * int * &float * int -> double = 'cblas_dsdot($a)';
// Function: float cblas_sdot (const int N, const float * x, const int incx, const float * y, const int incy)
  fun cblas_sdot: int * &float * int * &float * int -> float = 'cblas_sdot($a)';
// Function: double cblas_ddot (const int N, const double * x, const int incx, const double * y, const int incy)
  fun cblas_ddot: int * &double * int * &double * int -> double = 'cblas_ddot($a)';
// Function: void cblas_cdotu_sub (const int N, const void * x, const int incx, const void * y, const int incy, void * dotu)
  proc cblas_cdotu_sub: int * &void * int * &void * int * &void = 'cblas_cdotu_sub($a);';
// Function: void cblas_cdotc_sub (const int N, const void * x, const int incx, const void * y, const int incy, void * dotc)
  proc cblas_cdotc_sub: int * &void * int * &void * int * &void = 'cblas_cdotc_sub($a);';
// Function: void cblas_zdotu_sub (const int N, const void * x, const int incx, const void * y, const int incy, void * dotu)
  proc cblas_zdotu_sub: int * &void * int * &void * int * &void = 'cblas_zdotu_sub($a);';
// Function: void cblas_zdotc_sub (const int N, const void * x, const int incx, const void * y, const int incy, void * dotc)
  proc cblas_zdotc_sub: int * &void * int * &void * int * &void = 'cblas_zdotc_sub($a);';
// Function: float cblas_snrm2 (const int N, const float * x, const int incx)
  fun cblas_snrm2: int * &float * int -> float = 'cblas_snrm2($a)';
// Function: float cblas_sasum (const int N, const float * x, const int incx)
  fun cblas_sasum: int * &float * int -> float = 'cblas_sasum($a)';
// Function: double cblas_dnrm2 (const int N, const double * x, const int incx)
  fun cblas_dnrm2: int * &double * int -> double = 'cblas_dnrm2($a)';
// Function: double cblas_dasum (const int N, const double * x, const int incx)
  fun cblas_dasum: int * &double * int -> double = 'cblas_dasum($a)';
// Function: float cblas_scnrm2 (const int N, const void * x, const int incx)
  fun cblas_scnrm2: int * &void * int -> float = 'cblas_scnrm2($a)';
// Function: float cblas_scasum (const int N, const void * x, const int incx)
  fun cblas_scasum: int * &void * int -> float = 'cblas_scasum($a)';
// Function: double cblas_dznrm2 (const int N, const void * x, const int incx)
  fun cblas_dznrm2: int * &void * int -> double = 'cblas_dznrm2($a)';
// Function: double cblas_dzasum (const int N, const void * x, const int incx)
  fun cblas_dzasum: int * &void * int -> double = 'cblas_dzasum($a)';
// Function: CBLAS_INDEX cblas_isamax (const int N, const float * x, const int incx)
  fun cblas_isamax: int * &float * int -> CBLAS_INDEX = 'cblas_isamax($a)';
// Function: CBLAS_INDEX cblas_idamax (const int N, const double * x, const int incx)
  fun cblas_idamax: int * &double * int -> CBLAS_INDEX = 'cblas_idamax($a)';
// Function: CBLAS_INDEX cblas_icamax (const int N, const void * x, const int incx)
  fun cblas_icamax: int * &void * int -> CBLAS_INDEX = 'cblas_icamax($a)';
// Function: CBLAS_INDEX cblas_izamax (const int N, const void * x, const int incx)
  fun cblas_izamax: int * &void * int -> CBLAS_INDEX = 'cblas_izamax($a)';
// Function: void cblas_sswap (const int N, float * x, const int incx, float * y, const int incy)
  proc cblas_sswap: int * &float * int * &float * int = 'cblas_sswap($a);';
// Function: void cblas_scopy (const int N, const float * x, const int incx, float * y, const int incy)
  proc cblas_scopy: int * &float * int * &float * int = 'cblas_scopy($a);';
// Function: void cblas_saxpy (const int N, const float alpha, const float * x, const int incx, float * y, const int incy)
  proc cblas_saxpy: int * float * &float * int * &float * int = 'cblas_saxpy($a);';
// Function: void cblas_dswap (const int N, double * x, const int incx, double * y, const int incy)
  proc cblas_dswap: int * &double * int * &double * int = 'cblas_dswap($a);';
// Function: void cblas_dcopy (const int N, const double * x, const int incx, double * y, const int incy)
  proc cblas_dcopy: int * &double * int * &double * int = 'cblas_dcopy($a);';
// Function: void cblas_daxpy (const int N, const double alpha, const double * x, const int incx, double * y, const int incy)
  proc cblas_daxpy: int * double * &double * int * &double * int = 'cblas_daxpy($a);';
// Function: void cblas_cswap (const int N, void * x, const int incx, void * y, const int incy)
  proc cblas_cswap: int * &void * int * &void * int = 'cblas_cswap($a);';
// Function: void cblas_ccopy (const int N, const void * x, const int incx, void * y, const int incy)
  proc cblas_ccopy: int * &void * int * &void * int = 'cblas_ccopy($a);';
// Function: void cblas_caxpy (const int N, const void * alpha, const void * x, const int incx, void * y, const int incy)
  proc cblas_caxpy: int * &void * &void * int * &void * int = 'cblas_caxpy($a);';
// Function: void cblas_zswap (const int N, void * x, const int incx, void * y, const int incy)
  proc cblas_zswap: int * &void * int * &void * int = 'cblas_zswap($a);';
// Function: void cblas_zcopy (const int N, const void * x, const int incx, void * y, const int incy)
  proc cblas_zcopy: int * &void * int * &void * int = 'cblas_zcopy($a);';
// Function: void cblas_zaxpy (const int N, const void * alpha, const void * x, const int incx, void * y, const int incy)
  proc cblas_zaxpy: int * &void * &void * int * &void * int = 'cblas_zaxpy($a);';
// Function: void cblas_srotg (float * a, float * b, float * c, float * s)
  proc cblas_srotg: &float * &float * &float * &float = 'cblas_srotg($a);';
// Function: void cblas_srotmg (float * d1, float * d2, float * b1, const float b2, float * P)
  proc cblas_srotmg: &float * &float * &float * float * &float = 'cblas_srotmg($a);';
// Function: void cblas_srot (const int N, float * x, const int incx, float * y, const int incy, const float c, const float s)
  proc cblas_srot: int * &float * int * &float * int * float * float = 'cblas_srot($a);';
// Function: void cblas_srotm (const int N, float * x, const int incx, float * y, const int incy, const float * P)
  proc cblas_srotm: int * &float * int * &float * int * &float = 'cblas_srotm($a);';
// Function: void cblas_drotg (double * a, double * b, double * c, double * s)
  proc cblas_drotg: &double * &double * &double * &double = 'cblas_drotg($a);';
// Function: void cblas_drotmg (double * d1, double * d2, double * b1, const double b2, double * P)
  proc cblas_drotmg: &double * &double * &double * double * &double = 'cblas_drotmg($a);';
// Function: void cblas_drot (const int N, double * x, const int incx, double * y, const int incy, const double c, const double s)
  proc cblas_drot: int * &double * int * &double * int * double * double = 'cblas_drot($a);';
// Function: void cblas_drotm (const int N, double * x, const int incx, double * y, const int incy, const double * P)
  proc cblas_drotm: int * &double * int * &double * int * &double = 'cblas_drotm($a);';
// Function: void cblas_sscal (const int N, const float alpha, float * x, const int incx)
  proc cblas_sscal: int * float * &float * int = 'cblas_sscal($a);';
// Function: void cblas_dscal (const int N, const double alpha, double * x, const int incx)
  proc cblas_dscal: int * double * &double * int = 'cblas_dscal($a);';
// Function: void cblas_cscal (const int N, const void * alpha, void * x, const int incx)
  proc cblas_cscal: int * &void * &void * int = 'cblas_cscal($a);';
// Function: void cblas_zscal (const int N, const void * alpha, void * x, const int incx)
  proc cblas_zscal: int * &void * &void * int = 'cblas_zscal($a);';
// Function: void cblas_csscal (const int N, const float alpha, void * x, const int incx)
  proc cblas_csscal: int * float * &void * int = 'cblas_csscal($a);';
// Function: void cblas_zdscal (const int N, const double alpha, void * x, const int incx)
  proc cblas_zdscal: int * double * &void * int = 'cblas_zdscal($a);';
//*****
// D .02.00 GSL-CBLAS-Level-2.
// Function: void cblas_sgemv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const float alpha, const float * A, const int lda, const float * x, const int incx, const float beta, float * y, const int incy)
  proc cblas_sgemv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * float * &float * int * &float * int * float * &float * int = 'cblas_sgemv($a);';
// Function: void cblas_sgbmv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const int KL, const int KU, const float alpha, const float * A, const int lda, const float * x, const int incx, const float beta, float * y, const int incy)
  proc cblas_sgbmv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * int * int * float * &float * int * &float * int * float * &float * int = 'cblas_sgbmv($a);';
// Function: void cblas_strmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const float * A, const int lda, float * x, const int incx)
  proc cblas_strmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &float * int * &float * int = 'cblas_strmv($a);';
// Function: void cblas_stbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const float * A, const int lda, float * x, const int incx)
  proc cblas_stbmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &float * int * &float * int = 'cblas_stbmv($a);';
// Function: void cblas_stpmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const float * Ap, float * x, const int incx)
  proc cblas_stpmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &float * &float * int = 'cblas_stpmv($a);';
// Function: void cblas_strsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const float * A, const int lda, float * x, const int incx)
  proc cblas_strsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &float * int * &float * int = 'cblas_strsv($a);';
// Function: void cblas_stbsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const float * A, const int lda, float * x, const int incx)
  proc cblas_stbsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &float * int * &float * int = 'cblas_stbsv($a);';
// Function: void cblas_stpsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const float * Ap, float * x, const int incx)
  proc cblas_stpsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &float * &float * int = 'cblas_stpsv($a);';
// Function: void cblas_dgemv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const double alpha, const double * A, const int lda, const double * x, const int incx, const double beta, double * y, const int incy)
  proc cblas_dgemv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * double * &double * int * &double * int * double * &double * int = 'cblas_dgemv($a);';
// Function: void cblas_dgbmv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const int KL, const int KU, const double alpha, const double * A, const int lda, const double * x, const int incx, const double beta, double * y, const int incy)
  proc cblas_dgbmv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * int * int * double * &double * int * &double * int * double * &double * int = 'cblas_dgbmv($a);';
// Function: void cblas_dtrmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const double * A, const int lda, double * x, const int incx)
  proc cblas_dtrmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &double * int * &double * int = 'cblas_dtrmv($a);';
// Function: void cblas_dtbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const double * A, const int lda, double * x, const int incx)
  proc cblas_dtbmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &double * int * &double * int = 'cblas_dtbmv($a);';
// Function: void cblas_dtpmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const double * Ap, double * x, const int incx)
  proc cblas_dtpmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &double * &double * int = 'cblas_dtpmv($a);';
// Function: void cblas_dtrsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const double * A, const int lda, double * x, const int incx)
  proc cblas_dtrsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &double * int * &double * int = 'cblas_dtrsv($a);';
// Function: void cblas_dtbsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const double * A, const int lda, double * x, const int incx)
  proc cblas_dtbsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &double * int * &double * int = 'cblas_dtbsv($a);';
// Function: void cblas_dtpsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const double * Ap, double * x, const int incx)
  proc cblas_dtpsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &double * &double * int = 'cblas_dtpsv($a);';
// Function: void cblas_cgemv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_cgemv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_cgemv($a);';
// Function: void cblas_cgbmv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const int KL, const int KU, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_cgbmv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_cgbmv($a);';
// Function: void cblas_ctrmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * A, const int lda, void * x, const int incx)
  proc cblas_ctrmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * int * &void * int = 'cblas_ctrmv($a);';
// Function: void cblas_ctbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const void * A, const int lda, void * x, const int incx)
  proc cblas_ctbmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * int * &void * int = 'cblas_ctbmv($a);';
// Function: void cblas_ctpmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * Ap, void * x, const int incx)
  proc cblas_ctpmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * &void * int = 'cblas_ctpmv($a);';
// Function: void cblas_ctrsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * A, const int lda, void * x, const int incx)
  proc cblas_ctrsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * int * &void * int = 'cblas_ctrsv($a);';
// Function: void cblas_ctbsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const void * A, const int lda, void * x, const int incx)
  proc cblas_ctbsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * int * &void * int = 'cblas_ctbsv($a);';
// Function: void cblas_ctpsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * Ap, void * x, const int incx)
  proc cblas_ctpsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * &void * int = 'cblas_ctpsv($a);';
// Function: void cblas_zgemv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_zgemv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zgemv($a);';
// Function: void cblas_zgbmv (const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE TransA, const int M, const int N, const int KL, const int KU, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_zgbmv: CBLAS_ORDER * CBLAS_TRANSPOSE * int * int * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zgbmv($a);';
// Function: void cblas_ztrmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * A, const int lda, void * x, const int incx)
  proc cblas_ztrmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * int * &void * int = 'cblas_ztrmv($a);';
// Function: void cblas_ztbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const void * A, const int lda, void * x, const int incx)
  proc cblas_ztbmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * int * &void * int = 'cblas_ztbmv($a);';
// Function: void cblas_ztpmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * Ap, void * x, const int incx)
  proc cblas_ztpmv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * &void * int = 'cblas_ztpmv($a);';
// Function: void cblas_ztrsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * A, const int lda, void * x, const int incx)
  proc cblas_ztrsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * int * &void * int = 'cblas_ztrsv($a);';
// Function: void cblas_ztbsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const int K, const void * A, const int lda, void * x, const int incx)
  proc cblas_ztbsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * int * &void * int = 'cblas_ztbsv($a);';
// Function: void cblas_ztpsv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int N, const void * Ap, void * x, const int incx)
  proc cblas_ztpsv: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * &void * &void * int = 'cblas_ztpsv($a);';
// Function: void cblas_ssymv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const float * A, const int lda, const float * x, const int incx, const float beta, float * y, const int incy)
  proc cblas_ssymv: CBLAS_ORDER * CBLAS_UPLO * int * float * &float * int * &float * int * float * &float * int = 'cblas_ssymv($a);';
// Function: void cblas_ssbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const int K, const float alpha, const float * A, const int lda, const float * x, const int incx, const float beta, float * y, const int incy)
  proc cblas_ssbmv: CBLAS_ORDER * CBLAS_UPLO * int * int * float * &float * int * &float * int * float * &float * int = 'cblas_ssbmv($a);';
// Function: void cblas_sspmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const float * Ap, const float * x, const int incx, const float beta, float * y, const int incy)
  proc cblas_sspmv: CBLAS_ORDER * CBLAS_UPLO * int * float * &float * &float * int * float * &float * int = 'cblas_sspmv($a);';
// Function: void cblas_sger (const enum CBLAS_ORDER order, const int M, const int N, const float alpha, const float * x, const int incx, const float * y, const int incy, float * A, const int lda)
  proc cblas_sger: CBLAS_ORDER * int * int * float * &float * int * &float * int * &float * int = 'cblas_sger($a);';
// Function: void cblas_ssyr (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const float * x, const int incx, float * A, const int lda)
  proc cblas_ssyr: CBLAS_ORDER * CBLAS_UPLO * int * float * &float * int * &float * int = 'cblas_ssyr($a);';
// Function: void cblas_sspr (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const float * x, const int incx, float * Ap)
  proc cblas_sspr: CBLAS_ORDER * CBLAS_UPLO * int * float * &float * int * &float = 'cblas_sspr($a);';
// Function: void cblas_ssyr2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const float * x, const int incx, const float * y, const int incy, float * A, const int lda)
  proc cblas_ssyr2: CBLAS_ORDER * CBLAS_UPLO * int * float * &float * int * &float * int * &float * int = 'cblas_ssyr2($a);';
// Function: void cblas_sspr2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const float * x, const int incx, const float * y, const int incy, float * A)
  proc cblas_sspr2: CBLAS_ORDER * CBLAS_UPLO * int * float * &float * int * &float * int * &float = 'cblas_sspr2($a);';
// Function: void cblas_dsymv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const double * A, const int lda, const double * x, const int incx, const double beta, double * y, const int incy)
  proc cblas_dsymv: CBLAS_ORDER * CBLAS_UPLO * int * double * &double * int * &double * int * double * &double * int = 'cblas_dsymv($a);';
// Function: void cblas_dsbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const int K, const double alpha, const double * A, const int lda, const double * x, const int incx, const double beta, double * y, const int incy)
  proc cblas_dsbmv: CBLAS_ORDER * CBLAS_UPLO * int * int * double * &double * int * &double * int * double * &double * int = 'cblas_dsbmv($a);';
// Function: void cblas_dspmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const double * Ap, const double * x, const int incx, const double beta, double * y, const int incy)
  proc cblas_dspmv: CBLAS_ORDER * CBLAS_UPLO * int * double * &double * &double * int * double * &double * int = 'cblas_dspmv($a);';
// Function: void cblas_dger (const enum CBLAS_ORDER order, const int M, const int N, const double alpha, const double * x, const int incx, const double * y, const int incy, double * A, const int lda)
  proc cblas_dger: CBLAS_ORDER * int * int * double * &double * int * &double * int * &double * int = 'cblas_dger($a);';
// Function: void cblas_dsyr (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const double * x, const int incx, double * A, const int lda)
  proc cblas_dsyr: CBLAS_ORDER * CBLAS_UPLO * int * double * &double * int * &double * int = 'cblas_dsyr($a);';
// Function: void cblas_dspr (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const double * x, const int incx, double * Ap)
  proc cblas_dspr: CBLAS_ORDER * CBLAS_UPLO * int * double * &double * int * &double = 'cblas_dspr($a);';
// Function: void cblas_dsyr2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const double * x, const int incx, const double * y, const int incy, double * A, const int lda)
  proc cblas_dsyr2: CBLAS_ORDER * CBLAS_UPLO * int * double * &double * int * &double * int * &double * int = 'cblas_dsyr2($a);';
// Function: void cblas_dspr2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const double * x, const int incx, const double * y, const int incy, double * A)
  proc cblas_dspr2: CBLAS_ORDER * CBLAS_UPLO * int * double * &double * int * &double * int * &double = 'cblas_dspr2($a);';
// Function: void cblas_chemv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_chemv: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_chemv($a);';
// Function: void cblas_chbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const int K, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_chbmv: CBLAS_ORDER * CBLAS_UPLO * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_chbmv($a);';
// Function: void cblas_chpmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * Ap, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_chpmv: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * &void * int * &void * &void * int = 'cblas_chpmv($a);';
// Function: void cblas_cgeru (const enum CBLAS_ORDER order, const int M, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * A, const int lda)
  proc cblas_cgeru: CBLAS_ORDER * int * int * &void * &void * int * &void * int * &void * int = 'cblas_cgeru($a);';
// Function: void cblas_cgerc (const enum CBLAS_ORDER order, const int M, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * A, const int lda)
  proc cblas_cgerc: CBLAS_ORDER * int * int * &void * &void * int * &void * int * &void * int = 'cblas_cgerc($a);';
// Function: void cblas_cher (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const void * x, const int incx, void * A, const int lda)
  proc cblas_cher: CBLAS_ORDER * CBLAS_UPLO * int * float * &void * int * &void * int = 'cblas_cher($a);';
// Function: void cblas_chpr (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const float alpha, const void * x, const int incx, void * A)
  proc cblas_chpr: CBLAS_ORDER * CBLAS_UPLO * int * float * &void * int * &void = 'cblas_chpr($a);';
// Function: void cblas_cher2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * A, const int lda)
  proc cblas_cher2: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * int * &void * int * &void * int = 'cblas_cher2($a);';
// Function: void cblas_chpr2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * Ap)
  proc cblas_chpr2: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * int * &void * int * &void = 'cblas_chpr2($a);';
// Function: void cblas_zhemv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_zhemv: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zhemv($a);';
// Function: void cblas_zhbmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const int K, const void * alpha, const void * A, const int lda, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_zhbmv: CBLAS_ORDER * CBLAS_UPLO * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zhbmv($a);';
// Function: void cblas_zhpmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * Ap, const void * x, const int incx, const void * beta, void * y, const int incy)
  proc cblas_zhpmv: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * &void * int * &void * &void * int = 'cblas_zhpmv($a);';
// Function: void cblas_zgeru (const enum CBLAS_ORDER order, const int M, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * A, const int lda)
  proc cblas_zgeru: CBLAS_ORDER * int * int * &void * &void * int * &void * int * &void * int = 'cblas_zgeru($a);';
// Function: void cblas_zgerc (const enum CBLAS_ORDER order, const int M, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * A, const int lda)
  proc cblas_zgerc: CBLAS_ORDER * int * int * &void * &void * int * &void * int * &void * int = 'cblas_zgerc($a);';
// Function: void cblas_zher (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const void * x, const int incx, void * A, const int lda)
  proc cblas_zher: CBLAS_ORDER * CBLAS_UPLO * int * double * &void * int * &void * int = 'cblas_zher($a);';
// Function: void cblas_zhpr (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const void * x, const int incx, void * A)
  proc cblas_zhpr: CBLAS_ORDER * CBLAS_UPLO * int * double * &void * int * &void = 'cblas_zhpr($a);';
// Function: void cblas_zher2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * A, const int lda)
  proc cblas_zher2: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * int * &void * int * &void * int = 'cblas_zher2($a);';
// Function: void cblas_zhpr2 (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N, const void * alpha, const void * x, const int incx, const void * y, const int incy, void * Ap)
  proc cblas_zhpr2: CBLAS_ORDER * CBLAS_UPLO * int * &void * &void * int * &void * int * &void = 'cblas_zhpr2($a);';
//*****
// D .03.00 GSL-CBLAS-Level-3.
// Function: void cblas_sgemm (const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K, const float alpha, const float * A, const int lda, const float * B, const int ldb, const float beta, float * C, const int ldc)
  proc cblas_sgemm: CBLAS_ORDER * CBLAS_TRANSPOSE * CBLAS_TRANSPOSE * int * int * int * float * &float * int * &float * int * float * &float * int = 'cblas_sgemm($a);';
// Function: void cblas_ssymm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const int M, const int N, const float alpha, const float * A, const int lda, const float * B, const int ldb, const float beta, float * C, const int ldc)
  proc cblas_ssymm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * int * int * float * &float * int * &float * int * float * &float * int = 'cblas_ssymm($a);';
// Function: void cblas_ssyrk (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const float alpha, const float * A, const int lda, const float beta, float * C, const int ldc)
  proc cblas_ssyrk: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * float * &float * int * float * &float * int = 'cblas_ssyrk($a);';
// Function: void cblas_ssyr2k (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const float alpha, const float * A, const int lda, const float * B, const int ldb, const float beta, float * C, const int ldc)
  proc cblas_ssyr2k: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * float * &float * int * &float * int * float * &float * int = 'cblas_ssyr2k($a);';
// Function: void cblas_strmm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const float alpha, const float * A, const int lda, float * B, const int ldb)
  proc cblas_strmm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * float * &float * int * &float * int = 'cblas_strmm($a);';
// Function: void cblas_strsm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const float alpha, const float * A, const int lda, float * B, const int ldb)
  proc cblas_strsm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * float * &float * int * &float * int = 'cblas_strsm($a);';
// Function: void cblas_dgemm (const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K, const double alpha, const double * A, const int lda, const double * B, const int ldb, const double beta, double * C, const int ldc)
  proc cblas_dgemm: CBLAS_ORDER * CBLAS_TRANSPOSE * CBLAS_TRANSPOSE * int * int * int * double * &double * int * &double * int * double * &double * int = 'cblas_dgemm($a);';
// Function: void cblas_dsymm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const int M, const int N, const double alpha, const double * A, const int lda, const double * B, const int ldb, const double beta, double * C, const int ldc)
  proc cblas_dsymm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * int * int * double * &double * int * &double * int * double * &double * int = 'cblas_dsymm($a);';
// Function: void cblas_dsyrk (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const double alpha, const double * A, const int lda, const double beta, double * C, const int ldc)
  proc cblas_dsyrk: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * double * &double * int * double * &double * int = 'cblas_dsyrk($a);';
// Function: void cblas_dsyr2k (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const double alpha, const double * A, const int lda, const double * B, const int ldb, const double beta, double * C, const int ldc)
  proc cblas_dsyr2k: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * double * &double * int * &double * int * double * &double * int = 'cblas_dsyr2k($a);';
// Function: void cblas_dtrmm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const double alpha, const double * A, const int lda, double * B, const int ldb)
  proc cblas_dtrmm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * double * &double * int * &double * int = 'cblas_dtrmm($a);';
// Function: void cblas_dtrsm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const double alpha, const double * A, const int lda, double * B, const int ldb)
  proc cblas_dtrsm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * double * &double * int * &double * int = 'cblas_dtrsm($a);';
// Function: void cblas_cgemm (const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_cgemm: CBLAS_ORDER * CBLAS_TRANSPOSE * CBLAS_TRANSPOSE * int * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_cgemm($a);';
// Function: void cblas_csymm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const int M, const int N, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_csymm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_csymm($a);';
// Function: void cblas_csyrk (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void * alpha, const void * A, const int lda, const void * beta, void * C, const int ldc)
  proc cblas_csyrk: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * &void * int = 'cblas_csyrk($a);';
// Function: void cblas_csyr2k (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_csyr2k: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_csyr2k($a);';
// Function: void cblas_ctrmm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const void * alpha, const void * A, const int lda, void * B, const int ldb)
  proc cblas_ctrmm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * &void * int * &void * int = 'cblas_ctrmm($a);';
// Function: void cblas_ctrsm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const void * alpha, const void * A, const int lda, void * B, const int ldb)
  proc cblas_ctrsm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * &void * int * &void * int = 'cblas_ctrsm($a);';
// Function: void cblas_zgemm (const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_zgemm: CBLAS_ORDER * CBLAS_TRANSPOSE * CBLAS_TRANSPOSE * int * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zgemm($a);';
// Function: void cblas_zsymm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const int M, const int N, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_zsymm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zsymm($a);';
// Function: void cblas_zsyrk (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void * alpha, const void * A, const int lda, const void * beta, void * C, const int ldc)
  proc cblas_zsyrk: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * &void * int = 'cblas_zsyrk($a);';
// Function: void cblas_zsyr2k (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_zsyr2k: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zsyr2k($a);';
// Function: void cblas_ztrmm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const void * alpha, const void * A, const int lda, void * B, const int ldb)
  proc cblas_ztrmm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * &void * int * &void * int = 'cblas_ztrmm($a);';
// Function: void cblas_ztrsm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, const int M, const int N, const void * alpha, const void * A, const int lda, void * B, const int ldb)
  proc cblas_ztrsm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * CBLAS_TRANSPOSE * CBLAS_DIAG * int * int * &void * &void * int * &void * int = 'cblas_ztrsm($a);';
// Function: void cblas_chemm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const int M, const int N, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_chemm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_chemm($a);';
// Function: void cblas_cherk (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const float alpha, const void * A, const int lda, const float beta, void * C, const int ldc)
  proc cblas_cherk: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * float * &void * int * float * &void * int = 'cblas_cherk($a);';
// Function: void cblas_cher2k (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const float beta, void * C, const int ldc)
  proc cblas_cher2k: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * int * float * &void * int = 'cblas_cher2k($a);';
// Function: void cblas_zhemm (const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, const enum CBLAS_UPLO Uplo, const int M, const int N, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const void * beta, void * C, const int ldc)
  proc cblas_zhemm: CBLAS_ORDER * CBLAS_SIDE * CBLAS_UPLO * int * int * &void * &void * int * &void * int * &void * &void * int = 'cblas_zhemm($a);';
// Function: void cblas_zherk (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const double alpha, const void * A, const int lda, const double beta, void * C, const int ldc)
  proc cblas_zherk: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * double * &void * int * double * &void * int = 'cblas_zherk($a);';
// Function: void cblas_zher2k (const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void * alpha, const void * A, const int lda, const void * B, const int ldb, const double beta, void * C, const int ldc)
  proc cblas_zher2k: CBLAS_ORDER * CBLAS_UPLO * CBLAS_TRANSPOSE * int * int * &void * &void * int * &void * int * double * &void * int = 'cblas_zher2k($a);';
// Function: void cblas_xerbla (int p, const char * rout, const char * form, ...)
  proc cblas_xerbla: int * &char * &char * ... = 'cblas_xerbla($a);';
//*****

Package: src/packages/gui.fdoc

utitle GUI ============ ========================== key file ============ ========================== __init__.flx share/lib/gui/__init__.flx types.flx share/lib/gui/types.flx events.flx share/lib/gui/events.flx ============ ==========================

key file
init.flx share/lib/gui/init.flx
font.flx share/lib/gui/font.flx
color.flx share/lib/gui/color.flx
surface.flx share/lib/gui/surface.flx
drawable.flx share/lib/gui/drawable.flx
drawchain.flx share/lib/gui/drawchain.flx
key file
window.flx share/lib/gui/window.flx
window_controller_interface.flx share/lib/gui/window_controller_interface.flx
window_controller.flx share/lib/gui/window_controller.flx
window_manager.flx share/lib/gui/window_manager.flx
key file
button.flx share/lib/gui/button.flx
menu.flx share/lib/gui/menu.flx
line_buffer_display_controller_interface.flx share/lib/gui/line_buffer_display_controller_interface.flx
line_buffer_display_controller.flx share/lib/gui/line_buffer_display_controller.flx
line_buffer_interface.flx share/lib/gui/line_buffer_interface.flx
line_buffer_object.flx share/lib/gui/line_buffer_object.flx
line_editor.flx share/lib/gui/line_editor.flx
linegraph.flx share/lib/gui/linegraph.flx

Basics

The Felix portable GUI is based on the portable SDL library and the Felix bindings thereof. SDL_ttf and SDL_image are required too for font and image handling.

//[__init__.flx]
include "sdl/SDL2";
include "sdl/SDL_ttf";
include "sdl/SDL_image";

The basic SDL initialisation stuff.

//[__init__.flx]
include "gui/init";
include "gui/types";
include "gui/events";
include "gui/font";

Basic GUI abstractions. Felix uses the Model-View-Controller (MVC) design idea.

The <em>model</em> is representation of the abstract state. independent of the visual interface.

The <em>view</em> provides the operations required to render the abstract state onto a graphical surface.

The <em>controller</em> is responsible for event management and in particular state mutations and scheduling display updates corresponding to them in the view, based on input from the client mouse and keyboard.

//[__init__.flx]
include "gui/color";
include "gui/surface";
include "gui/drawable";
include "gui/drawchain";
include "gui/window";
include "gui/window_controller_interface";
include "gui/window_controller";
include "gui/window_manager";

Widgets

And of course now for some Widgets! Felix uses a novel mechanism. It is not like other GUIs. Where other systems use subtyping and callbacks, in Felix the controllers for widgets are active threads of control modelled by Felix fthreads (synchronous fibres).

Widgets, and the window manager communicate using schannels (synchronous channels) instead of using callbacks for message passing. This avoids the catastrophic design failing of other GUI systems in which components are reactive slaves. In Felix, the components are autonomous active actors.

In particular interfaces are primarily based on communication protocols which allow plugins to provide services.

Buttons and menus.

//[__init__.flx]
include "gui/button";
include "gui/menu";

//[__init__.flx]
include "gui/line_buffer_interface";
include "gui/line_buffer_object";
include "gui/line_buffer_display_controller_interface";
include "gui/line_buffer_display_controller";
include "gui/line_editor";

Integrated presentation.

Merge all the separate classes into a single class to make it a all a bit easier to use.

//[__init__.flx]
class FlxGui
{
 inherit FlxGuiInit;
 inherit FlxGuiTypes;
 inherit FlxGuiEvents;
 inherit FlxGuiFont;
 inherit FlxGuiColor;
 inherit FlxGuiSurface;
 inherit FlxGuiDrawable;
 inherit FlxGuiDrawChain;

 inherit FlxGuiWindow;
 inherit FlxGuiWindowController;
 inherit FlxGuiWindowControllerInterface;
 inherit FlxGuiWindowManager;

 inherit FlxGuiButton;

 inherit FlxGuiMenu;

 // text field editor
 inherit FlxGuiLineBufferInterface;
 inherit FlxGuiLineBuffer;
 inherit FlxGuiLineBufferDisplayControllerInterface;
 inherit FlxGuiLineBufferDisplayController;
 inherit FlxGuiLineEditor;

} // class FlxGui

Core types

Mostly we just lift them from the sdl library which in turn lifts them from the C SDL2 library.

The result is somewhat messy, especially for messages, since SDL’s emulation of unions in C is a long way from the well presented sum type Felix would use.

//[types.flx]
class FlxGuiTypes
{
  typedef font_t = TTF_Font;
  typedef colour_t = SDL_Color;
  typedef color_t = colour_t; // dang yanks ..

  // rectangular shape without origin
  typedef box_t = (w:int,h:int);
  ctor box_t(w:int,h:int)=>(w=w,h=h);

  // point
  typedef point_t = SDL_Point;
  ctor point_t(x:int,y:int)=>SDL_Point(x,y);

  // box with origin for label (margin, baseline)
  typedef label_box_t = (box:box_t, label_origin: point_t);
  ctor label_box_t (box:box_t, label_origin: point_t)=> (box=box,label_origin=label_origin);

  // rectangular shape with top left origin
  typedef rect_t = SDL_Rect;
  ctor rect_t (x:int, y:int, w:int, h:int) => SDL_Rect (x,y,w,h);
  ctor rect_t (xy:point_t, dim:box_t) => SDL_Rect (xy.x,xy.y,dim.w,dim.h);

  // label rect
  typedef label_rect_t = (xy:point_t, lb: label_box_t);
}

//[events.flx]
class FlxGuiEvents
{
  typedef event_t = SDL_Event;

  fun _match_ctor_QUIT (e:event_t) => e.type == SDL_QUIT.uint32;
  fun _match_ctor_WINDOWEVENT (e:event_t) => e.type == SDL_WINDOWEVENT.uint32;
  fun _ctor_arg_WINDOWEVENT (e:event_t) => e.window;

  fun _match_ctor_KEYDOWN (e:event_t) => e.type == SDL_KEYDOWN.uint32;
  fun _ctor_arg_KEYDOWN (e:event_t) => e.key;

  fun _match_ctor_KEYUP (e:event_t) => e.type == SDL_KEYUP.uint32;
  fun _ctor_arg_KEYUP(e:event_t) => e.key;

  fun _match_ctor_MOUSEMOTION (e:event_t) => e.type == SDL_MOUSEMOTION.uint32;
  fun _ctor_arg_MOUSEMOTION (e:event_t) => e.motion;

  fun _match_ctor_MOUSEBUTTONDOWN (e:event_t) => e.type == SDL_MOUSEBUTTONDOWN.uint32;
  fun _ctor_arg_MOUSEBUTTONDOWN (e:event_t) => e.button;

  fun _match_ctor_MOUSEBUTTONUP (e:event_t) => e.type == SDL_MOUSEBUTTONUP.uint32;
  fun _ctor_arg_MOUSEBUTTONUP (e:event_t) => e.button;

  fun _match_ctor_MOUSEWHEEL  (e:event_t) => e.type == SDL_MOUSEWHEEL.uint32;
  fun _ctor_arg_MOUSEWHEEL (e:event_t) => e.wheel;

  fun _match_ctor_TEXTINPUT (e:event_t) => e.type == SDL_TEXTINPUT.uint32;
  fun _ctor_arg_TEXTINPUT (e:event_t) => e.text;

  fun _match_ctor_TEXTEDITING (e:event_t) => e.type == SDL_TEXTEDITING.uint32;
  fun _ctor_arg_TEXTEDITING (e:event_t) => e.edit;

  chip event_source
    connector events
      pin src : %> event_t
  {
      var clock = Faio::mk_alarm_clock();
      var e : SDL_Event;
      // dummy first event
      e&.type <- SDL_FIRSTEVENT.uint32;
      write$ events.src,e;
      proc waitevent()
      {
      nexte:>
        var result = SDL_PollEvent$ &e;
        if result == 0 do
          Faio::sleep(clock,0.1);
          goto nexte;
        done
      }
      waitevent;
      while e.type.SDL_EventType != SDL_QUIT do
//println$ "SDL EVENT: " + e.type.SDL_EventType.str + " SDL window #" + e.window.windowID.str;
        write$ events.src, e;
        waitevent;
      done
      println$ "[event_source] SDL_QUIT seen!";
      write$ events.src, e;
      return;
  } // chip event_source

  proc demo_timer (quit:&bool) (var d:double) ()
  {
    var delta = 0.1;
    var clock = Faio::mk_alarm_clock();
  again:>
    Faio::sleep(clock,delta);
    d -= delta;
    if *quit goto doquit;
    if d > 0.0 goto again;
    quit <- true;
    var quitmsg : SDL_Event;
    quitmsg&.type <- SDL_QUIT.uint32;
println$ "TIMEOUT";
    C_hack::ignore(SDL_PushEvent(&quitmsg));
doquit:>
  }

}

Subsystem initialisation.

Ensures we have visuals, sound, fonts, and images. Display versions of libraries, both the one from the compiled header files and the binary linked in.

//[init.flx]
class FlxGuiInit
{
  proc init()
  {
    if SDL_Init(SDL_INIT_AUDIO \| SDL_INIT_VIDEO) < 0  do
      eprintln$ f"Unable to init SDL: %S\n" #SDL_GetError;
      System::exit(1);
    done
    println$ "SDL_init OK";
    if TTF_Init() < 0 do
      eprintln$ f"Unable to init TTF: %S\n" #TTF_GetError;
      System::exit(1);
    done
    println$ "TTF_init OK";
    if IMG_Init(IMG_INIT_PNG) < 0 do
      eprintln$ f"Unable to init IMG with PNG: %S\n" #IMG_GetError;
      System::exit(1);
    done
    println$ "IMG_init OK";
  }

  proc quit() { SDL_Quit(); }

  proc versions ()
  {
    begin
      var compiled = #SDL_Compiled_Version;
      var linked = #SDL_Linked_Version;
      println$ f"We compiled against SDL version %d.%d.%d ..."
        (compiled.major.int, compiled.minor.int, compiled.patch.int);
      println$ f"But we are linking against SDL version %d.%d.%d."
        (linked.major.int, linked.minor.int, linked.patch.int);
    end

    begin
      var compiled = #TTF_Compiled_Version;
      var linked = #TTF_Linked_Version;
      println$ f"We compiled against TTF version %d.%d.%d ..."
        (compiled.major.int, compiled.minor.int, compiled.patch.int);
      println$ f"But we are linking against TTF version %d.%d.%d."
        (linked.major.int, linked.minor.int, linked.patch.int);
    end

    begin
      var compiled = #IMG_Compiled_Version;
      var linked = #IMG_Linked_Version;
      println$ f"We compiled against IMG version %d.%d.%d ..."
        (compiled.major.int, compiled.minor.int, compiled.patch.int);
      println$ f"But we are linking against IMG version %d.%d.%d."
        (linked.major.int, linked.minor.int, linked.patch.int);
    end
  }

}

Font handling.

Felix uses SDL_ttf which in turn uses Freetype to render TrueType fonts with some hinting. Unfortunately in my experience the rending is appalling. The glyphs are barely readable. It is not known if this problem is with SDL_ttf or Freetype. The rending is just barely good enough for GUI tools such as game scenario editors, it wouldn’t be useful in game.

Felix provides three fonts borrowed from Apple to save the user from having to set up a font library Felix knows about.

//[font.flx]
class FlxGuiFont
{
  private fun / (s:string, t:string) => Filename::join (s,t);

  fun dflt_mono_font() => #Config::std_config.FLX_SHARE_DIR/ "src"/"lib"/"fonts"/ "Courier New.ttf";
  fun dflt_sans_serif_font() => #Config::std_config.FLX_SHARE_DIR/ "src"/"lib"/"fonts"/ "Arial.ttf";
  fun dflt_serif_font() => #Config::std_config.FLX_SHARE_DIR/ "src"/"lib"/"fonts"/ "Times New Roman.ttf";

  gen get_font (font_file:string, ptsize:int) = {
    var font = TTF_OpenFont (font_file,ptsize);
    if not (TTF_ValidFont font) do
      eprintln$ f"Unable to open TTF font %S\n" font_file;
      System::exit 1;
    done
    TTF_SetFontKerning (font,0);
    var isfixed = TTF_FontFaceIsFixedWidth (font);
    println$ "Opened Font " + font_file +
      " Facename: " + TTF_FontFaceFamilyName font +
      (if isfixed>0 then " MONOSPACED "+ isfixed.str else " VARIABLE WIDTH");
    println$ "Metrics: Height "+font.TTF_FontHeight.str +
      ", Ascent "+ font.TTF_FontAscent.str +
      ", Descent "+ font.TTF_FontDescent.str +
      ", Lineskip"+ font.TTF_FontLineSkip.str
    ;
    TTF_SetFontHinting (font,TTF_HINTING_MONO); // guess...
    return font;
  }

  fun get_lineskip (f: font_t) => TTF_FontLineSkip(f) + 1;

  fun get_textsize (f: font_t, s:string) =
  {
    var w: int; var h: int;
    C_hack::ignore$ TTF_SizeText (f,s,&w, &h);
    return w,h;
  }

  // x,y is the origin  of the first character
  // The bounding box is 2 pixels up from the highest char
  // 2 pixies down from the lowest char
  // 2 pixies to the left of the first character's orgin
  // and 2 pix right from the origin of the last char + the notional advance
  // this ONLY works right for a monospaced font!
  fun bounding_box (f:font_t, x:int, y:int, s:string) : rect_t =
  {
    var n = s.len.int;
    var w =
      #{
        var minx:int; var maxx:int; var miny:int; var maxy:int; var advance:int;
        C_hack::ignore$ TTF_GlyphMetrics(f,"m".char.ord.uint16,&minx, &maxx, &miny, &maxy, &advance);
        return advance;
      }
    ;
    var a = f.TTF_FontAscent;
    var d = f.TTF_FontDescent;
    // the 5 = 4 + 1 is due to what looks like a BUG in SDL or TTF:
    // for at least one font, height = ascent - descent + 1
    // even though lineskip = ascent - descent
    return SDL_Rect (x - 2,y - a - 2, w * n +4, a - d + 5);
  }
}

Colours.

Felix uses RGBA colour scheme: 8 bits of Red, Blue and Green followed by 8 bits of transparency, where 0 means no colour and full transparency, and 255 means maximum colour and opaque rendering.

//[color.flx]
class FlxGuiColor
{
  fun RGB (r:int, g:int, b:int) =>
    SDL_Color (r.uint8, g.uint8, b.uint8, 255u8)
  ;

  // create some colours and clear the window
  var white = RGB (255,255,255);
  var black = RGB (0,0,0);
  var lightgrey = RGB (180,180,180);
  var grey = RGB (100,100,100);
  var darkgrey = RGB (60,60,60);
  var red = RGB(255,0,0);
  var green = RGB (0,255,0);
  var blue = RGB (0,0,255);
  var purple = RGB (255,0,255);
  var yellow = RGB (255,255,0);
  var orange = RGB (100,255,100);

}

Surfaces.

A surface is something you can do simple drawing on. It is basically a representation of a rectangular grid of pixels. The pixels may support full RGBA or not, depending on construction. For example we might provide a bitmap which supports only black and white using a 1 bit encoding.

Each window will have a native surface onto which we must render the imagery we wish to appear on the client display device. In general, however, we should be using full RGBA arrays for rendering and then blit those arrays onto hardware dependent surfaces.

SDL only provides a very limited set of operations on surfaces! Complex rendering requires OpenGL. But we do not need that in GUI.

//[surface.flx]
class FlxGuiSurface
{
  proc clear(surf:&SDL_Surface) (c: colour_t)
  {
    var pixelformat : &SDL_PixelFormat  = surf*.format;
    var bgpixels = SDL_MapRGB(pixelformat,c.r,c.g,c.b);
    SDL_ClearClipRect (surf);
    C_hack::ignore$ SDL_FillSurface (surf, bgpixels);
  }

  proc fill (surf:&SDL_Surface) (var r:rect_t, c:colour_t)
  {
    SDL_ClearClipRect (surf);
    var pixelformat : &SDL_PixelFormat  = surf*.format;
    var bgpixels = SDL_MapRGB(pixelformat,c.r,c.g,c.b);
    C_hack::ignore$ SDL_FillRect (surf, &r, bgpixels);
    SDL_ClearClipRect (surf);
  }

  noinline proc draw_line (surf:&SDL_Surface)  (c:color_t, x0:int, y0:int, x1:int, y1:int)
  {
     var r: SDL_Renderer = SDL_CreateSoftwareRenderer surf;
     C_hack::ignore$ SDL_SetRenderDrawColor (r, c.r, c.g, c.b, c.a);
     C_hack::ignore$ SDL_RenderDrawLine (r, x0, y0, x1, y1);
     SDL_DestroyRenderer r;
  }

  proc write(surf:&SDL_Surface) (x:int, y:int, font:font_t, c: colour_t, s:string)
  {
    var rendered = TTF_RenderText_Solid (font,s,c);
    var rect : SDL_Rect;

    var minx:int; var maxx:int; var miny:int; var maxy:int; var advance:int;
    C_hack::ignore$ TTF_GlyphMetrics(font,"m".char.ord.uint16,&minx, &maxx, &miny, &maxy, &advance);

    rect&.x <- x + (min (minx,0));
    rect&.y <- y - maxy;
    var nullRect = C_hack::null[SDL_Rect];

    var result = SDL_BlitSurface (rendered, nullRect, surf, &rect);
    if result != 0 do
      eprintln$ "Unable to blit text to surface";
      System::exit 1;
    done
    SDL_FreeSurface rendered;
  }

  proc blit (surf:&SDL_Surface) (dstx:int, dsty:int, src: &SDL_Surface)
  {
    var nullRect = C_hack::null[SDL_Rect];
    var dstRect = rect_t (dstx, dsty,0,0);
    var result = SDL_BlitSurface (src, nullRect, surf, &dstRect);
    if result != 0 do
      eprintln$ "Unable to blit surface to surface at (" + dstx.str + "," + dsty.str + ")";
      //System::exit 1;
    done

  }

  interface surface_t {
    get_sdl_surface: 1 -> &SDL_Surface;
    get_width : 1 -> int;
    get_height: 1 -> int;
    clear: colour_t -> 0;
    fill: rect_t * colour_t -> 0;
    draw_line: colour_t * int * int * int * int -> 0; // x0,y0,x1,y1
    write: int * int * font_t * colour_t * string -> 0;
  }

  // Wrapper around SDL surface
  // borrows the SDL_Surface!! Does not own or delete
  object surface (surf: &SDL_Surface) implements surface_t =
  {
    method fun get_sdl_surface () => surf;
    method fun get_width () => surf*.w;
    method fun get_height() => surf*.h;
    method proc clear (c:colour_t) => FlxGuiSurface::clear surf c;
    method proc fill (r:rect_t, c:colour_t) => FlxGuiSurface::fill surf (r,c);
    method proc draw_line (c:colour_t, x0:int, y0:int, x1:int, y1:int) { FlxGuiSurface::draw_line surf (c,x0,y0,x1,y1); }
    method proc write (x:int, y:int, font:font_t, c: colour_t, s:string) { FlxGuiSurface::write surf (x,y,font,c,s); }
  }

  // Takes possession of the surface
  // Frees surface when object is freed by GC

  header surface_deleter = """
    struct _SDL_SurfaceDeleter {
       _SDL_Surface *p;
       _SDL_SurfaceDeleter () : p (nullptr) {}
       ~_SDL_SurfaceDeleter () { SDL_FreeSurface (p); }
    };
  """;
  type surface_holder_t = "surface_deleter" requires surface_deleter;
  proc set : &surface_holder_t * &SDL_Surface = "$1->p=$2;";

  object owned_surface (surf: &SDL_Surface) implements surface_t =
  {
    var holder: surface_holder_t;
    set (&holder, surf);

    // returns a LOAN of the surface only
    method fun get_sdl_surface () => surf;
    method fun get_width () => surf*.w;
    method fun get_height() => surf*.h;
    method proc clear (c:colour_t) => FlxGuiSurface::clear surf c;
    method proc fill (r:rect_t, c:colour_t) => FlxGuiSurface::fill surf (r,c);
    method proc draw_line (c:colour_t, x0:int, y0:int, x1:int, y1:int) { FlxGuiSurface::draw_line surf (c,x0,y0,x1,y1); }
    method proc write (x:int, y:int, font:font_t, c: colour_t, s:string) { FlxGuiSurface::write surf (x,y,font,c,s); }
  }

}

Drawables

Things which can draw on surface planes. A surface provides x,y coordinates, a plane adds a z coordinate. The z coordinate is used to control drawing order: the drawables with lowest z are applied first.

//[drawable.flx]
class FlxGuiDrawable
{
  interface drawable_t {
     draw: surface_t -> 0;
     get_z: 1 -> uint32;
     get_tag: 1 -> string;
  }

  object drawable (tag:string) (z:uint32) (d: surface_t -> 0) implements drawable_t =
  {
    method fun get_z () => z;
    method proc draw (surf:surface_t) => d surf;
    method fun get_tag () => tag;
  }

  // given some routine like draw_line (s:&SDL_surface) (p:parameters)
  // this wrapper constructs a drawable by adding a tag name, a Z coordinate
  // and binding the parameters.
  noinline fun mk_drawable[T] (tag:string) (z:uint32) (d: &SDL_Surface -> T -> 0) (var a:T) : drawable_t =>
    drawable tag z (proc (s:surface_t) { d (s.get_sdl_surface()) a; })
  ;

  noinline fun mk_drawable[T] (d: &SDL_Surface -> T -> 0) (var a:T) : drawable_t =>
    drawable "notag" 100u32 (proc (s:surface_t) { d (s.get_sdl_surface()) a; })
  ;

  noinline fun mk_drawable[T] (tag:string) (d: &SDL_Surface -> T -> 0) (var a:T) : drawable_t =>
    drawable tag 100u32 (proc (s:surface_t) { d (s.get_sdl_surface()) a; })
  ;

}

Draw Chain

A dynamic set of drawables, maintained in Z order. The draw method draws the drawables in the stored Z order. Drawchains are used to schedule and manage the appearance of a window surface for which drawing is demanded asynchronously from the scheduling. This is usual in windowing systems where the window can be hidden, exposed, or require display by events occuring at times different to the events such as mouse clicks triggering state changes.

//[drawchain.flx]
include "gui/__init__";
class FlxGuiDrawChain
{
  open FlxGui;
  interface drawchain_t {
    draw: surface_t -> 0;
    remove: string -> 0;
    add: drawable_t -> 0;
    len: 1 -> size;
    get_drawables : 1 -> darray[drawable_t];
  }

  object drawchain() implements drawchain_t =
  {
    var drawables = darray[drawable_t] ();
    method fun len () => drawables.len;
    method fun get_drawables () => drawables;

    method proc draw (surf: surface_t)
    {
//println$ "----";
      for d in drawables do
        d.draw surf;
//println$ "Drawn " + d.get_tag() + " " + #(d.get_z).str;
      done
    }

    method proc remove (tag:string)
    {
//println$ "remove " + tag;
      var i = 0;
      while i < drawables.len.int do
        if drawables.i.get_tag () == tag do
          erase (drawables, i);
        else
          ++i;
        done
      done
    }

    method proc add (d:drawable_t)
    {
      var z = d.get_z ();
      var i = 0;
    next:>
      if i == drawables.len.int do
        push_back (drawables, d);
      else
        if drawables.i.get_z() > z do
          insert(drawables, i, d);
        else
          ++i;
          goto next;
        done
      done
    }
  }
}

Windows

We provide a model for a platform dependent top level overlapping window. Windows provide a method to get a surface in the same pixel format as the window. We draw on that then use update operation to synchronise transfer of the surface to the hardware screen.

The provided surface may be the actual window surface in video ram, or it may be a software surface which is blitted to the hardware by system dependent operations.

NOTE: in earlier SDL2 versions there is a catastrophic bug when a window is hidden: the surface becomes invalid. So it is not possible to create the window hidden, initialise it with imagery, and then display it. This means there may be a flicker on window creation as the unpopulated window image is shown then replaced by a populated display.

//[window.flx]
class FlxGuiWindow
{
  interface window_t {
    get_sdl_window : 1 -> SDL_Window;
    get_sdl_surface: 1 -> &SDL_Surface;
    get_sdl_window_id : 1 -> uint32;

    get_surface: 1 -> surface_t;
    add: drawable_t -> 0;
    remove: string -> 0;
    get_drawchain: 1 -> drawchain_t;
    draw: 1 -> 0;

    show: 1 -> 0;
    hide: 1 -> 0;
    raise: 1 -> 0;
    prim_update: 1 -> 0;
    update: 1 -> 0; // does a draw then prim_update
    destroy: 1 -> 0;
  }

  object window (title:string, xpos:int, ypos:int, width:int,height:int, flag:uint32) implements window_t =
  {
    var w = SDL_CreateWindow(
      title,
      xpos,ypos,
      width, height,
      flag
    );
    var dc = drawchain ();

    method fun get_drawchain () => dc;
    method proc add (d:drawable_t) => dc.add d;
    method proc remove (tag:string) => dc.remove tag;


    method fun get_sdl_window_id () => SDL_GetWindowID w;
    method fun get_sdl_window () => w;
    method fun get_sdl_surface() => SDL_GetWindowSurface w;
    method fun get_surface () : surface_t => surface (SDL_GetWindowSurface w);

    method proc show () { SDL_ShowWindow w; }
    method proc hide () { SDL_HideWindow w; }
    method proc raise () { SDL_RaiseWindow w; }
    method proc destroy () { SDL_DestroyWindow w; }

    method proc prim_update()
    {
      var result = SDL_UpdateWindowSurface w;
      if result != 0 do
        eprintln$ "Unable to update window";
        System::exit 1;
      done
    }

    method proc draw ()
    {
      var surf =  surface (SDL_GetWindowSurface w);
      dc.draw surf;
    }

    method proc update () { draw(); prim_update(); }

  }

  gen create_fixed_window (title:string, x:int, y:int, width:int, height:int) : window_t =>
    window (title, x,y,width,height, SDL_WINDOW_SHOWN \| SDL_WINDOW_ALLOW_HIGHDPI)
  ;

  gen create_resizable_window (title:string, x:int, y:int, width:int, height:int) : window_t =>
    window (title, x,y,width,height, SDL_WINDOW_RESIZABLE \| SDL_WINDOW_ALLOW_HIGHDPI)
  ;


}

The Window Controller.

In Felix, the window controller is an object which dispatches events read from an input schannel.

The user provides a procedure which can handle the events by reading on an schannel of events. The window controller creates an schannel of events and starts the user procedure as an fthread, passing it the input end of the schannel.

After creation, the window controller object provides a method so the client can fetch the output end of this schannel on which the client writes events. These will then be serviced by the procedure the client provided since the window controller has started it running.

The controller is basically a Felix kind of RAII: on construction an active process is started which can service events.

//[window_controller_interface.flx]
class FlxGuiWindowControllerInterface
{
  // ------------------------------------------------------------------
  // Window controller is responsible for all the work
  // being done on a window. It requires support for
  // dispatching events on its event channel.
  interface window_controller_interface {
    get_window_id : 1 -> uint32;
    get_oschannel : 1 -> oschannel[event_t];
    destroy_window : 1 -> 0;
    display: 1 -> 0;
  }
}

//[window_controller.flx]

class FlxGuiWindowController
{
  object window_controller
  (
    w:window_t,
    p:(input:ischannel[event_t]) -> 1->0 // chip interface
  )
    implements window_controller_interface =
  {
    var imsgs,omsgs = #mk_ioschannel_pair[event_t];

    method fun get_window_id () => w.get_sdl_window_id ();
    method proc destroy_window () => w.destroy ();
    method fun get_oschannel () => omsgs;
    method proc display() { w.update(); }
    circuit
      wire imsgs to p.input
    endcircuit
    //spawn_fthread (p imsgs);
  }
}

The Window Manager.

The Window manager is a top level object that is used to fetch process level events such as mouse clicks and dispatch them to the appropriate window event handler.

Note that the Window manager MUST run in the main thread! This is because some system GUI’s maintain separate event queues for each thread (Windows) or may provide a unified queue (X-Windows).

Windows managed by the window manager have two identifying tags: the window ID, maintained by SDL, and the window index, which is the slot number in an array the Felix Window manager uses to store the window controller associated with the window.

The window manager creates the SDL event queue and reads events from the queue. It dispatches them to the appropriate windows based on the SDL window ID if the even has one, or all windows if there isn’t one.

The dispatch, of course, is done by writing the event down the schannel of the window controller associated with the window.

Note carefully that the window manager is the equivalent of a traditional event dispatch loop, and underneath, Felix indeed implements fthreads with schannel I/O using callbacks. However this is transparent to the client programmer! For all intents and purpose the dispatching is done by a background thread to windows each of which is running an active process that listens for events.

//[window_manager.flx]
class FlxGuiWindowManager
{
// Window Manager is responsible for a set of windows,
// and dispatching events specific to a particular
// window to that window.

// ------------------------------------------------------------------
object window_manager () =
{
  var windows = darray[window_controller_interface]();

  method fun get_n_windows () => windows.len.int;

  // add a new window to the controlled set
  // return its current index
  method gen add_window (w:window_controller_interface) : int =
  {
    windows += w;
println$ "add_window: index = " + (windows.len.int - 1  ).str + " SDL windows id = " + #(w.get_window_id).str;
    return windows.len.int - 1;
  }

  fun find_window(wid: uint32) : opt[window_controller_interface] =
  {
    for wobj in windows do
      if wid == #(wobj.get_window_id) do
        return Some wobj;
      done
    done
    return None[window_controller_interface];
  }

  fun find_window_index (wid: uint32) : opt[int] =
  {
    for var i in 0 upto windows.len.int - 1 do
      if wid == #(windows.i.get_window_id) return Some i;
    done
    return None[int];
  }

  method fun get_window_controller_from_index (i:int) => windows.i;

  method proc delete_window (wid: uint32)
  {
    match find_window_index wid with
    | #None => ;
    | Some i =>
      println$ "delete window found index " + i.str;
      windows.i.destroy_window ();
      println$ "SDL destroyed";
      erase (windows, i);
      println$ "Window erased";
    endmatch;
  }

  chip window_event_dispatcher
   connector events
     pin eventin : %<event_t
     pin quit: %>int
  {
    forever:while true do
      var e = read events.eventin;
      if e.type.SDL_EventType == SDL_QUIT break forever
      dispatch_window_event e;
    done
    write$ events.quit,1;
  }
  method fun get_window_event_dispatcher () => window_event_dispatcher;
  method proc dispatch_window_event (e:event_t)
  {
    match SDL_GetWindowID e with
    | Some wid =>
      match find_window wid with
      | Some wobj =>
        var omsgs = #(wobj.get_oschannel);
        write (omsgs, e);
        if e.type.SDL_EventType == SDL_WINDOWEVENT and
          e.window.event.SDL_WindowEventID == SDL_WINDOWEVENT_CLOSE
        do
          #(wobj.get_window_id).delete_window;
          println$ "dispatch: window deleted!";
        else
          wobj.display();
        done
      | #None => println$ "Can't find window ID = " + str wid;
      endmatch;
    | #None => println$ "No window for message: Event type " + e.type.SDL_EventType.str;
    endmatch;
  }

  method proc delete_all()
  {
    println$ "Delete all";
    var e : SDL_Event;
    e&.type <- SDL_WINDOWEVENT.uint32;
    e&.window.event <- SDL_WINDOWEVENT_CLOSE.uint8;
    for wobj in windows do
      var omsgs = #(wobj.get_oschannel);
      e&.window.windowID <- #(wobj.get_window_id);
      write (omsgs, e);
    done
    // note: not bothering to delete the darray :)
  }

  // the quit channel is deliberately connected to a dummy channel
  // (a dummy is used to suppress compiler non-connection warning)
  // the WM will suicide when it gets a SDL_QUIT message
  method proc start ()
  {
    var qin,qout = mk_ioschannel_pair[int]();
    circuit
      connect window_event_dispatcher.eventin, event_source.src
      wire qout to window_event_dispatcher.quit
    endcircuit
  }

  // start WM, wait until SDL_QUIT seen
  // closes windows before returning
  method proc run_until_quit ()
  {
    var qin,qout = mk_ioschannel_pair[int]();

    circuit
      connect window_event_dispatcher.eventin, event_source.src
      wire qout to window_event_dispatcher.quit
    endcircuit

    C_hack::ignore(read qin);

    // we must have got a quit ..
    println$ "QUIT EVENT, deleting all windows";
    delete_all();
  }

  // start WM, wait until SDL_QUIT issued by either
  // the user or the timer
  // closes windows before returning
  method proc run_with_timeout (var timeout: double)
  {
    var qin,qout = mk_ioschannel_pair[int]();

    circuit
      connect window_event_dispatcher.eventin, event_source.src
      wire qout to window_event_dispatcher.quit
    endcircuit

    var quit = false;
    spawn_fthread$ demo_timer &quit timeout;
    C_hack::ignore(read qin);
    quit = true;

    // we must have got a quit ..
    println$ "QUIT EVENT, deleting all windows";
    delete_all();
  }
}

gen create_SDL_event_source () : ischannel[event_t]  =
{
  var imsgs, omsgs = mk_ioschannel_pair[event_t]();
  circuit
    wire omsgs to event_source.src
  endcircuit
  return imsgs;
}
}

Widgets

Simple Click Button

//[button.flx]
class FlxGuiButton
{
  variant button_state_t =
    | Up       // ready
    | Down     // being clicked
    | Disabled // inactive
    | Mouseover // ready and mouse is over
  ;

  variant button_action_t =
    | NoAction
    | ClickAction of string
  ;

  interface button_model_t
  {
    get_state: 1 -> button_state_t;
    set_state: button_state_t -> 0;
    get_tag: 1 -> string;
  }

  object ButtonModel
    (var tag: string, init_state:button_state_t)
    implements button_model_t
  =
  {
    var state = init_state;
    method fun get_state() => state;
    method proc set_state (s:button_state_t) => state = s;
    method fun get_tag () => tag;
  }

  typedef button_colour_scheme_t =
  (
    label_colour: colour_t,
    bg_colour: colour_t,
    top_colour: colour_t,
    left_colour: colour_t,
    bottom_colour: colour_t,
    right_colour: colour_t
  );

  typedef button_skin_t =
  (
    up: button_colour_scheme_t,
    down: button_colour_scheme_t,
    disabled: button_colour_scheme_t,
    mouseover: button_colour_scheme_t
  );

  interface button_display_t {
    display: 1 -> 0;
    get_client_rect: 1 -> rect_t;
    get_label : 1 -> string;
    get_tag: 1 -> string;
  }

  object ButtonDisplay (b:button_model_t)
  (
    w:window_t, // change to surface later
    font:font_t,
    label:string,
    tag: string, // note: NOT the same as the button's tag!
    skin : button_skin_t,
    coords: rect_t,
    origin: point_t
   )
   implements button_display_t =
   {
     // NOTE: the tag must be unique per button-display on each window.
     // it is used to *remove* the drawing instructions from the window
     // for the previous button state prior to adding new instructions.
     // Dont confuse with the label (which might change per display)
     // or the button state tag (which is not enough if the same button state
     // drives two displays on the same window).
     method fun get_tag () => tag;

     method fun get_client_rect () => coords;

     method fun get_label () => label;
     method proc display()
     {
      var state = b.get_state ();
      var scheme = match state with
        | #Up => skin.up
        | #Down => skin.down
        | #Disabled => skin.disabled
        | #Mouseover => skin.mouseover
        endmatch
      ;
      w.remove tag;
      var left_x = coords.x;
      var right_x = coords.x + coords.w - 1;
      var top_y = coords.y;
      var bottom_y = coords.y + coords.h - 1;
      var origin_x = origin.x;
      var origin_y = origin.y;

      // top
      w.add$ mk_drawable tag draw_line (scheme.top_colour, left_x - 2,top_y - 2,right_x + 2, top_y - 2) ;
      w.add$ mk_drawable tag draw_line (scheme.top_colour, left_x - 1,top_y - 1,right_x + 1, top_y - 1);
      // left
      w.add$ mk_drawable tag draw_line (scheme.left_colour, left_x - 2,top_y - 2,left_x - 2, bottom_y + 2);
      w.add$ mk_drawable tag draw_line (scheme.left_colour, left_x - 1,top_y - 1,left_x - 1, bottom_y + 1);
      // right
      w.add$ mk_drawable tag draw_line (scheme.right_colour, right_x + 2,top_y - 2,right_x + 2, bottom_y + 2);
      w.add$ mk_drawable tag draw_line (scheme.right_colour, right_x + 1,top_y - 1,right_x + 1, bottom_y + 1);
      // bottom
      w.add$ mk_drawable tag draw_line (scheme.bottom_colour, left_x - 1,bottom_y + 1,right_x + 1, bottom_y + 1);
      w.add$ mk_drawable tag draw_line (scheme.bottom_colour, left_x - 2,bottom_y + 2,right_x + 2, bottom_y + 2);

      w.add$ mk_drawable tag fill(SDL_Rect (left_x, top_y, right_x - left_x + 1, bottom_y - top_y + 1), scheme.bg_colour);
      w.add$ mk_drawable tag FlxGuiSurface::write (origin_x, origin_y, font, scheme.label_colour, label);
    } // draw
    display();
  } //button

chip button_controller
(
  bm: button_model_t,
  bd: button_display_t
)
connector but
  pin ec: %<event_t
  pin response: %>button_action_t
{
  bd.display();
  var run = true;
  var e = read but.ec;
  while run do
    match e with
    | MOUSEMOTION mm =>
      var x,y = mm.x,mm.y; //int32
      if SDL_Point (x.int,y.int) \in bd.get_client_rect () do
        //println$ "Motion in client rect of button " + bd.get_label();
        match bm.get_state () with
        | #Up => bm.set_state Mouseover; bd.display(); // Enter
        | _ => ;
        endmatch;
      else
        match bm.get_state () with
        | #Mouseover => bm.set_state Up; bd.display(); // Leave
        | #Down => bm.set_state Up; bd.display(); // Leave
        | _ => ;
        endmatch;
      done
      write$ but.response, NoAction;

    | MOUSEBUTTONDOWN mbd =>
      x,y = mbd.x,mbd.y; //int32
      if SDL_Point (x.int,y.int) \in bd.get_client_rect () do
        //println$ "Button down in client rect of button " + bd.get_label();
        bm.set_state Down; bd.display();
      done
      write$ but.response, NoAction;

    | MOUSEBUTTONUP mbu =>
      x,y = mbu.x,mbu.y; //int32
      if SDL_Point (x.int,y.int) \in bd.get_client_rect () do
        //println$ "Button up in client rect of button " + bd.get_label();
        bm.set_state Mouseover; bd.display();
        write$ but.response, ClickAction #(bm.get_tag);
      else
        bm.set_state Up; bd.display();
        write$ but.response, NoAction;
      done
    | WINDOWEVENT we when we.event == SDL_WINDOWEVENT_LEAVE.uint8  =>
      bm.set_state Up; bd.display();
      write$ but.response, NoAction;

    | _ =>
      write$ but.response, NoAction;
    endmatch;
    e = read but.ec;
  done

}

} // class

Cascading Menu

//[menu.flx]
// interim menu stuff
// these menus are transient, retaining state only when open


include "std/datatype/lsexpr";

class FlxGuiMenu
{
  // A menu entry is either some text or a separator
  // The text has a visual label and a separate tag
  // returned when an entry is selected
  variant menu_entry_active_t = Active | Disabled;
  typedef menu_text_entry_t = (tag:string, label:string, active:menu_entry_active_t);

  variant menu_entry_t = Separator | Text of menu_text_entry_t;

  // A menu is a list of trees with both leaves and nodes labelled
  typedef menu_item_t = LS_expr::lsexpr[menu_entry_t, menu_entry_t];
  typedef menu_data_t = list[menu_item_t];

  // A position in the tree is a list of integers
  // Separators do not count
  typedef menu_position_t = list[int];

  // A menu is either closed, or open at a particular position
  variant menu_state_t = Closed | Open of menu_position_t;

  variant menu_action_t = NoAction | ChangedPosition | SelectedAction of string;

  interface menu_model_t
  {
    get_menu: 1 -> menu_data_t;
    get_state: 1 -> menu_state_t;
    set_state: menu_state_t -> 0;
    get_current_tag: 1 -> string; // empty string if closed
    get_current_tag_chain: 1 -> list[string]; // from the top
  }

  object MenuModel (m:menu_data_t) implements menu_model_t =
  {
    var state = Closed;
    method fun get_menu () => m;
    method fun get_state () => state;
    method proc set_state (s:menu_state_t) => state = s;

    // find ix'th entry in a menu if it exists,
    // separators not counted
    fun find (m:menu_data_t, ix:int) : opt[menu_item_t] =>
      match m with
      | #Empty => None[menu_item_t]
      | Cons (h,t) =>
        match h with
        | Leaf (Separator) => find (t,ix)
        | x => if ix == 0 then Some x else find (t,ix - 1)
        endmatch
      endmatch
    ;

    fun find_tag (pos: menu_position_t, menu:menu_data_t) : string =>
      match pos,menu with
      | #Empty, _ => "Empty"
      | Cons (i,t), m =>
        match find (m,i),t with
        | Some (Leaf (Text (tag=tag))), Empty => tag
        | Some (Tree (Text (tag=tag), _)), Empty => tag
        | Some (Tree (_, subtree)), _=> find_tag (t,subtree)
        | _ => "Error"
        endmatch
      endmatch
    ;
    method fun get_current_tag () =>
     match state with
     | #Closed => "Closed"
     | Open pos =>
        find_tag (pos,m)
     endmatch
    ;
    method fun get_current_tag_chain () => Empty[string];
  }

  interface menu_display_t
  {
    display: 1 -> 0;
    get_hotrects: 1 -> list[rect_t * menu_position_t];
    get_tag: 1 -> string;
  }

  typedef submenu_icon_t = (open_icon: surface_t, closed_icon: surface_t);

  object MenuDisplay
  (
    tag:string,
    m:menu_model_t,
    w:window_t,
    x:int,y:int,
    font:font_t,
    text_colour: button_colour_scheme_t,
    disabled_colour: button_colour_scheme_t,
    selected_colour: button_colour_scheme_t,
    submenu_icons: submenu_icon_t
  ) implements menu_display_t =
  {
    method fun get_tag () => tag;

    var icon_width = max (submenu_icons.open_icon.get_width(), submenu_icons.closed_icon.get_width());
    var lineskip = get_lineskip font;
    var baseline_offset = font.TTF_FontAscent;
    var border_width = 2;
    var left_padding = 4;
    var right_padding = 10 + icon_width;
    var min_width = 20;
    var separator_depth = 1;
    var top_padding = 1;
    var bottom_padding = 1;

    fun width (s:string) => (FlxGuiFont::get_textsize (font,s)).0;
    fun width: menu_entry_t -> int =
      | #Separator => left_padding + right_padding + min_width
      | Text s => left_padding + right_padding + width s.label
    ;
    fun depth : menu_entry_t -> int =
      | #Separator => top_padding + bottom_padding + separator_depth
      | Text s => top_padding + bottom_padding + lineskip
    ;
    fun width : menu_item_t -> int =
      | Leaf menu_entry => width menu_entry
      | Tree (menu_entries ,_) => width menu_entries
    ;

    fun depth : menu_item_t -> int =
      | Leaf menu_entry => depth menu_entry
      | Tree (menu_entry ,_) => depth menu_entry
    ;
    fun width (ls: menu_data_t) => fold_left
      (fun (w:int) (menu_item:menu_item_t) => max (w, width menu_item))
      0
      ls
    ;
    fun depth (ls: menu_data_t) => fold_left
      (fun (d:int) (menu_item:menu_item_t) => d + depth menu_item)
      0
      ls
    ;
    proc display_menu(x:int, y:int, menu:menu_data_t, position:menu_position_t)
    {
      var left_x = x;
      var top_y = y;
      var right_x = left_x + width menu;
      var bottom_y = top_y + depth menu;
      var scheme = text_colour;

      // top
      w.add$ mk_drawable tag draw_line (scheme.top_colour, left_x - 2,top_y - 2,right_x + 2, top_y - 2);
      w.add$ mk_drawable tag draw_line (scheme.top_colour, left_x - 1,top_y - 1,right_x + 1, top_y - 1);
      // left
      w.add$ mk_drawable tag draw_line (scheme.left_colour, left_x - 2,top_y - 2,left_x - 2, bottom_y + 2);
      w.add$ mk_drawable tag draw_line (scheme.left_colour, left_x - 1,top_y - 1,left_x - 1, bottom_y + 1);
      // right
      w.add$ mk_drawable tag draw_line (scheme.right_colour, right_x + 2,top_y - 2,right_x + 2, bottom_y + 2);
      w.add$ mk_drawable tag draw_line (scheme.right_colour, right_x + 1,top_y - 1,right_x + 1, bottom_y + 1);
      // bottom
      w.add$ mk_drawable tag draw_line (scheme.bottom_colour, left_x - 1,bottom_y + 1,right_x + 1, bottom_y + 1);
      w.add$ mk_drawable tag draw_line (scheme.bottom_colour, left_x - 2,bottom_y + 2,right_x + 2, bottom_y + 2);

      w.add$ mk_drawable tag fill(SDL_Rect (left_x, top_y, right_x - left_x + 1, bottom_y - top_y + 1), scheme.bg_colour);

      var selected = match position with
        | #Empty => 0 // ignore for the moment
        | Cons (h,_) => h
      ;

      var counter = 0;
      var ypos = top_y + top_padding;
      proc show_entry (entry: menu_entry_t) (submenu:menu_data_t) =>
        match entry with
        | #Separator =>
          var y = ypos;
          w.add$ mk_drawable tag draw_line (RGB(0,0,0), left_x, y, right_x, y);
          ypos = ypos + separator_depth + bottom_padding + top_padding;

        | Text (label=s,active=active) =>
          y = ypos + baseline_offset;
          var scheme, dosub = match active with
            | #Active => if counter == selected then selected_colour, true else text_colour, false
            | #Disabled => disabled_colour, false
          ;
          var client_area = rect_t (
            left_x+border_width,
            ypos+top_padding,
            right_x - left_x - 2 * border_width,
            lineskip
          );
          w.add$ mk_drawable tag fill (client_area, scheme.bg_colour);
          w.add$ mk_drawable tag FlxGui::write (left_x+left_padding, y,font,scheme.label_colour,s);

          match submenu with
          | #Empty => ;
          | _ =>
            var icon = if selected == counter then submenu_icons.open_icon else submenu_icons.closed_icon;
            var dst = rect_t (right_x - icon_width - border_width - 1, ypos, 0,0);
            w.add$ mk_drawable tag blit (dst.x, dst.y, icon.get_sdl_surface());
            if dosub do
              var subpos = match position with
                | Cons (_,tail) => tail
                | _ => position // empty
              ;
              display_menu (right_x+border_width,ypos+border_width,submenu,subpos);
            done
          endmatch;
          ypos = ypos + lineskip + bottom_padding+top_padding;
          ++counter;
        endmatch
      ;
      for item in menu do
        match item with
        | Leaf entry => show_entry entry Empty[LS_expr::lsexpr[menu_entry_t, menu_entry_t]];
        | Tree (entry, submenu) => show_entry entry submenu;
        endmatch;
      done
    }
    method proc display() {
      val position = match #(m.get_state) with
        | #Closed => list (0)
        | Open p => p
      ;
      display_menu (x,y,#(m.get_menu), position);
      //w.update();
    }

    proc get_hotrecs(x:int, y:int, menu:menu_data_t, position:menu_position_t)
      (revtrail: list[int])
      (photrecs:&list[rect_t * menu_position_t])=
    {
//println$ "get_hotrecs, revtrail=" + revtrail.str+", pos=" + position.str;
      var left_x = x;
      var top_y = y;
      var right_x = left_x + width menu;
      var bottom_y = top_y + depth menu;

      var selected = match position with
        | #Empty => 0 // ignore for the moment
        | Cons (h,_) => h
      ;

      var counter = 0;
      var ypos = top_y + top_padding;
      proc hotrecs (entry: menu_entry_t) (submenu:menu_data_t)
      {
        match entry with
        | #Separator =>
          ypos = ypos + separator_depth + bottom_padding + top_padding;
//println$ "SEPARATOR : Counter="+counter.str;

        | Text (label=s,active=active) =>
          y = ypos + baseline_offset;
          var dosub = match active with
            | #Active => counter == selected
            | #Disabled => false
          ;
          var client_area = rect_t (
            left_x+border_width,
            ypos+top_padding,
            right_x - left_x - 2 * border_width,
            lineskip
          );
//println$ "TEXT: Counter="+counter.str+", Rect=" + client_area.str;
          match active with
          | #Active => photrecs <- (client_area, rev (counter + revtrail)) + *photrecs;
          | #Disabled => ;
          endmatch;
          match submenu with
          | #Empty => ;
          | _ =>
            if dosub do
              var subpos = match position with
                | Cons (_,tail) => tail
                | _ => position // empty
              ;
              get_hotrecs (right_x+border_width,ypos+border_width,submenu,subpos) (counter+revtrail) photrecs;
            done
          endmatch;
          ypos = ypos + lineskip + bottom_padding+top_padding;
          ++counter;
        endmatch;
      }
      for item in menu do
        match item with
        | Leaf entry => hotrecs entry Empty[LS_expr::lsexpr[menu_entry_t, menu_entry_t]];
        | Tree (entry, submenu) => hotrecs entry submenu;
        endmatch;
      done
    }

    method fun get_hotrects() : list[rect_t * menu_position_t] =
    {
      val position = match #(m.get_state) with
        | #Closed => list (0)
        | Open p => p
      ;
      var hotrecs = Empty[rect_t * menu_position_t];
      get_hotrecs (x,y,#(m.get_menu),position) Empty[int] &hotrecs;
      return rev hotrecs;
    }

  }

  fun hotpos (point:SDL_Point, hot:list[rect_t * menu_position_t]) : opt[menu_position_t] =>
    match hot with
    | #Empty => None[menu_position_t]
    | Cons ((r,pos),tail) =>
      if point \in r then Some pos else hotpos (point, tail)
    endmatch
  ;

  // ===============================================================================
  object MenuBarDisplay
  (
    tag:string,
    m:menu_model_t,
    w:window_t,
    x:int,y:int,
    font:font_t,
    text_colour: button_colour_scheme_t,
    disabled_colour: button_colour_scheme_t,
    selected_colour: button_colour_scheme_t,
    submenu_icons: submenu_icon_t
  ) implements menu_display_t =
  {
    method fun get_tag() => tag;
    var icon_width = max (submenu_icons.open_icon.get_width(), submenu_icons.closed_icon.get_width());
    var lineskip = get_lineskip font;
    var baseline_offset = font.TTF_FontAscent;
    var border_width = 2;
    var left_padding = 4;
    var right_padding = 4;
    var min_width = 20;
    var separator_width = 1;
    var top_padding = 1;
    var bottom_padding = 1;
    var bar_depth =
      top_padding + bottom_padding + lineskip
    ;

    fun width (s:string) => (FlxGuiFont::get_textsize (font,s)).0;

    fun width: menu_entry_t -> int =
      | #Separator => left_padding + right_padding + separator_width
      | Text s => left_padding + right_padding + max(min_width, width s.label)
    ;

    fun width : menu_item_t -> int =
      | Leaf menu_entry => width menu_entry
      | Tree (menu_entry,_) => width menu_entry
    ;

    fun width (ls: menu_data_t) => fold_left
      (fun (w:int) (menu_item:menu_item_t) => w + width menu_item)
      0
      ls
    ;

    proc display_menu(x:int, y:int, menu:menu_data_t, position:menu_position_t)
    {
      var left_x = x;
      var top_y = y;
      var right_x = left_x + width menu;
      var bottom_y = top_y + bar_depth;
      var scheme = text_colour;

      w.remove tag;
      // top
      w.add$ mk_drawable tag draw_line (scheme.top_colour, left_x - 2,top_y - 2,right_x + 2, top_y - 2);
      w.add$ mk_drawable tag draw_line (scheme.top_colour, left_x - 1,top_y - 1,right_x + 1, top_y - 1);
      // left
      w.add$ mk_drawable tag draw_line (scheme.left_colour, left_x - 2,top_y - 2,left_x - 2, bottom_y + 2);
      w.add$ mk_drawable tag draw_line (scheme.left_colour, left_x - 1,top_y - 1,left_x - 1, bottom_y + 1);
      // right
      w.add$ mk_drawable tag draw_line (scheme.right_colour, right_x + 2,top_y - 2,right_x + 2, bottom_y + 2);
      w.add$ mk_drawable tag draw_line (scheme.right_colour, right_x + 1,top_y - 1,right_x + 1, bottom_y + 1);
      // bottom
      w.add$ mk_drawable tag draw_line (scheme.bottom_colour, left_x - 1,bottom_y + 1,right_x + 1, bottom_y + 1);
      w.add$ mk_drawable tag draw_line (scheme.bottom_colour, left_x - 2,bottom_y + 2,right_x + 2, bottom_y + 2);

      w.add$ mk_drawable tag fill(SDL_Rect (left_x, top_y, right_x - left_x + 1, bottom_y - top_y + 1), scheme.bg_colour);

      var selected = match position with
        | #Empty => 0 // ignore for the moment
        | Cons (h,_) => h
      ;

      var counter = 0;
      var xpos = left_x + left_padding;
//println$ "Display Menu "+ tag;
      proc show_entry (entry: menu_entry_t) (submenu:menu_data_t) =>
        match entry with
        | #Separator =>
          w.add$ mk_drawable tag draw_line (RGB(0,0,0), xpos, top_y, xpos, top_y+bar_depth);
          xpos = xpos + separator_width + right_padding + left_padding;

        | Text (label=s,active=active) =>
          var scheme, dosub = match active with
            | #Active => if counter == selected then selected_colour, true else text_colour, false
            | #Disabled => disabled_colour, false
          ;
          var item_width =  max (width s, min_width);
          var client_area = rect_t (
            xpos+border_width,
            top_y+top_padding,
            item_width,
            lineskip
          );
          w.add$ mk_drawable tag fill (client_area, scheme.bg_colour);
//println$ "Menu bar counter=" + counter.str + ", xpos= " + xpos.str + ", text="+s.str;
          w.add$ mk_drawable tag FlxGui::write (
            xpos+left_padding,
            top_y+baseline_offset,
            font,
            scheme.label_colour,
            s
          );

          match submenu with
          | #Empty => ;
          | _ =>
            if dosub do
              println "SUBMENU SELECTED";
              var smm = MenuModel ( submenu );
              var smd = MenuDisplay ( tag,
                smm,
                w,
                xpos,bottom_y+border_width,
                font,
                text_colour,
                disabled_colour,
                selected_colour,
                submenu_icons
              );
              match position with
              | Cons (_,tail) => smm.set_state (Open tail);
              | _ => ;
              endmatch;
              smd.display();
            done
          endmatch;
          xpos = xpos + item_width + right_padding+left_padding;
          ++counter;
        endmatch
      ;
      for item in menu do
        match item with
        | Leaf entry => show_entry entry Empty[LS_expr::lsexpr[menu_entry_t, menu_entry_t]];
        | Tree (entry, submenu) => show_entry entry submenu;
        endmatch;
      done
    }

    method proc display() {
      val position = match #(m.get_state) with
        | #Closed => list (0)
        | Open p => p
      ;
      display_menu (x,y,#(m.get_menu), position);
      //w.update();
    }
    proc get_hotrecs(x:int, y:int, menu:menu_data_t, position:menu_position_t)
      (revtrail: list[int])
      (photrecs:&list[rect_t * menu_position_t])=
    {
//println$ "get_hotrecs, revtrail=" + revtrail.str+", pos=" + position.str;
      var left_x = x;
      var top_y = y;
      var right_x = left_x + width menu;
      var bottom_y = top_y + bar_depth;

      var selected = match position with
        | #Empty => 0 // ignore for the moment
        | Cons (h,_) => h
      ;

      var counter = 0;
      var xpos = left_x + left_padding;
      proc hotrecs (entry: menu_entry_t) (submenu:menu_data_t)
      {
        match entry with
        | #Separator =>
          xpos = xpos + separator_width + right_padding + left_padding;
//println$ "SEPARATOR : Counter="+counter.str;

        | Text (label=s,active=active) =>
          var dosub = match active with
            | #Active => counter == selected
            | #Disabled => false
          ;
          var item_width = max (width s, min_width);
          var client_area = rect_t (
            xpos+border_width,
            top_y+top_padding,
            item_width,
            lineskip
          );
//println$ "TEXT: Counter="+counter.str+", Rect=" + client_area.str;
          match active with
          | #Active => photrecs <- (client_area, rev (counter + revtrail)) + *photrecs;
          | #Disabled => ;
          endmatch;
          match submenu with
          | #Empty => ;
          | _ =>
            if dosub do
              var smm = MenuModel ( submenu );
              var smd = MenuDisplay (tag,
                smm,
                w,
                xpos,bottom_y+border_width,
                font,
                text_colour,
                disabled_colour,
                selected_colour,
                submenu_icons
              );
              match position with
              | Cons (_,tail) => smm.set_state (Open tail);
              | _ => ;
              endmatch;
              var shots = smd.get_hotrects();
              shots = map (fun (h:rect_t,pos:menu_position_t) => (h,Cons(counter,pos) )) shots;
              photrecs <- *photrecs + shots;
            done
          endmatch;
          xpos = xpos + item_width + right_padding +left_padding;
          ++counter;
        endmatch;
      }
      for item in menu do
        match item with
        | Leaf entry => hotrecs entry Empty[LS_expr::lsexpr[menu_entry_t, menu_entry_t]];
        | Tree (entry, submenu) => hotrecs entry submenu;
        endmatch;
      done
    }


    method fun get_hotrects() : list[rect_t * menu_position_t] =
    {
      val position = match #(m.get_state) with
        | #Closed => list (0)
        | Open p => p
      ;
      var hotrecs = Empty[rect_t * menu_position_t];
      get_hotrecs (x,y,#(m.get_menu),position) Empty[int] &hotrecs;
      return rev hotrecs;
    }

  }
  // ===============================================================================


  chip menu_controller
  (
    mm: menu_model_t,
    md: menu_display_t
  )
  connector mio
    pin ec: %<event_t
    pin response: %>menu_action_t
  {
    md.display();
    var run = true;
    var e = read mio.ec;
    while run do
      match e.type.SDL_EventType with
      | $(SDL_WINDOWEVENT) =>
        match e.window.event.SDL_WindowEventID with
        | $(SDL_WINDOWEVENT_RESIZED) =>
          md.display();
          write$ mio.response, NoAction;

        | _ => write$ mio.response, NoAction;
        endmatch;

      | $(SDL_MOUSEMOTION) =>
        var hotrecs = md.get_hotrects();
        //List::iter proc (r:rect_t, pos:menu_position_t) { println$ "Rect=" + r.str + ", Pos=" + pos.str; } hotrecs;

        var x,y = e.motion.x,e.motion.y; //int32
        match hotpos ( SDL_Point (x.int,y.int), hotrecs) with
        | #None =>
          write$ mio.response, NoAction;
        | Some pos =>
          println$ "Mouse Move Position " + pos.str;
          match #(mm.get_state) with
          | #Closed =>
            write$ mio.response, ChangedPosition;
          | Open oldpos =>
            if oldpos == pos do
              write$ mio.response, NoAction;
            else
              mm.set_state (Open pos);
              write$ mio.response, ChangedPosition;
            done
          endmatch;
        endmatch;

      | $(SDL_MOUSEBUTTONDOWN) =>
        hotrecs = md.get_hotrects();
        x,y = e.button.x,e.button.y; //int32
        match hotpos ( SDL_Point (x.int,y.int), hotrecs) with
        | #None =>
          write$ mio.response, NoAction;
        | Some pos =>
          println$ "Mouse down Position " + pos.str;
          match #(mm.get_state) with
          | #Closed =>
            write$ mio.response, ChangedPosition;
          | Open oldpos =>
            if oldpos == pos do
              write$ mio.response, NoAction;
            else
              mm.set_state (Open pos);
              write$ mio.response, ChangedPosition;
            done
          endmatch;
        endmatch;

      | $(SDL_MOUSEBUTTONUP) =>
        hotrecs = md.get_hotrects();
        x,y = e.button.x,e.button.y; //int32
        match hotpos ( SDL_Point (x.int,y.int), hotrecs) with
        | #None =>
          write$ mio.response, NoAction;
        | Some pos =>
          println$ "Mouse up Position " + pos.str;
          match #(mm.get_state) with
          | #Closed =>
            write$ mio.response, ChangedPosition;
          | Open oldpos =>
            if oldpos == pos do
              var selected_tag = #(mm.get_current_tag);
              write$ mio.response, SelectedAction selected_tag;
            else
              mm.set_state (Open pos);
              write$ mio.response, ChangedPosition;
            done
          endmatch;
        endmatch;



      | $(SDL_WINDOWEVENT) when e.window.event == SDL_WINDOWEVENT_LEAVE.uint8  =>
        write$ mio.response, NoAction;

      | _ =>
        write$ mio.response, NoAction;
      endmatch;
      e = read mio.ec;
    done

  }

}

//[line_buffer_display_controller_interface.flx]
class FlxGuiLineBufferDisplayControllerInterface
{
interface line_buffer_display_controller_interface
{
  get_tag : 1 -> string;
  get_client_rect : 1 -> rect_t;
  get_char_width : 1 -> int;
  display : 1 -> 0;
  set_focus_gained: 1 -> 0; //
  set_focus_lost: 1 -> 0;
}
}

//[line_buffer_display_controller.flx]
include "gui/line_buffer_display_controller_interface";

class FlxGuiLineBufferDisplayController
{
object line_buffer_display_controller
(
  w:window_t, tag:string, f:font_t, c:colour_t, bg:colour_t,
  x: int, y:int, b:line_buffer_interface
)
implements line_buffer_display_controller_interface =
{
  method fun get_tag() => tag;
  method fun get_client_rect () => bounding_box (f,x,y,b.get());
  method fun get_char_width () = {
    var minx:int; var maxx:int; var miny:int; var maxy:int; var advance:int;
    C_hack::ignore$ TTF_GlyphMetrics(f,"m".char.ord.uint16,&minx, &maxx, &miny, &maxy, &advance);
    return advance;
  }

  var has_focus = false;
  method proc set_focus_gained () => has_focus = true;
  method proc set_focus_lost () => has_focus = false;

  method proc display ()
  {
    var nullRect = C_hack::null[SDL_Rect];
    var s = #(b.get);
//  println$ "Edit box = '" + s + "'";
    var text_rendered = TTF_RenderText_Blended(f,s,c);
    var bbox = bounding_box (f,x,y,s);
//println$ "Bounding box for ("+x.str+","+y.str+")=("+bbox.x.str+","+bbox.y.str+","+bbox.w.str+","+bbox.h.str+")";
    w.remove tag;
    w.add$ mk_drawable tag fill (bbox,bg);
    var viewport: SDL_Rect;
    var minx:int; var maxx:int; var miny:int; var maxy:int; var advance:int;
    C_hack::ignore$ TTF_GlyphMetrics(f,"m".char.ord.uint16,&minx, &maxx, &miny, &maxy, &advance);

    viewport&.x <- bbox.x + min(minx,0) + 2;
    viewport&.y <- bbox.y + 2; // actually y + font.ascent + 2
    viewport&.h <-  bbox.h;
//println$ "Viewpos for ("+x.str+","+y.str+")=("+viewport.x.str+","+viewport.y.str;
    w.add$ mk_drawable tag blit (viewport.x, viewport.y, text_rendered);
    //SDL_FreeSurface text_rendered;
    if has_focus do
      var charwidth =
        #{
          var minx:int; var maxx:int; var miny:int; var maxy:int; var advance:int;
          C_hack::ignore$ TTF_GlyphMetrics(f,"m".char.ord.uint16,&minx, &maxx, &miny, &maxy, &advance);
          return advance;
        }
      ;
      var curpos = x + charwidth * #(b.get_pos);
      w.add$ mk_drawable tag draw_line(red,curpos,viewport.y - 1,curpos,viewport.y + viewport.h - 2);
    done
  }
  display();
}
}

//[line_buffer_interface.flx]
class FlxGuiLineBufferInterface
{
  interface line_buffer_interface
  {
    get: 1 -> string;
    get_pos: 1 -> int;
    set_pos: int -> 0;

    // movement
    mv_left : 1 -> 0;
    mv_right : 1 -> 0;
    mv_start : 1 -> 0;
    mv_end : 1 -> 0;

    // insert and overwrite
    ins: char -> 0;
    ovr: char -> 0;

    // delete
    del_left: 1 -> 0;
    del_right: 1 -> 0;
    clear : 1 ->0;
    clear_right : 1 -> 0;
    clear_left : 1 -> 0;
  }
}

//[line_buffer_object.flx]
include "gui/line_buffer_interface";

class FlxGuiLineBuffer
{
  object line_buffer (n:int, var b:string) implements line_buffer_interface =
  {
    b = substring (b+ ' ' *n,0,n); //clip and pad to n chars
    assert b.len.int == n;

    // caret position: can range between 0 and n inclusive!
    // its the position *between* two characters!!
    var pos = 0;
    method fun get() => b;
    method fun get_pos () => pos;
    method proc set_pos (x:int) => pos = x;

    // movement
    method proc mv_left () => pos = max (0,pos - 1);
    method proc mv_right () => pos = min (n, pos + 1);
    method proc mv_start () => pos = 0;
    method proc mv_end () => pos = n;

    // insert and move right
    method proc ins (ch:char)
    {
      b = substring (b, 0, pos) + ch + substring (b, pos, n);
      pos = min (pos + 1, n);
      assert b.len.int == n;
    }
    // overwrite and move right
    method proc ovr (ch:char)
    {
      if pos < n do
        b = substring (b, 0, pos) + ch + substring (b, pos+1, n);
        pos = min (pos + 1, n);
      done
      assert b.len.int == n;
    }
    // delete to the left
    method proc del_left ()
    {
      if pos > 0 do
        b = substring (b, 0, pos - 1) + substring (b, pos, n) + ' ';
        pos = max (0, pos - 1);
      done
      assert b.len.int == n;
    }
    // delete to the right
    method proc del_right ()
    {
      if pos < n do
        b = substring (b, 0, pos) + substring (b, pos + 1, n) + ' ';
      done
      assert b.len.int == n;
    }
    // clear all
    method proc clear ()
    {
      b = ' ' *n;
      pos = 0;
      assert b.len.int == n;
    }
    method proc clear_right ()
    {
      b = substring (b, 0, pos) + ' ' * (n - pos);
      assert b.len.int == n;
    }
    method proc clear_left ()
    {
      b = substring (b, pos, n) + ' ' * pos;
      pos = 0;
      assert b.len.int == n;
    }
  }

}

//[line_editor.flx]
class FlxGuiLineEditor
{
chip line_edit
  (b:line_buffer_interface)
  (d:line_buffer_display_controller_interface)
  connector lin
    pin ec: %<event_t
{
  //println$ "Line buffer running";
  d.display();
  var run = true;
  var e : event_t = read lin.ec;
  while run do
    match e.type.SDL_EventType with
    | $(SDL_WINDOWEVENT) =>
      match e.window.event.SDL_WindowEventID with
      | $(SDL_WINDOWEVENT_FOCUS_GAINED) => d.set_focus_gained (); d.display();
      | $(SDL_WINDOWEVENT_FOCUS_LOST) => d.set_focus_lost (); d.display();
      | $(SDL_WINDOWEVENT_RESIZED) =>  d.display();
      | _ => ;
      endmatch;

    | $(SDL_MOUSEBUTTONDOWN) =>
      var x,y = e.button.x,e.button.y; //int32
      if SDL_Point (x.int,y.int) \in d.get_client_rect () do
        var w = d.get_char_width();
        var inchar = (x.int - (d.get_client_rect()).x + w / 2) / w;
        //println$ "Button down in client rect of line edit " + d.get_tag() + ", pos = " + inchar.str;
        b.set_pos inchar;
        d.display();
      done


    | $(SDL_KEYDOWN) =>
      var vkey = e.key.keysym.sym;
      match vkey with
      | $(SDLK_LEFT) => b.mv_left (); d.display();
      | $(SDLK_RIGHT) => b.mv_right (); d.display();
      | $(SDLK_HOME) => b.mv_start (); d.display();
      | $(SDLK_END) => b.mv_end (); d.display();
      | $(SDLK_DELETE) => b.del_right(); d.display();
      | $(SDLK_BACKSPACE) => b.del_left(); d.display();
      | $(SDLK_RETURN) => b.mv_start(); d.display();
      | $(SDLK_TAB) => b.mv_start(); d.display();
      | _ => ;
      endmatch;
    | $(SDL_TEXTINPUT) =>
      var text_buffer : +char = e.text.text;
      var ch = text_buffer . 0;
      b.ovr ch;
      d.display();

    // NOTE: not an actual SDL_QUIT!
    // We just need something to terminate.
    // Should be sent on window close actually.
    | $(SDL_QUIT) =>
      run = false;
    | _ => ;
    endmatch;
    e = read lin.ec;
  done
} //chip
} //class

Tools

//[linegraph.flx]
include "gui/__init__";


library GraphTools {
open FlxGui;
  interface linegraph_t {
    title: string;
    func: double -> double;
    xmin: double;
    xmax: double;
    ymin: double;
    ymax: double;
    client: rect_t;
  }

  proc linegraph (g:linegraph_t) {
    // SDL
    FlxGui::init();

    // window
    var w = create_resizable_window(g.title,
      g.client.x,g.client.y,g.client.w,g.client.h
    );
    w.add$ mk_drawable FlxGui::clear lightgrey;

    // font and label
    var font_name = dflt_sans_serif_font();
    var font : font_t = get_font(font_name, 12);
    var bigfont : font_t = get_font(font_name, 14);
    var lineskip = get_lineskip font;

    // bounding box for graph
    var t = 20;
    var l = 50;
    var b = g.client.h - 90;
    var r = g.client.w - 10;
    w.add$ mk_drawable FlxGui::write (l+(r - l)/2,10,bigfont,black,g.title);


    var c = RGB(0,0,255);
    var c2 = RGB(0,0,0);

    // top
    w.add$ mk_drawable draw_line (c, l - 5,t,r,t);
    w.add$ mk_drawable FlxGui::write (l - 40,t,font,black,g.ymax.str);

    // bottom
    w.add$ mk_drawable draw_line (c, l - 5,b,r,b);
    w.add$ mk_drawable FlxGui::write (l - 40,b,font,black,g.ymin.str);

    // left
    w.add$ mk_drawable draw_line (c, l,t,l,b + 5);
    w.add$ mk_drawable FlxGui::write (l,b + 15,font,black,g.xmin.str);

    // right
    w.add$ mk_drawable draw_line (c, r,t,r,b + 5);
    w.add$ mk_drawable FlxGui::write (r - 40,b + 15,font,black,g.xmax.str);

    // coordinate transforms
    fun i2x (i:int): double =>  (i - l).double / (r - l).double * (g.xmax - g.xmin) + g.xmin;
    fun y2j (y:double) : int => b-((y - g.ymin)/ (g.ymax - g.ymin) * (b - t).double).int;
    fun x2i (x:double) : int => ((x - g.xmin) / (g.xmax - g.xmin) * (r - l).double).int + l;

    // x axis (y=0)
    var jorig = y2j 0.0;
    w.add$ mk_drawable FlxGui::write (l - 40,jorig,font,black,"0");
    w.add$ mk_drawable draw_line (blue,l,jorig,r,jorig);

    // y axis (x=0)
    var iorig = x2i 0.0;
    w.add$ mk_drawable draw_line (red,iorig,t,iorig,b+5);
    w.add$ mk_drawable FlxGui::write (iorig,b+15,font,black,"0");

    w.update();
    w.show();


    var oldi = -2000;
    var oldj = 0;
    rfor i in l..r do
      var x = i2x i;
      var y = g.func x;
      var j = y2j y;
      //println$ g.title+"(" + x.str + ")=" y.str + ", coord(" + i.str + "," + j.str + ")";
      var data = c2,oldi,oldj,i,j;
      if oldi != -2000 do
        w.add$ mk_drawable draw_line data;
      done
      oldi = i;
      oldj= j;
      w.update();
      sleep(0.01);
    done
    w.add$ mk_drawable draw_line (c, l,t,r,b);

    w.update();
    var wm = window_manager();
    wm.run_with_timeout 15.0;
    FlxGui::quit();
  } // lilnegraph
} // GraphTools

Package: src/packages/regex.fdoc

Regular Expressions

key file
re2.py $PWD/buildsystem/re2.py
unix_re2.fpc $PWD/src/config/unix/re2.fpc
win_re2.fpc $PWD/src/config/win/re2.fpc
flx_re2_config.hpp share/lib/rtl/flx_re2_config.hpp
key file
__init__.flx share/lib/std/regex/__init__.flx
key file
re2.flx share/lib/std/regex/re2.flx
tre.flx share/lib/std/regex/tre.flx
regdef.flx share/lib/std/regex/regdef.flx
lexer.flx share/lib/std/regex/lexer.flx
key file
regexp_index.fdoc $PWD/src/web/tut/regexp_index.fdoc

RE2 Bootstrap Builder

#[re2.py]

import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record

import buildsystem

# ------------------------------------------------------------------------------

def build_runtime(phase):
    path = Path(phase.ctx.buildroot/'share'/'src/re2/re2')

    buildsystem.copy_to(phase.ctx, phase.ctx.buildroot / "share/lib/rtl/re2", [
        path / 're2/re2.h',
        path / 're2/set.h',
        path / 're2/stringpiece.h',
        path / 're2/variadic_function.h',
        ]
     )

    dst = 'host/lib/rtl/flx_re2'
    srcs = [
        path / 're2/bitstate.cc',
        path / 're2/compile.cc',
        path / 're2/dfa.cc',
        path / 're2/filtered_re2.cc',
        path / 're2/mimics_pcre.cc',
        path / 're2/nfa.cc',
        path / 're2/onepass.cc',
        path / 're2/parse.cc',
        path / 're2/perl_groups.cc',
        path / 're2/prefilter.cc',
        path / 're2/prefilter_tree.cc',
        path / 're2/prog.cc',
        path / 're2/re2.cc',
        path / 're2/regexp.cc',
        path / 're2/set.cc',
        path / 're2/simplify.cc',
        path / 're2/tostring.cc',
        path / 're2/unicode_casefold.cc',
        path / 're2/unicode_groups.cc',
        path / 'util/arena.cc',
        #path / 'util/benchmark.cc',
        path / 'util/hash.cc',
        #path / 'util/pcre.cc',
        #path / 'util/random.cc',
        path / 'util/rune.cc',
        path / 'util/stringpiece.cc',
        path / 'util/stringprintf.cc',
        path / 'util/strutil.cc',
        #path / 'util/thread.cc',
        path / 'util/valgrind.cc',
     ]
    includes = [
      phase.ctx.buildroot / 'share/lib/rtl',
      phase.ctx.buildroot / 'host/lib/rtl',
      path ]
    macros = ['BUILD_RE2'] + (['WIN32', 'NOMINMAX'],[])[not 'win32' in phase.platform]
    cflags = ([], ['-Wno-sign-compare'])[not 'win32' in phase.platform]
    lflags = []
    libs = []
    external_libs = []

    return Record(
        static=buildsystem.build_cxx_static_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            cflags=cflags,
            libs=libs,
            external_libs=external_libs,
            lflags=lflags),
        shared=buildsystem.build_cxx_shared_lib(phase, dst, srcs,
            includes=includes,
            macros=macros,
            cflags=cflags,
            libs=libs,
            external_libs=external_libs,
            lflags=lflags))

String handling

//[__init__.flx]
include "std/regex/re2";
include "std/regex/tre";
include "std/regex/regdef";
include "std/regex/lexer";

RE2 regexps

//[re2.flx]

include "stl/stl_map";

//$ Binding of Google RE2 regexp library.
open class Re2 {
  requires package "re2";

// This is an almost full binding of Google's re2 package.
// We do not support conversions of digits strings to integers
//
// TODO: we need to check the lvalue handling here
// The RE2, Options classes aren't copyable, so we may have
// to use pointers
//
// TODO: named group extractor

  // hackery because ::re2::RE2 isn't copyable, so we have to use a pointer
  // but we need the shape of RE2 to create on the heap
  private body RE2_serial = """
  static ::std::string RE2_encoder(void *p) {
    return (*(::std::shared_ptr< ::re2::RE2>*)p)->pattern();
  }

  static size_t RE2_decoder (void *p, char *s, size_t i) {
    char tmp[sizeof(::std::string)];
    i = ::flx::gc::generic::string_decoder (&tmp,s,i);
    new(p) ::std::shared_ptr< ::re2::RE2> (new ::re2::RE2 (*(::std::string*)(&tmp)));
    ::destroy((::std::string*)&tmp);
    return i;
  }
  """;
/*
  private type RE2_ = "::re2::RE2"
  ;
*/
  type RE2 = "::std::shared_ptr< ::re2::RE2>"
    requires Cxx11_headers::memory,
    RE2_serial, encoder "RE2_encoder", decoder "RE2_decoder"
  ;

  gen _ctor_RE2 : string -> RE2 = "::std::shared_ptr< ::re2::RE2>(new RE2($1))";


  type StringPiece = "::re2::StringPiece";
    ctor StringPiece: &string = "::re2::StringPiece(*$1)"; // Argument must be reference to variable!
    ctor StringPiece: string = "::re2::StringPiece($1)"; // DANGEROUS DEPRECATE
    ctor StringPiece: unit = "::re2::StringPiece()";
    ctor StringPiece: StringPiece = "::re2::StringPiece($1)"; // copy constructor
    ctor StringPiece: +char * !ints = "::re2::StringPiece($1,$2)"; // array and length
    ctor StringPiece (x:varray[char]) => StringPiece(x.stl_begin,x.len);
    ctor string: StringPiece = "$1.as_string()";
    fun len: StringPiece -> size = "(size_t)$1.length()";
    fun data: StringPiece -> +char = "(char*)$1.data()"; // cast away const


    instance Container[StringPiece,char] {
      fun len: StringPiece -> size = "$1.size()";
    }
    instance Eq[StringPiece] {
      fun == : StringPiece * StringPiece -> bool = "$1==$2";
    }
    instance Tord[StringPiece] {
      fun < : StringPiece * StringPiece -> bool = "$1<$2";
    }
    instance Str[StringPiece] {
      fun str: StringPiece -> string ="$1.as_string()";
    }

  fun subscript (x:StringPiece, s:slice[int]):StringPiece =>
    match s with
    | #Slice_all => x

    | Slice_from (start) =>
      // unsafe, FIXME
      StringPiece (x.data + start.size, x.len.int - start)

    | Slice_to_incl (xend) =>
      // unsafe, FIXME
      StringPiece (x.data, xend + 1)

    | Slice_to_excl (xend) =>
      // unsafe, FIXME
      StringPiece (x.data, xend)

    | Slice_range_incl (start, xend) =>
      // unsafe, FIXME
      StringPiece (x.data + start.size, xend - start+1)

    | Slice_range_excl (start, xend) =>
      // unsafe, FIXME
      StringPiece (x.data + start, xend - start)

    | Slice_one (index) =>
      // unsafe, FIXME
      StringPiece (x.data + index, 1)
    endmatch
  ;

  type Arg = "::re2::Arg";

  type Encoding = "::re2::RE2::Encoding";
    const EncodingUTF8: Encoding = "::re2::RE2::EncodingUTF8";
    const EncodingLatin1: Encoding = "::re2::RE2::EncodingLatin1";

  type RE2Options = "::re2::RE2::Options";

    proc Copy: RE2Options * RE2Options = "$1.Copy($2);";

    fun encoding: RE2Options -> Encoding = "$1.encoding()";
    proc set_encoding: RE2Options * Encoding = "$1.set_encoding($2);";

    fun posix_syntax: RE2Options -> bool = "$1.posix_syntax()";
    proc set_posix_syntax: RE2Options * bool = "$1.set_posix_syntax($2);";

    fun longest_match: RE2Options -> bool = "$1.longest_match()";
    proc set_longest_match: RE2Options * bool = "$1.set_longest_match($2);";

    fun log_errors: RE2Options -> bool = "$1.log_errors()";
    proc set_log_errors: RE2Options * bool = "$1.set_log_errors($2);";

    fun max_mem: RE2Options -> int = "$1.max_mem()";
    proc set_max_mem: RE2Options * int = "$1.set_max_mem($2);";

    fun literal: RE2Options -> bool = "$1.literal()";
    proc set_literal: RE2Options * bool = "$1.set_literal($2);";

    fun never_nl: RE2Options -> bool = "$1.never_nl()";
    proc set_never_nl: RE2Options * bool = "$1.set_never_nl($2);";

    fun case_sensitive: RE2Options -> bool = "$1.case_sensitive()";
    proc set_case_sensitive: RE2Options * bool = "$1.set_case_sensitive($2);";

    fun perl_classes: RE2Options -> bool = "$1.perl_classes()";
    proc set_perl_classes: RE2Options * bool = "$1.set_perl_classes($2);";

    fun word_boundary: RE2Options -> bool = "$1.word_boundary()";
    proc set_word_boundary: RE2Options * bool = "$1.set_word_boundary($2);";

    fun one_line: RE2Options -> bool = "$1.one_line()";
    proc set_one_line: RE2Options * bool = "$1.set_one_line($2);";

    fun ParseFlags: RE2Options -> int = "$1.ParseFlags()";

  type ErrorCode = "::re2::RE2::ErrorCode";
    const NoError : ErrorCode = "::re2::RE2::NoError";
    const ErrorInternal: ErrorCode = "::re2::RE2::ErrorInternal";
    const ErrorBadEscape : ErrorCode = "::re2::RE2::ErrorBadEscape";
    const ErrorBadCharClass : ErrorCode = "::re2::RE2::ErrorBadCharClass";
    const ErrorBadCharRange : ErrorCode = "::re2::RE2::ErrorBadCharRange";
    const ErrorMissingBracket : ErrorCode = "::re2::RE2::ErrorMissingBracket";
    const ErrorMissingParen : ErrorCode = "::re2::RE2::ErrorMissingParen";
    const ErrorTrailingBackslash : ErrorCode = "::re2::RE2::ErrorTrailingBackslash";
    const ErrorRepeatArgument : ErrorCode = "::re2::RE2::ErrorRepeatArgument";
    const ErrorRepeatSize : ErrorCode = "::re2::RE2::ErrorRepeatSize";
    const ErrorRepeatOp: ErrorCode = "::re2::RE2::ErrorRepeatOp";
    const ErrorBadPerlOp: ErrorCode = "::re2::RE2::ErrprBadPerlOp";
    const ErrorBadUTF8: ErrorCode = "::re2::RE2::ErrorBadUTF8";
    const ErrorBadNamedCapture: ErrorCode = "::re2::RE2::ErrorBadNamedCapture";
    const ErrorPatternTooLarge: ErrorCode = "::re2::RE2::ErrorPatternTooLarge";

  type Anchor = "::re2::RE2::Anchor";
    const UNANCHORED: Anchor = "::re2::RE2::UNANCHORED";
    const ANCHOR_START: Anchor = "::re2::RE2::ANCHOR_START";
    const ANCHOR_BOTH: Anchor = "::re2::RE2::ANCHOR_BOTH";

  fun pattern: RE2 -> string = "$1->pattern()";
  instance Str[RE2] {
    fun str (r:RE2) => r.pattern;
  }

  fun error: RE2 -> string = "$1->error()";
  fun error_code: RE2 -> ErrorCode = "$1->error_code()";
  fun error_arg: RE2 -> string = "$1->error_arg()";
  fun ok: RE2 -> bool = "$1->ok()";
  fun ProgramSize: RE2 -> int = "$1->ProgramSize()";

  gen GlobalReplace: &string * RE2 * StringPiece -> int = "::re2::RE2::GlobalReplace($1, *$2, $3)";
  gen Extract: StringPiece * RE2 * StringPiece * &string -> bool = "::re2::RE2::Extract($1, *$2, $3, $4)";

  fun QuoteMeta: StringPiece -> string = "::re2::RE2::QuoteMeta($1)";

  fun PossibleMatchRange: RE2 * &string * &string * int -> bool = "$1->PossibleMatchRange($2,$3,$3,$4)";
  fun NumberOfCapturingGroups: RE2 -> int = "$1->NumberOfCapturingGroups()";
  fun NamedCapturingGroups: RE2 -> Stl_Map::stl_map[string, int] = "$1->NamedCapturingGroups()";

  // this function is fully general, just needs an anchor
  gen Match: RE2 * StringPiece * int * Anchor * +StringPiece * int -> bool =
    "$1->Match($2, $3, $2.length(),$4, $5, $6)"
   ;

  noinline gen Match(re:RE2, var s:string) : opt[varray[string]] = {
    var emptystring = "";
    var n = NumberOfCapturingGroups re;
    var v = varray[StringPiece] (n.size+1,StringPiece emptystring);
    var Match-result = Match (re, StringPiece s, 0, ANCHOR_BOTH, v.stl_begin, n+1);
    return
      if Match-result then
        Some$ map string of (StringPiece) v
      else
        None[varray[string]]
    ;
  }

  gen apply (re:RE2, s:string) => Match (re,s);

  fun CheckRewriteString: RE2 * StringPiece * &string -> bool = "$1->CheckRewriteString($2, $3)";

  instance Set[RE2, string] {
    fun \in : string * RE2 -> bool =
      "$2->Match(::re2::StringPiece($1),0, ::re2::StringPiece($1).length(),::re2::RE2::ANCHOR_BOTH, (::re2::StringPiece*)0, 0)"
    ;
  }

  gen iterator (re2:string, var target:string) => iterator (RE2 re2, target);

  instance Iterable[RE2 * string, varray[string]] {
    gen iterator (r:RE2, var target:string) () : opt[varray[string]] = {
      var emptystring = "";
      var l = len target;
      var s = StringPiece target;
      var p1 = s.data;
      var p = 0;
      var n = NumberOfCapturingGroups(r)+1;
      var v1 = varray[StringPiece] (n.size,StringPiece emptystring);
      var v2 = varray[string] (n.size,"");
    again:>
      var result = Match(r, s, p, UNANCHORED,v1.stl_begin, n);
      if not result goto endoff;
      for var i in 0 upto n - 1 do set(v2, i.size, string(v1.i)); done
      var p2 = v1.0.data;
      assert(v1.0.len.int > 0); // prevent infinite loop
      p = (p2 - p1).int+v1.0.len.int;
      yield Some v2;
      goto again;
    endoff:>
      return None[varray[string]];
    }
  }
  inherit Streamable[RE2 * string, Varray::varray[string]];

  // Extract Some match array or None if not matching.
  fun extract (re2:string, target:string) : opt[varray[string]] => iterator (RE2 re2, target) ();
  fun extract (re2:RE2, target:string) : opt[varray[string]] => iterator (re2, target) ();

}

open Set[RE2, string];

Regular definitions

//[regdef.flx]

class Regdef {
  variant regex =
  | Alts of list[regex]
  | Seqs of list[regex]
  | Rpt of regex * int * int
  | Charset of string
  | String of string
  | Group of regex
  | Perl of string
  ;

  private fun prec: regex -> int =
  | Perl _ => 3
  | Alts _ => 3
  | Seqs _ => 2
  | String _ => 2
  | Rpt _ => 1
  | Charset _ => 0
  | Group _ => 0
  ;

  private fun hex_digit (i:int)=>
    if i<10 then string (char (ord (char "0") + i))
    else string (char (ord (char "A") + i - 10))
    endif
  ;
  private fun hex2(c:char)=>
    let i = ord c in
    "\\x" + hex_digit ( i / 16 ) + hex_digit ( i % 16 )
  ;
  private fun charset_quote(c:char)=>
    if c in "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstvuwxyz" then string c
    else hex2 c
    endif
  ;

  private fun hex(s:string when len s > 0uz)= {
    var r = "";
    for var i in 0uz upto len s - 1uz do
      r += charset_quote s.[i];
    done
    return r;
  }

  fun ngrp (s:string)=> "(?:"+s+")";
  private fun cngrp (s:string, op: int, ip: int) => if ip > op then ngrp (s) else s endif;

  fun render: regex -> string =
  | Alts rs => fold_left
   (fun (acc:string) (elt:regex)=>
     (if acc == "" then "" else acc + "|" endif) + (render elt))
    "" rs
  | Seqs rs => fold_left
    (fun (acc:string) (elt:regex)=> acc + cngrp(render elt,2,prec elt))
    "" rs
  | Rpt (r,i,x) =>
    if i == 0 and x == -1 then ngrp (render r) + "*"
    elif i == 1 and x == -1 then ngrp (render r) + "+"
    elif i == 0 and x == 1 then ngrp (render r) + "?"
    else
      cngrp(render r,1,prec r) + "{" + str i + "," + if x < 0 then "" else str x endif + "}"
    endif

  | String s => hex(s)
  | Charset s => "[" + hex s + "]"
  | Group r => "(" + render r + ")"
  | Perl s => s
  ;
}

Lexer

//[lexer.flx]
class Lexer
{
  pod type lex_iterator = "char const*";
  fun start_iterator : string -> lex_iterator = "$1.c_str()";
  fun end_iterator: string -> lex_iterator = "$1.c_str()+$1.size()";
  fun bounds (x:string): lex_iterator * lex_iterator = {
    return
      start_iterator x,
      end_iterator x
    ;
  }
  fun string_between: lex_iterator * lex_iterator -> string =
   "::std::string($1,$2)";

  fun + : lex_iterator * int -> lex_iterator = "$1 + $2";
  fun - : lex_iterator * int -> lex_iterator = "$1 - $2";
  fun - : lex_iterator * lex_iterator -> int = "$1 - $2";
  fun deref: lex_iterator -> char = "*$1";
}

instance Eq[Lexer::lex_iterator] {
  fun == :Lexer::lex_iterator * Lexer::lex_iterator -> bool = "$1==$2";
}

instance Tord[Lexer::lex_iterator] {
  fun < :Lexer::lex_iterator * Lexer::lex_iterator -> bool = "$1<$2";
}

open Eq[Lexer::lex_iterator];

Config

//[unix_re2.fpc]
Name: Re2
Description: Google Re2 regexp library
provides_dlib: -lflx_re2_dynamic
provides_slib: -lflx_re2_static
includes: '"re2/re2.h"'
library: flx_re2
macros: BUILD_RE2
srcdir: src/re2/re2
headers: re2/(re2|set|stringpiece|variadic_function)\.h
src: re2/[^/]*\.cc|util/arena\.cc|util/hash\.cc|util/rune\.cc|util/stringpiece\.cc|util/strutil.cc|util/stringprintf\.cc|util/valgrind\.cc
build_includes: src/re2/re2

//[win_re2.fpc]
Name: Re2
Description: Google Re2 regexp library
provides_dlib: /DEFAULTLIB:flx_re2_dynamic
provides_slib: /DEFAULTLIB:flx_re2_static
includes: '"re2/re2.h"'
library: flx_re2
macros: BUILD_RE2 WIN32 NOMINMAX
srcdir: src\re2\re2
headers: re2\\(re2|set|stringpiece|variadic_function)\.h
src: re2\\[^\\]*\.cc|util\\arena\.cc|util\\hash\.cc|util\\rune\.cc|util\\stringpiece\.cc|util\\strutil.cc|util\\stringprintf\.cc|util\\valgrind\.cc
build_includes: src/re2/re2

//[flx_re2_config.hpp]
#ifndef __FLX_RE2_CONFIG_H__
#define __FLX_RE2_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_RE2
#define RE2_EXTERN FLX_EXPORT
#else
#define RE2_EXTERN FLX_IMPORT
#endif
#endif

Package: src/packages/sdl.fdoc

SDL2 bindings

key file
SDL2.flx share/lib/sdl/SDL2.flx
SDL_active.flx share/lib/sdl/SDL_active.flx
SDL_audio.flx share/lib/sdl/SDL_audio.flx
SDL_cdrom.flx share/lib/sdl/SDL_cdrom.flx
SDL_clipboard.flx share/lib/sdl/SDL_clipboard.flx
SDL_endian.flx share/lib/sdl/SDL_endian.flx
SDL_error.flx share/lib/sdl/SDL_error.flx
SDL_events.flx share/lib/sdl/SDL_events.flx
SDL_framerate.flx share/lib/sdl/SDL_framerate.flx
SDL_gfxPrimitives.flx share/lib/sdl/SDL_gfxPrimitives.flx
SDL_gfxPrimitives_font.flx share/lib/sdl/SDL_gfxPrimitives_font.flx
SDL_image.flx share/lib/sdl/SDL_image.flx
SDL_imageFilter.flx share/lib/sdl/SDL_imageFilter.flx
SDL_joystick.flx share/lib/sdl/SDL_joystick.flx
SDL_keyboard.flx share/lib/sdl/SDL_keyboard.flx
SDL_keycode.flx share/lib/sdl/SDL_keycode.flx
SDL_mixer.flx share/lib/sdl/SDL_mixer.flx
SDL_mouse.flx share/lib/sdl/SDL_mouse.flx
SDL_mutex.flx share/lib/sdl/SDL_mutex.flx
SDL_net.flx share/lib/sdl/SDL_net.flx
SDL_opengl.flx share/lib/sdl/SDL_opengl.flx
SDL_pixels.flx share/lib/sdl/SDL_pixels.flx
SDL_rect.flx share/lib/sdl/SDL_rect.flx
SDL_render.flx share/lib/sdl/SDL_render.flx
SDL_rotozoom.flx share/lib/sdl/SDL_rotozoom.flx
SDL_rwops.flx share/lib/sdl/SDL_rwops.flx
SDL_scancode.flx share/lib/sdl/SDL_scancode.flx
SDL_sound.flx share/lib/sdl/SDL_sound.flx
SDL_surface.flx share/lib/sdl/SDL_surface.flx
SDL_timer.flx share/lib/sdl/SDL_timer.flx
SDL_ttf.flx share/lib/sdl/SDL_ttf.flx
SDL_types.flx share/lib/sdl/SDL_types.flx
SDL_version.flx share/lib/sdl/SDL_version.flx
SDL_video.flx share/lib/sdl/SDL_video.flx
flx_faio_sdl.flx share/lib/sdl/flx_faio_sdl.flx
key file
linux_sdl2.fpc $PWD/src/config/linux/sdl2.fpc
linux_sdl2_image.fpc $PWD/src/config/linux/sdl2_image.fpc
linux_sdl2_ttf.fpc $PWD/src/config/linux/sdl2_ttf.fpc
key file
macosx_sdl2.fpc $PWD/src/config/macosx/sdl2.fpc
macosx_sdl2_image.fpc $PWD/src/config/macosx/sdl2_image.fpc
macosx_sdl2_ttf.fpc $PWD/src/config/macosx/sdl2_ttf.fpc
key file
win_sdl2.fpc $PWD/src/config/win/sdl2.fpc
win_sdl2_image.fpc $PWD/src/config/win/sdl2_image.fpc
win_sdl2_ttf.fpc $PWD/src/config/win/sdl2_ttf.fpc
key file
macosx_SDL2_gfx.fpc $PWD/src/config/macosx/SDL2_gfx.fpc

SDL2.flx

//[SDL2.flx]

open class SDL2
{
  requires package "sdl2";

  const SDL_INIT_EVERYTHING: uint32;
  const SDL_INIT_NOPARACHUTE: uint32;
  const SDL_INIT_JOYSTICK: uint32;
  const SDL_INIT_HAPTIC: uint32;
  const SDL_INIT_CDROM : uint32;
  const SDL_INIT_VIDEO: uint32;
  const SDL_INIT_AUDIO: uint32;
  const SDL_INIT_TIMER: uint32;

  //PROCEDURES
  proc SDL_Quit: 1;
  proc SDL_QuitSubSystem: uint32;

  //FUNCTIONS
  gen SDL_Init: uint32 -> int;
  gen SDL_InitSubSystem: uint32 -> int;
  fun SDL_WasInit: uint32 -> uint32;
}

include "sdl/SDL_error";
include "sdl/SDL_version";

include "sdl/SDL_video";
include "sdl/SDL_events";

include "sdl/SDL_keyboard";
include "sdl/SDL_keycode";
include "sdl/SDL_scancode";
include "sdl/SDL_mouse";
include "sdl/SDL_rect";

include "sdl/SDL_rwops";
include "sdl/SDL_pixels";
include "sdl/SDL_surface";
include "sdl/SDL_render";
include "sdl/SDL_clipboard";

/*
include "std/io/faio";
include "sdl/flx_faio_sdl";

include "sdl/SDL_active";
include "sdl/SDL_audio";
include "sdl/SDL_cdrom";
include "sdl/SDL_endian";
include "sdl/SDL_framerate";
include "sdl/SDL_gfxPrimitives";
include "sdl/SDL_gfxPrimitives_font";
include "sdl/SDL_image";
include "sdl/SDL_imageFilter";
include "sdl/SDL_joystick";
include "sdl/SDL_mixer";
include "sdl/SDL_mutex"; // DONT USE (Felix does it better)
//include "sdl/SDL_net";   // DONT USE (Felix does it better)
include "sdl/SDL_opengl";
include "sdl/SDL_rotozoom";
include "sdl/SDL_sound";
include "sdl/SDL_timer"; // DONT USE (Felix does it better)
include "sdl/SDL_ttf";
include "sdl/SDL_types";

*/

SDL_active.flx

//[SDL_active.flx]


//Module        : SDL_active_h
//Timestamp     : 2006/1/6 2:18:42 UTC
//Timestamp     : 2006/1/6 13:18:42 (local)
//Raw Header    : SDL_active.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SDL_APPACTIVE         0x04            /* The application is active */
//#define SDL_APPINPUTFOCUS     0x02            /* The app has input focus */
//#define SDL_APPMOUSEFOCUS     0x01            /* The app has mouse coverage */
//#define _SDL_active_h

open module SDL_active_h
{
  requires package "sdl";
  header '#include "SDL_active.h"';

  //FUNCTIONS
  fun SDL_GetAppState: 1 -> uint8;
}

SDL_audio.flx

//[SDL_audio.flx]


//Module        : SDL_audio_h
//Timestamp     : 2006/1/6 2:18:42 UTC
//Timestamp     : 2006/1/6 13:18:42 (local)
//Raw Header    : SDL_audio.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1


open module SDL_audio_h
{
  requires package "sdl";
  header '#include "SDL_audio.h"';

  const SDL_MIX_MAXVOLUME : int;
  const AUDIO_S16MSB : uint16;
  const AUDIO_U16MSB : uint16;
  const AUDIO_S16LSB : uint16;
  const AUDIO_U16LSB : uint16;
  const AUDIO_S16SYS : uint16;
  const AUDIO_U16SYS : uint16;
  const AUDIO_S16 : uint16;
  const AUDIO_U16 : uint16;
  const AUDIO_S8 : uint16;
  const AUDIO_U8 : uint16;

  //ABSTRACT TYPES
  type SDL_audiostatus = 'SDL_audiostatus';
  fun eq:SDL_audiostatus * SDL_audiostatus -> bool = "$1==$2";

  //CSTRUCTS
  cstruct SDL_AudioCVT {
    needed: int;
    src_format: uint16;
    dst_format: uint16;
    rate_incr: double;
    buf: &uint8;
    len: int;
    len_cvt: int;
    len_mult: int;
    len_ratio: double;
    filters: &SDL_audio_h_cft_2;
    filter_index: int;
  };
  cstruct SDL_AudioSpec {
    freq: int;
    format: uint16;
    channels: uint8;
    silence: uint8;
    samples: uint16;
    padding: uint16;
    size: uint32;
    callback_: SDL_audio_h_cft_1;
    userdata: address;
  };

  fun get_callback: SDL_AudioSpec -> SDL_audio_h_cft_1 = "$1.callback";

  //C FUNCTION POINTER TYPES
  header '''typedef void (*SDL_audio_h_cft_2)(struct SDL_AudioCVT *,  Uint16);''';
  type SDL_audio_h_cft_2 = 'SDL_audio_h_cft_2';

  header '''typedef void (*SDL_audio_h_cft_1)(void *,  Uint8 *, int);''';
  type SDL_audio_h_cft_1 = 'SDL_audio_h_cft_1';

  typedef flx_audio_callback_arg_t = &uint8 * int;
  typedef flx_audio_callback_t = flx_audio_callback_arg_t -> void;
  export type (flx_audio_callback_t) as "flx_audio_callback_t";
  export type (flx_audio_callback_arg_t) as "flx_audio_callback_arg_t";

  header """
    void SDL_audio_callback(void *obj, Uint8 *stream, int len);
  """;

  body """
    // audio callback thunk
    void SDL_audio_callback(void *obj, Uint8 *stream, int len) {
      flx_audio_callback_t callback = (flx_audio_callback_t)obj;
      flx::rtl::con_t *p =
        callback->
        clone()->
        call(0,flx_audio_callback_arg_t(stream,len))
      ;
      while(p) p = p->resume();
    }
  """;

// not working yet
//  callback proc SDL_audio_callback: SDL_audio_callback * &uint8 * int;

  //STRUCT or UNION TAG ALIASES

  /*
  //TYPE ALIASES
  typedef _struct_SDL_AudioSpec = SDL_AudioSpec;
  typedef _struct_SDL_AudioCVT = SDL_AudioCVT;
  */

  //ENUMERATION CONSTANTS
  const SDL_AUDIO_PAUSED: SDL_audiostatus = 'SDL_AUDIO_PAUSED';
  const SDL_AUDIO_STOPPED: SDL_audiostatus = 'SDL_AUDIO_STOPPED';
  const SDL_AUDIO_PLAYING: SDL_audiostatus = 'SDL_AUDIO_PLAYING';

  //PROCEDURES
  proc SDL_AudioQuit: 1;
  proc SDL_CloseAudio: 1;
  proc SDL_FreeWAV: &uint8;
  proc SDL_LockAudio: 1;
  proc SDL_MixAudio: &uint8 * &uint8 * uint32 * int;
  proc SDL_PauseAudio: int;
  proc SDL_UnlockAudio: 1;

  //FUNCTIONS
  fun SDL_AudioDriverName: &char * int -> &char;
  fun SDL_AudioInit: &char -> int;
  fun SDL_BuildAudioCVT: &SDL_AudioCVT * uint16 * uint8 * int * uint16 * uint8 * int -> int;
  fun SDL_ConvertAudio: &SDL_AudioCVT -> int;
  fun SDL_GetAudioStatus: 1 -> SDL_audiostatus;
  fun SDL_LoadWAV_RW: &SDL_RWops * int * &SDL_AudioSpec * &&uint8 * &uint32 -> &SDL_AudioSpec;
  fun SDL_OpenAudio: &SDL_AudioSpec * &SDL_AudioSpec -> int;
  fun SDL_LoadWAV: &char * &SDL_AudioSpec * &&uint8 * &uint32 -> &SDL_AudioSpec;
}

SDL_cdrom.flx

//[SDL_cdrom.flx]

//Module        : SDL_cdrom_h
//Timestamp     : 2006/1/6 2:18:42 UTC
//Timestamp     : 2006/1/6 13:18:42 (local)
//Raw Header    : SDL_cdrom.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define MSF_TO_FRAMES(M, S, F)        ((M)*60*CD_FPS+(S)*CD_FPS+(F))
//#define FRAMES_TO_MSF(f, M,S,F)       {                                       \
//#define CD_FPS        75
//#define CD_INDRIVE(status)    ((int)status > 0)
//#define SDL_DATA_TRACK        0x04
//#define SDL_AUDIO_TRACK       0x00
//#define SDL_MAX_TRACKS        99
//#define _SDL_cdrom_h

open module SDL_cdrom_h
{
  requires package "sdl";
  header '#include "SDL_cdrom.h"';

  //ABSTRACT TYPES
  type CDstatus = 'CDstatus';

  //CSTRUCTS
  cstruct SDL_CD {
    id: int;
    status: CDstatus;
    numtracks: int;
    cur_track: int;
    cur_frame: int;
    track: &SDL_CDtrack;
  };
  cstruct SDL_CDtrack {
    id: uint8;
    type_: uint8;
    unused: uint16;
    length: uint32;
    offset: uint32;
  };

  //STRUCT or UNION TAG ALIASES

  /*
  //TYPE ALIASES
  typedef _struct_SDL_CD = SDL_CD;
  typedef _struct_SDL_CDtrack = SDL_CDtrack;
  */

  //ENUMERATION CONSTANTS
  const CD_TRAYEMPTY: int = 'CD_TRAYEMPTY';
  const CD_PLAYING: int = 'CD_PLAYING';
  const CD_ERROR: int = 'CD_ERROR';
  const CD_PAUSED: int = 'CD_PAUSED';
  const CD_STOPPED: int = 'CD_STOPPED';

  //PROCEDURES
  proc SDL_CDClose: &SDL_CD;

  //FUNCTIONS
  fun SDL_CDEject: &SDL_CD -> int;
  fun SDL_CDName: int -> &char;
  fun SDL_CDNumDrives: 1 -> int;
  fun SDL_CDOpen: int -> &SDL_CD;
  fun SDL_CDPause: &SDL_CD -> int;
  fun SDL_CDPlay: &SDL_CD * int * int -> int;
  fun SDL_CDPlayTracks: &SDL_CD * int * int * int * int -> int;
  fun SDL_CDResume: &SDL_CD -> int;
  fun SDL_CDStatus: &SDL_CD -> CDstatus;
  fun SDL_CDStop: &SDL_CD -> int;
}

SDL_clipboard.flx

//[SDL_clipboard.flx]


open class SDL_clipboard_h
{
  requires package "sdl2";


  /**
   * \brief Put UTF-8 text into the clipboard
   *
   * \sa SDL_GetClipboardText()
   */
  gen SDL_SetClipboardText: string -> int = "SDL_SetClipboardText($1.c_str())";

  /**
   * \brief Get UTF-8 text from the clipboard, which must be freed with SDL_free()
   *
   * \sa SDL_SetClipboardText()
   */
  private fun gcbt :1 -> +char = "SDL_GetClipboardText()";
  fun SDL_GetClipboardText () : string =
  {
    var p = gcbt();
    var s = string p;
    free p;
    return s;
  }

  /**
   * \brief Returns a flag indicating whether the clipboard exists and contains a text string that is non-empty
   *
   * \sa SDL_GetClipboardText()
   */
  fun SDL_HasClipboardText: 1 -> bool;
}

SDL_endian.flx

//[SDL_endian.flx]

//Module        : SDL_endian_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_endian.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SDL_SwapBE64(X)       (X)
//#define SDL_SwapBE32(X)       (X)
//#define SDL_SwapBE16(X)       (X)
//#define SDL_SwapLE64(X)       SDL_Swap64(X)
//#define SDL_SwapLE32(X)       SDL_Swap32(X)
//#define SDL_SwapLE16(X)       SDL_Swap16(X)
//#define SDL_SwapBE64(X)       SDL_Swap64(X)
//#define SDL_SwapBE32(X)       SDL_Swap32(X)
//#define SDL_SwapBE16(X)       SDL_Swap16(X)
//#define SDL_SwapLE64(X)       (X)
//#define SDL_SwapLE32(X)       (X)
//#define SDL_SwapLE16(X)       (X)
//#define SDL_Swap64(X) (X)
//#define _SDL_endian_h

open module SDL_endian_h
{
  requires package "sdl";
  header '#include "SDL_endian.h"';

  //FUNCTIONS
  fun SDL_ReadBE16: &SDL_RWops -> uint16;
  fun SDL_ReadBE32: &SDL_RWops -> uint32;
  fun SDL_ReadBE64: &SDL_RWops -> uint64;
  fun SDL_ReadLE16: &SDL_RWops -> uint16;
  fun SDL_ReadLE32: &SDL_RWops -> uint32;
  fun SDL_ReadLE64: &SDL_RWops -> uint64;
  fun SDL_Swap16: uint16 -> uint16;
  fun SDL_Swap32: uint32 -> uint32;
  fun SDL_Swap64: uint64 -> uint64;
  fun SDL_WriteBE16: &SDL_RWops * uint16 -> int;
  fun SDL_WriteBE32: &SDL_RWops * uint32 -> int;
  fun SDL_WriteBE64: &SDL_RWops * uint64 -> int;
  fun SDL_WriteLE16: &SDL_RWops * uint16 -> int;
  fun SDL_WriteLE32: &SDL_RWops * uint32 -> int;
  fun SDL_WriteLE64: &SDL_RWops * uint64 -> int;
}

SDL_error.flx

//[SDL_error.flx]

//#define SDL_OutOfMemory()     SDL_Error(SDL_ENOMEM)
//#define _SDL_error_h

open class SDL_error_h
{
  requires package "sdl2";

  //ABSTRACT TYPES
  //type SDL_errorcode = 'SDL_errorcode';

  //ENUMERATION CONSTANTS
  //const SDL_EFSEEK: int = 'SDL_EFSEEK';
  //const SDL_ENOMEM: int = 'SDL_ENOMEM';
  //const SDL_LASTERROR: int = 'SDL_LASTERROR';
  //const SDL_EFREAD: int = 'SDL_EFREAD';
  //const SDL_EFWRITE: int = 'SDL_EFWRITE';

  //PROCEDURES
  proc SDL_ClearError: 1;
  //proc SDL_Error: SDL_errorcode;
  //proc SDL_SetError[t]: t;

  //FUNCTIONS
  fun SDL_GetError: 1 -> string = "::std::string(SDL_GetError())";
}

SDL_events.flx

//[SDL_events.flx]

open class SDL_events_h
{
  requires package "sdl2";

  cenum SDL_EventType =
      SDL_FIRSTEVENT,             /**< Unused (do not remove) */

      /* Application events */
      SDL_QUIT,                   /**< User-requested quit */

      /* These application events have special meaning on iOS, see README.iOS for details */
      SDL_APP_TERMINATING,        /**< The application is being terminated by the OS
                                       Called on iOS in applicationWillTerminate()
                                       Called on Android in onDestroy()
                                  */
      SDL_APP_LOWMEMORY,          /**< The application is low on memory, free memory if possible.
                                       Called on iOS in applicationDidReceiveMemoryWarning()
                                       Called on Android in onLowMemory()
                                  */
      SDL_APP_WILLENTERBACKGROUND, /**< The application is about to enter the background
                                       Called on iOS in applicationWillResignActive()
                                       Called on Android in onPause()
                                  */
      SDL_APP_DIDENTERBACKGROUND, /**< The application did enter the background and may not get CPU for some time
                                       Called on iOS in applicationDidEnterBackground()
                                       Called on Android in onPause()
                                  */
      SDL_APP_WILLENTERFOREGROUND, /**< The application is about to enter the foreground
                                       Called on iOS in applicationWillEnterForeground()
                                       Called on Android in onResume()
                                  */
      SDL_APP_DIDENTERFOREGROUND, /**< The application is now interactive
                                       Called on iOS in applicationDidBecomeActive()
                                       Called on Android in onResume()
                                  */

      /* Window events */
      SDL_WINDOWEVENT,            /**< Window state change */
      SDL_SYSWMEVENT,             /**< System specific event */

      /* Keyboard events */
      SDL_KEYDOWN,                /**< Key pressed */
      SDL_KEYUP,                  /**< Key released */
      SDL_TEXTEDITING,            /**< Keyboard text editing (composition) */
      SDL_TEXTINPUT,              /**< Keyboard text input */

      /* Mouse events */
      SDL_MOUSEMOTION,            /**< Mouse moved */
      SDL_MOUSEBUTTONDOWN,        /**< Mouse button pressed */
      SDL_MOUSEBUTTONUP,          /**< Mouse button released */
      SDL_MOUSEWHEEL,             /**< Mouse wheel motion */

      /* Joystick events */
      SDL_JOYAXISMOTION,          /**< Joystick axis motion */
      SDL_JOYBALLMOTION,          /**< Joystick trackball motion */
      SDL_JOYHATMOTION,           /**< Joystick hat position change */
      SDL_JOYBUTTONDOWN,          /**< Joystick button pressed */
      SDL_JOYBUTTONUP,            /**< Joystick button released */
      SDL_JOYDEVICEADDED,         /**< A new joystick has been inserted into the system */
      SDL_JOYDEVICEREMOVED,       /**< An opened joystick has been removed */

      /* Game controller events */
      SDL_CONTROLLERAXISMOTION,          /**< Game controller axis motion */
      SDL_CONTROLLERBUTTONDOWN,          /**< Game controller button pressed */
      SDL_CONTROLLERBUTTONUP,            /**< Game controller button released */
      SDL_CONTROLLERDEVICEADDED,         /**< A new Game controller has been inserted into the system */
      SDL_CONTROLLERDEVICEREMOVED,       /**< An opened Game controller has been removed */
      SDL_CONTROLLERDEVICEREMAPPED,      /**< The controller mapping was updated */

      /* Touch events */
      SDL_FINGERDOWN,
      SDL_FINGERUP,
      SDL_FINGERMOTION,

      /* Gesture events */
      SDL_DOLLARGESTURE,
      SDL_DOLLARRECORD,
      SDL_MULTIGESTURE,

      /* Clipboard events */
      SDL_CLIPBOARDUPDATE,         /**< The clipboard changed */

      /* Drag and drop events */
      SDL_DROPFILE,                 /**< The system requests a file open */

      /** Events ::SDL_USEREVENT through ::SDL_LASTEVENT are for your use,
       *  and should be allocated with SDL_RegisterEvents()
       */
      SDL_USEREVENT,

      /**
       *  This last event is only for bounding internal arrays
       */
      SDL_LASTEVENT    /* 0xFFFF */
  ;

  instance Str[SDL_EventType] {
    fun str: SDL_EventType -> string =
      | $(SDL_FIRSTEVENT) => "SDL_FIRSTEVENT"
      | $(SDL_QUIT) => "SDL_QUIT"
      | $(SDL_APP_TERMINATING) => "SDL_APP_TERMINATING"
      | $(SDL_APP_LOWMEMORY) => "SDL_APP_LOWMEMORY"
      | $(SDL_APP_WILLENTERBACKGROUND) => "SDL_APP_WILLENTERBACKGROUND"
      | $(SDL_APP_DIDENTERBACKGROUND) => "SDL_APP_DIDENTERBACKGROUND"
      | $(SDL_APP_WILLENTERFOREGROUND) => "SDL_APP_WILLENTERFOREGROUND"
      | $(SDL_APP_DIDENTERFOREGROUND) => "SDL_APP_DIDENTERFOREGROUND"
      | $(SDL_WINDOWEVENT) => "SDL_WINDOWEVENT"
      | $(SDL_SYSWMEVENT) => "SDL_SYSWMEVENT"
      | $(SDL_KEYDOWN) => "SDL_KEYDOWN"
      | $(SDL_KEYUP) => "SDL_KEYUP"
      | $(SDL_TEXTEDITING) => "SDL_TEXTEDITING"
      | $(SDL_TEXTINPUT) => "SDL_TEXTINPUT"
      | $(SDL_MOUSEMOTION) => "SDL_MOUSEMOTION"
      | $(SDL_MOUSEBUTTONDOWN) => "SDL_MOUSEBUTTONDOWN"
      | $(SDL_MOUSEBUTTONUP) => "SDL_MOUSEBUTTONUP"
      | $(SDL_MOUSEWHEEL) => "SDL_MOUSEWHEEL"
      | $(SDL_JOYAXISMOTION) => "SDL_JOYAXISMOTION"
      | $(SDL_JOYBALLMOTION) => "SDL_JOYBALLMOTION"
      | $(SDL_JOYHATMOTION) => "SDL_JOYHATMOTION"
      | $(SDL_JOYBUTTONDOWN) => "SDL_JOYBUTTONDOWN"
      | $(SDL_JOYBUTTONUP) => "SDL_JOYBUTTONUP"
      | $(SDL_JOYDEVICEADDED) => "SDL_JOYDEVICEADDED"
      | $(SDL_JOYDEVICEREMOVED) => "SDL_JOYDEVICEREMOVED"
      | $(SDL_CONTROLLERAXISMOTION) => "SDL_CONTROLLERAXISMOTION"
      | $(SDL_CONTROLLERBUTTONDOWN) => "SDL_CONTROLLERBUTTONDOWN"
      | $(SDL_CONTROLLERBUTTONUP) => "SDL_CONTROLLERBUTTONUP"
      | $(SDL_CONTROLLERDEVICEADDED) => "SDL_CONTROLLERDEVICEADDED"
      | $(SDL_CONTROLLERDEVICEREMOVED) => "SDL_CONTROLLERDEVICEREMOVED"
      | $(SDL_CONTROLLERDEVICEREMAPPED) => "SDL_CONTROLLERDEVICEREMAPPED"
      | $(SDL_FINGERDOWN) => "SDL_FINGERDOWN"
      | $(SDL_FINGERUP) => "SDL_FINGERUP"
      | $(SDL_FINGERMOTION) => "SDL_FINGERMOTION"
      | $(SDL_DOLLARGESTURE) => "SDL_DOLLARGESTURE"
      | $(SDL_DOLLARRECORD) => "SDL_DOLLARRECORD"
      | $(SDL_MULTIGESTURE) => "SDL_MULTIGESTURE"
      | $(SDL_CLIPBOARDUPDATE) => "SDL_CLIPBOARDUPDATE"
      | $(SDL_DROPFILE) => "SDL_DROPFILE"
      | $(SDL_USEREVENT) => "SDL_USEREVENT"
      | x => "UNKNOWN_EVENT #"+x.uint32.str
    ;
  }

  ctor uint32 : SDL_EventType = "(uint32_t)$1";
  ctor SDL_EventType : uint32 = "(SDL_EventType)$1";

  cenum SDL_WindowEventID =
    SDL_WINDOWEVENT_NONE,
    SDL_WINDOWEVENT_SHOWN,
    SDL_WINDOWEVENT_HIDDEN,
    SDL_WINDOWEVENT_EXPOSED,
    SDL_WINDOWEVENT_MOVED,
    SDL_WINDOWEVENT_RESIZED,
    SDL_WINDOWEVENT_SIZE_CHANGED,
    SDL_WINDOWEVENT_MINIMIZED,
    SDL_WINDOWEVENT_MAXIMIZED,
    SDL_WINDOWEVENT_RESTORED,
    SDL_WINDOWEVENT_ENTER,
    SDL_WINDOWEVENT_LEAVE,
    SDL_WINDOWEVENT_FOCUS_GAINED,
    SDL_WINDOWEVENT_FOCUS_LOST,
    SDL_WINDOWEVENT_CLOSE
  ;
  instance Str[SDL_WindowEventID] {
    fun str : SDL_WindowEventID -> string =
    | $(SDL_WINDOWEVENT_NONE) => "none"
    | $(SDL_WINDOWEVENT_SHOWN) => "shown"
    | $(SDL_WINDOWEVENT_HIDDEN) => "hidden"
    | $(SDL_WINDOWEVENT_EXPOSED) => "exposed"
    | $(SDL_WINDOWEVENT_MOVED) => "moved"
    | $(SDL_WINDOWEVENT_RESIZED) => "resized"
    | $(SDL_WINDOWEVENT_SIZE_CHANGED) => "size_changed"
    | $(SDL_WINDOWEVENT_MINIMIZED) => "minimised"
    | $(SDL_WINDOWEVENT_MAXIMIZED) => "maximised"
    | $(SDL_WINDOWEVENT_RESTORED) => "restored"
    | $(SDL_WINDOWEVENT_ENTER) => "enter"
    | $(SDL_WINDOWEVENT_LEAVE) => "leave"
    | $(SDL_WINDOWEVENT_FOCUS_GAINED) => "focus_gained"
    | $(SDL_WINDOWEVENT_FOCUS_LOST) => "focus_lost"
    | $(SDL_WINDOWEVENT_CLOSE) => "close"
    | x => "UnknownWindowEvent #"+x.uint8.str
    ;
  }
  ctor uint8 : SDL_WindowEventID = "(uint8_t)$1";
  ctor SDL_WindowEventID : uint8 = "(SDL_WindowEventID)$1";

  // Warning: inaccurate cstructs are
  // perfectly fine for reading and writing data,
  // even in this case, where the real
  // data is actually a union. All that is important
  // are the field names.
  //
  // However you must NOT constuct one with a
  // struct constructor!
  cstruct SDL_Event {
    type     : uint32;
    window   : SDL_WindowEvent;
    key      : SDL_KeyboardEvent;
    edit     : SDL_TextEditingEvent;
    text     : SDL_TextInputEvent;
    motion   : SDL_MouseMotionEvent;
    button   : SDL_MouseButtonEvent;
    wheel    : SDL_MouseWheelEvent;
    //jaxis    : SDL_JoystickAxisEvent;
    //jball    : SDL_JoystickBallEvent;
    //jhat     : SDL_JoystickHatEvent;
    //jbutton  : SDL_JoystickButtonEvent;
    quit     : SDL_QuitEvent;
    user     : SDL_UserEvent;
    syswm    : SDL_SysWMEvent;
    //tfinger  : SDL_TouchFingerEvent;
    //tbutton  : SDL_TouchButtonEvent;
    //mgesture : SDL_MultiGestureEvent;
    //dgesture : SDL_DollarGestureEvent;
    drop     : SDL_DropEvent;
  };

  /**
   *  \brief Fields shared by every event
   */
  typedef struct SDL_CommonEvent
  {
      uint32 type;
      uint32 timestamp;
  } SDL_CommonEvent;

  /**
   *  \brief Window state change event data (event.window.*)
   */
  typedef struct SDL_WindowEvent
  {
      uint32 type;        /**< ::SDL_WINDOWEVENT */
      uint32 timestamp;
      uint32 windowID;    /**< The associated window */
      uint8 event;        /**< ::SDL_WindowEventID */
      uint8 padding1;
      uint8 padding2;
      uint8 padding3;
      int32 data1;       /**< event dependent data */
      int32 data2;       /**< event dependent data */
  } SDL_WindowEvent;

  /**
   *  \brief Keyboard button event structure (event.key.*)
   */
  typedef struct SDL_KeyboardEvent
  {
      uint32 type;        /**< ::SDL_KEYDOWN or ::SDL_KEYUP */
      uint32 timestamp;
      uint32 windowID;    /**< The window with keyboard focus, if any */
      uint8 state;        /**< ::SDL_PRESSED or ::SDL_RELEASED */
      uint8 repeat;       /**< Non-zero if this is a key repeat */
      uint8 padding2;
      uint8 padding3;
      SDL_Keysym keysym;  /**< The key that was pressed or released */
  } SDL_KeyboardEvent;

  macro val SDL_TEXTEDITINGEVENT_TEXT_SIZE = 32;
  /**
   *  \brief Keyboard text editing event structure (event.edit.*)
   */
  typedef struct SDL_TextEditingEvent
  {
      uint32 type;                                /**< ::SDL_TEXTEDITING */
      uint32 timestamp;
      uint32 windowID;                            /**< The window with keyboard focus, if any */
      +char text;    /* actually a buffer size 32 */ /**< The editing text */
      int32 start;                               /**< The start cursor of selected editing text */
      int32 length;                              /**< The length of selected editing text */
  } SDL_TextEditingEvent;

  macro val SDL_TEXTINPUTEVENT_TEXT_SIZE = 32;
  /**
   *  \brief Keyboard text input event structure (event.text.*)
   */
  typedef struct SDL_TextInputEvent
  {
      uint32 type;                              /**< ::SDL_TEXTINPUT */
      uint32 timestamp;
      uint32 windowID;                          /**< The window with keyboard focus, if any */
      +char text;       /* actually a buffer */ /**< The input text */
  } SDL_TextInputEvent;

  /**
   *  \brief Mouse motion event structure (event.motion.*)
   */
  typedef struct SDL_MouseMotionEvent
  {
      uint32 type;        /**< ::SDL_MOUSEMOTION */
      uint32 timestamp;
      uint32 windowID;    /**< The window with mouse focus, if any */
      uint32 which;       /**< The mouse instance id, or SDL_TOUCH_MOUSEID */
      uint32 state;       /**< The current button state */
      int32 x;           /**< X coordinate, relative to window */
      int32 y;           /**< Y coordinate, relative to window */
      int32 xrel;        /**< The relative motion in the X direction */
      int32 yrel;        /**< The relative motion in the Y direction */
  } SDL_MouseMotionEvent;

  /**
   *  \brief Mouse button event structure (event.button.*)
   */
  typedef struct SDL_MouseButtonEvent
  {
      uint32 type;        /**< ::SDL_MOUSEBUTTONDOWN or ::SDL_MOUSEBUTTONUP */
      uint32 timestamp;
      uint32 windowID;    /**< The window with mouse focus, if any */
      uint32 which;       /**< The mouse instance id, or SDL_TOUCH_MOUSEID */
      uint8 button;       /**< The mouse button index */
      uint8 state;        /**< ::SDL_PRESSED or ::SDL_RELEASED */
      uint8 padding1;
      uint8 padding2;
      int32 x;           /**< X coordinate, relative to window */
      int32 y;           /**< Y coordinate, relative to window */
  } SDL_MouseButtonEvent;

  /**
   *  \brief Mouse wheel event structure (event.wheel.*)
   */
  typedef struct SDL_MouseWheelEvent
  {
      uint32 type;        /**< ::SDL_MOUSEWHEEL */
      uint32 timestamp;
      uint32 windowID;    /**< The window with mouse focus, if any */
      uint32 which;       /**< The mouse instance id, or SDL_TOUCH_MOUSEID */
      int32 x;           /**< The amount scrolled horizontally */
      int32 y;           /**< The amount scrolled vertically */
  } SDL_MouseWheelEvent;

/*
  /**
   *  \brief Joystick axis motion event structure (event.jaxis.*)
   */
  typedef struct SDL_JoyAxisEvent
  {
      uint32 type;        /**< ::SDL_JOYAXISMOTION */
      uint32 timestamp;
      SDL_JoystickID which; /**< The joystick instance id */
      uint8 axis;         /**< The joystick axis index */
      uint8 padding1;
      uint8 padding2;
      uint8 padding3;
      int16 value;       /**< The axis value (range: -32768 to 32767) */
      uint16 padding4;
  } SDL_JoyAxisEvent;
*/
  /**
   *  \brief Joystick trackball motion event structure (event.jball.*)
   */
/*
  typedef struct SDL_JoyBallEvent
  {
      uint32 type;        /**< ::SDL_JOYBALLMOTION */
      uint32 timestamp;
      SDL_JoystickID which; /**< The joystick instance id */
      uint8 ball;         /**< The joystick trackball index */
      uint8 padding1;
      uint8 padding2;
      uint8 padding3;
      int16 xrel;        /**< The relative motion in the X direction */
      int16 yrel;        /**< The relative motion in the Y direction */
  } SDL_JoyBallEvent;
*/
  /**
   *  \brief Joystick hat position change event structure (event.jhat.*)
   */
/*
  typedef struct SDL_JoyHatEvent
  {
      uint32 type;        /**< ::SDL_JOYHATMOTION */
      uint32 timestamp;
      SDL_JoystickID which; /**< The joystick instance id */
      uint8 hat;          /**< The joystick hat index */
      uint8 value;        /**< The hat position value.
                           *   \sa ::SDL_HAT_LEFTUP ::SDL_HAT_UP ::SDL_HAT_RIGHTUP
                           *   \sa ::SDL_HAT_LEFT ::SDL_HAT_CENTERED ::SDL_HAT_RIGHT
                           *   \sa ::SDL_HAT_LEFTDOWN ::SDL_HAT_DOWN ::SDL_HAT_RIGHTDOWN
                           *
                           *   Note that zero means the POV is centered.
                           */
      uint8 padding1;
      uint8 padding2;
  } SDL_JoyHatEvent;
*/
/*
  /**
   *  \brief Joystick button event structure (event.jbutton.*)
   */
  typedef struct SDL_JoyButtonEvent
  {
      uint32 type;        /**< ::SDL_JOYBUTTONDOWN or ::SDL_JOYBUTTONUP */
      uint32 timestamp;
      SDL_JoystickID which; /**< The joystick instance id */
      uint8 button;       /**< The joystick button index */
      uint8 state;        /**< ::SDL_PRESSED or ::SDL_RELEASED */
      uint8 padding1;
      uint8 padding2;
  } SDL_JoyButtonEvent;
*/
/*
  /**
   *  \brief Joystick device event structure (event.jdevice.*)
   */
  typedef struct SDL_JoyDeviceEvent
  {
      uint32 type;        /**< ::SDL_JOYDEVICEADDED or ::SDL_JOYDEVICEREMOVED */
      uint32 timestamp;
      int32 which;       /**< The joystick device index for the ADDED event, instance id for the REMOVED event */
  } SDL_JoyDeviceEvent;

*/
  /**
   *  \brief Game controller axis motion event structure (event.caxis.*)
   */
/*
  typedef struct SDL_ControllerAxisEvent
  {
      uint32 type;        /**< ::SDL_CONTROLLERAXISMOTION */
      uint32 timestamp;
      SDL_JoystickID which; /**< The joystick instance id */
      uint8 axis;         /**< The controller axis (SDL_GameControllerAxis) */
      uint8 padding1;
      uint8 padding2;
      uint8 padding3;
      int16 value;       /**< The axis value (range: -32768 to 32767) */
      uint16 padding4;
  } SDL_ControllerAxisEvent;
*/
/*
  /**
   *  \brief Game controller button event structure (event.cbutton.*)
   */
  typedef struct SDL_ControllerButtonEvent
  {
      uint32 type;        /**< ::SDL_CONTROLLERBUTTONDOWN or ::SDL_CONTROLLERBUTTONUP */
      uint32 timestamp;
      SDL_JoystickID which; /**< The joystick instance id */
      uint8 button;       /**< The controller button (SDL_GameControllerButton) */
      uint8 state;        /**< ::SDL_PRESSED or ::SDL_RELEASED */
      uint8 padding1;
      uint8 padding2;
  } SDL_ControllerButtonEvent;
*/
/*
  /**
   *  \brief Controller device event structure (event.cdevice.*)
   */
  typedef struct SDL_ControllerDeviceEvent
  {
      uint32 type;        /**< ::SDL_CONTROLLERDEVICEADDED, ::SDL_CONTROLLERDEVICEREMOVED, or ::SDL_CONTROLLERDEVICEREMAPPED */
      uint32 timestamp;
      int32 which;       /**< The joystick device index for the ADDED event, instance id for the REMOVED or REMAPPED event */
  } SDL_ControllerDeviceEvent;

*/
/*
  /**
   *  \brief Touch finger event structure (event.tfinger.*)
   */
  typedef struct SDL_TouchFingerEvent
  {
      uint32 type;        /**< ::SDL_FINGERMOTION or ::SDL_FINGERDOWN or ::SDL_FINGERUP */
      uint32 timestamp;
      SDL_TouchID touchId; /**< The touch device id */
      SDL_FingerID fingerId;
      float x;            /**< Normalized in the range 0...1 */
      float y;            /**< Normalized in the range 0...1 */
      float dx;           /**< Normalized in the range 0...1 */
      float dy;           /**< Normalized in the range 0...1 */
      float pressure;     /**< Normalized in the range 0...1 */
  } SDL_TouchFingerEvent;

*/
/*
  /**
   *  \brief Multiple Finger Gesture Event (event.mgesture.*)
   */
  typedef struct SDL_MultiGestureEvent
  {
      uint32 type;        /**< ::SDL_MULTIGESTURE */
      uint32 timestamp;
      SDL_TouchID touchId; /**< The touch device index */
      float dTheta;
      float dDist;
      float x;
      float y;
      uint16 numFingers;
      uint16 padding;
  } SDL_MultiGestureEvent;
*/
/*
  /* (event.dgesture.*) */
  typedef struct SDL_DollarGestureEvent
  {
      uint32 type;        /**< ::SDL_DOLLARGESTURE */
      uint32 timestamp;
      SDL_TouchID touchId; /**< The touch device id */
      SDL_GestureID gestureId;
      uint32 numFingers;
      float error;
      float x;            /**< Normalized center of gesture */
      float y;            /**< Normalized center of gesture */
  } SDL_DollarGestureEvent;
*/

  /**
   *  \brief An event used to request a file open by the system (event.drop.*)
   *         This event is disabled by default, you can enable it with SDL_EventState()
   *  \note If you enable this event, you must free the filename in the event.
   */
  typedef struct SDL_DropEvent
  {
      uint32 type;        /**< ::SDL_DROPFILE */
      uint32 timestamp;
      +char file;         /**< The file name, which should be freed with SDL_free() */
  } SDL_DropEvent;


  /**
   *  \brief The "quit requested" event
   */
  typedef struct SDL_QuitEvent
  {
      uint32 type;        /**< ::SDL_QUIT */
      uint32 timestamp;
  } SDL_QuitEvent;

  /**
   *  \brief OS Specific event
   */
  typedef struct SDL_OSEvent
  {
      uint32 type;        /**< ::SDL_QUIT */
      uint32 timestamp;
  } SDL_OSEvent;

  /**
   *  \brief A user-defined event type (event.user.*)
   */
  typedef struct SDL_UserEvent
  {
      uint32 type;        /**< ::SDL_USEREVENT through ::SDL_LASTEVENT-1 */
      uint32 timestamp;
      uint32 windowID;    /**< The associated window if any */
      int32 n"code";        /**< User defined event code */
      address data1;        /**< User defined data pointer */
      address data2;        /**< User defined data pointer */
  } SDL_UserEvent;


  /*
  struct SDL_SysWMmsg;
  typedef struct SDL_SysWMmsg SDL_SysWMmsg;
  */

  /**
   *  \brief A video driver dependent system event (event.syswm.*)
   *         This event is disabled by default, you can enable it with SDL_EventState()
   *
   *  \note If you want to use this event, you should include SDL_syswm.h.
   */
  typedef struct SDL_SysWMEvent
  {
      uint32 type;        /**< ::SDL_SYSWMEVENT */
      uint32 timestamp;
      //SDL_SysWMmsg *msg;  /**< driver dependent data, defined in SDL_syswm.h */
      address msg;  /**< driver dependent data, defined in SDL_syswm.h */
  } SDL_SysWMEvent;

  fun SDL_GetWindowID (w:SDL_Event) : opt[uint32] =>
    match w.type.SDL_EventType with
    | $(SDL_WINDOWEVENT) => Some w.window.windowID
    | $(SDL_KEYDOWN) => Some w.key.windowID
    | $(SDL_KEYUP) => Some w.key.windowID
    | $(SDL_TEXTEDITING) => Some w.edit.windowID
    | $(SDL_TEXTINPUT) => Some w.text.windowID
    | $(SDL_MOUSEMOTION) => Some w.motion.windowID
    | $(SDL_MOUSEBUTTONDOWN) => Some w.button.windowID
    | $(SDL_MOUSEBUTTONUP) => Some w.button.windowID
    | $(SDL_MOUSEWHEEL) => Some w.wheel.windowID
    | _ => None[uint32]
    endmatch
  ;

  cenum SDL_eventaction =
    SDL_ADDEVENT,
    SDL_PEEKEVENT,
    SDL_GETEVENT
  ;

  gen SDL_PeepEvents:
    +SDL_Event * int /* numevents*/ *
    SDL_eventaction *
    uint32 /* minType */ * uint32 /* maxType */
    -> int
  ;

/*@}*/
/**
 *  Pumps the event loop, gathering events from the input devices.
 *
 *  This function updates the event queue and internal input device state.
 *
 *  This should only be run in the thread that sets the video mode.
 */

  proc SDL_PumpEvents: 1;

/**
 *  Checks to see if certain event types are in the event queue.
 */
  fun SDL_HasEvent:uint32 /* type */ -> bool;
  fun SDL_HasEvents:uint32 /* minType */ * uint32 /* maxType */ -> bool;

/**
 *  This function clears events from the event queue
 */
  proc SDL_FlushEvent:uint32;
  proc SDL_FlushEvents: uint32 /* minType */ * uint32 /* maxType */;

/**
 *  \brief Polls for currently pending events.
 *
 *  \return 1 if there are any pending events, or 0 if there are none available.
 *
 *  \param event If not NULL, the next event is removed from the queue and
 *               stored in that area.
 */
 gen SDL_PollEvent: &SDL_Event -> int;

/**
 *  \brief Waits indefinitely for the next available event.
 *
 *  \return 1, or 0 if there was an error while waiting for events.
 *
 *  \param event If not NULL, the next event is removed from the queue and
 *               stored in that area.
 */
  gen SDL_WaitEvent: &SDL_Event -> int;


/**
 *  \brief Waits until the specified timeout (in milliseconds) for the next
 *         available event.
 *
 *  \return 1, or 0 if there was an error while waiting for events.
 *
 *  \param event If not NULL, the next event is removed from the queue and
 *               stored in that area.
 *  \param timeout The timeout (in milliseconds) to wait for next event.
 */
  gen SDL_WaitEventTimeout: &SDL_Event * int -> int;

/**
 *  \brief Add an event to the event queue.
 *
 *  \return 1 on success, 0 if the event was filtered, or -1 if the event queue
 *          was full or there was some other error.
 */
  gen SDL_PushEvent: &SDL_Event -> int;

  typedef SDL_EventFilter =  address *  &SDL_Event --> int;

/**
 *  Sets up a filter to process all events before they change internal state and
 *  are posted to the internal event queue.
 *
 *  The filter is prototyped as:
 *  \code
 *      int SDL_EventFilter(void *userdata, SDL_Event * event);
 *  \endcode
 *
 *  If the filter returns 1, then the event will be added to the internal queue.
 *  If it returns 0, then the event will be dropped from the queue, but the
 *  internal state will still be updated.  This allows selective filtering of
 *  dynamically arriving events.
 *
 *  \warning  Be very careful of what you do in the event filter function, as
 *            it may run in a different thread!
 *
 *  There is one caveat when dealing with the ::SDL_QuitEvent event type.  The
 *  event filter is only called when the window manager desires to close the
 *  application window.  If the event filter returns 1, then the window will
 *  be closed, otherwise the window will remain open if possible.
 *
 *  If the quit event is generated by an interrupt signal, it will bypass the
 *  internal queue and be delivered to the application at the next event poll.
 */

/* TODO: convert to use Felix closures! */

  proc SDL_SetEventFilter: SDL_EventFilter * address;

/**
 *  Return the current event filter - can be used to "chain" filters.
 *  If there is no event filter set, this function returns SDL_FALSE.
 */
  gen SDL_GetEventFilter: &SDL_EventFilter * &address -> bool;

/**
 *  Add a function which is called when an event is added to the queue.
 */
  proc SDL_AddEventWatch: SDL_EventFilter * address;

/**
 *  Remove an event watch function added with SDL_AddEventWatch()
 */
 proc SDL_DelEventWatch: SDL_EventFilter * address;

/**
 *  Run the filter function on the current event queue, removing any
 *  events for which the filter returns 0.
 */
  proc SDL_FilterEvents:SDL_EventFilter * address;

  const SDL_QUERY : int; // -1
  const SDL_IGNORE: int; // 0
  const SDL_DISABLE : int; // 0
  const SDL_ENABLE : int; // 1

/**
 *  This function allows you to set the state of processing certain events.
 *   - If \c state is set to ::SDL_IGNORE, that event will be automatically
 *     dropped from the event queue and will not event be filtered.
 *   - If \c state is set to ::SDL_ENABLE, that event will be processed
 *     normally.
 *   - If \c state is set to ::SDL_QUERY, SDL_EventState() will return the
 *     current processing state of the specified event.
 */

  gen SDL_EventState:uint32 * int -> int = "(int)SDL_EventState ($1,$2)";

/**
 *  This function allocates a set of user-defined events, and returns
 *  the beginning event number for that set of events.
 *
 *  If there aren't enough user-defined events left, this function
 *  returns (Uint32)-1
 */
/*
extern DECLSPEC Uint32 SDLCALL SDL_RegisterEvents(int numevents);
*/


}

SDL_framerate.flx

//[SDL_framerate.flx]

//Module        : SDL_framerate_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_framerate.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define DLLINTERFACE
//#define DLLINTERFACE __declspec(dllimport)
//#define DLLINTERFACE __declspec(dllexport)
//#define FPS_DEFAULT           30
//#define FPS_LOWER_LIMIT               1
//#define FPS_UPPER_LIMIT               200
//#define _SDL_framerate_h

open module SDL_framerate_h
{
  requires package "sdl";
  header '#include "SDL_framerate.h"';

  //ABSTRACT TYPES
  type FPSmanager = 'FPSmanager';

  //PROCEDURES
  proc SDL_framerateDelay: &FPSmanager;
  proc SDL_initFramerate: &FPSmanager;

  //FUNCTIONS
  fun SDL_getFramerate: &FPSmanager -> int;
  fun SDL_setFramerate: &FPSmanager * int -> int;
}

SDL_gfxPrimitives.flx

//[SDL_gfxPrimitives.flx]


//Module        : SDL_gfxPrimitives_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_gfxPrimitives.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define DLLINTERFACE
//#define DLLINTERFACE __declspec(dllimport)
//#define DLLINTERFACE __declspec(dllexport)
//#define SDL_GFXPRIMITIVES_MINOR       0
//#define SDL_GFXPRIMITIVES_MAJOR       2
//#define M_PI  3.141592654
//#define _SDL_gfxPrimitives_h

open module SDL_gfxPrimitives_h
{
  requires package "sdl";
  header '#include "SDL_gfxPrimitives.h"';

  //FUNCTIONS
  fun aacircleColor: &SDL_Surface * int16 * int16 * int16 * uint32 -> int;
  fun aacircleRGBA: &SDL_Surface * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun aaellipseColor: &SDL_Surface * int16 * int16 * int16 * int16 * uint32 -> int;
  fun aaellipseRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun aalineColor: &SDL_Surface * int16 * int16 * int16 * int16 * uint32 -> int;
  fun aalineRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun aapolygonColor: &SDL_Surface * &int16 * &int16 * int * uint32 -> int;
  fun aapolygonRGBA: &SDL_Surface * &int16 * &int16 * int * uint8 * uint8 * uint8 * uint8 -> int;
  fun aatrigonColor: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * int16 * uint32 -> int;
  fun aatrigonRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun bezierColor: &SDL_Surface * &int16 * &int16 * int * int * uint32 -> int;
  fun bezierRGBA: &SDL_Surface * &int16 * &int16 * int * int * uint8 * uint8 * uint8 * uint8 -> int;
  fun boxColor: &SDL_Surface * int16 * int16 * int16 * int16 * uint32 -> int;
  fun boxRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun characterColor: &SDL_Surface * int16 * int16 * char * uint32 -> int;
  fun characterRGBA: &SDL_Surface * int16 * int16 * char * uint8 * uint8 * uint8 * uint8 -> int;
  fun circleColor: &SDL_Surface * int16 * int16 * int16 * uint32 -> int;
  fun circleRGBA: &SDL_Surface * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun ellipseColor: &SDL_Surface * int16 * int16 * int16 * int16 * uint32 -> int;
  fun ellipseRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun filledCircleColor: &SDL_Surface * int16 * int16 * int16 * uint32 -> int;
  fun filledCircleRGBA: &SDL_Surface * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun filledEllipseColor: &SDL_Surface * int16 * int16 * int16 * int16 * uint32 -> int;
  fun filledEllipseRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun filledPolygonColor: &SDL_Surface * &int16 * &int16 * int * int -> int;
  fun filledPolygonRGBA: &SDL_Surface * &int16 * &int16 * int * uint8 * uint8 * uint8 * uint8 -> int;
  fun filledTrigonColor: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * int16 * int -> int;
  fun filledTrigonRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun filledpieColor: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * uint32 -> int;
  fun filledpieRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun hlineColor: &SDL_Surface * int16 * int16 * int16 * uint32 -> int;
  fun hlineRGBA: &SDL_Surface * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun lineColor: &SDL_Surface * int16 * int16 * int16 * int16 * uint32 -> int;
  fun lineRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun pixelColor: &SDL_Surface * int16 * int16 * uint32 -> int;
  fun pixelRGBA: &SDL_Surface * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun polygonColor: &SDL_Surface * &int16 * &int16 * int * uint32 -> int;
  fun polygonRGBA: &SDL_Surface * &int16 * &int16 * int * uint8 * uint8 * uint8 * uint8 -> int;
  fun rectangleColor: &SDL_Surface * int16 * int16 * int16 * int16 * uint32 -> int;
  fun rectangleRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun stringColor: &SDL_Surface * int16 * int16 * &char * uint32 -> int;
  fun stringRGBA: &SDL_Surface * int16 * int16 * &char * uint8 * uint8 * uint8 * uint8 -> int;
  fun trigonColor: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * int16 * uint32 -> int;
  fun trigonRGBA: &SDL_Surface * int16 * int16 * int16 * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
  fun vlineColor: &SDL_Surface * int16 * int16 * int16 * uint32 -> int;
  fun vlineRGBA: &SDL_Surface * int16 * int16 * int16 * uint8 * uint8 * uint8 * uint8 -> int;
}

SDL_gfxPrimitives_font.flx

//[SDL_gfxPrimitives_font.flx]


//Module        : SDL_gfxPrimitives_font_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_gfxPrimitives_font.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define GFX_FONTDATAMAX (8*256)

open module SDL_gfxPrimitives_font_h
{
  requires package "sdl";
  header '#include "SDL_gfxPrimitives_font.h"';

  //VARIABLES
  const gfxPrimitivesFontdata: &utiny = 'gfxPrimitivesFontdata';
}

SDL_image.flx

//[SDL_image.flx]


//Module        : SDL_image_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_image.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define IMG_GetError  SDL_GetError
//#define IMG_SetError  SDL_SetError
//#define SDL_IMAGE_VERSION(X)                                          \
//#define SDL_IMAGE_PATCHLEVEL  4
//#define SDL_IMAGE_MINOR_VERSION       2
//#define SDL_IMAGE_MAJOR_VERSION       1
//#define _SDL_IMAGE_H

open class SDL_image_h
{
  requires package "sdl2", package "sdl2_image";

  fun IMG_Linked_Version: 1 -> SDL_version = "*(IMG_Linked_Version())";
  proc IMG_Compiled_Version: &SDL_version = "SDL_IMAGE_VERSION($1);"; // macro
  fun IMG_Compiled_Version () : SDL_version = {
    var v: SDL_version;
    IMG_Compiled_Version$ &v;
    return v;
  }

  const IMG_INIT_JPG : uint32 /* = 0x00000001 */;
  const IMG_INIT_PNG : uint32 /* = 0x00000002 */;
  const IMG_INIT_TIF : uint32 /* = 0x00000004 */;
  const IMG_INIT_WEBP : uint32  /* = 0x00000008 */;


  gen IMG_Init : uint32 -> int;
  gen IMG_GetError: 1 -> string = "::std::string(IMG_GetError())";
  proc IMG_Quit: 1;

  fun IMG_InvertAlpha: int -> int;
  fun IMG_Load: +char -> &SDL_Surface;
  fun IMG_LoadBMP_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadGIF_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadJPG_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadLBM_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadPCX_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadPNG_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadPNM_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadTGA_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadTIF_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadTyped_RW: SDL_RWops * int * &char -> &SDL_Surface;
  fun IMG_LoadXCF_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_LoadXPM_RW: SDL_RWops -> &SDL_Surface;
  fun IMG_Load_RW: SDL_RWops * int -> &SDL_Surface;
  fun IMG_ReadXPMFromArray: &&char -> &SDL_Surface;

  fun IMG_isBMP: SDL_RWops -> int;
  fun IMG_isGIF: SDL_RWops -> int;
  fun IMG_isJPG: SDL_RWops -> int;
  fun IMG_isLBM: SDL_RWops -> int;
  fun IMG_isPCX: SDL_RWops -> int;
  fun IMG_isPNG: SDL_RWops -> int;
  fun IMG_isPNM: SDL_RWops -> int;
  fun IMG_isTIF: SDL_RWops -> int;
  fun IMG_isXCF: SDL_RWops -> int;
  fun IMG_isXPM: SDL_RWops -> int;
}

SDL_imageFilter.flx

//[SDL_imageFilter.flx]

//Module        : SDL_imageFilter_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_imageFilter.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define DLLINTERFACE
//#define DLLINTERFACE __declspec(dllimport)
//#define DLLINTERFACE __declspec(dllexport)
//#define _SDL_imageFilter_h

open module SDL_imageFilter_h
{
  requires package "sdl";
  header '#include "SDL_imageFilter.h"';

  //PROCEDURES
  proc SDL_imageFilterAlignStack: 1;
  proc SDL_imageFilterMMXoff: 1;
  proc SDL_imageFilterMMXon: 1;
  proc SDL_imageFilterRestoreStack: 1;

  //FUNCTIONS
  fun SDL_imageFilterAbsDiff: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterAdd: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterAddByte: &utiny * &utiny * int * utiny -> int;
  fun SDL_imageFilterAddByteToHalf: &utiny * &utiny * int * utiny -> int;
  fun SDL_imageFilterBinarizeUsingThreshold: &utiny * &utiny * int * utiny -> int;
  fun SDL_imageFilterBitAnd: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterBitNegation: &utiny * &utiny * int -> int;
  fun SDL_imageFilterBitOr: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterClipToRange: &utiny * &utiny * int * utiny * utiny -> int;
  fun SDL_imageFilterConvolveKernel3x3Divide: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterConvolveKernel3x3ShiftRight: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterConvolveKernel5x5Divide: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterConvolveKernel5x5ShiftRight: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterConvolveKernel7x7Divide: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterConvolveKernel7x7ShiftRight: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterConvolveKernel9x9Divide: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterConvolveKernel9x9ShiftRight: &utiny * &utiny * int * int * &short * utiny -> int;
  fun SDL_imageFilterDiv: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterMMXdetect: 1 -> int;
  fun SDL_imageFilterMean: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterMult: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterMultByByte: &utiny * &utiny * int * utiny -> int;
  fun SDL_imageFilterMultDivby2: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterMultDivby4: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterMultNor: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterNormalizeLinear: &utiny * &utiny * int * int * int * int * int -> int;
  fun SDL_imageFilterShiftLeft: &utiny * &utiny * int * utiny -> int;
  fun SDL_imageFilterShiftLeftByte: &utiny * &utiny * int * utiny -> int;
  fun SDL_imageFilterShiftRight: &utiny * &utiny * int * utiny -> int;
  fun SDL_imageFilterShiftRightAndMultByByte: &utiny * &utiny * int * utiny * utiny -> int;
  fun SDL_imageFilterSobelX: &utiny * &utiny * int * int -> int;
  fun SDL_imageFilterSobelXShiftRight: &utiny * &utiny * int * int * utiny -> int;
  fun SDL_imageFilterSub: &utiny * &utiny * &utiny * int -> int;
  fun SDL_imageFilterSubByte: &utiny * &utiny * int * utiny -> int;
}

SDL_joystick.flx

//[SDL_joystick.flx]


//Module        : SDL_joystick_h
//Timestamp     : 2006/1/6 2:18:42 UTC
//Timestamp     : 2006/1/6 13:18:42 (local)
//Raw Header    : SDL_joystick.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SDL_HAT_LEFTDOWN      (SDL_HAT_LEFT|SDL_HAT_DOWN)
//#define SDL_HAT_LEFTUP                (SDL_HAT_LEFT|SDL_HAT_UP)
//#define SDL_HAT_RIGHTDOWN     (SDL_HAT_RIGHT|SDL_HAT_DOWN)
//#define SDL_HAT_RIGHTUP               (SDL_HAT_RIGHT|SDL_HAT_UP)
//#define SDL_HAT_LEFT          0x08
//#define SDL_HAT_DOWN          0x04
//#define SDL_HAT_RIGHT         0x02
//#define SDL_HAT_UP            0x01
//#define SDL_HAT_CENTERED      0x00
//#define _SDL_joystick_h

open module SDL_joystick_h
{
  requires package "sdl";
  header '#include "SDL_joystick.h"';

  //PURE INCOMPLETE TYPES
  type _struct__SDL_Joystick = 'struct _SDL_Joystick'; //local

  //STRUCT or UNION TAG ALIASES
  typedef SDL_Joystick = _struct__SDL_Joystick;

  //PROCEDURES
  proc SDL_JoystickClose: &SDL_Joystick;
  proc SDL_JoystickUpdate: 1;

  //FUNCTIONS
  fun SDL_JoystickEventState: int -> int;
  fun SDL_JoystickGetAxis: &SDL_Joystick * int -> int16;
  fun SDL_JoystickGetBall: &SDL_Joystick * int * &int * &int -> int;
  fun SDL_JoystickGetButton: &SDL_Joystick * int -> uint8;
  fun SDL_JoystickGetHat: &SDL_Joystick * int -> uint8;
  fun SDL_JoystickIndex: &SDL_Joystick -> int;
  fun SDL_JoystickName: int -> &char;
  fun SDL_JoystickNumAxes: &SDL_Joystick -> int;
  fun SDL_JoystickNumBalls: &SDL_Joystick -> int;
  fun SDL_JoystickNumButtons: &SDL_Joystick -> int;
  fun SDL_JoystickNumHats: &SDL_Joystick -> int;
  fun SDL_JoystickOpen: int -> &SDL_Joystick;
  fun SDL_JoystickOpened: int -> int;
  fun SDL_NumJoysticks: 1 -> int;
}

SDL_keyboard.flx

//[SDL_keyboard.flx]

//#define SDL_DEFAULT_REPEAT_INTERVAL   30
//#define SDL_DEFAULT_REPEAT_DELAY      500
//#define SDL_ALL_HOTKEYS               0xFFFFFFFF
//#define _SDL_keyboard_h

open module SDL_keyboard_h
{
  requires package "sdl2";

  /**
   *  \brief The SDL keysym structure, used in key events.
   */
  typedef struct SDL_Keysym
  {
      SDL_Scancode scancode;      /**< SDL physical key code - see ::SDL_Scancode for details */
      SDL_Keycode sym;            /**< SDL virtual key code - see ::SDL_Keycode for details */
      uint16 mod;                 /**< current key modifiers */
      uint32 unicode;             /**< \deprecated use SDL_TextInputEvent instead */
  } SDL_Keysym;


/*
  /*
  //TYPE ALIASES
  typedef _struct_SDL_keysym = SDL_keysym;
  */

  //PROCEDURES
  proc SDL_SetModState: SDLMod;

  //FUNCTIONS
  fun SDL_EnableKeyRepeat: int * int -> int;
  fun SDL_EnableUNICODE: int -> int;
  fun SDL_GetKeyName: SDLKey -> &char;
  fun SDL_GetKeyState: &int -> &uint8;
  fun SDL_GetModState: 1 -> SDLMod;
*/

}

SDL_keycode.flx

//[SDL_keycode.flx]

open class SDL_keycode_h
{
  requires package "sdl2";

  cenum SDL_Keycode =
      SDLK_UNKNOWN,

      SDLK_RETURN,
      SDLK_ESCAPE,
      SDLK_BACKSPACE,
      SDLK_TAB,
      SDLK_SPACE,
      SDLK_EXCLAIM,
      SDLK_QUOTEDBL,
      SDLK_HASH,
      SDLK_PERCENT,
      SDLK_DOLLAR,
      SDLK_AMPERSAND,
      SDLK_QUOTE,
      SDLK_LEFTPAREN,
      SDLK_RIGHTPAREN,
      SDLK_ASTERISK,
      SDLK_PLUS,
      SDLK_COMMA,
      SDLK_MINUS,
      SDLK_PERIOD,
      SDLK_SLASH,
      SDLK_0,
      SDLK_1,
      SDLK_2,
      SDLK_3,
      SDLK_4,
      SDLK_5,
      SDLK_6,
      SDLK_7,
      SDLK_8,
      SDLK_9,
      SDLK_COLON,
      SDLK_SEMICOLON,
      SDLK_LESS,
      SDLK_EQUALS,
      SDLK_GREATER,
      SDLK_QUESTION,
      SDLK_AT,
      /*
         Skip uppercase letters
       */
      SDLK_LEFTBRACKET,
      SDLK_BACKSLASH,
      SDLK_RIGHTBRACKET,
      SDLK_CARET,
      SDLK_UNDERSCORE,
      SDLK_BACKQUOTE,
      SDLK_a,
      SDLK_b,
      SDLK_c,
      SDLK_d,
      SDLK_e,
      SDLK_f,
      SDLK_g,
      SDLK_h,
      SDLK_i,
      SDLK_j,
      SDLK_k,
      SDLK_l,
      SDLK_m,
      SDLK_n,
      SDLK_o,
      SDLK_p,
      SDLK_q,
      SDLK_r,
      SDLK_s,
      SDLK_t,
      SDLK_u,
      SDLK_v,
      SDLK_w,
      SDLK_x,
      SDLK_y,
      SDLK_z,

      SDLK_CAPSLOCK,

      SDLK_F1,
      SDLK_F2,
      SDLK_F3,
      SDLK_F4,
      SDLK_F5,
      SDLK_F6,
      SDLK_F7,
      SDLK_F8,
      SDLK_F9,
      SDLK_F10,
      SDLK_F11,
      SDLK_F12,

      SDLK_PRINTSCREEN,
      SDLK_SCROLLLOCK,
      SDLK_PAUSE,
      SDLK_INSERT,
      SDLK_HOME,
      SDLK_PAGEUP,
      SDLK_DELETE,
      SDLK_END,
      SDLK_PAGEDOWN,
      SDLK_RIGHT,
      SDLK_LEFT,
      SDLK_DOWN,
      SDLK_UP,

      SDLK_NUMLOCKCLEAR,
      SDLK_KP_DIVIDE,
      SDLK_KP_MULTIPLY,
      SDLK_KP_MINUS,
      SDLK_KP_PLUS,
      SDLK_KP_ENTER,
      SDLK_KP_1,
      SDLK_KP_2,
      SDLK_KP_3,
      SDLK_KP_4,
      SDLK_KP_5,
      SDLK_KP_6,
      SDLK_KP_7,
      SDLK_KP_8,
      SDLK_KP_9,
      SDLK_KP_0,
      SDLK_KP_PERIOD,

      SDLK_APPLICATION,
      SDLK_POWER,
      SDLK_KP_EQUALS,
      SDLK_F13,
      SDLK_F14,
      SDLK_F15,
      SDLK_F16,
      SDLK_F17,
      SDLK_F18,
      SDLK_F19,
      SDLK_F20,
      SDLK_F21,
      SDLK_F22,
      SDLK_F23,
      SDLK_F24,
      SDLK_EXECUTE,
      SDLK_HELP,
      SDLK_MENU,
      SDLK_SELECT,
      SDLK_STOP,
      SDLK_AGAIN,
      SDLK_UNDO,
      SDLK_CUT,
      SDLK_COPY,
      SDLK_PASTE,
      SDLK_FIND,
      SDLK_MUTE,
      SDLK_VOLUMEUP,
      SDLK_VOLUMEDOWN,
      SDLK_KP_COMMA,
      SDLK_KP_EQUALSAS400,

      SDLK_ALTERASE,
      SDLK_SYSREQ,
      SDLK_CANCEL,
      SDLK_CLEAR,
      SDLK_PRIOR,
      SDLK_RETURN2,
      SDLK_SEPARATOR,
      SDLK_OUT,
      SDLK_OPER,
      SDLK_CLEARAGAIN,
      SDLK_CRSEL,
      SDLK_EXSEL,

      SDLK_KP_00,
      SDLK_KP_000,
      SDLK_THOUSANDSSEPARATOR,
      SDLK_DECIMALSEPARATOR,
      SDLK_CURRENCYUNIT,
      SDLK_CURRENCYSUBUNIT,
      SDLK_KP_LEFTPAREN,
      SDLK_KP_RIGHTPAREN,
      SDLK_KP_LEFTBRACE,
      SDLK_KP_RIGHTBRACE,
      SDLK_KP_TAB,
      SDLK_KP_BACKSPACE,
      SDLK_KP_A,
      SDLK_KP_B,
      SDLK_KP_C,
      SDLK_KP_D,
      SDLK_KP_E,
      SDLK_KP_F,
      SDLK_KP_XOR,
      SDLK_KP_POWER,
      SDLK_KP_PERCENT,
      SDLK_KP_LESS,
      SDLK_KP_GREATER,
      SDLK_KP_AMPERSAND,
      SDLK_KP_DBLAMPERSAND,
      SDLK_KP_VERTICALBAR,
      SDLK_KP_DBLVERTICALBAR,
      SDLK_KP_COLON,
      SDLK_KP_HASH,
      SDLK_KP_SPACE,
      SDLK_KP_AT,
      SDLK_KP_EXCLAM,
      SDLK_KP_MEMSTORE,
      SDLK_KP_MEMRECALL,
      SDLK_KP_MEMCLEAR,
      SDLK_KP_MEMADD,
      SDLK_KP_MEMSUBTRACT,
      SDLK_KP_MEMMULTIPLY,
      SDLK_KP_MEMDIVIDE,
      SDLK_KP_PLUSMINUS,
      SDLK_KP_CLEAR,
      SDLK_KP_CLEARENTRY,
      SDLK_KP_BINARY,
      SDLK_KP_OCTAL,
      SDLK_KP_DECIMAL,
      SDLK_KP_HEXADECIMAL,

      SDLK_LCTRL,
      SDLK_LSHIFT,
      SDLK_LALT,
      SDLK_LGUI,
      SDLK_RCTRL,
      SDLK_RSHIFT,
      SDLK_RALT,
      SDLK_RGUI,

      SDLK_MODE,

      SDLK_AUDIONEXT,
      SDLK_AUDIOPREV,
      SDLK_AUDIOSTOP,
      SDLK_AUDIOPLAY,
      SDLK_AUDIOMUTE,
      SDLK_MEDIASELECT,
      SDLK_WWW,
      SDLK_MAIL,
      SDLK_CALCULATOR,
      SDLK_COMPUTER,
      SDLK_AC_SEARCH,
      SDLK_AC_HOME,
      SDLK_AC_BACK,
      SDLK_AC_FORWARD,
      SDLK_AC_STOP,
      SDLK_AC_REFRESH,
      SDLK_AC_BOOKMARKS,

      SDLK_BRIGHTNESSDOWN,
      SDLK_BRIGHTNESSUP,
      SDLK_DISPLAYSWITCH,
      SDLK_KBDILLUMTOGGLE,
      SDLK_KBDILLUMDOWN,
      SDLK_KBDILLUMUP,
      SDLK_EJECT,
      SDLK_SLEEP
  ;
  ctor int : SDL_Keycode = "(int)$1";
  ctor SDL_Keycode : int = "(SDL_Keycode)$1";

  instance Str[SDL_Keycode] {
    fun str : SDL_Keycode -> string =
      | $(SDLK_UNKNOWN) => "SDLK_UNKNOWN"

      | $(SDLK_RETURN) => "SDLK_RETURN"
      | $(SDLK_ESCAPE) => "SDLK_ESCAPE"
      | $(SDLK_BACKSPACE) => "SDLK_BACKSPACE"
      | $(SDLK_TAB) => "SDLK_TAB"
      | $(SDLK_SPACE) => "SDLK_SPACE"
      | $(SDLK_EXCLAIM) => "SDLK_EXCLAIM"
      | $(SDLK_QUOTEDBL) => "SDLK_QUOTEDBL"
      | $(SDLK_HASH) => "SDLK_HASH"
      | $(SDLK_PERCENT) => "SDLK_PERCENT"
      | $(SDLK_DOLLAR) => "SDLK_DOLLAR"
      | $(SDLK_AMPERSAND) => "SDLK_AMPERSAND"
      | $(SDLK_QUOTE) => "SDLK_QUOTE"
      | $(SDLK_LEFTPAREN) => "SDLK_LEFTPAREN"
      | $(SDLK_RIGHTPAREN) => "SDLK_RIGHTPAREN"
      | $(SDLK_ASTERISK) => "SDLK_ASTERISK"
      | $(SDLK_PLUS) => "SDLK_PLUS"
      | $(SDLK_COMMA) => "SDLK_COMMA"
      | $(SDLK_MINUS) => "SDLK_MINUS"
      | $(SDLK_PERIOD) => "SDLK_PERIOD"
      | $(SDLK_SLASH) => "SDLK_SLASH"
      | $(SDLK_0) => "SDLK_0"
      | $(SDLK_1) => "SDLK_1"
      | $(SDLK_2) => "SDLK_2"
      | $(SDLK_3) => "SDLK_3"
      | $(SDLK_4) => "SDLK_4"
      | $(SDLK_5) => "SDLK_5"
      | $(SDLK_6) => "SDLK_6"
      | $(SDLK_7) => "SDLK_7"
      | $(SDLK_8) => "SDLK_8"
      | $(SDLK_9) => "SDLK_9"
      | $(SDLK_COLON) => "SDLK_COLON"
      | $(SDLK_SEMICOLON) => "SDLK_SEMICOLON"
      | $(SDLK_LESS) => "SDLK_LESS"
      | $(SDLK_EQUALS) => "SDLK_EQUALS"
      | $(SDLK_GREATER) => "SDLK_GREATER"
      | $(SDLK_QUESTION) => "SDLK_QUESTION"
      | $(SDLK_AT) => "SDLK_AT"
      /*
         Skip uppercase letters
       */
      | $(SDLK_LEFTBRACKET) => "SDLK_LEFTBRACKET"
      | $(SDLK_BACKSLASH) => "SDLK_BACKSLASH"
      | $(SDLK_RIGHTBRACKET) => "SDLK_RIGHTBRACKET"
      | $(SDLK_CARET) => "SDLK_CARET"
      | $(SDLK_UNDERSCORE) => "SDLK_UNDERSCORE"
      | $(SDLK_BACKQUOTE) => "SDLK_BACKQUOTE"
      | $(SDLK_a) => "SDLK_a"
      | $(SDLK_b) => "SDLK_b"
      | $(SDLK_c) => "SDLK_c"
      | $(SDLK_d) => "SDLK_d"
      | $(SDLK_e) => "SDLK_e"
      | $(SDLK_f) => "SDLK_f"
      | $(SDLK_g) => "SDLK_g"
      | $(SDLK_h) => "SDLK_h"
      | $(SDLK_i) => "SDLK_i"
      | $(SDLK_j) => "SDLK_j"
      | $(SDLK_k) => "SDLK_k"
      | $(SDLK_l) => "SDLK_l"
      | $(SDLK_m) => "SDLK_m"
      | $(SDLK_n) => "SDLK_n"
      | $(SDLK_o) => "SDLK_o"
      | $(SDLK_p) => "SDLK_p"
      | $(SDLK_q) => "SDLK_q"
      | $(SDLK_r) => "SDLK_r"
      | $(SDLK_s) => "SDLK_s"
      | $(SDLK_t) => "SDLK_t"
      | $(SDLK_u) => "SDLK_u"
      | $(SDLK_v) => "SDLK_v"
      | $(SDLK_w) => "SDLK_w"
      | $(SDLK_x) => "SDLK_x"
      | $(SDLK_y) => "SDLK_y"
      | $(SDLK_z) => "SDLK_z"

      | $(SDLK_CAPSLOCK) => "SDLK_CAPSLOCK"

      | $(SDLK_F1) => "SDLK_F1"
      | $(SDLK_F2) => "SDLK_F2"
      | $(SDLK_F3) => "SDLK_F3"
      | $(SDLK_F4) => "SDLK_F4"
      | $(SDLK_F5) => "SDLK_F5"
      | $(SDLK_F6) => "SDLK_F6"
      | $(SDLK_F7) => "SDLK_F7"
      | $(SDLK_F8) => "SDLK_F8"
      | $(SDLK_F9) => "SDLK_F9"
      | $(SDLK_F10) => "SDLK_F10"
      | $(SDLK_F11) => "SDLK_F11"
      | $(SDLK_F12) => "SDLK_F12"

      | $(SDLK_PRINTSCREEN) => "SDLK_PRINTSCREEN"
      | $(SDLK_SCROLLLOCK) => "SDLK_SCROLLLOCK"
      | $(SDLK_PAUSE) => "SDLK_PAUSE"
      | $(SDLK_INSERT) => "SDLK_INSERT"
      | $(SDLK_HOME) => "SDLK_HOME"
      | $(SDLK_PAGEUP) => "SDLK_PAGEUP"
      | $(SDLK_DELETE) => "SDLK_DELETE"
      | $(SDLK_END) => "SDLK_END"
      | $(SDLK_PAGEDOWN) => "SDLK_PAGEDOWN"
      | $(SDLK_RIGHT) => "SDLK_RIGHT"
      | $(SDLK_LEFT) => "SDLK_LEFT"
      | $(SDLK_DOWN) => "SDLK_DOWN"
      | $(SDLK_UP) => "SDLK_UP"

      | $(SDLK_NUMLOCKCLEAR) => "SDLK_NUMLOCKCLEAR"
      | $(SDLK_KP_DIVIDE) => "SDLK_KP_DIVIDE"
      | $(SDLK_KP_MULTIPLY) => "SDLK_KP_MULTIPLY"
      | $(SDLK_KP_MINUS) => "SDLK_KP_MINUS"
      | $(SDLK_KP_PLUS) => "SDLK_KP_PLUS"
      | $(SDLK_KP_ENTER) => "SDLK_KP_ENTER"
      | $(SDLK_KP_1) => "SDLK_KP_1"
      | $(SDLK_KP_2) => "SDLK_KP_2"
      | $(SDLK_KP_3) => "SDLK_KP_3"
      | $(SDLK_KP_4) => "SDLK_KP_4"
      | $(SDLK_KP_5) => "SDLK_KP_5"
      | $(SDLK_KP_6) => "SDLK_KP_6"
      | $(SDLK_KP_7) => "SDLK_KP_7"
      | $(SDLK_KP_8) => "SDLK_KP_8"
      | $(SDLK_KP_9) => "SDLK_KP_9"
      | $(SDLK_KP_0) => "SDLK_KP_0"
      | $(SDLK_KP_PERIOD) => "SDLK_KP_PERIOD"

      | $(SDLK_APPLICATION) => "SDLK_APPLICATION"
      | $(SDLK_POWER) => "SDLK_POWER"
      | $(SDLK_KP_EQUALS) => "SDLK_KP_EQUALS"
      | $(SDLK_F13) => "SDLK_F13"
      | $(SDLK_F14) => "SDLK_F14"
      | $(SDLK_F15) => "SDLK_F15"
      | $(SDLK_F16) => "SDLK_F16"
      | $(SDLK_F17) => "SDLK_F17"
      | $(SDLK_F18) => "SDLK_F18"
      | $(SDLK_F19) => "SDLK_F19"
      | $(SDLK_F20) => "SDLK_F20"
      | $(SDLK_F21) => "SDLK_F21"
      | $(SDLK_F22) => "SDLK_F22"
      | $(SDLK_F23) => "SDLK_F23"
      | $(SDLK_F24) => "SDLK_F24"
      | $(SDLK_EXECUTE) => "SDLK_EXECUTE"
      | $(SDLK_HELP) => "SDLK_HELP"
      | $(SDLK_MENU) => "SDLK_MENU"
      | $(SDLK_SELECT) => "SDLK_SELECT"
      | $(SDLK_STOP) => "SDLK_STOP"
      | $(SDLK_AGAIN) => "SDLK_AGAIN"
      | $(SDLK_UNDO) => "SDLK_UNDO"
      | $(SDLK_CUT) => "SDLK_CUT"
      | $(SDLK_COPY) => "SDLK_COPY"
      | $(SDLK_PASTE) => "SDLK_PASTE"
      | $(SDLK_FIND) => "SDLK_FIND"
      | $(SDLK_MUTE) => "SDLK_MUTE"
      | $(SDLK_VOLUMEUP) => "SDLK_VOLUMEUP"
      | $(SDLK_VOLUMEDOWN) => "SDLK_VOLUMEDOWN"
      | $(SDLK_KP_COMMA) => "SDLK_KP_COMMA"
      | $(SDLK_KP_EQUALSAS400) => "SDLK_KP_EQUALSAS400"

      | $(SDLK_ALTERASE) => "SDLK_ALTERASE"
      | $(SDLK_SYSREQ) => "SDLK_SYSREQ"
      | $(SDLK_CANCEL) => "SDLK_CANCEL"
      | $(SDLK_CLEAR) => "SDLK_CLEAR"
      | $(SDLK_PRIOR) => "SDLK_PRIOR"
      | $(SDLK_RETURN2) => "SDLK_RETURN2"
      | $(SDLK_SEPARATOR) => "SDLK_SEPARATOR"
      | $(SDLK_OUT) => "SDLK_OUT"
      | $(SDLK_OPER) => "SDLK_OPER"
      | $(SDLK_CLEARAGAIN) => "SDLK_CLEARAGAIN"
      | $(SDLK_CRSEL) => "SDLK_CRSEL"
      | $(SDLK_EXSEL) => "SDLK_EXSEL"

      | $(SDLK_KP_00) => "SDLK_KP_00"
      | $(SDLK_KP_000) => "SDLK_KP_000"
      | $(SDLK_THOUSANDSSEPARATOR) => "SDLK_THOUSANDSSEPARATOR"
      | $(SDLK_DECIMALSEPARATOR) => "SDLK_DECIMALSEPARATOR"
      | $(SDLK_CURRENCYUNIT) => "SDLK_CURRENCYUNIT"
      | $(SDLK_CURRENCYSUBUNIT) => "SDLK_CURRENCYSUBUNIT"
      | $(SDLK_KP_LEFTPAREN) => "SDLK_KP_LEFTPAREN"
      | $(SDLK_KP_RIGHTPAREN) => "SDLK_KP_RIGHTPAREN"
      | $(SDLK_KP_LEFTBRACE) => "SDLK_KP_LEFTBRACE"
      | $(SDLK_KP_RIGHTBRACE) => "SDLK_KP_RIGHTBRACE"
      | $(SDLK_KP_TAB) => "SDLK_KP_TAB"
      | $(SDLK_KP_BACKSPACE) => "SDLK_KP_BACKSPACE"
      | $(SDLK_KP_A) => "SDLK_KP_A"
      | $(SDLK_KP_B) => "SDLK_KP_B"
      | $(SDLK_KP_C) => "SDLK_KP_C"
      | $(SDLK_KP_D) => "SDLK_KP_D"
      | $(SDLK_KP_E) => "SDLK_KP_E"
      | $(SDLK_KP_F) => "SDLK_KP_F"
      | $(SDLK_KP_XOR) => "SDLK_KP_XOR"
      | $(SDLK_KP_POWER) => "SDLK_KP_POWER"
      | $(SDLK_KP_PERCENT) => "SDLK_KP_PERCENT"
      | $(SDLK_KP_LESS) => "SDLK_KP_LESS"
      | $(SDLK_KP_GREATER) => "SDLK_KP_GREATER"
      | $(SDLK_KP_AMPERSAND) => "SDLK_KP_AMPERSAND"
      | $(SDLK_KP_DBLAMPERSAND) => "SDLK_KP_DBLAMPERSAND"
      | $(SDLK_KP_VERTICALBAR) => "SDLK_KP_VERTICALBAR"
      | $(SDLK_KP_DBLVERTICALBAR) => "SDLK_KP_DBLVERTICALBAR"
      | $(SDLK_KP_COLON) => "SDLK_KP_COLON"
      | $(SDLK_KP_HASH) => "SDLK_KP_HASH"
      | $(SDLK_KP_SPACE) => "SDLK_KP_SPACE"
      | $(SDLK_KP_AT) => "SDLK_KP_AT"
      | $(SDLK_KP_EXCLAM) => "SDLK_KP_EXCLAM"
      | $(SDLK_KP_MEMSTORE) => "SDLK_KP_MEMSTORE"
      | $(SDLK_KP_MEMRECALL) => "SDLK_KP_MEMRECALL"
      | $(SDLK_KP_MEMCLEAR) => "SDLK_KP_MEMCLEAR"
      | $(SDLK_KP_MEMADD) => "SDLK_KP_MEMADD"
      | $(SDLK_KP_MEMSUBTRACT) => "SDLK_KP_MEMSUBTRACT"
      | $(SDLK_KP_MEMMULTIPLY) => "SDLK_KP_MEMMULTIPLY"
      | $(SDLK_KP_MEMDIVIDE) => "SDLK_KP_MEMDIVIDE"
      | $(SDLK_KP_PLUSMINUS) => "SDLK_KP_PLUSMINUS"
      | $(SDLK_KP_CLEAR) => "SDLK_KP_CLEAR"
      | $(SDLK_KP_CLEARENTRY) => "SDLK_KP_CLEARENTRY"
      | $(SDLK_KP_BINARY) => "SDLK_KP_BINARY"
      | $(SDLK_KP_OCTAL) => "SDLK_KP_OCTAL"
      | $(SDLK_KP_DECIMAL) => "SDLK_KP_DECIMAL"
      | $(SDLK_KP_HEXADECIMAL) => "SDLK_KP_HEXADECIMAL"

      | $(SDLK_LCTRL) => "SDLK_LCTRL"
      | $(SDLK_LSHIFT) => "SDLK_LSHIFT"
      | $(SDLK_LALT) => "SDLK_LALT"
      | $(SDLK_LGUI) => "SDLK_LGUI"
      | $(SDLK_RCTRL) => "SDLK_RCTRL"
      | $(SDLK_RSHIFT) => "SDLK_RSHIFT"
      | $(SDLK_RALT) => "SDLK_RALT"
      | $(SDLK_RGUI) => "SDLK_RGUI"

      | $(SDLK_MODE) => "SDLK_MODE"

      | $(SDLK_AUDIONEXT) => "SDLK_AUDIONEXT"
      | $(SDLK_AUDIOPREV) => "SDLK_AUDIOPREV"
      | $(SDLK_AUDIOSTOP) => "SDLK_AUDIOSTOP"
      | $(SDLK_AUDIOPLAY) => "SDLK_AUDIOPLAY"
      | $(SDLK_AUDIOMUTE) => "SDLK_AUDIOMUTE"
      | $(SDLK_MEDIASELECT) => "SDLK_MEDIASELECT"
      | $(SDLK_WWW) => "SDLK_WWW"
      | $(SDLK_MAIL) => "SDLK_MAIL"
      | $(SDLK_CALCULATOR) => "SDLK_CALCULATOR"
      | $(SDLK_COMPUTER) => "SDLK_COMPUTER"
      | $(SDLK_AC_SEARCH) => "SDLK_AC_SEARCH"
      | $(SDLK_AC_HOME) => "SDLK_AC_HOME"
      | $(SDLK_AC_BACK) => "SDLK_AC_BACK"
      | $(SDLK_AC_FORWARD) => "SDLK_AC_FORWARD"
      | $(SDLK_AC_STOP) => "SDLK_AC_STOP"
      | $(SDLK_AC_REFRESH) => "SDLK_AC_REFRESH"
      | $(SDLK_AC_BOOKMARKS) => "SDLK_AC_BOOKMARKS"

      | $(SDLK_BRIGHTNESSDOWN) => "SDLK_BRIGHTNESSDOWN"
      | $(SDLK_BRIGHTNESSUP) => "SDLK_BRIGHTNESSUP"
      | $(SDLK_DISPLAYSWITCH) => "SDLK_DISPLAYSWITCH"
      | $(SDLK_KBDILLUMTOGGLE) => "SDLK_KBDILLUMTOGGLE"
      | $(SDLK_KBDILLUMDOWN) => "SDLK_KBDILLUMDOWN"
      | $(SDLK_KBDILLUMUP) => "SDLK_KBDILLUMUP"
      | $(SDLK_EJECT) => "SDLK_EJECT"
      | $(SDLK_SLEEP) => "SDL_EJECT"
      | other => "KEY_"+other.int.str
    ;
  }
  /**
   * \brief Enumeration of valid key mods (possibly OR'd together).
   */
  cflags SDL_Keymod =
    KMOD_NONE,
    KMOD_LSHIFT,
    KMOD_RSHIFT,
    KMOD_LCTRL,
    KMOD_RCTRL,
    KMOD_LALT,
    KMOD_RALT,
    KMOD_LGUI,
    KMOD_RGUI,
    KMOD_NUM,
    KMOD_CAPS,
    KMOD_MODE,
    KMOD_RESERVED,
    KMOD_CTRL,
    KMOD_SHIFT,
    KMOD_ALT,
    KMOD_GUI
  ;
  ctor uint16 : SDL_Keymod = "$1";

  fun strmods (m:uint16) =
  {
    var mods = "";
    if m \& KMOD_LSHIFT.uint16 != 0u16 do mods += "LSHIFT-"; done;
    if m \& KMOD_RSHIFT.uint16 != 0u16 do mods += "RSHIFT-"; done;
    if m \& KMOD_LCTRL.uint16 != 0u16 do mods += "LCTRL-"; done;
    if m \& KMOD_RCTRL.uint16 != 0u16 do mods += "RCTRL-"; done;
    if m \& KMOD_LALT.uint16 != 0u16 do mods += "LALT-"; done;
    if m \& KMOD_RALT.uint16 != 0u16 do mods += "RALT-"; done;
    if m \& KMOD_LGUI.uint16 != 0u16 do mods += "LGUI-"; done;
    if m \& KMOD_RGUI.uint16 != 0u16 do mods += "RGUI-"; done;
    if m \& KMOD_NUM.uint16 != 0u16 do mods += "NUM-"; done;
    if m \& KMOD_CAPS.uint16 != 0u16 do mods += "CAPS-"; done;
    if m \& KMOD_MODE.uint16 != 0u16 do mods += "MODE-"; done;
    return mods;
  }

}

SDL_mixer.flx

//[SDL_mixer.flx]

//Module        : SDL_mixer_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_mixer.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define Mix_GetError  SDL_GetError
//#define Mix_SetError  SDL_SetError
//#define Mix_FadeInChannel(channel,chunk,loops,ms) Mix_FadeInChannelTimed(channel,chunk,loops,ms,-1)
//#define Mix_PlayChannel(channel,chunk,loops) Mix_PlayChannelTimed(channel,chunk,loops,-1)
//#define MIX_EFFECTSMAXSPEED  "MIX_EFFECTSMAXSPEED"
//#define MIX_CHANNEL_POST  -2
//#define Mix_LoadWAV(file)     Mix_LoadWAV_RW(SDL_RWFromFile(file, "rb"), 1)
//#define MIX_MAX_VOLUME                128     /* Volume of a chunk */
//#define MIX_DEFAULT_CHANNELS  2
//#define MIX_DEFAULT_FORMAT    AUDIO_S16MSB
//#define MIX_DEFAULT_FORMAT    AUDIO_S16LSB
//#define MIX_DEFAULT_FREQUENCY 22050
//#define MIX_CHANNELS  8
//#define MIX_VERSION(X)                SDL_MIXER_VERSION(X)
//#define MIX_PATCHLEVEL                SDL_MIXER_PATCHLEVEL
//#define MIX_MINOR_VERSION     SDL_MIXER_MINOR_VERSION
//#define MIX_MAJOR_VERSION     SDL_MIXER_MAJOR_VERSION
//#define SDL_MIXER_VERSION(X)                                          \
//#define SDL_MIXER_PATCHLEVEL  6
//#define SDL_MIXER_MINOR_VERSION       2
//#define SDL_MIXER_MAJOR_VERSION       1
//#define _SDL_MIXER_H

open module SDL_mixer_h
{
  requires package "sdl";
  header '#include "SDL_mixer.h"';

  //ABSTRACT TYPES
  type Mix_MusicType = 'Mix_MusicType';
  type Mix_Chunk = 'Mix_Chunk';
  type Mix_Fading = 'Mix_Fading';

  //C FUNCTION POINTER TYPES
  header '''typedef void (*SDL_mixer_h_cft_3)(void *, Uint8 *, int);''';
  type SDL_mixer_h_cft_3 = 'SDL_mixer_h_cft_3';
  header '''typedef void (*SDL_mixer_h_cft_1)(int, void *, int,  void *);''';
  type SDL_mixer_h_cft_1 = 'SDL_mixer_h_cft_1';
  header '''typedef void (*SDL_mixer_h_cft_2)(int, void *);''';
  type SDL_mixer_h_cft_2 = 'SDL_mixer_h_cft_2';
  header '''typedef void (*SDL_mixer_h_cft_5)(int);''';
  type SDL_mixer_h_cft_5 = 'SDL_mixer_h_cft_5';
  header '''typedef void (*SDL_mixer_h_cft_4)(void);''';
  type SDL_mixer_h_cft_4 = 'SDL_mixer_h_cft_4';

  //PURE INCOMPLETE TYPES
  type _struct__Mix_Music = 'struct _Mix_Music'; //local

  //STRUCT or UNION TAG ALIASES
  typedef Mix_Music = _struct__Mix_Music;

  //TYPE ALIASES
  typedef Mix_EffectDone_t = SDL_mixer_h_cft_2;
  typedef Mix_EffectFunc_t = SDL_mixer_h_cft_1;

  //ENUMERATION CONSTANTS
  const MUS_CMD: int = 'MUS_CMD';
  const MIX_FADING_OUT: int = 'MIX_FADING_OUT';
  const MIX_NO_FADING: int = 'MIX_NO_FADING';
  const MIX_FADING_IN: int = 'MIX_FADING_IN';
  const MUS_WAV: int = 'MUS_WAV';
  const MUS_MID: int = 'MUS_MID';
  const MUS_OGG: int = 'MUS_OGG';
  const MUS_NONE: int = 'MUS_NONE';
  const MUS_MOD: int = 'MUS_MOD';
  const MUS_MP3: int = 'MUS_MP3';

  //PROCEDURES
  proc Mix_ChannelFinished: SDL_mixer_h_cft_5;
  proc Mix_CloseAudio: 1;
  proc Mix_FreeChunk: &Mix_Chunk;
  proc Mix_FreeMusic: &Mix_Music;
  proc Mix_HookMusic: SDL_mixer_h_cft_3 * address;
  proc Mix_HookMusicFinished: SDL_mixer_h_cft_4;
  proc Mix_Pause: int;
  proc Mix_PauseMusic: 1;
  proc Mix_Resume: int;
  proc Mix_ResumeMusic: 1;
  proc Mix_RewindMusic: 1;
  proc Mix_SetPostMix: SDL_mixer_h_cft_3 * address;

  //FUNCTIONS
  fun Mix_AllocateChannels: int -> int;
  fun Mix_ExpireChannel: int * int -> int;
  fun Mix_FadeInChannelTimed: int * &Mix_Chunk * int * int * int -> int;
  fun Mix_FadeInMusic: &Mix_Music * int * int -> int;
  fun Mix_FadeInMusicPos: &Mix_Music * int * int * double -> int;
  fun Mix_FadeOutChannel: int * int -> int;
  fun Mix_FadeOutGroup: int * int -> int;
  fun Mix_FadeOutMusic: int -> int;
  fun Mix_FadingChannel: int -> Mix_Fading;
  fun Mix_FadingMusic: 1 -> Mix_Fading;
  fun Mix_GetChunk: int -> &Mix_Chunk;
  fun Mix_GetMusicHookData: 1 -> address;
  fun Mix_GetMusicType: &Mix_Music -> Mix_MusicType;
  fun Mix_GetSynchroValue: 1 -> int;
  fun Mix_GroupAvailable: int -> int;
  fun Mix_GroupChannel: int * int -> int;
  fun Mix_GroupChannels: int * int * int -> int;
  fun Mix_GroupCount: int -> int;
  fun Mix_GroupNewer: int -> int;
  fun Mix_GroupOldest: int -> int;
  fun Mix_HaltChannel: int -> int;
  fun Mix_HaltGroup: int -> int;
  fun Mix_HaltMusic: 1 -> int;
  fun Mix_Linked_Version: 1 -> &SDL_version;
  fun Mix_LoadMUS: &char -> &Mix_Music;
  fun Mix_LoadWAV_RW: &SDL_RWops * int -> &Mix_Chunk;
  fun Mix_OpenAudio: int * uint16 * int * int -> int;
  fun Mix_Paused: int -> int;
  fun Mix_PausedMusic: 1 -> int;
  fun Mix_PlayChannelTimed: int * &Mix_Chunk * int * int -> int;
  fun Mix_PlayMusic: &Mix_Music * int -> int;
  fun Mix_Playing: int -> int;
  fun Mix_PlayingMusic: 1 -> int;
  fun Mix_QuerySpec: &int * &uint16 * &int -> int;
  fun Mix_QuickLoad_RAW: &uint8 * uint32 -> &Mix_Chunk;
  fun Mix_QuickLoad_WAV: &uint8 -> &Mix_Chunk;
  fun Mix_RegisterEffect: int * SDL_mixer_h_cft_1 * SDL_mixer_h_cft_2 * address -> int;
  fun Mix_ReserveChannels: int -> int;
  fun Mix_SetDistance: int * uint8 -> int;
  fun Mix_SetMusicCMD: &char -> int;
  fun Mix_SetMusicPosition: double -> int;
  fun Mix_SetPanning: int * uint8 * uint8 -> int;
  fun Mix_SetPosition: int * int16 * uint8 -> int;
  fun Mix_SetReverseStereo: int * int -> int;
  fun Mix_SetSynchroValue: int -> int;
  fun Mix_UnregisterAllEffects: int -> int;
  fun Mix_UnregisterEffect: int * SDL_mixer_h_cft_1 -> int;
  fun Mix_Volume: int * int -> int;
  fun Mix_VolumeChunk: &Mix_Chunk * int -> int;
  fun Mix_VolumeMusic: int -> int;

  //CALLBACK TYPE WRAPPERS
  //callback type SDL_mixer_h_cft_2, client data at 1
  typedef _fcbat_SDL_mixer_h_cft_2 = int;
  export type (_fcbat_SDL_mixer_h_cft_2) as "_fcbat_SDL_mixer_h_cft_2";
  typedef _fcbt_SDL_mixer_h_cft_2 = int -> void;
  export type (_fcbt_SDL_mixer_h_cft_2) as "_fcbt_SDL_mixer_h_cft_2";
  header '''void _fcbw_SDL_mixer_h_cft_2(int a1, void *a2);''';

  const _fcbw_SDL_mixer_h_cft_2: SDL_mixer_h_cft_2 = "_fcbw_SDL_mixer_h_cft_2";
  body '''
  void _fcbw_SDL_mixer_h_cft_2(int a1, void *a2){
    con_t *p  = ((_fcbt_SDL_mixer_h_cft_2)a2)->call(0, a1);
    while(p) p=p->resume();
  }''';

  //callback type SDL_mixer_h_cft_3, client data at 0
  typedef _fcbat_SDL_mixer_h_cft_3 = &uint8 * int;
  export type (_fcbat_SDL_mixer_h_cft_3) as "_fcbat_SDL_mixer_h_cft_3";
  typedef _fcbt_SDL_mixer_h_cft_3 = &uint8 * int -> void;
  export type (_fcbt_SDL_mixer_h_cft_3) as "_fcbt_SDL_mixer_h_cft_3";
  header '''void _fcbw_SDL_mixer_h_cft_3(void *a1, Uint8 *a2, int a3);''';

  const _fcbw_SDL_mixer_h_cft_3: SDL_mixer_h_cft_3 = "_fcbw_SDL_mixer_h_cft_3";
  body '''
  void _fcbw_SDL_mixer_h_cft_3(void *a1, Uint8 *a2, int a3){
    con_t *p  = ((_fcbt_SDL_mixer_h_cft_3)a1)->call(0, _fcbat_SDL_mixer_h_cft_3(a2, a3));
    while(p) p=p->resume();
  }''';


  //CALLBACK CLIENT WRAPPERS
  //callback client Mix_HookMusic, client data at 0, callback at 1
  proc wrapper_Mix_HookMusic(a1: _fcbt_SDL_mixer_h_cft_3) {
    Mix_HookMusic(_fcbw_SDL_mixer_h_cft_3, C_hack::cast[address]a1);
  }
  //callback client Mix_RegisterEffect, client data at 2, callback at 3
  fun wrapper_Mix_RegisterEffect(a1: int, a2: SDL_mixer_h_cft_1, a3: _fcbt_SDL_mixer_h_cft_2): int= {
    return Mix_RegisterEffect(a1, a2, _fcbw_SDL_mixer_h_cft_2, C_hack::cast[address]a3);
  }
  //callback client Mix_SetPostMix, client data at 0, callback at 1
  proc wrapper_Mix_SetPostMix(a1: _fcbt_SDL_mixer_h_cft_3) {
    Mix_SetPostMix(_fcbw_SDL_mixer_h_cft_3, C_hack::cast[address]a1);
  }
}

SDL_mouse.flx

//[SDL_mouse.flx]



open class SDL_mouse_h
{
  requires package "sdl2";

  // mouse button state things
  const SDL_BUTTON_RMASK : uint8;
  const SDL_BUTTON_MMASK : uint8;
  const SDL_BUTTON_LMASK : uint8;
  const SDL_BUTTON_X1MASK : uint8;
  const SDL_BUTTON_X2MASK : uint8;

  const SDL_BUTTON_RIGHT : uint8;
  const SDL_BUTTON_MIDDLE : uint8;
  const SDL_BUTTON_LEFT   : uint8;
  const SDL_BUTTON_X1   : uint8;
  const SDL_BUTTON_X2   : uint8;

  // platform cursor
  cenum SDL_SystemCursor =
      SDL_SYSTEM_CURSOR_ARROW,     /**< Arrow */
      SDL_SYSTEM_CURSOR_IBEAM,     /**< I-beam */
      SDL_SYSTEM_CURSOR_WAIT,      /**< Wait */
      SDL_SYSTEM_CURSOR_CROSSHAIR, /**< Crosshair */
      SDL_SYSTEM_CURSOR_WAITARROW, /**< Small wait cursor (or Wait if not available) */
      SDL_SYSTEM_CURSOR_SIZENWSE,  /**< Double arrow pointing northwest and southeast */
      SDL_SYSTEM_CURSOR_SIZENESW,  /**< Double arrow pointing northeast and southwest */
      SDL_SYSTEM_CURSOR_SIZEWE,    /**< Double arrow pointing west and east */
      SDL_SYSTEM_CURSOR_SIZENS,    /**< Double arrow pointing north and south */
      SDL_SYSTEM_CURSOR_SIZEALL,   /**< Four pointed arrow pointing north, south, east, and west */
      SDL_SYSTEM_CURSOR_NO,        /**< Slashed circle or crossbones */
      SDL_SYSTEM_CURSOR_HAND,      /**< Hand */
      SDL_NUM_SYSTEM_CURSORS
  ;

  type SDL_Cursor = "SDL_Cursor*";

  //PROCEDURES
  proc SDL_FreeCursor: SDL_Cursor;
  proc SDL_SetCursor: SDL_Cursor;
  proc SDL_WarpMouseInWindow: &SDL_Window * uint16 * uint16;

  //FUNCTIONS
  fun SDL_CreateCursor: &uint8 * &uint8 * int * int * int * int -> SDL_Cursor;
  fun SDL_CreateColorCursor : &SDL_Surface * int * int -> SDL_Cursor;
  fun SDL_CreateSystemCursor : SDL_SystemCursor -> SDL_Cursor;
  fun SDL_GetCursor: 1 -> SDL_Cursor;
  fun SDL_GetDefaultCursor: 1 -> SDL_Cursor;
  fun SDL_ShowCursor: int -> int;

  fun SDL_GetMouseState: &int * &int -> uint8;
  fun SDL_GetRelativeMouseState: &int * &int -> uint8;
  fun SDL_GetMouseFocus : 1 -> &SDL_Window;
  fun SDL_SetRelativeMouseMode : bool -> int;
  fun SDL_GetRelativeMouseMode : 1 -> bool;
}

SDL_mutex.flx

//[SDL_mutex.flx]


//Module        : SDL_mutex_h
//Timestamp     : 2006/1/6 2:5:23 UTC
//Timestamp     : 2006/1/6 13:5:23 (local)
//Raw Header    : SDL_mutex.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SDL_MUTEX_MAXWAIT     (~(Uint32)0)
//#define SDL_MUTEX_TIMEDOUT    1
//#define _SDL_mutex_h

// DO NOT USE THIS MODULE
// FELIX HAS ITS OWN THREAD HANDLING

open module SDL_mutex_h
{
  requires package "sdl";
  header '#include "SDL_mutex.h"';

  incomplete ctypes SDL_mutex, SDL_cond, SDL_sem;

  //PROCEDURES
  proc SDL_DestroyCond: &SDL_cond;
  proc SDL_DestroyMutex: &SDL_mutex;
  proc SDL_DestroySemaphore: &SDL_sem;

  //FUNCTIONS
  fun SDL_CondBroadcast: &SDL_cond -> int;
  fun SDL_CondSignal: &SDL_cond -> int;
  fun SDL_CondWait: &SDL_cond * &SDL_mutex -> int;
  fun SDL_CondWaitTimeout: &SDL_cond * &SDL_mutex * uint32 -> int;
  fun SDL_CreateCond: 1 -> &SDL_cond;
  fun SDL_CreateMutex: 1 -> &SDL_mutex;
  fun SDL_CreateSemaphore: uint32 -> &SDL_sem;
  fun SDL_SemPost: &SDL_sem -> int;
  fun SDL_SemTryWait: &SDL_sem -> int;
  fun SDL_SemValue: &SDL_sem -> uint32;
  fun SDL_SemWait: &SDL_sem -> int;
  fun SDL_SemWaitTimeout: &SDL_sem * uint32 -> int;
  fun SDL_mutexP: &SDL_mutex -> int;
  fun SDL_mutexV: &SDL_mutex -> int;
  fun SDL_LockMutex: &SDL_mutex -> int;
  fun SDL_UnlockMutex: &SDL_mutex -> int;
}

SDL_net.flx

//[SDL_net.flx]


//Module        : SDL_net_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_net.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SDLNet_Read32(areap)          \
//#define SDLNet_Read32(areap)          \
//#define SDLNet_Read32(areap)          \
//#define SDLNet_Read16(areap)          \
//#define SDLNet_Read16(areap)          \
//#define SDLNet_Read16(areap)          \
//#define SDLNet_Write32(value, areap)  \
//#define SDLNet_Write32(value, areap)  \
//#define SDLNet_Write32(value, areap)  \
//#define SDLNet_Write16(value, areap)  \
//#define SDLNet_Write16(value, areap)  \
//#define SDLNet_Write16(value, areap)  \
//#define SDL_DATA_ALIGNED      0
//#define SDL_DATA_ALIGNED      1
//#define SDLNet_GetError       SDL_GetError
//#define SDLNet_SetError       SDL_SetError
//#define SDLNet_SocketReady(sock) \
//#define SDLNet_UDP_DelSocket(set, sock) \
//#define SDLNet_TCP_DelSocket(set, sock) \
//#define SDLNet_UDP_AddSocket(set, sock) \
//#define SDLNet_TCP_AddSocket(set, sock) \
//#define SDLNET_MAX_UDPADDRESSES       4
//#define SDLNET_MAX_UDPCHANNELS        32
//#define INADDR_BROADCAST      0xFFFFFFFF
//#define INADDR_NONE           0xFFFFFFFF
//#define INADDR_ANY            0x00000000
//#define _SDLnet_h

// NO NOT USE: Felix has its own networking
module SDL_net_h
{
  requires package "sdl";
  header '#include "SDL_net.h"';

  //ABSTRACT TYPES
  type SDLNet_GenericSocket = 'SDLNet_GenericSocket';
  type IPaddress = 'IPaddress';
  type UDPpacket = 'UDPpacket';

  //PURE INCOMPLETE TYPES
  type _struct__UDPsocket = 'struct _UDPsocket'; //local
  type _struct__SDLNet_SocketSet = 'struct _SDLNet_SocketSet'; //local
  type _struct__TCPsocket = 'struct _TCPsocket'; //local

  //TYPE ALIASES
  typedef UDPsocket = &_struct__UDPsocket;
  typedef TCPsocket = &_struct__TCPsocket;
  typedef SDLNet_SocketSet = &_struct__SDLNet_SocketSet;

  //PROCEDURES
  proc SDLNet_FreePacket: &UDPpacket;
  proc SDLNet_FreePacketV: &&UDPpacket;
  proc SDLNet_FreeSocketSet: SDLNet_SocketSet;
  proc SDLNet_Quit: 1;
  proc SDLNet_TCP_Close: TCPsocket;
  proc SDLNet_UDP_Close: UDPsocket;
  proc SDLNet_UDP_Unbind: UDPsocket * int;
  proc SDLNet_Write16: uint16 * address;
  proc SDLNet_Write32: uint32 * address;

  //FUNCTIONS
  fun SDLNet_AddSocket: SDLNet_SocketSet * SDLNet_GenericSocket -> int;
  fun SDLNet_AllocPacket: int -> &UDPpacket;
  fun SDLNet_AllocPacketV: int * int -> &&UDPpacket;
  fun SDLNet_AllocSocketSet: int -> SDLNet_SocketSet;
  fun SDLNet_CheckSockets: SDLNet_SocketSet * uint32 -> int;
  fun SDLNet_DelSocket: SDLNet_SocketSet * SDLNet_GenericSocket -> int;
  fun SDLNet_Init: 1 -> int;
  fun SDLNet_Read16: address -> uint16;
  fun SDLNet_Read32: address -> uint32;
  fun SDLNet_ResizePacket: &UDPpacket * int -> int;
  fun SDLNet_ResolveHost: &IPaddress * &char * uint16 -> int;
  fun SDLNet_ResolveIP: &IPaddress -> &char;
  fun SDLNet_TCP_Accept: TCPsocket -> TCPsocket;
  fun SDLNet_TCP_GetPeerAddress: TCPsocket -> &IPaddress;
  fun SDLNet_TCP_Open: &IPaddress -> TCPsocket;
  fun SDLNet_TCP_Recv: TCPsocket * address * int -> int;
  fun SDLNet_TCP_Send: TCPsocket * address * int -> int;
  fun SDLNet_UDP_Bind: UDPsocket * int * &IPaddress -> int;
  fun SDLNet_UDP_GetPeerAddress: UDPsocket * int -> &IPaddress;
  fun SDLNet_UDP_Open: uint16 -> UDPsocket;
  fun SDLNet_UDP_Recv: UDPsocket * &UDPpacket -> int;
  fun SDLNet_UDP_RecvV: UDPsocket * &&UDPpacket -> int;
  fun SDLNet_UDP_Send: UDPsocket * int * &UDPpacket -> int;
  fun SDLNet_UDP_SendV: UDPsocket * &&UDPpacket * int -> int;
}

SDL_opengl.flx

//[SDL_opengl.flx]

header '#include "SDL_opengl.h"';

include "GL/gl_lib";
include "GL/glu_lib";

open module SDL_opengl_h
{
  inherit GL_gl_h;
  inherit GL_glu_h;
}

SDL_pixels.flx

//[SDL_pixels.flx]


open class SDL_pixels_h
{
  requires package "sdl2";

  typedef struct SDL_Color
  {
    uint8 r;
    uint8 g;
    uint8 b;
    uint8 a;
  } SDL_Color;

  typedef struct SDL_Palette
  {
    int ncolors;
    +SDL_Color colors;
    uint32 version;
    int refcount;
  } SDL_Palette;


  typedef struct SDL_PixelFormat
  {
    uint32 format;
    &SDL_Palette palette;
    uint8 BitsPerPixel;
    uint8 BytesPerPixel;
    uint8 padding1; uint8 padding2;
    uint32 Rmask;
    uint32 Gmask;
    uint32 Bmask;
    uint32 Amask;
    uint8 Rloss;
    uint8 Gloss;
    uint8 Bloss;
    uint8 Aloss;
    uint8 Rshift;
    uint8 Gshift;
    uint8 Bshift;
    uint8 Ashift;
    int refcount;
    next: &SDL_PixelFormat; // should allow NULL
  } SDL_PixelFormat;

  fun SDL_MapRGB: &SDL_PixelFormat * uint8 * uint8 * uint8 -> uint32;
  fun SDL_MapRGBA: &SDL_PixelFormat * uint8 * uint8 * uint8 * uint8 -> uint32;
}

SDL_rect.flx

//[SDL_rect.flx]


open class SDL_rect_h
{
  typedef struct
  {
    int x;
    int y;
  } SDL_Point;

  typedef struct SDL_Rect
  {
    int x; int y;
    int w; int h;
  } SDL_Rect;

  fun \in (p:SDL_Point, r:SDL_Rect) =>
    p.x >= r.x and p.x < r.x + r.w and p.y >= r.y and p.y < r.y + r.h
  ;

  fun inRect (x:int, y:int, r:SDL_Rect) => SDL_Point (x,y) in r;

  instance Str[SDL_Rect] {
    fun str (r:SDL_Rect)=>"Rect(x="+r.x.str+",y="+r.y.str+",h="+r.h.str+",w="+r.w.str+")";
  }
}

SDL_render.flx

//[SDL_render.flx]


open class SDL_Render_h
{
  type SDL_Renderer = "SDL_Renderer*";
  fun SDL_CreateSoftwareRenderer : &SDL_Surface -> SDL_Renderer;
  gen SDL_RenderDrawLine : SDL_Renderer * int * int * int * int -> int;
  gen SDL_SetRenderDrawColor: SDL_Renderer * uint8 * uint8 * uint8 * uint8 -> int;
  proc SDL_DestroyRenderer : SDL_Renderer;
  gen SDL_RenderSetClipRect : SDL_Renderer * &SDL_Rect -> int;
  gen SDL_RenderSetScale : SDL_Renderer * float * float -> int;
}

SDL_rotozoom.flx

//[SDL_rotozoom.flx]

//Module        : SDL_rotozoom_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_rotozoom.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define DLLINTERFACE
//#define DLLINTERFACE __declspec(dllimport)
//#define DLLINTERFACE __declspec(dllexport)
//#define SMOOTHING_ON          1
//#define SMOOTHING_OFF         0
//#define M_PI  3.141592654
//#define _SDL_rotozoom_h

open module SDL_rotozoom_h
{
  requires package "sdl";
  header '#include "SDL_rotozoom.h"';

  //CSTRUCTS
  cstruct tColorRGBA {
    r: uint8;
    g: uint8;
    b: uint8;
    a: uint8;
  };
  cstruct tColorY {
    y: uint8;
  };

  //STRUCT or UNION TAG ALIASES

  //TYPE ALIASES
  typedef _struct_tColorY = tColorY;
  typedef _struct_tColorRGBA = tColorRGBA;

  //PROCEDURES
  proc rotozoomSurfaceSize: int * int * double * double * &int * &int;
  proc zoomSurfaceSize: int * int * double * double * &int * &int;

  //FUNCTIONS
  fun rotozoomSurface: &SDL_Surface * double * double * int -> &SDL_Surface;
  fun zoomSurface: &SDL_Surface * double * double * int -> &SDL_Surface;
}

SDL_rwops.flx

//[SDL_rwops.flx]

//#define SDL_RWclose(ctx)              (ctx)->close(ctx)
//#define SDL_RWwrite(ctx, ptr, size, n)        (ctx)->write(ctx, ptr, size, n)
//#define SDL_RWread(ctx, ptr, size, n) (ctx)->read(ctx, ptr, size, n)
//#define SDL_RWtell(ctx)                       (ctx)->seek(ctx, 0, SEEK_CUR)
//#define SDL_RWseek(ctx, offset, whence)       (ctx)->seek(ctx, offset, whence)
//#define _SDL_RWops_h

//INCLUDES

open class SDL_rwops_h
{
  //ABSTRACT TYPES
  type SDL_RWops = 'SDL_RWops*';

/*
  //C FUNCTION POINTER TYPES
  header '''typedef int (*SDL_rwops_h_cft_1)(struct SDL_RWops *,  int, int);''';
  type SDL_rwops_h_cft_1 = 'SDL_rwops_h_cft_1';
  header '''typedef int (*SDL_rwops_h_cft_3)(struct SDL_RWops *,  void const *,  int, int);''';
  type SDL_rwops_h_cft_3 = 'SDL_rwops_h_cft_3';
  header '''typedef int (*SDL_rwops_h_cft_2)(struct SDL_RWops *,  void *, int,  int);''';
  type SDL_rwops_h_cft_2 = 'SDL_rwops_h_cft_2';
  header '''typedef int (*SDL_rwops_h_cft_4)(struct SDL_RWops *);''';
  type SDL_rwops_h_cft_4 = 'SDL_rwops_h_cft_4';
*/
  //PROCEDURES
  proc SDL_FreeRW: SDL_RWops;

  //FUNCTIONS
  fun SDL_AllocRW: 1 -> SDL_RWops;
  fun SDL_RWFromConstMem: address * int -> SDL_RWops;
  fun SDL_RWFromFP: FILE * int -> SDL_RWops;
  fun SDL_RWFromInputFile: string -> SDL_RWops = 'SDL_RWFromFile($1.c_str(),"r")';
  fun SDL_RWFromFile: string -> SDL_RWops = 'SDL_RWFromFile($1.c_str(),"rw")';
  fun SDL_RWFromMem: address * int -> SDL_RWops;

/*
  //STRUCT and UNION FIELDS
  fun get_read: _struct_SDL_RWops -> SDL_rwops_h_cft_2 = '$1->read';
  fun get_write: _struct_SDL_RWops -> SDL_rwops_h_cft_3 = '$1->write';
  fun get_seek: _struct_SDL_RWops -> SDL_rwops_h_cft_1 = '$1->seek';
  fun get_close: _struct_SDL_RWops -> SDL_rwops_h_cft_4 = '$1->close';
  fun get_type: _struct_SDL_RWops -> uint32 = '$1->type';
*/

}

SDL_scancode.flx

//[SDL_scancode.flx]


open class SDL_scancode_h
{
  requires package "sdl2";

  cenum SDL_Scancode =
    SDL_SCANCODE_UNKNOWN,
    /**
     *  \name Usage page 0x07
     *
     *  These values are from usage page 0x07 (USB keyboard page).
     */
    /*@{*/

    SDL_SCANCODE_A,
    SDL_SCANCODE_B,
    SDL_SCANCODE_C,
    SDL_SCANCODE_D,
    SDL_SCANCODE_E,
    SDL_SCANCODE_F,
    SDL_SCANCODE_G,
    SDL_SCANCODE_H,
    SDL_SCANCODE_I,
    SDL_SCANCODE_J,
    SDL_SCANCODE_K,
    SDL_SCANCODE_L,
    SDL_SCANCODE_M,
    SDL_SCANCODE_N,
    SDL_SCANCODE_O,
    SDL_SCANCODE_P,
    SDL_SCANCODE_Q,
    SDL_SCANCODE_R,
    SDL_SCANCODE_S,
    SDL_SCANCODE_T,
    SDL_SCANCODE_U,
    SDL_SCANCODE_V,
    SDL_SCANCODE_W,
    SDL_SCANCODE_X,
    SDL_SCANCODE_Y,
    SDL_SCANCODE_Z,

    SDL_SCANCODE_1,
    SDL_SCANCODE_2,
    SDL_SCANCODE_3,
    SDL_SCANCODE_4,
    SDL_SCANCODE_5,
    SDL_SCANCODE_6,
    SDL_SCANCODE_7,
    SDL_SCANCODE_8,
    SDL_SCANCODE_9,
    SDL_SCANCODE_0,

    SDL_SCANCODE_RETURN,
    SDL_SCANCODE_ESCAPE,
    SDL_SCANCODE_BACKSPACE,
    SDL_SCANCODE_TAB,
    SDL_SCANCODE_SPACE,

    SDL_SCANCODE_MINUS,
    SDL_SCANCODE_EQUALS,
    SDL_SCANCODE_LEFTBRACKET,
    SDL_SCANCODE_RIGHTBRACKET,
    SDL_SCANCODE_BACKSLASH, /**< Located at the lower left of the return
                                  *   key on ISO keyboards and at the right end
                                  *   of the QWERTY row on ANSI keyboards.
                                  *   Produces REVERSE SOLIDUS (backslash) and
                                  *   VERTICAL LINE in a US layout, REVERSE
                                  *   SOLIDUS and VERTICAL LINE in a UK Mac
                                  *   layout, NUMBER SIGN and TILDE in a UK
                                  *   Windows layout, DOLLAR SIGN and POUND SIGN
                                  *   in a Swiss German layout, NUMBER SIGN and
                                  *   APOSTROPHE in a German layout, GRAVE
                                  *   ACCENT and POUND SIGN in a French Mac
                                  *   layout, and ASTERISK and MICRO SIGN in a
                                  *   French Windows layout.
                                  */
    SDL_SCANCODE_NONUSHASH, /**< ISO USB keyboards actually use this code
                                  *   instead of 49 for the same key, but all
                                  *   OSes I've seen treat the two codes
                                  *   identically. So, as an implementor, unless
                                  *   your keyboard generates both of those
                                  *   codes and your OS treats them differently,
                                  *   you should generate SDL_SCANCODE_BACKSLASH
                                  *   instead of this code. As a user, you
                                  *   should not rely on this code because SDL
                                  *   will never generate it with most (all?)
                                  *   keyboards.
                                  */
    SDL_SCANCODE_SEMICOLON,
    SDL_SCANCODE_APOSTROPHE,
    SDL_SCANCODE_GRAVE, /**< Located in the top left corner (on both ANSI
                              *   and ISO keyboards). Produces GRAVE ACCENT and
                              *   TILDE in a US Windows layout and in US and UK
                              *   Mac layouts on ANSI keyboards, GRAVE ACCENT
                              *   and NOT SIGN in a UK Windows layout, SECTION
                              *   SIGN and PLUS-MINUS SIGN in US and UK Mac
                              *   layouts on ISO keyboards, SECTION SIGN and
                              *   DEGREE SIGN in a Swiss German layout (Mac:
                              *   only on ISO keyboards), CIRCUMFLEX ACCENT and
                              *   DEGREE SIGN in a German layout (Mac: only on
                              *   ISO keyboards), SUPERSCRIPT TWO and TILDE in a
                              *   French Windows layout, COMMERCIAL AT and
                              *   NUMBER SIGN in a French Mac layout on ISO
                              *   keyboards, and LESS-THAN SIGN and GREATER-THAN
                              *   SIGN in a Swiss German, German, or French Mac
                              *   layout on ANSI keyboards.
                              */
    SDL_SCANCODE_COMMA,
    SDL_SCANCODE_PERIOD,
    SDL_SCANCODE_SLASH,

    SDL_SCANCODE_CAPSLOCK,

    SDL_SCANCODE_F1,
    SDL_SCANCODE_F2,
    SDL_SCANCODE_F3,
    SDL_SCANCODE_F4,
    SDL_SCANCODE_F5,
    SDL_SCANCODE_F6,
    SDL_SCANCODE_F7,
    SDL_SCANCODE_F8,
    SDL_SCANCODE_F9,
    SDL_SCANCODE_F10,
    SDL_SCANCODE_F11,
    SDL_SCANCODE_F12,

    SDL_SCANCODE_PRINTSCREEN,
    SDL_SCANCODE_SCROLLLOCK,
    SDL_SCANCODE_PAUSE,
    SDL_SCANCODE_INSERT, /**< insert on PC, help on some Mac keyboards (but
                                   does send code 73, not 117) */
    SDL_SCANCODE_HOME,
    SDL_SCANCODE_PAGEUP,
    SDL_SCANCODE_DELETE,
    SDL_SCANCODE_END,
    SDL_SCANCODE_PAGEDOWN,
    SDL_SCANCODE_RIGHT,
    SDL_SCANCODE_LEFT,
    SDL_SCANCODE_DOWN,
    SDL_SCANCODE_UP,

    SDL_SCANCODE_NUMLOCKCLEAR, /**< num lock on PC, clear on Mac keyboards
                                     */
    SDL_SCANCODE_KP_DIVIDE,
    SDL_SCANCODE_KP_MULTIPLY,
    SDL_SCANCODE_KP_MINUS,
    SDL_SCANCODE_KP_PLUS,
    SDL_SCANCODE_KP_ENTER,
    SDL_SCANCODE_KP_1,
    SDL_SCANCODE_KP_2,
    SDL_SCANCODE_KP_3,
    SDL_SCANCODE_KP_4,
    SDL_SCANCODE_KP_5,
    SDL_SCANCODE_KP_6,
    SDL_SCANCODE_KP_7,
    SDL_SCANCODE_KP_8,
    SDL_SCANCODE_KP_9,
    SDL_SCANCODE_KP_0,
    SDL_SCANCODE_KP_PERIOD,

    SDL_SCANCODE_NONUSBACKSLASH, /**< This is the additional key that ISO
                                        *   keyboards have over ANSI ones,
                                        *   located between left shift and Y.
                                        *   Produces GRAVE ACCENT and TILDE in a
                                        *   US or UK Mac layout, REVERSE SOLIDUS
                                        *   (backslash) and VERTICAL LINE in a
                                        *   US or UK Windows layout, and
                                        *   LESS-THAN SIGN and GREATER-THAN SIGN
                                        *   in a Swiss German, German, or French
                                        *   layout. */
    SDL_SCANCODE_APPLICATION, /**< windows contextual menu, compose */
    SDL_SCANCODE_POWER, /**< The USB document says this is a status flag,
                               *   not a physical key - but some Mac keyboards
                               *   do have a power key. */
    SDL_SCANCODE_KP_EQUALS,
    SDL_SCANCODE_F13,
    SDL_SCANCODE_F14,
    SDL_SCANCODE_F15,
    SDL_SCANCODE_F16,
    SDL_SCANCODE_F17,
    SDL_SCANCODE_F18,
    SDL_SCANCODE_F19,
    SDL_SCANCODE_F20,
    SDL_SCANCODE_F21,
    SDL_SCANCODE_F22,
    SDL_SCANCODE_F23,
    SDL_SCANCODE_F24,
    SDL_SCANCODE_EXECUTE,
    SDL_SCANCODE_HELP,
    SDL_SCANCODE_MENU,
    SDL_SCANCODE_SELECT,
    SDL_SCANCODE_STOP,
    SDL_SCANCODE_AGAIN,   /**< redo */
    SDL_SCANCODE_UNDO,
    SDL_SCANCODE_CUT,
    SDL_SCANCODE_COPY,
    SDL_SCANCODE_PASTE,
    SDL_SCANCODE_FIND,
    SDL_SCANCODE_MUTE,
    SDL_SCANCODE_VOLUMEUP,
    SDL_SCANCODE_VOLUMEDOWN,
/* not sure whether there's a reason to enable these */
/*     SDL_SCANCODE_LOCKINGCAPSLOCK,  */
/*     SDL_SCANCODE_LOCKINGNUMLOCK, */
/*     SDL_SCANCODE_LOCKINGSCROLLLOCK, */
    SDL_SCANCODE_KP_COMMA,
    SDL_SCANCODE_KP_EQUALSAS400,

    SDL_SCANCODE_INTERNATIONAL1, /**< used on Asian keyboards, see
                                            footnotes in USB doc */
    SDL_SCANCODE_INTERNATIONAL2,
    SDL_SCANCODE_INTERNATIONAL3, /**< Yen */
    SDL_SCANCODE_INTERNATIONAL4,
    SDL_SCANCODE_INTERNATIONAL5,
    SDL_SCANCODE_INTERNATIONAL6,
    SDL_SCANCODE_INTERNATIONAL7,
    SDL_SCANCODE_INTERNATIONAL8,
    SDL_SCANCODE_INTERNATIONAL9,
    SDL_SCANCODE_LANG1, /**< Hangul/English toggle */
    SDL_SCANCODE_LANG2, /**< Hanja conversion */
    SDL_SCANCODE_LANG3, /**< Katakana */
    SDL_SCANCODE_LANG4, /**< Hiragana */
    SDL_SCANCODE_LANG5, /**< Zenkaku/Hankaku */
    SDL_SCANCODE_LANG6, /**< reserved */
    SDL_SCANCODE_LANG7, /**< reserved */
    SDL_SCANCODE_LANG8, /**< reserved */
    SDL_SCANCODE_LANG9, /**< reserved */

    SDL_SCANCODE_ALTERASE, /**< Erase-Eaze */
    SDL_SCANCODE_SYSREQ,
    SDL_SCANCODE_CANCEL,
    SDL_SCANCODE_CLEAR,
    SDL_SCANCODE_PRIOR,
    SDL_SCANCODE_RETURN2,
    SDL_SCANCODE_SEPARATOR,
    SDL_SCANCODE_OUT,
    SDL_SCANCODE_OPER,
    SDL_SCANCODE_CLEARAGAIN,
    SDL_SCANCODE_CRSEL,
    SDL_SCANCODE_EXSEL,

    SDL_SCANCODE_KP_00,
    SDL_SCANCODE_KP_000,
    SDL_SCANCODE_THOUSANDSSEPARATOR,
    SDL_SCANCODE_DECIMALSEPARATOR,
    SDL_SCANCODE_CURRENCYUNIT,
    SDL_SCANCODE_CURRENCYSUBUNIT,
    SDL_SCANCODE_KP_LEFTPAREN,
    SDL_SCANCODE_KP_RIGHTPAREN,
    SDL_SCANCODE_KP_LEFTBRACE,
    SDL_SCANCODE_KP_RIGHTBRACE,
    SDL_SCANCODE_KP_TAB,
    SDL_SCANCODE_KP_BACKSPACE,
    SDL_SCANCODE_KP_A,
    SDL_SCANCODE_KP_B,
    SDL_SCANCODE_KP_C,
    SDL_SCANCODE_KP_D,
    SDL_SCANCODE_KP_E,
    SDL_SCANCODE_KP_F,
    SDL_SCANCODE_KP_XOR,
    SDL_SCANCODE_KP_POWER,
    SDL_SCANCODE_KP_PERCENT,
    SDL_SCANCODE_KP_LESS,
    SDL_SCANCODE_KP_GREATER,
    SDL_SCANCODE_KP_AMPERSAND,
    SDL_SCANCODE_KP_DBLAMPERSAND,
    SDL_SCANCODE_KP_VERTICALBAR,
    SDL_SCANCODE_KP_DBLVERTICALBAR,
    SDL_SCANCODE_KP_COLON,
    SDL_SCANCODE_KP_HASH,
    SDL_SCANCODE_KP_SPACE,
    SDL_SCANCODE_KP_AT,
    SDL_SCANCODE_KP_EXCLAM,
    SDL_SCANCODE_KP_MEMSTORE,
    SDL_SCANCODE_KP_MEMRECALL,
    SDL_SCANCODE_KP_MEMCLEAR,
    SDL_SCANCODE_KP_MEMADD,
    SDL_SCANCODE_KP_MEMSUBTRACT,
    SDL_SCANCODE_KP_MEMMULTIPLY,
    SDL_SCANCODE_KP_MEMDIVIDE,
    SDL_SCANCODE_KP_PLUSMINUS,
    SDL_SCANCODE_KP_CLEAR,
    SDL_SCANCODE_KP_CLEARENTRY,
    SDL_SCANCODE_KP_BINARY,
    SDL_SCANCODE_KP_OCTAL,
    SDL_SCANCODE_KP_DECIMAL,
    SDL_SCANCODE_KP_HEXADECIMAL,

    SDL_SCANCODE_LCTRL,
    SDL_SCANCODE_LSHIFT,
    SDL_SCANCODE_LALT, /**< alt, option */
    SDL_SCANCODE_LGUI, /**< windows, command (apple), meta */
    SDL_SCANCODE_RCTRL,
    SDL_SCANCODE_RSHIFT,
    SDL_SCANCODE_RALT, /**< alt gr, option */
    SDL_SCANCODE_RGUI, /**< windows, command (apple), meta */

    SDL_SCANCODE_MODE,    /**< I'm not sure if this is really not covered
                                 *   by any of the above, but since there's a
                                 *   special KMOD_MODE for it I'm adding it here
                                 */

    /*@}*//*Usage page 0x07*/

    /**
     *  \name Usage page 0x0C
     *
     *  These values are mapped from usage page 0x0C (USB consumer page).
     */
    /*@{*/

    SDL_SCANCODE_AUDIONEXT,
    SDL_SCANCODE_AUDIOPREV,
    SDL_SCANCODE_AUDIOSTOP,
    SDL_SCANCODE_AUDIOPLAY,
    SDL_SCANCODE_AUDIOMUTE,
    SDL_SCANCODE_MEDIASELECT,
    SDL_SCANCODE_WWW,
    SDL_SCANCODE_MAIL,
    SDL_SCANCODE_CALCULATOR,
    SDL_SCANCODE_COMPUTER,
    SDL_SCANCODE_AC_SEARCH,
    SDL_SCANCODE_AC_HOME,
    SDL_SCANCODE_AC_BACK,
    SDL_SCANCODE_AC_FORWARD,
    SDL_SCANCODE_AC_STOP,
    SDL_SCANCODE_AC_REFRESH,
    SDL_SCANCODE_AC_BOOKMARKS,

    /*@}*//*Usage page 0x0C*/

    /**
     *  \name Walther keys
     *
     *  These are values that Christian Walther added (for mac keyboard?).
     */
    /*@{*/

    SDL_SCANCODE_BRIGHTNESSDOWN,
    SDL_SCANCODE_BRIGHTNESSUP,
    SDL_SCANCODE_DISPLAYSWITCH, /**< display mirroring/dual display
                                           switch, video mode switch */
    SDL_SCANCODE_KBDILLUMTOGGLE,
    SDL_SCANCODE_KBDILLUMDOWN,
    SDL_SCANCODE_KBDILLUMUP,
    SDL_SCANCODE_EJECT,
    SDL_SCANCODE_SLEEP,

    SDL_SCANCODE_APP1,
    SDL_SCANCODE_APP2,

    /*@}*//*Walther keys*/

    /* Add any other keys here. */

    SDL_NUM_SCANCODES /**< not a key, just marks the number of scancodes
                                 for array bounds */
  ;
}

SDL_sound.flx

//[SDL_sound.flx]


//Module        : SDL_sound_h
//Timestamp     : 2006/1/8 3:36:0 UTC
//Timestamp     : 2006/1/8 14:36:0 (local)
//Raw Header    : /usr/include/SDL/SDL_sound.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SOUND_VERSION(x) \
//#define SOUND_VER_PATCH 1
//#define SOUND_VER_MINOR 0
//#define SOUND_VER_MAJOR 1
//#define SNDDECLSPEC
//#define SNDDECLSPEC __declspec(dllexport)
//#define SDLCALL
//#define _INCLUDE_SDL_SOUND_H_

open module SDL_sound_h
{
  requires package "sdl";
  header '#include "SDL_sound.h"';

  //ABSTRACT TYPES
  type Sound_Sample = 'Sound_Sample';
  type Sound_Version = 'Sound_Version';
  type Sound_AudioInfo = 'Sound_AudioInfo';
  type Sound_SampleFlags = 'Sound_SampleFlags';
  type Sound_DecoderInfo = 'Sound_DecoderInfo';

  //ENUMERATION CONSTANTS
  const SOUND_SAMPLEFLAG_ERROR: int = 'SOUND_SAMPLEFLAG_ERROR';
  const SOUND_SAMPLEFLAG_NONE: int = 'SOUND_SAMPLEFLAG_NONE';
  const SOUND_SAMPLEFLAG_EAGAIN: int = 'SOUND_SAMPLEFLAG_EAGAIN';
  const SOUND_SAMPLEFLAG_EOF: int = 'SOUND_SAMPLEFLAG_EOF';
  const SOUND_SAMPLEFLAG_CANSEEK: int = 'SOUND_SAMPLEFLAG_CANSEEK';

  //PROCEDURES
  proc Sound_ClearError: 1;
  proc Sound_FreeSample: &Sound_Sample;
  proc Sound_GetLinkedVersion: &Sound_Version;

  //FUNCTIONS
  fun Sound_AvailableDecoders: 1 -> &&Sound_DecoderInfo;
  fun Sound_Decode: &Sound_Sample -> uint32;
  fun Sound_DecodeAll: &Sound_Sample -> uint32;
  fun Sound_GetError: 1 -> &char;
  fun Sound_Init: 1 -> int;
  fun Sound_NewSample: &SDL_RWops * &char * &Sound_AudioInfo * uint32 -> &Sound_Sample;
  fun Sound_NewSampleFromFile: &char * &Sound_AudioInfo * uint32 -> &Sound_Sample;
  fun Sound_Quit: 1 -> int;
  fun Sound_Rewind: &Sound_Sample -> int;
  fun Sound_Seek: &Sound_Sample * uint32 -> int;
  fun Sound_SetBufferSize: &Sound_Sample * uint32 -> int;
}

SDL_surface.flx

//[SDL_surface.flx]


open class SDL_surface_h
{
  requires package "sdl2";

  typedef struct SDL_Surface
  {
      uint32 flags;               /**< Read-only */
      &SDL_PixelFormat format;    /**< Read-only */
      int w; int h;                   /**< Read-only */
      int pitch;                  /**< Read-only */
      address pixels;               /**< Read-write */

      /** Application data associated with the surface */
      address userdata;             /**< Read-write */

      /** information needed for surfaces requiring locks */
      int locked;                 /**< Read-only */
      address lock_data;            /**< Read-only */

      /** clipping information */
      SDL_Rect clip_rect;         /**< Read-only */

      /** info for fast blit mapping to other surfaces */
      //struct SDL_BlitMap *map;    /**< Private */

      /** Reference count -- used when freeing surface */
      int refcount;               /**< Read-mostly */
  } SDL_Surface;

  gen SDL_BlitSurface : &SDL_Surface * &SDL_Rect * &SDL_Surface * &SDL_Rect -> int;
  proc SDL_FreeSurface: &SDL_Surface;
  gen SDL_FillRect : &SDL_Surface * &SDL_Rect * uint32 -> int;
  gen SDL_FillSurface : &SDL_Surface * uint32 -> int = "SDL_FillRect ($1, NULL, $2)";
  gen SDL_SetClipRect : &SDL_Surface * &SDL_Rect -> bool;
  proc SDL_ClearClipRect : &SDL_Surface = "SDL_SetClipRect($1,NULL);";
  fun SDL_MUSTLOCK: &SDL_Surface -> bool = "(SDL_MUSTLOCK($1)==SDL_TRUE)";
  proc SDL_LockSurface : &SDL_Surface = "SDL_LockSurface($1);";
  proc SDL_UnlockSurface : &SDL_Surface = "SDL_LockSurface($1);";
}

SDL_timer.flx

//[SDL_timer.flx]


//Module        : SDL_timer_h
//Timestamp     : 2006/1/6 2:5:23 UTC
//Timestamp     : 2006/1/6 13:5:23 (local)
//Raw Header    : SDL_timer.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define TIMER_RESOLUTION      10      /* Experimentally determined */
//#define SDL_TIMESLICE         10
//#define _SDL_timer_h

// DO NOT USE Felix has its own timer
open module SDL_timer_h
{
  requires package "sdl";
  header '#include "SDL_timer.h"';

  //C FUNCTION POINTER TYPES
  header '''typedef Uint32 (*SDL_timer_h_cft_2)(Uint32,  void *);''';
  type SDL_timer_h_cft_2 = 'SDL_timer_h_cft_2';
  header '''typedef Uint32 (*SDL_timer_h_cft_1)(Uint32);''';
  type SDL_timer_h_cft_1 = 'SDL_timer_h_cft_1';

  //PURE INCOMPLETE TYPES
  type _struct__SDL_TimerID = 'struct _SDL_TimerID'; //local

  //TYPE ALIASES
  typedef SDL_NewTimerCallback = SDL_timer_h_cft_2;
  typedef SDL_TimerID = &_struct__SDL_TimerID;
  typedef SDL_TimerCallback = SDL_timer_h_cft_1;

  //PROCEDURES
  proc SDL_Delay: uint32;

  //FUNCTIONS
  fun SDL_AddTimer: uint32 * SDL_timer_h_cft_2 * address -> SDL_TimerID;
  fun SDL_GetTicks: 1 -> uint32;
  fun SDL_RemoveTimer: SDL_TimerID -> SDL_bool;
  fun SDL_SetTimer: uint32 * SDL_timer_h_cft_1 -> int;

  //CALLBACK TYPE WRAPPERS
  //callback type SDL_timer_h_cft_2, client data at 1
  typedef _fcbat_SDL_timer_h_cft_2 = uint32;
  export type (_fcbat_SDL_timer_h_cft_2) as "_fcbat_SDL_timer_h_cft_2";
  typedef _fcbt_SDL_timer_h_cft_2 = uint32 -> uint32;
  export type (_fcbt_SDL_timer_h_cft_2) as "_fcbt_SDL_timer_h_cft_2";
  header '''Uint32 _fcbw_SDL_timer_h_cft_2(Uint32 a1,  void *a2);''';

  const _fcbw_SDL_timer_h_cft_2: SDL_timer_h_cft_2 = "_fcbw_SDL_timer_h_cft_2";
  body '''
  Uint32 _fcbw_SDL_timer_h_cft_2(Uint32 a1,  void *a2){
    return ((_fcbt_SDL_timer_h_cft_2)a2)->apply(a1);
  }''';


  //CALLBACK CLIENT WRAPPERS
  //callback client SDL_AddTimer, client data at 1, callback at 2
  fun wrapper_SDL_AddTimer(a1: uint32, a2: _fcbt_SDL_timer_h_cft_2): SDL_TimerID= {
    return SDL_AddTimer(a1, _fcbw_SDL_timer_h_cft_2, C_hack::cast[address]a2);
  }
}

SDL_ttf.flx

//[SDL_ttf.flx]

//#define TTF_SetError  SDL_SetError
//#define TTF_RenderUNICODE(font, text, fg, bg) \
//#define TTF_RenderUTF8(font, text, fg, bg)    \
//#define TTF_RenderText(font, text, fg, bg)    \
//#define UNICODE_BOM_SWAPPED   0xFFFE
//#define UNICODE_BOM_NATIVE    0xFEFF
//#define TTF_VERSION(X)                                                        \
//#define TTF_PATCHLEVEL                6
//#define TTF_MINOR_VERSION     0
//#define TTF_MAJOR_VERSION     2
//#define _SDLttf_h

open class SDL_ttf_h
{
  requires package "sdl2", package "sdl2_ttf";

  proc TTF_Compiled_Version: &SDL_version = "SDL_TTF_VERSION($1);"; // macro
  fun TTF_Linked_Version: 1 -> SDL_version = "*(TTF_Linked_Version())";

  fun TTF_Compiled_Version () : SDL_version = {
    var v: SDL_version;
    TTF_Compiled_Version$ &v;
    return v;
  }

  gen TTF_Init : 1 -> int;
  gen TTF_GetError: 1 -> string = "::std::string(TTF_GetError())";
  proc TTF_Quit: 1;
  fun TTF_WasInit: 1 -> int;
  proc TTF_ByteSwappedUNICODE: int;


  type TTF_Font = 'TTF_Font*';

  gen TTF_OpenFontIndexRW: SDL_RWops * int * int * long -> TTF_Font;
  gen TTF_OpenFontIndex: string * int * long -> TTF_Font = "TTF_OpenFont($1.c_str(),$2, $3)";
  fun TTF_OpenFontRW: SDL_RWops * int * int -> TTF_Font;
  gen TTF_OpenFont: string * int -> TTF_Font = "TTF_OpenFont($1.c_str(),$2)";
  proc TTF_CloseFont: TTF_Font;
  fun TTF_ValidFont : TTF_Font -> bool = "($1!=NULL)";

  // Metrics
  fun TTF_GetFontStyle: TTF_Font -> int;
  proc TTF_SetFontStyle: TTF_Font * int;

    const TTF_STYLE_UNDERLINE : int; // 0x4
    const TTF_STYLE_ITALIC : int; // 0x2
    const TTF_STYLE_BOLD : int; // 0x01
    const TTF_STYLE_NORMAL : int; // 0x00

  fun TTF_GetFontOutline: TTF_Font -> int;
  proc TTF_SetFontOutline: TTF_Font * int;

  fun TTF_GetFontHeight: TTF_Font -> int;

  fun TTF_GetFontHinting: TTF_Font -> int;
  proc TTF_SetFontHinting: TTF_Font * int;

    const TTF_HINTING_NORMAL :int; //    0
    const TTF_HINTING_LIGHT  :int; //    1
    const TTF_HINTING_MONO  :int; //     2
    const TTF_HINTING_NONE  :int; //     3

  fun TTF_GetFontKerning: TTF_Font -> int;
  proc TTF_SetFontKerning: TTF_Font * int;


  fun TTF_FontHeight: TTF_Font -> int;
  fun TTF_FontAscent: TTF_Font -> int;
  fun TTF_FontDescent: TTF_Font -> int;
  fun TTF_FontLineSkip: TTF_Font -> int;
  fun TTF_FontFaces: TTF_Font -> long;
  fun TTF_FontFaceIsFixedWidth: TTF_Font -> int;
  fun TTF_FontFaceFamilyName: TTF_Font -> string = "::std::string(TTF_FontFaceFamilyName($1))";
  fun TTF_FontFaceStyleName: TTF_Font -> string = "::std::string(TTF_FontFaceStyleName($1))";

  fun TTF_GlyphIsProvided: TTF_Font * uint16 -> int;

  fun TTF_GlyphMetrics: TTF_Font * uint16 * &int * &int * &int * &int * &int -> int;

  gen TTF_SizeText: TTF_Font * string * &int * &int -> int =
    "TTF_SizeText($1,$2.c_str(),$3,$4)"
  ;
  gen TTF_SizeUNICODE: TTF_Font * +uint16 * &int * &int -> int;
  gen TTF_SizeUTF8: TTF_Font * string * &int * &int -> int =
    "TTF_SizeUTF8($1,$2.c_str(),$3,$4)"
  ;

  // Render Solid
  fun TTF_RenderGlyph_Solid: TTF_Font * uint16 * SDL_Color -> &SDL_Surface;
  fun TTF_RenderText_Solid: TTF_Font * string * SDL_Color -> &SDL_Surface =
     "TTF_RenderText_Solid($1,$2.c_str(),$3)"
  ;
  fun TTF_RenderUNICODE_Solid: TTF_Font * +uint16 * SDL_Color -> &SDL_Surface;
  fun TTF_RenderUTF8_Solid: TTF_Font * string * SDL_Color -> &SDL_Surface =
     "TTF_RenderUTF8_Solid($1,$2.c_str(),$3)"
  ;

  // Render Shaded
  fun TTF_RenderGlyph_Shaded: TTF_Font * uint16 * SDL_Color * SDL_Color -> &SDL_Surface;
  fun TTF_RenderText_Shaded: TTF_Font * string * SDL_Color * SDL_Color -> &SDL_Surface =
    "TTF_RenderText_Shaded($1,$2.c_str(),$3,$4)"
  ;
  fun TTF_RenderUNICODE_Shaded: TTF_Font * +uint16 * SDL_Color * SDL_Color -> &SDL_Surface;
  fun TTF_RenderUTF8_Shaded: TTF_Font * string * SDL_Color * SDL_Color -> &SDL_Surface =
    "TTF_RenderUTF8_Shaded($1,$2.c_str(),$3,$4)"
  ;

  // Render Blended
  fun TTF_RenderGlyph_Blended: TTF_Font * uint16 * SDL_Color -> &SDL_Surface;
  fun TTF_RenderText_Blended: TTF_Font * string * SDL_Color -> &SDL_Surface =
    "TTF_RenderText_Blended($1,$2.c_str(),$3)"
  ;
  fun TTF_RenderUNICODE_Blended: TTF_Font * +uint16 * SDL_Color -> &SDL_Surface;
  fun TTF_RenderUTF8_Blended: TTF_Font * string * SDL_Color -> &SDL_Surface =
    "TTF_RenderUTF8_Blended($1,$2.c_str(),$3)"
  ;

  // Render Blended Wrapped
  fun TTF_RenderGlyph_Blended_Wrapped: TTF_Font * uint16 * SDL_Color * uint32 -> &SDL_Surface;
  fun TTF_RenderText_Blended_Wrapped: TTF_Font * string * SDL_Color * uint32  -> &SDL_Surface=
    "TTF_RenderText_Blended_Wrapped($1,$2.c_str(),$3,$4)"
  ;
  fun TTF_RenderUNICODE_Blended_Wrapped: TTF_Font * +uint16 * SDL_Color * uint32 -> &SDL_Surface;
  fun TTF_RenderUTF8_Blended_Wrapped: TTF_Font * string * SDL_Color * uint32 -> &SDL_Surface=
    "TTF_RenderUTF8_Blended_Wrapped($1,$2.c_str(),$3,$4)"
  ;

  fun TTF_GetFontKerningSize: TTF_Font * int * int -> int;

}

SDL_types.flx

//[SDL_types.flx]

//Module        : SDL_types_h
//Timestamp     : 2006/1/6 2:18:42 UTC
//Timestamp     : 2006/1/6 13:18:42 (local)
//Raw Header    : SDL_types.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SDL_COMPILE_TIME_ASSERT(name, x)               \
//#define SDL_HAS_64BIT_TYPE    __int64
//#define SDL_HAS_64BIT_TYPE    long long
//#define SDL_HAS_64BIT_TYPE    long
//#define SDL_TABLESIZE(table)  (sizeof(table)/sizeof(table[0]))
//#define _SDL_types_h

open module SDL_types_h
{
  requires package "sdl";
  header '#include "SDL_types.h"';

  //ABSTRACT TYPES
  type SDL_bool = 'SDL_bool';
  type SDL_DUMMY_ENUM = 'SDL_DUMMY_ENUM';

  //TYPE ALIASES
  typedef SDL_dummy_uint32 = &int;
  typedef SDL_dummy_sint64 = &int;
  typedef SDL_dummy_sint16 = &int;
  typedef SDL_dummy_sint8 = &int;
  typedef SDL_dummy_sint32 = &int;
  typedef SDL_dummy_uint8 = &int;
  typedef SDL_dummy_uint64 = &int;
  typedef SDL_dummy_uint16 = &int;
  typedef SDL_dummy_enum = &int;

  //ENUMERATION CONSTANTS
  const SDL_PRESSED: int = 'SDL_PRESSED';
  const DUMMY_ENUM_VALUE: int = 'DUMMY_ENUM_VALUE';
  const SDL_RELEASED: int = 'SDL_RELEASED';
  const SDL_TRUE: int = 'SDL_TRUE';
  const SDL_FALSE: int = 'SDL_FALSE';
}

SDL_version.flx

//[SDL_version.flx]


//#define SDL_VERSION_ATLEAST(X, Y, Z) \
//#define SDL_COMPILEDVERSION \
//#define SDL_VERSIONNUM(X, Y, Z)                                               \
//#define SDL_VERSION(X)                                                        \
//#define SDL_PATCHLEVEL                8
//#define SDL_MINOR_VERSION     2
//#define SDL_MAJOR_VERSION     1
//#define _SDL_version_h

open class SDL_version_h
{
  requires package "sdl2";

  cstruct SDL_version {
    major: uint8;
    minor: uint8;
    patch: uint8;
  };

  proc SDL_Linked_Version: &SDL_version = "SDL_GetVersion ($1);"; // function
  proc SDL_Compiled_Version: &SDL_version = "SDL_VERSION($1);"; // macro

  fun SDL_Linked_Version () : SDL_version = {
    var v: SDL_version;
    SDL_Linked_Version$ &v;
    return v;
  }

  fun SDL_Compiled_Version () : SDL_version = {
    var v: SDL_version;
    SDL_Compiled_Version$ &v;
    return v;
  }
}

SDL_video.flx

//[SDL_video.flx]

//Module        : SDL_video_h
//Timestamp     : 2006/1/6 2:18:42 UTC
//Timestamp     : 2006/1/6 13:18:42 (local)
//Raw Header    : SDL_video.h
//Preprocessor  : gcc -E
//Input file: sdl.flxcc.i
//Flxcc Control : sdl.flxcc
//Felix Version : 1.1.2_rc1

//#define SDL_BlitSurface SDL_UpperBlit
//#define SDL_SaveBMP(surface, file) \
//#define SDL_AllocSurface    SDL_CreateRGBSurface
//#define SDL_PHYSPAL 0x02
//#define SDL_LOGPAL 0x01
//#define SDL_YVYU_OVERLAY  0x55595659  /* Packed mode: Y0+V0+Y1+U0 (1 plane) */
//#define SDL_UYVY_OVERLAY  0x59565955  /* Packed mode: U0+Y0+V0+Y1 (1 plane) */
//#define SDL_YUY2_OVERLAY  0x32595559  /* Packed mode: Y0+U0+Y1+V0 (1 plane) */
//#define SDL_IYUV_OVERLAY  0x56555949  /* Planar mode: Y + U + V  (3 planes) */
//#define SDL_YV12_OVERLAY  0x32315659  /* Planar mode: Y + V + U  (3 planes) */
//#define SDL_PREALLOC  0x01000000      /* Surface uses preallocated memory */
//#define SDL_SRCALPHA  0x00010000      /* Blit uses source alpha blending */
//#define SDL_RLEACCEL  0x00004000      /* Surface is RLE encoded */
//#define SDL_RLEACCELOK        0x00002000      /* Private flag */
//#define SDL_SRCCOLORKEY       0x00001000      /* Blit uses a source color key */
//#define SDL_HWACCEL   0x00000100      /* Blit uses hardware acceleration */
//#define SDL_NOFRAME   0x00000020      /* No window caption or edge frame */
//#define SDL_RESIZABLE 0x00000010      /* This video mode may be resized */
//#define SDL_OPENGLBLIT        0x0000000A      /* Create an OpenGL rendering context and use it for blitting */
//#define SDL_OPENGL      0x00000002      /* Create an OpenGL rendering context */
//#define SDL_FULLSCREEN        0x80000000      /* Surface is a full screen display */
//#define SDL_DOUBLEBUF 0x40000000      /* Set up double-buffered video mode */
//#define SDL_HWPALETTE 0x20000000      /* Surface has exclusive palette */
//#define SDL_ANYFORMAT 0x10000000      /* Allow any video depth/pixel-format */
//#define SDL_ASYNCBLIT 0x00000004      /* Use asynchronous blits if possible */
//#define SDL_HWSURFACE 0x00000001      /* Surface is in video memory */
//#define SDL_SWSURFACE 0x00000000      /* Surface is in system memory */
//#define SDL_Colour SDL_Color
//#define SDL_ALPHA_TRANSPARENT 0
//#define SDL_ALPHA_OPAQUE 255
//#define _SDL_video_h

open class SDL_video_h
{
  requires package "sdl2";

  // Window position special values
  const SDL_WINDOWPOS_CENTERED : int;
  const SDL_WINDOWPOS_UNDEFINED : int;

  // Window flags
  const SDL_WINDOW_FULLSCREEN : uint32;
  const SDL_WINDOW_FULLSCREEN_DESKTOP : uint32;
  const SDL_WINDOW_OPENGL : uint32;
  const SDL_WINDOW_SHOWN : uint32;
  const SDL_WINDOW_HIDDEN : uint32;
  const SDL_WINDOW_BORDERLESS : uint32;
  const SDL_WINDOW_RESIZABLE : uint32;
  const SDL_WINDOW_MINIMIZED : uint32;
  const SDL_WINDOW_MAXIMIZED : uint32;
  const SDL_WINDOW_INPUT_GRABBED : uint32;
  const SDL_WINDOW_INPUT_FOCUS : uint32;
  const SDL_WINDOW_MOUSE_FOCUS : uint32;
  const SDL_WINDOW_FOREIGN: uint32;
  const SDL_WINDOW_ALLOW_HIGHDPI: uint32;

  type SDL_Window = "SDL_Window*";
  gen SDL_CreateWindow: string * int * int * int * int * uint32 -> SDL_Window =
     "SDL_CreateWindow ($1.c_str(), $2, $3, $4, $5, $6)"
  ;
  proc SDL_DestroyWindow : SDL_Window;

  fun SDL_GetWindowSurface : SDL_Window -> &SDL_Surface;
  gen SDL_UpdateWindowSurface: SDL_Window -> int;
  fun SDL_GetWindowID: SDL_Window -> uint32;
  proc SDL_GetWindowPosition : SDL_Window * &int * &int;
  proc SDL_GetWindowSize: SDL_Window * &int * &int;
  proc SDL_SetWindowGrab: SDL_Window * bool = "SDL_SetWindowGrab($1,SDL_bool($2));";
  fun SDL_GetWindowGrab: SDL_Window -> bool;

  proc SDL_SetWindowMinumumSize: SDL_Window * int * int;
  proc SDL_GetWindowMinumumSize: SDL_Window * &int * &int;
  proc SDL_SetWindowMaximumSize: SDL_Window * int * int;
  proc SDL_GetWindowMaximumSize: SDL_Window * &int * &int;

  proc SDL_ShowWindow: SDL_Window;
  proc SDL_HideWindow: SDL_Window;
  proc SDL_RaiseWindow: SDL_Window;
  proc SDL_MaximizeWindow: SDL_Window;
  proc SDL_MinimizeWindow: SDL_Window;
  proc SDL_RestoreWindow: SDL_Window;
  proc SDL_SetWindowFullScreen: SDL_Window;
  proc SDL_SetWindowBrightness: SDL_Window * float;
  fun SDL_SetWindowBrightness: SDL_Window -> float;
  fun SDL_GetWindowBordered: SDL_Window -> bool;
  proc SDL_SetWindowBordered: SDL_Window * bool = "SDL_SetWindowBordered($1,SDL_bool($2));";


}

flx_faio_sdl.flx

//[flx_faio_sdl.flx]




open module SDL_events
{
  requires package "sdl";
  open C_hack;

  fun event_type: SDL_Event -> uint8 = "$1.type";

  proc block_sdl_events(m:&SDL_mutex)
  {
    var dummy = SDL_UserEvent(cast[uint32] SDL_USEREVENT,0,NULL,NULL);
    ignore(SDL_PushEvent(cast [&SDL_Event] (&dummy)));
    ignore(SDL_LockMutex(m));
  }

  proc unblock_sdl_events(m:&SDL_mutex)
  {
    ignore(SDL_UnlockMutex(m));
  }
}

Package Configuration

//[linux_sdl2.fpc]
Name: SDL2
Description: Simple Direct Media Layer 2.0
cflags: -I/usr/local/include/SDL2
includes: '"SDL.h"'
provides_dlib: -L/usr/local/lib -lSDL2
provides_slib: -L/usr/local/lib -lSDL2

//[linux_sdl2_image.fpc]
Name: SDL2_image
Description: Simple Direct Media Layer 2.0: image loader
cflags: -I/usr/local/include/SDL2
includes: '"SDL_image.h"'
provides_dlib: -L/usr/local/lib -lSDL2_image
provides_slib: -L/usr/local/lib -lSDL2_image
requires_dlibs: -ljpeg -ltiff -lpng
requires_slibs: -ljpeg -ltiff -lpng

//[linux_sdl2_ttf.fpc]
Name: SDL2_ttf
Description: Simple Direct Media Layer 2.0: free type interface
cflags: -I/usr/local/include/SDL2
includes: '"SDL_ttf.h"'
provides_dlib: -L/usr/local/lib -lSDL2_ttf
provides_slib: -L/usr/local/lib -lSDL2_ttf
requires_dlibs: -lfreetype
requires_slibs: -lfreetype

//[macosx_sdl2.fpc]
Name: SDL2
Description: Simple Direct Media Layer 2.0
cflags: -I/usr/local/include/SDL2
includes: '"SDL.h"'
provides_dlib: -L/usr/local/lib -lSDL2
provides_slib: -L/usr/local/lib -lSDL2
requires_dlibs: ---framework=OpenGL
requires_slibs: ---framework=OpenGL

//[macosx_sdl2_image.fpc]
Name: SDL2_image
Description: Simple Direct Media Layer 2.0: image loader
cflags: -I/usr/local/include/SDL2
includes: '"SDL_image.h"'
provides_dlib: -L/usr/local/lib -lSDL2_image
provides_slib: -L/usr/local/lib -lSDL2_image

//[macosx_sdl2_ttf.fpc]
Name: SDL2_ttf
Description: Simple Direct Media Layer 2.0: free type interface
cflags: -I/usr/local/include/SDL2
includes: '"SDL_ttf.h"'
provides_dlib: -L/usr/local/lib -lSDL2_ttf
provides_slib: -L/usr/local/lib -lSDL2_ttf
requires_dlibs: -lfreetype
requires_slibs: -lfreetype

//[macosx_SDL2_gfx.fpc]
Name: SDL2_gfx
Description: Simple Direct Media Layer 2.0: SDL2_gfx
cflags: -I/usr/local/include/SDL2
includes: '"SDL2_gfxPrimitives.h"'
provides_dlib: -L/usr/local/lib -lSDL2_gfx
provides_slib: -L/usr/local/lib -lSDL2_gfx

//[win_sdl2.fpc]
Name: SDL2
Description: Simple Direct Media Layer 2.0
cflags: /I\Users\skaller\Desktop\SDL2-2.0.3\include
includes: '"SDL.h"'
provides_dlib: /DEFAULTLIB:\Users\skaller\Desktop\SDL2-2.0.3\lib\x64\SDL2

//[win_sdl2_image.fpc]
Name: SDL2_image
Description: Simple Direct Media Layer 2.0: image loader
cflags: /I\Users\skaller\Desktop\SDL2_image-2.0.0\include
includes: '"SDL_image.h"'
provides_dlib: /DEFAULTLIB:\Users\skaller\Desktop\SDL2_image-2.0.0\lib\x64\SDL2_image

//[win_sdl2_ttf.fpc]
Name: SDL2_ttf
Description: Simple Direct Media Layer 2.0: free type interface
cflags: /I\Users\skaller\Desktop\SDL2_ttf-2.0.12\include
includes: '"SDL_ttf.h"'
provides_dlib: /DEFAULTLIB:\Users\skaller\Desktop\SDL2_ttf-2.0.12\lib\x64\SDL2_ttf

Package: src/packages/stl.fdoc

C++ Standard Template Library bindings.

key file
stl.flx share/lib/stl/stl.flx
stl_vector.flx share/lib/stl/stl_vector.flx
stl_set.flx share/lib/stl/stl_set.flx
stl_multiset.flx share/lib/stl/stl_multiset.flx
stl_map.flx share/lib/stl/stl_map.flx
stl_multimap.flx share/lib/stl/stl_multimap.flx
stl_list.flx share/lib/stl/stl_list.flx
stl_deque.flx share/lib/stl/stl_deque.flx

Stl Iterators

//[stl.flx]

class Iterator[it,t] {
  virtual fun deref: it -> t;
}

class Forward_iterator[it,t] {
  inherit ForwardSequence[it];
  inherit Iterator[it,t];
}

class Bidirectional_iterator[it,t] {
  inherit Forward_iterator[it,t];
  inherit BidirectionalSequence[it];
}

class Sequence[c,it,v] {
  inherit Eq[c];
  inherit Forward_iterator[it,v];
  inherit Container[c,v];
  virtual gen begin: c -> it;
  virtual gen end: c -> it;
  virtual proc erase: c * it;
  virtual proc erase_between: c * it * it;
  virtual proc clear: c;
  virtual fun fold[i] (f:i->v->i) (var acc:i) (x:c): i = {
    var s = begin x; var e = end x;
    while s != e do acc = f acc (*s); ++s; done;
    return acc;
  }
}

class Reversible_Sequence[c,it,rit,v] {
  inherit Sequence[c,it,v];
  inherit Bidirectional_iterator[it,v];
  inherit Bidirectional_iterator[rit,v];
  virtual gen rbegin: c -> rit;
  virtual gen rend: c -> rit;
  virtual fun rfold[i] (f:i->v->i) (var acc:i) (x:c): i = {
    var s = rbegin x; var e = rend x;
    while s != e do acc = f acc (*s); ++s; done;
    return acc;
  }
}


class Stl
{
  type pair[k,v] = "::std::pair<?1 const,?2>";
  fun make_pair[k,v]: k * v ->pair[k,v] = "::std::make_pair($1,$2)";
}

Stl Vector

//[stl_vector.flx]

include "stl/stl";

class Stl_Vector[t]
{
    requires Cxx_headers::vector;
    type stl_vector = "::std::vector<?1>";
    fun create : unit -> stl_vector = "(FLX_GXX_PARSER_HACK std::vector<?1>())";
    fun create : int * t -> stl_vector= "(FLX_GXX_PARSER_HACK std::vector<?1>($1,$2))";
    fun create[i] : i * i -> stl_vector = "(FLX_GXX_PARSER_HACK std::vector<?1>($1,$2))";
    type stl_vector_iterator = "::std::vector<?1>::iterator";
    type stl_vector_reverse_iterator = "::std::vector<?1>::reverse_iterator";
    proc insert: stl_vector * stl_vector_iterator *  t  = "$1.insert($2,$3);";
    proc push_back : stl_vector *  t  = "$1.push_back($2);";
    fun front : stl_vector -> t = "$1.front()";
    fun front : stl_vector -> t = "$1.front()";
    //lvalue fun subscript : stl_vector * size -> t = "$1.at($2)";
    fun subscript : stl_vector * size -> t = "$1.at($2)";
    proc reserve: stl_vector * size -> t = "$1.reserve($2);";
    fun add: stl_vector_iterator * int -> stl_vector_iterator = "$1+$2";
    fun sub: stl_vector_iterator * int -> stl_vector_iterator = "$1-$2";
    proc pluseq: &stl_vector_iterator * int = "*$1+=$2;";
    proc minuseq: &stl_vector_iterator * int = "*$1-=$2;";
    //lvalue fun subscript: stl_vector_iterator * size -> t = "$1[$2]";
    fun subscript: stl_vector_iterator * size -> t = "$1[$2]";
// Stl_Vector
  instance Eq[stl_vector] {
    fun == : stl_vector * stl_vector -> bool = "$1==$2";
  }
  instance Container[stl_vector,t] {
    fun len: stl_vector -> size = "$1.size()";
    fun empty: stl_vector -> bool = "$1.empty()";
  }
  instance Sequence[stl_vector,stl_vector_iterator,t] {
    fun begin : stl_vector-> stl_vector_iterator= "$1.begin()";
    fun end : stl_vector-> stl_vector_iterator= "$1.end()";
    proc erase : stl_vector * stl_vector_iterator = "$1.erase($1);";
    proc erase_between : stl_vector * stl_vector_iterator * stl_vector_iterator = "$1.erase($1,$2);";
    proc clear : stl_vector = "$1.clear();";
  }
  instance Reversible_Sequence[stl_vector,stl_vector_iterator,stl_vector_reverse_iterator,t] {
    fun rbegin : stl_vector-> stl_vector_reverse_iterator= "$1.rbegin()";
    fun rend : stl_vector-> stl_vector_reverse_iterator= "$1.rend()";
  }

// Stl_Vector iterator
  instance Eq[stl_vector_iterator] {
    fun == : stl_vector_iterator * stl_vector_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_vector_iterator] {
    fun < : stl_vector_iterator * stl_vector_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_vector_iterator,t] {
    fun deref : stl_vector_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_vector_iterator] {
    fun succ: stl_vector_iterator -> stl_vector_iterator = "$1+1";
    proc pre_incr : &stl_vector_iterator = "++*$1;";
    proc post_incr : &stl_vector_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_vector_iterator,t] {}
  instance BidirectionalSequence[stl_vector_iterator] {
    fun pred: stl_vector_iterator -> stl_vector_iterator = "$1-1;";
    proc pre_decr : &stl_vector_iterator = "--*$1;";
    proc post_decr : &stl_vector_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_vector_iterator,t] {}

// Stl_Vector reverse iterator
  instance Eq[stl_vector_reverse_iterator] {
    fun == : stl_vector_reverse_iterator * stl_vector_reverse_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_vector_reverse_iterator] {
    fun < : stl_vector_reverse_iterator * stl_vector_reverse_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_vector_reverse_iterator,t] {
    fun deref : stl_vector_reverse_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_vector_reverse_iterator] {
    fun succ: stl_vector_reverse_iterator -> stl_vector_reverse_iterator = "$1+1";
    proc pre_incr : &stl_vector_reverse_iterator = "++*$1;";
    proc post_incr : &stl_vector_reverse_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_vector_reverse_iterator,t] {}
  instance BidirectionalSequence[stl_vector_reverse_iterator] {
    fun pred: stl_vector_reverse_iterator -> stl_vector_reverse_iterator = "$1-1;";
    proc pre_decr : &stl_vector_reverse_iterator = "--*$1;";
    proc post_decr : &stl_vector_reverse_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_vector_reverse_iterator,t] {}
}

open[t] Stl_Vector[t];
open[t] Reversible_Sequence[
  Stl_Vector::stl_vector[t],
  Stl_Vector::stl_vector_iterator[t],
  Stl_Vector::stl_vector_reverse_iterator[t],t];
open[t] Bidirectional_iterator[Stl_Vector::stl_vector_iterator[t],t];
open[t] Bidirectional_iterator[Stl_Vector::stl_vector_reverse_iterator[t],t];

Stl Set

//[stl_set.flx]

include "stl/stl";
  class Stl_Set[t]
  {
    requires Cxx_headers::set;
    type stl_set = "::std::set<?1>";
    type stl_set_iterator = "::std::set<?1>::iterator";
    type stl_set_reverse_iterator = "::std::set<?1>::reverse_iterator";
    fun create : unit -> stl_set = "(FLX_GXX_PARSER_HACK std::set<?1>())";
    proc insert : stl_set * t = "$1.insert($2);";
    fun find : stl_set * t ->  stl_set_iterator = "$1.find($2)";
    fun mem : stl_set * t -> bool = "$1.find($2) != $1.end()";
// Stl_Set
  instance Eq[Stl_Set::stl_set] {
    fun == : Stl_Set::stl_set * Stl_Set::stl_set -> bool = "$1==$2";
  }
  instance Container[Stl_Set::stl_set,t] {
    fun len: Stl_Set::stl_set -> size = "$1.size()";
    fun empty: Stl_Set::stl_set -> bool = "$1.empty()";
  }
  instance Sequence[Stl_Set::stl_set,Stl_Set::stl_set_iterator,t] {
    fun begin : Stl_Set::stl_set-> Stl_Set::stl_set_iterator= "$1.begin()";
    fun end : Stl_Set::stl_set-> Stl_Set::stl_set_iterator= "$1.end()";
    proc erase : Stl_Set::stl_set * Stl_Set::stl_set_iterator = "$1.erase($1);";
    proc erase_between : Stl_Set::stl_set * Stl_Set::stl_set_iterator * Stl_Set::stl_set_iterator = "$1.erase($1,$2);";
    proc clear : Stl_Set::stl_set = "$1.clear();";
  }
  instance Reversible_Sequence[Stl_Set::stl_set,Stl_Set::stl_set_iterator,Stl_Set::stl_set_reverse_iterator,t] {
    fun rbegin : Stl_Set::stl_set-> Stl_Set::stl_set_reverse_iterator= "$1.rbegin()";
    fun rend : Stl_Set::stl_set-> Stl_Set::stl_set_reverse_iterator= "$1.rend()";
  }

// Stl_Set iterator
  instance Eq[stl_set_iterator] {
    fun == : stl_set_iterator * stl_set_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_set_iterator] {
    fun < : stl_set_iterator * stl_set_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_set_iterator,t] {
    fun deref : stl_set_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_set_iterator] {
    fun succ: stl_set_iterator -> stl_set_iterator = "$1+1";
    proc pre_incr : &stl_set_iterator = "++*$1;";
    proc post_incr : &stl_set_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_set_iterator,t] {}
  instance BidirectionalSequence[stl_set_iterator] {
    fun pred: stl_set_iterator -> stl_set_iterator = "$1-1;";
    proc pre_decr : &stl_set_iterator = "--*$1;";
    proc post_decr : &stl_set_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_set_iterator,t] {}

// Stl_Set reverse iterator
  instance Eq[stl_set_reverse_iterator] {
    fun == : stl_set_reverse_iterator * stl_set_reverse_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_set_reverse_iterator] {
    fun < : stl_set_reverse_iterator * stl_set_reverse_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_set_reverse_iterator,t] {
    fun deref : stl_set_reverse_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_set_reverse_iterator] {
    fun succ: stl_set_reverse_iterator -> stl_set_reverse_iterator = "$1+1";
    proc pre_incr : &stl_set_reverse_iterator = "++*$1;";
    proc post_incr : &stl_set_reverse_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_set_reverse_iterator,t] {}
  instance BidirectionalSequence[stl_set_reverse_iterator] {
    fun pred: stl_set_reverse_iterator -> stl_set_reverse_iterator = "$1-1;";
    proc pre_decr : &stl_set_reverse_iterator = "--*$1;";
    proc post_decr : &stl_set_reverse_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_set_reverse_iterator,t] {}

}

open Stl_Set;
open[t] Reversible_Sequence[
  Stl_Set::stl_set[t],
  Stl_Set::stl_set_iterator[t],
  Stl_Set::stl_set_reverse_iterator[t],t];
open[t] Bidirectional_iterator[Stl_Set::stl_set_iterator[t],t];
open[t] Bidirectional_iterator[Stl_Set::stl_set_reverse_iterator[t],t];

Stl Multiset

//[stl_multiset.flx]

include "stl/stl";
class Stl_MultiSet[t]
  {
    requires Cxx_headers::set;
    type stl_multiset = "::std::multiset<?1>";
    type stl_multiset_iterator = "::std::multiset<?1>::iterator";
    type stl_multiset_reverse_iterator = "::std::multiset<?1>::reverse_iterator";
    fun create : unit -> stl_multiset = "(FLX_GXX_PARSER_HACK std::multiset<?1>())";
    proc insert : stl_multiset * t = "$1.insert($2);";
    fun find : stl_multiset * t ->  stl_multiset_iterator = "$1.find($2)";
    fun mem : stl_multiset * t -> bool = "$1.find($2) != $1.end()";
// Stl_MultiSet
  instance Eq[stl_multiset] {
    fun == : stl_multiset * stl_multiset -> bool = "$1==$2";
  }
  instance Container[stl_multiset,t] {
    fun len: stl_multiset -> size = "$1.size()";
    fun empty: stl_multiset -> bool = "$1.empty()";
  }
  instance Sequence[stl_multiset,stl_multiset_iterator,t] {
    fun begin : stl_multiset-> stl_multiset_iterator= "$1.begin()";
    fun end : stl_multiset-> stl_multiset_iterator= "$1.end()";
    proc erase : stl_multiset * stl_multiset_iterator = "$1.erase($1);";
    proc erase_between : stl_multiset * stl_multiset_iterator * stl_multiset_iterator = "$1.erase($1,$2);";
    proc clear : stl_multiset = "$1.clear();";
  }
  instance Reversible_Sequence[stl_multiset,stl_multiset_iterator,stl_multiset_reverse_iterator,t] {
    fun rbegin : stl_multiset-> stl_multiset_reverse_iterator= "$1.rbegin()";
    fun rend : stl_multiset-> stl_multiset_reverse_iterator= "$1.rend()";
  }

// Stl_MultiSet iterator
  instance Eq[stl_multiset_iterator] {
    fun == : stl_multiset_iterator * stl_multiset_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_multiset_iterator] {
    fun < : stl_multiset_iterator * stl_multiset_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_multiset_iterator,t] {
    fun deref : stl_multiset_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_multiset_iterator] {
    fun succ: stl_multiset_iterator -> stl_multiset_iterator = "$1+1";
    proc pre_incr : &stl_multiset_iterator = "++*$1;";
    proc post_incr : &stl_multiset_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_multiset_iterator,t] {}
  instance BidirectionalSequence[stl_multiset_iterator] {
    fun pred: stl_multiset_iterator -> stl_multiset_iterator = "$1-1;";
    proc pre_decr : &stl_multiset_iterator = "--*$1;";
    proc post_decr : &stl_multiset_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_multiset_iterator,t] {}

// Stl_MultiSet reverse iterator
  instance Eq[stl_multiset_reverse_iterator] {
    fun == : stl_multiset_reverse_iterator * stl_multiset_reverse_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_multiset_reverse_iterator] {
    fun < : stl_multiset_reverse_iterator * stl_multiset_reverse_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_multiset_reverse_iterator,t] {
    fun deref : stl_multiset_reverse_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_multiset_reverse_iterator] {
    fun succ: stl_multiset_reverse_iterator -> stl_multiset_reverse_iterator = "$1+1";
    proc pre_incr : &stl_multiset_reverse_iterator = "++*$1;";
    proc post_incr : &stl_multiset_reverse_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_multiset_reverse_iterator,t] {}
  instance BidirectionalSequence[stl_multiset_reverse_iterator] {
    fun pred: stl_multiset_reverse_iterator -> stl_multiset_reverse_iterator = "$1-1;";
    proc pre_decr : &stl_multiset_reverse_iterator = "--*$1;";
    proc post_decr : &stl_multiset_reverse_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_multiset_reverse_iterator,t] {}

}

open Stl_MultiSet;
open[t] Reversible_Sequence[
  Stl_MultiSet::stl_multiset[t],
  Stl_MultiSet::stl_multiset_iterator[t],
  Stl_MultiSet::stl_multiset_reverse_iterator[t],t];
open[t] Bidirectional_iterator[Stl_MultiSet::stl_multiset_iterator[t],t];
open[t] Bidirectional_iterator[Stl_MultiSet::stl_multiset_reverse_iterator[t],t];

Stl Map

//[stl_map.flx]

include "stl/stl";
class Stl_Map[k,v]
{
    requires Cxx_headers::map;
    type stl_map = "::std::map<?1,?2>";
    type stl_map_iterator = "::std::map<?1,?2>::iterator";
    type stl_map_reverse_iterator = "::std::map<?1,?2>::reverse_iterator";
    fun create : unit -> stl_map = "(FLX_GXX_PARSER_HACK std::map<?1,?2>())";
    //lvalue fun subscript: stl_map * k -> v = "$1[$2]";
    fun subscript: stl_map * k -> v = "$1[$2]";
    fun find : stl_map * k ->  stl_map_iterator = "$1.find($2)";
    fun mem : stl_map * k -> bool = "$1.find($2) != $1.end()";
    proc insert : stl_map * k * v = "$1.insert(std::make_pair($2,$3));";
// Stl_Map
  instance Eq[stl_map] {
    fun ==: stl_map * stl_map -> bool = "$1==$2";
  }
  instance Container[stl_map,k*v] {
    fun len: stl_map -> size = "$1.size()";
    fun empty: stl_map -> bool = "$1.empty()";
  }
  instance Sequence[stl_map,stl_map_iterator,k*v] {
    fun begin : stl_map-> stl_map_iterator= "$1.begin()";
    fun end : stl_map-> stl_map_iterator= "$1.end()";
    proc erase : stl_map * stl_map_iterator = "$1.erase($1);";
    proc erase_between : stl_map * stl_map_iterator * stl_map_iterator = "$1.erase($1,$2);";
    proc clear : stl_map = "$1.clear();";
  }
  instance Reversible_Sequence[stl_map,stl_map_iterator,stl_map_reverse_iterator,k*v] {
    fun rbegin : stl_map-> stl_map_reverse_iterator= "$1.rbegin()";
    fun rend : stl_map-> stl_map_reverse_iterator= "$1.rend()";
  }

// Stl_Map iterator
  instance Eq[stl_map_iterator] {
    fun ==: stl_map_iterator * stl_map_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_map_iterator] {
    fun < : stl_map_iterator * stl_map_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_map_iterator,k*v] {
    fun deref : stl_map_iterator ->  k*v  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_map_iterator] {
    fun succ: stl_map_iterator -> stl_map_iterator = "$1+1";
    proc pre_incr : &stl_map_iterator = "++*$1;";
    proc post_incr : &stl_map_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_map_iterator,k*v] {}
  instance BidirectionalSequence[stl_map_iterator] {
    fun pred: stl_map_iterator -> stl_map_iterator = "$1-1;";
    proc pre_decr : &stl_map_iterator = "--*$1;";
    proc post_decr : &stl_map_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_map_iterator,k*v] {}

// Stl_Map reverse iterator
  instance Eq[stl_map_reverse_iterator] {
    fun ==: stl_map_reverse_iterator * stl_map_reverse_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_map_reverse_iterator] {
    fun < : stl_map_reverse_iterator * stl_map_reverse_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_map_reverse_iterator,k*v] {
    fun deref : stl_map_reverse_iterator ->  k*v  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_map_reverse_iterator] {
    fun succ: stl_map_reverse_iterator -> stl_map_reverse_iterator = "$1+1";
    proc pre_incr : &stl_map_reverse_iterator = "++*$1;";
    proc post_incr : &stl_map_reverse_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_map_reverse_iterator,k*v] {}
  instance BidirectionalSequence[stl_map_reverse_iterator] {
    fun pred: stl_map_reverse_iterator -> stl_map_reverse_iterator = "$1-1;";
    proc pre_decr : &stl_map_reverse_iterator = "--*$1;";
    proc post_decr : &stl_map_reverse_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_map_reverse_iterator,k*v] {}

}

open[k,v] Stl_Map[k,v];
open[k,v] Reversible_Sequence[
  Stl_Map::stl_map[k,v],
  Stl_Map::stl_map_iterator[k,v],
  Stl_Map::stl_map_reverse_iterator[k,v],k*v];
open[k,v] Bidirectional_iterator[Stl_Map::stl_map_iterator[k,v],k*v];
open[k,v] Bidirectional_iterator[Stl_Map::stl_map_reverse_iterator[k,v],k*v];

Stl Multimap

//[stl_multimap.flx]

include "stl/stl";
class Stl_MultiMap[k,v]
  {
    requires Cxx_headers::map;
    type stl_multimap = "::std::multimap<?1,?2>";
    type stl_multimap_iterator = "::std::multimap<?1,?2>::iterator";
    type stl_multimap_reverse_iterator = "::std::multimap<?1,?2>::reverse_iterator";
    fun create : unit -> stl_multimap = "(FLX_GXX_PARSER_HACK std::multimap<?1,?2>())";
    fun subscript: stl_multimap * k -> v = "$1[$2]";
    fun find : stl_multimap * k ->  stl_multimap_iterator = "$1.find($2)";
    fun mem : stl_multimap * k -> bool = "$1.find($2) != $1.end()";
    proc insert : stl_multimap * k * v = "$1.insert(std::make_pair($2,$3));";
// Stl_MultiMap
  instance Eq[stl_multimap] {
    fun == : stl_multimap * stl_multimap -> bool = "$1==$2";
  }
  instance Container[stl_multimap,k*v] {
    fun len: stl_multimap -> size = "$1.size()";
    fun empty: stl_multimap -> bool = "$1.empty()";
  }
  instance Sequence[stl_multimap,stl_multimap_iterator,k*v] {
    fun begin : stl_multimap-> stl_multimap_iterator= "$1.begin()";
    fun end : stl_multimap-> stl_multimap_iterator= "$1.end()";
    proc erase : stl_multimap * stl_multimap_iterator = "$1.erase($1);";
    proc erase_between : stl_multimap * stl_multimap_iterator * stl_multimap_iterator = "$1.erase($1,$2);";
    proc clear : stl_multimap = "$1.clear();";
  }
  instance Reversible_Sequence[stl_multimap,stl_multimap_iterator,stl_multimap_reverse_iterator,k*v] {
    fun rbegin : stl_multimap-> stl_multimap_reverse_iterator= "$1.rbegin()";
    fun rend : stl_multimap-> stl_multimap_reverse_iterator= "$1.rend()";
  }

// Stl_MultiMap iterator
  instance Eq[stl_multimap_iterator] {
    fun == : stl_multimap_iterator * stl_multimap_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_multimap_iterator] {
    fun < : stl_multimap_iterator * stl_multimap_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_multimap_iterator,k*v] {
    fun deref : stl_multimap_iterator ->  k*v  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_multimap_iterator] {
    fun succ: stl_multimap_iterator -> stl_multimap_iterator = "$1+1";
    proc pre_incr : &stl_multimap_iterator = "++*$1;";
    proc post_incr : &stl_multimap_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_multimap_iterator,k*v] {}
  instance BidirectionalSequence[stl_multimap_iterator] {
    fun pred: stl_multimap_iterator -> stl_multimap_iterator = "$1-1;";
    proc pre_decr : &stl_multimap_iterator = "--*$1;";
    proc post_decr : &stl_multimap_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_multimap_iterator,k*v] {}

//Stl_MultiMap reverse iterator
  instance Eq[stl_multimap_reverse_iterator] {
    fun == : stl_multimap_reverse_iterator * stl_multimap_reverse_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_multimap_reverse_iterator] {
    fun < : stl_multimap_reverse_iterator * stl_multimap_reverse_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_multimap_reverse_iterator,k*v] {
    fun deref : stl_multimap_reverse_iterator ->  k*v  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_multimap_reverse_iterator] {
    fun succ: stl_multimap_reverse_iterator -> stl_multimap_reverse_iterator = "$1+1";
    proc pre_incr : &stl_multimap_reverse_iterator = "++*$1;";
    proc post_incr : &stl_multimap_reverse_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_multimap_reverse_iterator,k*v] {}
  instance BidirectionalSequence[stl_multimap_reverse_iterator] {
    fun pred: stl_multimap_reverse_iterator -> stl_multimap_reverse_iterator = "$1-1;";
    proc pre_decr : &stl_multimap_reverse_iterator = "--*$1;";
    proc post_decr : &stl_multimap_reverse_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_multimap_reverse_iterator,k*v] {}

}

open Stl_MultiMap;
open[k,v] Reversible_Sequence[
  Stl_MultiMap::stl_multimap[k,v],
  Stl_MultiMap::stl_multimap_iterator[k,v],
  Stl_MultiMap::stl_multimap_reverse_iterator[k,v],k*v];
open[k,v] Bidirectional_iterator[Stl_MultiMap::stl_multimap_iterator[k,v],k*v];
open[k,v] Bidirectional_iterator[Stl_MultiMap::stl_multimap_reverse_iterator[k,v],k*v];

Stl List

//[stl_list.flx]

include "stl/stl";

class Stl_List[t]
{
    requires Cxx_headers::list;
    type stl_list = "::std::list<?1>";
    fun create : unit -> stl_list = "(FLX_GXX_PARSER_HACK std::list<?1>())";
    fun create : int * t -> stl_list= "(FLX_GXX_PARSER_HACK std::list<?1>($1,$2))";
    fun create[i] : i * i -> stl_list = "(FLX_GXX_PARSER_HACK std::list<?1>($1,$2))";
    type stl_list_iterator = "::std::list<?1>::iterator";
    type stl_list_reverse_iterator = "::std::list<?1>::reverse_iterator";
    proc insert: stl_list * stl_list_iterator *  t  = "$1.insert($2,$3);";
    proc push_front : stl_list *  t  = "$1.push_front($2);";
    proc push_back : stl_list *  t  = "$1.push_back($2);";
    fun front : stl_list -> t = "$1.front()";
    fun front : stl_list -> t = "$1.front()";
    proc pop_front : stl_list = "$1.pop_back();";
// List
  instance Eq[stl_list] {
    fun == : stl_list * stl_list -> bool = "$1==$2";
  }
  instance Container[stl_list,t] {
    fun len: stl_list -> size = "$1.size()";
    fun empty: stl_list -> bool = "$1.empty()";
  }
  instance Sequence[stl_list,stl_list_iterator,t] {
    fun begin : stl_list-> stl_list_iterator= "$1.begin()";
    fun end : stl_list-> stl_list_iterator= "$1.end()";
    proc erase : stl_list * stl_list_iterator = "$1.erase($1);";
    proc erase_between : stl_list * stl_list_iterator * stl_list_iterator = "$1.erase($1,$2);";
    proc clear : stl_list = "$1.clear();";
  }
  instance Reversible_Sequence[stl_list,stl_list_iterator,stl_list_reverse_iterator,t] {
    fun rbegin : stl_list-> stl_list_reverse_iterator= "$1.rbegin()";
    fun rend : stl_list-> stl_list_reverse_iterator= "$1.rend()";
  }

// List iterator
  instance Eq[stl_list_iterator] {
    fun == : stl_list_iterator * stl_list_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_list_iterator] {
    fun < : stl_list_iterator * stl_list_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_list_iterator,t] {
    fun deref : stl_list_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_list_iterator] {
    fun succ: stl_list_iterator -> stl_list_iterator = "$1+1";
    proc pre_incr : &stl_list_iterator = "++*$1;";
    proc post_incr : &stl_list_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_list_iterator,t] {}
  instance BidirectionalSequence[stl_list_iterator] {
    fun pred: stl_list_iterator -> stl_list_iterator = "$1-1;";
    proc pre_decr : &stl_list_iterator = "--*$1;";
    proc post_decr : &stl_list_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_list_iterator,t] {}

// List reverse iterator
  instance Eq[stl_list_reverse_iterator] {
    fun == : stl_list_reverse_iterator * stl_list_reverse_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_list_reverse_iterator] {
    fun < : stl_list_reverse_iterator * stl_list_reverse_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_list_reverse_iterator,t] {
    fun deref : stl_list_reverse_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_list_reverse_iterator] {
    fun succ: stl_list_reverse_iterator -> stl_list_reverse_iterator = "$1+1";
    proc pre_incr : &stl_list_reverse_iterator = "++*$1;";
    proc post_incr : &stl_list_reverse_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_list_reverse_iterator,t] {}
  instance BidirectionalSequence[stl_list_reverse_iterator] {
    fun pred: stl_list_reverse_iterator -> stl_list_reverse_iterator = "$1-1;";
    proc pre_decr : &stl_list_reverse_iterator = "--*$1;";
    proc post_decr : &stl_list_reverse_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_list_reverse_iterator,t] {}

}

open Stl_List;
open[t] Reversible_Sequence[
  Stl_List::stl_list[t],
  Stl_List::stl_list_iterator[t],
  Stl_List::stl_list_reverse_iterator[t],t];
open[t] Bidirectional_iterator[Stl_List::stl_list_iterator[t],t];
open[t] Bidirectional_iterator[Stl_List::stl_list_reverse_iterator[t],t];

Stl Deque

//[stl_deque.flx]


class Stl_Deque[t]
{
    requires Cxx_headers::deque;
    type stl_deque = "::std::deque<?1>";
    fun create : unit -> stl_deque = "(FLX_GXX_PARSER_HACK std::deque<?1>())";
    fun create : int * t -> stl_deque= "(FLX_GXX_PARSER_HACK std::deque<?1>($1,$2))";
    fun create[i] : i * i -> stl_deque = "(FLX_GXX_PARSER_HACK std::deque<?1>($1,$2))";
    type stl_deque_iterator = "::std::deque<?1>::iterator";
    type stl_deque_reverse_iterator = "::std::deque<?1>::reverse_iterator";
    proc insert: stl_deque * stl_deque_iterator *  t  = "$1.insert($2,$3);";
    proc push_front : stl_deque *  t  = "$1.push_front($2);";
    proc push_back : stl_deque *  t  = "$1.push_back($2);";
    proc pop_front : stl_deque = "$1.pop_back();";
    fun front : stl_deque -> t = "$1.front()";
    fun front : stl_deque -> t = "$1.front()";
    fun subscript : stl_deque * int -> t = "$1.at($2)";
// Stl_Deque
  instance Eq[stl_deque] {
    fun == : stl_deque * stl_deque -> bool = "$1==$2";
  }
  instance Container[stl_deque,t] {
    fun len: stl_deque -> size = "$1.size()";
    fun empty: stl_deque -> bool = "$1.empty()";
  }
  instance Sequence[stl_deque,stl_deque_iterator,t] {
    fun begin : stl_deque-> stl_deque_iterator= "$1.begin()";
    fun end : stl_deque-> stl_deque_iterator= "$1.end()";
    proc erase : stl_deque * stl_deque_iterator = "$1.erase($1);";
    proc erase_between : stl_deque * stl_deque_iterator * stl_deque_iterator = "$1.erase($1,$2);";
    proc clear : stl_deque = "$1.clear();";
  }
  instance Reversible_Sequence[stl_deque,stl_deque_iterator,stl_deque_reverse_iterator,t] {
    fun rbegin : stl_deque-> stl_deque_reverse_iterator= "$1.rbegin()";
    fun rend : stl_deque-> stl_deque_reverse_iterator= "$1.rend()";
  }

// Stl_Deque iterator
  instance Eq[stl_deque_iterator] {
    fun == : stl_deque_iterator * stl_deque_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_deque_iterator] {
    fun < : stl_deque_iterator * stl_deque_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_deque_iterator,t] {
    fun deref : stl_deque_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_deque_iterator] {
    fun succ: stl_deque_iterator -> stl_deque_iterator = "$1+1";
    proc pre_incr : &stl_deque_iterator = "++*$1;";
    proc post_incr : &stl_deque_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_deque_iterator,t] {}
  instance BidirectionalSequence[stl_deque_iterator] {
    fun pred: stl_deque_iterator -> stl_deque_iterator = "$1-1;";
    proc pre_decr : &stl_deque_iterator = "--*$1;";
    proc post_decr : &stl_deque_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_deque_iterator,t] {}

// Stl_Deque reverse iterator
  instance Eq[stl_deque_reverse_iterator] {
    fun == : stl_deque_reverse_iterator * stl_deque_reverse_iterator -> bool = "$1==$2";
  }
  instance Tord[stl_deque_reverse_iterator] {
    fun < : stl_deque_reverse_iterator * stl_deque_reverse_iterator -> bool = "$1<$2";
  }
  instance Iterator[stl_deque_reverse_iterator,t] {
    fun deref : stl_deque_reverse_iterator ->  t  = "*(#0*)(void*)&*$1";
  }
  instance ForwardSequence[stl_deque_reverse_iterator] {
    fun succ: stl_deque_reverse_iterator -> stl_deque_reverse_iterator = "$1+1";
    proc pre_incr : &stl_deque_reverse_iterator = "++*$1;";
    proc post_incr : &stl_deque_reverse_iterator = "++*$1;";
  }
  instance Forward_iterator[stl_deque_reverse_iterator,t] {}
  instance BidirectionalSequence[stl_deque_reverse_iterator] {
    fun pred: stl_deque_reverse_iterator -> stl_deque_reverse_iterator = "$1-1;";
    proc pre_decr : &stl_deque_reverse_iterator = "--*$1;";
    proc post_decr : &stl_deque_reverse_iterator = "--*$1;";
  }
  instance Bidirectional_iterator[stl_deque_reverse_iterator,t] {}

}

open Stl_Deque;
open[t] Reversible_Sequence[
  Stl_Deque::stl_deque[t],
  Stl_Deque::stl_deque_iterator[t],
  Stl:Stl_Deque::stl_deque_reverse_iterator[t],t];
open[t] Bidirectional_iterator[Stl_Deque::stl_deque_iterator[t],t];
open[t] Bidirectional_iterator[Stl_Deque::stl_deque_reverse_iterator[t],t];

Package: src/packages/sqlite3.fdoc

Database

key file
__init__.flx share/lib/std/db/__init__.flx
sqlite3.flx share/lib/std/db/sqlite3.flx
key file
unix_sqlite3.fpc $PWD/src/config/unix/sqlite3.fpc
win_sqlite3.fpc $PWD/src/config/win/sqlite3.fpc
key file
flx_sqlite3_config.hpp share/lib/rtl/flx_sqlite3_config.hpp
flx_sqlite3.hpp share/lib/rtl/flx_sqlite3.hpp
key file
sqlite3_01.flx $PWD/src/test/regress/rt/sqlite_01.flx
sqlite3_01.expect $PWD/src/test/regress/rt/sqlite_01.expect

Synopsis

//[__init__.flx]

include "std/db/sqlite3";

Sqlite3

//[sqlite3.flx]


//$ Core Sqlite3 functions and extensions to provide row iterator, simple statement execution,
//$ statement preperation and access to sqlite_step statement execution.
//$
//$ Iterator example:
//$
//$
//$@felix
//$ var db : sqlite3_db_t;
//$ var stmt:sqlite3_stmt_t;
//$ var err = sqlite3_open("multiple_sa.db", &db);
//$ if err != 0 do
//$   print "open DB error[abort] ";
//$   println $ sqlite3_errmsg db;
//$   goto finish;
//$ done;
//$ err = sqlite3_prepare_v2(db, "select * from contact", 21, stmt, "");
//$ if not err == (caseno SQLITE_OK) then
//$   { println ("sql error "+str(err)+":"+sqlite3_errmsg(db));goto finish; }
//$ else {
//$   var it = sqlite3_row_iterator (stmt);
//$   var row:ret_val[darray[column_value]];
//$   while (fun ():bool = { row = it();
//$              return (match row with |end_of_results[darray[column_value]] =>false |_ => true
//$              endmatch); }) () do
//$   var t = match row with
//$     | row a =>  ((get_text_val(get(a,0))),(get_text_val(get(a,1))))
//$     | _ => ("","")
//$   endmatch;
//$   print t; endl;
//$   done
//$ }
//$ finish:>
//$   err = sqlite3_finalize(stmt);
//$   println(str(err));
//$   sqlite3_close(db);
//$@

class Sqlite3 {
  requires package "flx_sqlite3";

  //$ Type of a database handle.
  type sqlite3_db_t = "sqlite3*";

  //$ Database open.
  gen sqlite3_open : string * &sqlite3_db_t -> int =
    "sqlite3_open($1.c_str(), $2)"
  ;

  //$ Database close.
  proc sqlite3_close : sqlite3_db_t = "sqlite3_close($1);";

  //$ Type of an exec callback.
  typedef sqlite3_exec_callback_t =
    address      // client data pointer established by call to sqlite3_exec
    * int        // number of result columns
    * +(+char)   // column value as text
    * +(+char)   // column name
    --> int
  ;

  //$ Quick sql execution using callback.
  //$ arg1: db_handle
  //$ arg2: sql statement.
  //$ arg3: callback function.
  //$ arg4: client data pointer.
  //$ arg5: pointer to error message array.
  //$ result: error code.
  gen sqlite3_exec : sqlite3_db_t * string * sqlite3_exec_callback_t * address * &(+char) -> int =
    "sqlite3_exec($1,$2.c_str(),$3,$4,$5)"
  ;

  //$ quick sql execution without data handler callback.
  //$ arg1: db_handle
  //$ arg2: sql statement.
  //$ arg3: pointer to error message array.
  gen sqlite3_exec : sqlite3_db_t * string   * &(+char) -> int =
    "sqlite3_exec($1,$2.c_str(),0,0,$3)"
  ;


  //$ Error message extractor.
  gen sqlite3_errmsg : sqlite3_db_t -> +char=
    "(char*)sqlite3_errmsg($1)"
  ;

  //$ Type of sql statement handle.
  type sqlite3_stmt_t = "sqlite3_stmt*";

  //$ Sqlite3 return codes.
  enum sqlite3_result_codes {
     SQLITE_OK         =   0,   /* Successful result */
     SQLITE_ERROR      =   1,   /* SQL error or missing database */
     SQLITE_INTERNAL   =   2,   /* Internal logic error in SQLite */
     SQLITE_PERM       =   3,   /* Access permission denied */
     SQLITE_ABORT      =   4,   /* Callback routine requested an abort */
     SQLITE_BUSY       =   5,   /* The database file is locked */
     SQLITE_LOCKED     =   6,   /* A table in the database is locked */
     SQLITE_NOMEM      =   7,   /* A malloc() failed */
     SQLITE_READONLY   =   8,   /* Attempt to write a readonly database */
     SQLITE_INTERRUPT  =   9,   /* Operation terminated by sqlite3_interrupt()*/
     SQLITE_IOERR      =  10,   /* Some kind of disk I/O error occurred */
     SQLITE_CORRUPT    =  11,   /* The database disk image is malformed */
     SQLITE_NOTFOUND   =  12,   /* Unknown opcode in sqlite3_file_control() */
     SQLITE_FULL       =  13,   /* Insertion failed because database is full */
     SQLITE_CANTOPEN   =  14,   /* Unable to open the database file */
     SQLITE_PROTOCOL   =  15,   /* Database lock protocol error */
     SQLITE_EMPTY      =  16,   /* Database is empty */
     SQLITE_SCHEMA     =  17,   /* The database schema changed */
     SQLITE_TOOBIG     =  18,   /* String or BLOB exceeds size limit */
     SQLITE_CONSTRAINT =  19,   /* Abort due to constraint violation */
     SQLITE_MISMATCH   =  20,   /* Data type mismatch */
     SQLITE_MISUSE     =  21,   /* Library used incorrectly */
     SQLITE_NOLFS      =  22,   /* Uses OS features not supported on host */
     SQLITE_AUTH       =  23,   /* Authorization denied */
     SQLITE_FORMAT     =  24,   /* Auxiliary database format error */
     SQLITE_RANGE      =  25,   /* 2nd parameter to sqlite3_bind out of range */
     SQLITE_NOTADB     =  26,   /* File opened that is not a database file */
     SQLITE_ROW        =  100,  /* sqlite3_step() has another row ready */
     SQLITE_DONE       =  101,  /* sqlite3_step() has finished executing */
     SQLITE_UNK_RESULT = 999
  }

  //$ Conversion from int result to named return codes.
  fun to_sqlite3_result_code: int -> sqlite3_result_codes =
     |0 => SQLITE_OK
     |1 => SQLITE_ERROR
     |2 => SQLITE_INTERNAL
     |3 => SQLITE_PERM
     |4 => SQLITE_ABORT
     |5 => SQLITE_BUSY
     |6 => SQLITE_LOCKED
     |7 => SQLITE_NOMEM
     |8 => SQLITE_READONLY
     |9 => SQLITE_INTERRUPT
     |10 => SQLITE_IOERR
     |11 => SQLITE_CORRUPT
     |12 => SQLITE_NOTFOUND
     |13 => SQLITE_FULL
     |14 => SQLITE_CANTOPEN
     |15 => SQLITE_PROTOCOL
     |16 => SQLITE_EMPTY
     |17 => SQLITE_SCHEMA
     |18 => SQLITE_TOOBIG
     |19 => SQLITE_CONSTRAINT
     |20 => SQLITE_MISMATCH
     |21 => SQLITE_MISUSE
     |22 => SQLITE_NOLFS
     |23 => SQLITE_AUTH
     |24 => SQLITE_FORMAT
     |25 => SQLITE_RANGE
     |26 => SQLITE_NOTADB
     |100 => SQLITE_ROW
     |101 => SQLITE_DONE
     | _   => SQLITE_UNK_RESULT;

  //$ Tag names for Sqlite3 data types.
  enum sqlite3_types {
    SQLITE_INTEGER  = 1,
    SQLITE_FLOAT    = 2,
    SQLITE_TEXT     = 3,
    SQLITE_BLOB     = 4,
    SQLITE_NULL     = 5,
    SQLITE_UNK_TYPE = 999
  }

  instance Eq[sqlite3_result_codes]  {
    //$ Allow checking for specific return codes.
    fun ==: sqlite3_result_codes * sqlite3_result_codes -> bool = "$1==$2";
  }
  open Eq[sqlite3_result_codes];

  //$ Conversion from int type to named Sqlite3 data type.
  fun to_sqlite3_type: int -> sqlite3_types =
    |1 => SQLITE_INTEGER
    |2 => SQLITE_FLOAT
    |4 => SQLITE_BLOB
    |5 => SQLITE_NULL
    |3 => SQLITE_TEXT
    | _ => SQLITE_UNK_TYPE;


  //$ Prepare an sqlite3 statement for execution.
  gen sqlite3_prepare_v2: sqlite3_db_t * string * int * sqlite3_stmt_t *string -> int =
  "sqlite3_prepare_v2($1,$2.c_str(),$3,&$4,NULL)";

  //$ Execute one step of the prepared statement.
  noinline gen sqlite3_step: sqlite3_stmt_t -> int = "sqlite3_step($1)";

  //$ Determine the number of columns (field) a statement will process.
  gen sqlite3_column_count: sqlite3_stmt_t -> int = "sqlite3_column_count($1)";

  //$ Determine the name of the n'th column to be processed.
  gen sqlite3_column_name: sqlite3_stmt_t*int -> string = "sqlite3_column_name($1,$2)";

  //$ Determine the type of the n'th column to be processed.
  gen sqlite3_column_type: sqlite3_stmt_t*int->int = "sqlite3_column_type($1,$2)";

  //$ Fetch the value of a text field.
  gen sqlite3_column_text: sqlite3_stmt_t*int->string = "(char *)(sqlite3_column_text($1,$2))";

  //$ Fetch the value of a double field.
  gen sqlite3_column_double: sqlite3_stmt_t*int->double = "sqlite3_column_double($1,$2)";

  //$ Fetch the value of a int field.
  gen sqlite3_column_int: sqlite3_stmt_t*int->int = "sqlite3_column_int($1,$2)";

  //$ Fetch the value of a blob field.
  gen sqlite3_column_blob: sqlite3_stmt_t*int->&byte = "(unsigned char *)sqlite3_column_blob($1,$2)";

  //$ Fetch the number of bytes of a field.
  gen sqlite3_column_bytes: sqlite3_stmt_t*int -> int = "sqlite3_column_bytes($1,$2)";

  //$ Finish up with stepping a statement.
  //$ Releases associated resources.
  //$ The statement handle becomes invalid afterwards.
  gen sqlite3_finalize: sqlite3_stmt_t -> int = "sqlite3_finalize($1)";

  //$ A unified type to fetch a field value.
  variant column_value =
     |int_val of int
     |double_val of double
     |text_val of string
     |byte_val of int*&byte
     |null_val;

  //$ A unified result of a statement.
  variant ret_val[t] =
     |row of t
     |row_fail of sqlite3_result_codes*string
     |end_of_results;

  //$ A unified result code.
  variant result_code[t] =
    | qry_ok of t
    | qry_fail of sqlite3_result_codes*string;

  //$ Unified preparation of a query.
  fun sqlite3_prepare_stmt (db:sqlite3_db_t,query:string):result_code[sqlite3_stmt_t] = {
    var stmt:sqlite3_stmt_t;
    return match to_sqlite3_result_code ( sqlite3_prepare_v2(db, query, int(len query), stmt, "")) with
      | #SQLITE_OK =>  qry_ok stmt
      | c     => qry_fail[sqlite3_stmt_t] (c,str(sqlite3_errmsg(db)))
    endmatch;
  }

  //$ Fetch all the columns of a query at once.
  //$ Return them in a darray.
  fun sqlite3_get_columns (stmt:sqlite3_stmt_t):darray[column_value] = {
    val n = sqlite3_column_count(stmt);
    val results = darray[column_value]( size n,null_val);
    for var i:int in 0 upto n - 1 do
       var v = match to_sqlite3_type( sqlite3_column_type(stmt, i) ) with
                 | #SQLITE_TEXT    => text_val (sqlite3_column_text(stmt, i))
                 | #SQLITE_INTEGER     => int_val (sqlite3_column_int(stmt, i))
                 | #SQLITE_FLOAT   => double_val (sqlite3_column_double(stmt, i))
                 | #SQLITE_BLOB    => byte_val (sqlite3_column_bytes(stmt,i),
                                              sqlite3_column_blob(stmt, i))
                 | #SQLITE_NULL => null_val
               endmatch;
       set(results,i,v );
    done;
    return results;
  }


  //$ A stream iterator which returns successive rows of a table.
  gen sqlite3_row_iterator (stmt:sqlite3_stmt_t) () :ret_val[darray[column_value]]  = {
    again:>
      var result_code = to_sqlite3_result_code$ sqlite3_step(stmt);
      if result_code == SQLITE_BUSY do goto again; done;
       match result_code  with
        | #SQLITE_DONE => {val p=sqlite3_finalize(stmt);}(); yield end_of_results[darray[column_value]];
        | #SQLITE_ROW  => yield ( row ( sqlite3_get_columns stmt) );
      //| #SQLITE_BUSY => { Faio::sleep (Faio::sys_clock,0.05); goto again; end_of_results[darray[column_value]];}
         | v =>  {val p=sqlite3_finalize stmt;}(); yield  end_of_results[darray[column_value]];
      endmatch;
      goto again;
      yield end_of_results[darray[column_value]];
  }


  //$ Get the int value out of a int typed field.
  //$ Throws match failure if the field isn't an int type.
  fun get_int_val: column_value->int = | int_val v => v;

  //$ Get the double value out of a double typed field.
  //$ Throws match failure if the field isn't a double type.
  fun get_double_val:  column_value->double = | double_val v => v;

  //$ Get the text value out of a text typed field.
  //$ Throws match failure if the field isn't a text type.
  fun get_text_val:  column_value->string = | text_val v => v;

  //$ Get the statement handle out of a return code.
  fun get_stmt: result_code[sqlite3_stmt_t]-> sqlite3_stmt_t = | qry_ok v => v;

  //$ Get the next row from an row iterator.
  gen get_next ( iter:()->ret_val[darray[column_value]],row:&ret_val[darray[column_value]]):bool = {
    row <- iter();
     return (match *row with
              | #end_of_results =>false
              | #row_fail =>false
              | _ => true
            endmatch);
  }

  //$ Execute an prepared statement.
  gen sqlite3_execute (stmt:sqlite3_stmt_t) :bool  = {
      val v= match to_sqlite3_result_code$ sqlite3_step(stmt)  with
        | #SQLITE_BUSY => sqlite3_execute(stmt)
        | #SQLITE_DONE => true
        | _           => false
      endmatch;
      val n = sqlite3_finalize stmt;
      return v;
  }

  header """
    std::string sqlite3_quote_helper(const char *str) {
      const char * val = sqlite3_mprintf("%q",str);
      std::string ret = std::string(val);
      sqlite3_free((char *)val);
      return ret;
    }
  """;

  //$ Quote a string for use in a query.
  gen sqlite3_quote: string->string = "sqlite3_quote_helper($1.c_str())";

}

Test Example

//[sqlite3_01.flx]
include "std/db/sqlite3";

open Sqlite3;

fun subscript: + (+char) * int -> +char = "$1[$2]";

cfun eh(data:address, ncols:int, values: + (+char), names: + (+char)):int =
{
  var ii:int = 0;
  while ii<ncols do
    print$ str names.[ii] + "=" + str values.[ii];
    if ii<ncols- 1  do print ", ";  done;
    ++ii;
  done;
  println "";
  return 0;
}

proc run(db:sqlite3_db_t) {
  sql :=
    "drop table if exists fred;",
    "create table fred (name, address);",
    "insert into fred values('joe','wigram');",
    "insert into fred values('max','gpr');",
    "insert into fred values('lee','wax');",
    "insert into fred values('henry','pollen');",
    "select all name,address from fred;",
    ""
  ;
  var usr: address =  address c"user pointer";
  var errm: +char =  C_hack::cast[+char] c""; // cast const ptr to non-const

  var i = 0;
  var p = sql.i;
  while p != "" do
    println p;
    val cb : sqlite3_exec_callback_t = eh;
    res := sqlite3_exec(db,p,cb,usr,&errm);
    if res !=0 do
      println$ "exec DB error[abort]: " + errm;
      return;
    done;
    ++i;
    p = sql.i;
  done;
}

println "Hello";
var db : sqlite3_db_t;
err := sqlite3_open("mydb.db", &db);
if err != 0 do
  print "open DB error[abort] ";
  println $ sqlite3_errmsg db;
  goto finish;
done;

run(db);

finish:>
  sqlite3_close(db);

Hello
drop table if exists fred;
create table fred (name, address);
insert into fred values('joe','wigram');
insert into fred values('max','gpr');
insert into fred values('lee','wax');
insert into fred values('henry','pollen');
select all name,address from fred;
name=joe, address=wigram
name=max, address=gpr
name=lee, address=wax
name=henry, address=pollen

Config Data

//[unix_sqlite3.fpc]
provides_dlib: -lflx_sqlite3_dynamic
provides_slib: -lflx_sqlite3_static
includes: '"flx_sqlite3.hpp"'
macros: BUILD_SQLITE3
build_includes: build/release/share/lib/rtl
library: flx_sqlite3
srcdir: src/sqlite3
src: sqlite3\.c

//[win_sqlite3.fpc]
provides_dlib: /DEFAULTLIB:flx_sqlite3_dynamic
provides_slib: /DEFAULTLIB:flx_sqlite3_static
includes: "<flx_sqlite3.hpp>"
macros: BUILD_SQLITE3
build_includes: build/release/share/lib/rtl
library: flx_sqlite3
srcdir: src/sqlite3
src: sqlite3\.c

//[flx_sqlite3_config.hpp]
#ifndef __FLX_SQLITE3_CONFIG_H__
#define __FLX_SQLITE3_CONFIG_H__
#include "flx_rtl_config.hpp"
#ifdef BUILD_SQLITE3
#define SQLITE3_EXTERN FLX_EXPORT
#else
#define SQLITE3_EXTERN FLX_IMPORT
#endif
#endif
#define SQLITE_API SQLITE3_EXTERN

//[flx_sqlite3.hpp]
#ifndef _FLX_SQLITE3_HPP
#define _FLX_SQLITE3_HPP
#include "flx_sqlite3_config.hpp"
#include "sqlite3/sqlite3.h"
#endif

Package: src/packages/ncurses.fdoc

ncurses binding

key file
ncurses.flx share/lib/std/io/ncurses.flx
ncurses_01.flx $PWD/src/examples/ncurses_01.flx
ncurses_02.flx $PWD/src/examples/ncurses_02.flx
ncurses_03.flx $PWD/src/examples/ncurses_03.flx
unix_ncurses.fpc $PWD/src/config/unix/ncurses.fpc

Expected to run on Unix platforms only.

//[ncurses.flx]
// This library is licenced under FFAU
class Ncurses
{
  requires package "ncurses";
  type WINDOW = "WINDOW*";
  type SCREEN = "SCREEN*";
  type NCURSES_SCREEN_CB = "NCURSE_SCREEN_CB";
  type NCURSES_WINDOW_CB = "NCURSE_WINDOW_CB";
  type NCURSES_ATTR_T = "NCURSES_ATTR_T";

  // hackery!
  typedef attr_t = uint;
  typedef chtype = uint;
  ctor chtype : int = "(unsigned int)$1";
  ctor chtype : char = "(unsigned int)$1";
  ctor char : chtype = "(char)$1";
  ctor int : chtype = "(int)$1";
  const stdscr : WINDOW = "stdscr";

  gen addch: chtype -> int;   // generated
  gen addchnstr: &chtype * int -> int;  // generated
  gen addchstr: &chtype -> int;   // generated
  gen addnstr: &char * int -> int;   // generated
  gen addstr: &char -> int;   // generated
  gen attroff: NCURSES_ATTR_T -> int;   // generated
  gen attron: NCURSES_ATTR_T -> int;   // generated
  gen attrset: NCURSES_ATTR_T -> int;   // generated
  gen attr_get: &attr_t * &short * address -> int; // generated
  gen attr_off: attr_t * address -> int;   // generated
  gen attr_on: attr_t * address -> int;   // generated
  gen attr_set: attr_t * short * address -> int;  // generated
  gen baudrate: unit -> int;    // implemented
  gen beep : unit -> int;    // implemented
  gen bkgd: chtype -> int;    // generated
  gen bkgdset: chtype -> void;    // generated
  gen border: chtype * chtype * chtype * chtype * chtype * chtype * chtype * chtype -> int; // generated
  gen box: WINDOW * chtype * chtype -> int;  // generated
  gen can_change_color: unit -> bool;   // implemented
  gen cbreak: unit -> int;    // implemented
  gen chgat: int * attr_t * short * address -> int; // generated
  gen clear: unit -> int;    // generated
  gen clearok: WINDOW * bool -> int;   // implemented
  gen clrtobot: unit -> int;    // generated
  gen clrtoeol: unit -> int;    // generated
  gen color_content: short * &short * &short * &short -> int; // implemented
  gen color_set: short * address -> int;   // generated
  gen COLOR_PAIR: int -> int;    // generated
  gen copywin: WINDOW * WINDOW * int * int * int * int * int * int * int -> int; // implemented
  gen curs_set: int -> int;    // implemented
  gen def_prog_mode: unit -> int;   // implemented
  gen def_shell_mode: unit -> int;   // implemented
  gen delay_output: int -> int;    // implemented
  gen delch: unit -> int;    // generated
  proc delscreen: SCREEN ;   // implemented
  gen delwin: WINDOW -> int;    // implemented
  gen deleteln: unit -> int;    // generated
  gen derwin: WINDOW * int * int * int * int -> WINDOW; // implemented
  gen doupdate: unit -> int;    // implemented
  gen dupwin: WINDOW -> WINDOW;   // implemented
  gen echo: unit -> int;     // implemented
  gen echochar: chtype -> int;   // generated
  gen erase: unit -> int;    // generated
  gen endwin: unit -> int;    // implemented
  gen erasechar: unit -> char;    // implemented
  gen filter: unit -> void;    // implemented
  gen flash: unit -> int;    // implemented
  gen flushinp: unit -> int;    // implemented
  gen getbkgd: WINDOW -> chtype;   // generated
  gen getch: unit -> int;    // generated
  gen getnstr: +char * int -> int;   // generated
  gen getstr: +char -> int;    // generated
//  gen getwin: &FILE -> WINDOW;   // implemented
  gen halfdelay: int -> int;    // implemented
  gen has_colors: unit -> bool;    // implemented
  gen has_ic: unit -> bool;    // implemented
  gen has_il: unit -> bool;    // implemented
  gen hline: chtype * int -> int;    // generated
  gen idcok: WINDOW * bool -> void;   // implemented
  gen idlok: WINDOW * bool -> int;   // implemented
  gen immedok: WINDOW * bool -> void;   // implemented
  gen inch: unit -> chtype;    // generated
  gen inchnstr: &chtype * int -> int;   // generated
  gen inchstr: &chtype -> int;    // generated
  gen initscr: unit -> WINDOW;    // implemented
  gen init_color: short * short * short * short -> int; // implemented
  gen init_pair: short * short * short -> int;  // implemented
  gen innstr: &char * int -> int;   // generated
  gen insch: chtype -> int;    // generated
  gen insdelln: int -> int;    // generated
  gen insertln: unit -> int;    // generated
  gen insnstr: &char * int -> int;   // generated
  gen insstr: &char -> int;   // generated
  gen instr: &char -> int;    // generated
  gen intrflush: WINDOW * bool -> int;   // implemented
  gen isendwin: unit -> bool;    // implemented
  gen is_linetouched: WINDOW * int -> bool;  // implemented
  gen is_wintouched: WINDOW -> bool;   // implemented
  gen keyname: int -> &char;  // implemented
  gen keypad: WINDOW * bool -> int;   // implemented
  gen killchar: unit -> char;    // implemented
  gen leaveok: WINDOW * bool -> int;   // implemented
  gen longname: unit -> &char;    // implemented
  gen meta: WINDOW * bool -> int;   // implemented
  gen move: int * int -> int;    // generated
  gen mvaddch: int * int * chtype -> int;  // generated
  gen mvaddchnstr: int * int * &chtype * int -> int; // generated
  gen mvaddchstr: int * int * &chtype -> int; // generated
  gen mvaddnstr: int * int * &char * int -> int; // generated
  gen mvaddstr: int * int * &char -> int;  // generated
  gen mvchgat: int * int * int * attr_t * short * address -> int; // generated
  gen mvcur: int * int * int * int -> int;   // implemented
  gen mvdelch: int * int -> int;    // generated
  gen mvderwin: WINDOW * int * int -> int;  // implemented
  gen mvgetch: int * int -> int;    // generated
  gen mvgetnstr: int * int * +char * int -> int;  // generated
  gen mvgetstr: int * int * +char -> int;   // generated
  gen mvhline: int * int * chtype * int -> int;  // generated
  gen mvinch: int * int -> chtype;   // generated
  gen mvinchnstr: int * int * &chtype * int -> int; // generated
  gen mvinchstr: int * int * &chtype -> int;  // generated
  gen mvinnstr: int * int * &char * int -> int;  // generated
  gen mvinsch: int * int * chtype -> int;   // generated
  gen mvinsnstr: int * int * &char * int -> int; // generated
  gen mvinsstr: int * int * &char -> int;  // generated
  gen mvinstr: int * int * &char -> int;   // generated
//extern NCURSES_EXPORT(int) mvprintw (int * int * &char * ...)  // implemented
//  GCC_PRINTFLIKE(3 * 4);
//extern NCURSES_EXPORT(int) mvscanw (int * int * &char * ...) // implemented
//  GCC_SCANFLIKE(3 * 4);
  proc mvprintw: int * int * string = '(void)mvprintw($1,$2,"%s",$1.c_str());';

  gen mvvline: int * int * chtype * int -> int;  // generated
  gen mvwaddch: WINDOW * int * int * chtype -> int; // generated
  gen mvwaddchnstr: WINDOW * int * int * &chtype * int -> int;// generated
  gen mvwaddchstr: WINDOW * int * int * &chtype -> int; // generated
  gen mvwaddnstr: WINDOW * int * int * &char * int -> int; // generated
  gen mvwaddstr: WINDOW * int * int * &char -> int; // generated
  gen mvwchgat: WINDOW * int * int * int * attr_t * short * address -> int;// generated
  gen mvwdelch: WINDOW * int * int -> int;  // generated
  gen mvwgetch: WINDOW * int * int -> int;  // generated
  gen mvwgetnstr: WINDOW * int * int * +char * int -> int; // generated
  gen mvwgetstr: WINDOW * int * int * +char -> int; // generated
  gen mvwhline: WINDOW * int * int * chtype * int -> int; // generated
  gen mvwin: WINDOW * int * int -> int;   // implemented
  gen mvwinch: WINDOW * int * int -> chtype;   // generated
  gen mvwinchnstr: WINDOW * int * int * &chtype * int -> int; // generated
  gen mvwinchstr: WINDOW * int * int * &chtype -> int;  // generated
  gen mvwinnstr: WINDOW * int * int * &char * int -> int;  // generated
  gen mvwinsch: WINDOW * int * int * chtype -> int;  // generated
  gen mvwinsnstr: WINDOW * int * int * &char * int -> int; // generated
  gen mvwinsstr: WINDOW * int * int * &char -> int;  // generated
  gen mvwinstr: WINDOW * int * int * &char -> int;  // generated
//extern NCURSES_EXPORT(int) mvwprintw (&WINDOW * int * int * &char * ...) // implemented
//  GCC_PRINTFLIKE(4 * 5);
//extern NCURSES_EXPORT(int) mvwscanw (WINDOW * int * int * &char * ...) // implemented
//  GCC_SCANFLIKE(4 * 5);
  proc mvwprintw: WINDOW * int * int * string = '(void)mvwprintw($1,$2,$3,"%s",$4.c_str());';

  gen mvwvline: WINDOW * int * int * chtype * int -> int; // generated
  gen napms: int -> int;     // implemented
  gen newpad: int * int -> WINDOW;    // implemented
  gen newterm: string * ifile * ofile -> SCREEN = "newterm(strdup($1.c_str()),$2,$3)"; // implemented
  //gen newterm: &char * &FILE * &FILE -> &SCREEN; // implemented
  gen newwin: int * int * int * int -> WINDOW;   // implemented
  gen nl: unit -> int;     // implemented
  gen nocbreak: unit -> int;    // implemented
  gen nodelay: WINDOW * bool -> int;   // implemented
  gen noecho: unit -> int;    // implemented
  gen nonl: unit -> int;     // implemented
  gen noqiflush: unit -> void;    // implemented
  gen noraw: unit -> int;    // implemented
  gen notimeout: WINDOW * bool -> int;   // implemented
  gen overlay: &WINDOW * WINDOW -> int;  // implemented
  gen overwrite: &WINDOW * WINDOW -> int;  // implemented
  gen pair_content: short * &short * &short -> int;  // implemented
  gen PAIR_NUMBER: int -> int;    // generated
  gen pechochar: WINDOW * chtype -> int;  // implemented
  gen pnoutrefresh: &WINDOW * int * int * int * int * int * int -> int;// implemented
  gen prefresh: WINDOW * int * int * int * int * int * int -> int; // implemented
//extern NCURSES_EXPORT(int) printw (&char * ...)   // implemented
//  GCC_PRINTFLIKE(1 * 2);

  proc printw : string = '(void)printw("%s",$1.c_str());';

  gen putwin: WINDOW * &FILE -> int;   // implemented
  gen qiflush: unit -> void;    // implemented
  gen raw: unit -> int;     // implemented
  gen redrawwin: WINDOW -> int;   // generated
  gen refresh: unit -> int;    // generated
  gen resetty: unit -> int;    // implemented
  gen reset_prog_mode: unit -> int;   // implemented
  gen reset_shell_mode: unit -> int;   // implemented
//   gen ripoffline (int * int: *)(WINDOW * int) -> int; // implemented
  gen savetty: unit -> int;    // implemented
//extern NCURSES_EXPORT(int) scanw (&char * ...)  // implemented
//  GCC_SCANFLIKE(1 * 2);
  gen scr_dump: &char -> int;   // implemented
  gen scr_init: &char -> int;   // implemented
  gen scrl: int -> int;     // generated
  gen scroll: WINDOW -> int;    // generated
  gen scrollok: WINDOW * bool -> int;   // implemented
  gen scr_restore: &char -> int;   // implemented
  gen scr_set: &char -> int;   // implemented
  gen setscrreg: int * int -> int;    // generated
  gen set_term: &SCREEN -> &SCREEN;   // implemented
  gen slk_attroff: chtype -> int;   // implemented
  gen slk_attr_off: attr_t * address -> int;  // generated:WIDEC
  gen slk_attron: chtype -> int;   // implemented
  gen slk_attr_on: attr_t * address -> int;   // generated:WIDEC
  gen slk_attrset: chtype -> int;   // implemented
  gen slk_attr: unit -> attr_t;    // implemented
  gen slk_attr_set: attr_t * short * address -> int; // implemented
  gen slk_clear: unit -> int;    // implemented
  gen slk_color: short -> int;    // implemented
  gen slk_init: int -> int;    // implemented
  gen slk_label: int -> &char;    // implemented
  gen slk_noutrefresh: unit -> int;   // implemented
  gen slk_refresh: unit -> int;    // implemented
  gen slk_restore: unit -> int;    // implemented
  gen slk_set: int * &char * int -> int;  // implemented
  gen slk_touch: unit -> int;    // implemented
  gen standout: unit -> int;    // generated
  gen standend: unit -> int;    // generated
  gen start_color: unit -> int;    // implemented
  gen subpad: WINDOW * int * int * int * int -> WINDOW; // implemented
  gen subwin: WINDOW * int * int * int * int -> WINDOW; // implemented
  gen syncok: WINDOW * bool -> int;   // implemented
  gen termattrs: unit -> chtype;    // implemented
  gen termname: unit -> &char;    // implemented
  gen timeout: int -> void;    // generated
  gen touchline: WINDOW * int * int -> int;  // generated
  gen touchwin: WINDOW -> int;    // generated
  gen typeahead: int -> int;    // implemented
  gen ungetch: int -> int;    // implemented
  gen untouchwin: WINDOW -> int;   // generated
  gen use_env: bool -> void;    // implemented
  gen vidattr: chtype -> int;    // implemented
//  gen vidputs (chtype * int: *)(int) -> int;  // implemented
  gen vline: chtype * int -> int;    // generated
  gen vwprintw: WINDOW * &char * C_hack::va_list -> int; // implemented
  gen vw_printw: WINDOW * &char * C_hack::va_list -> int; // generated
  gen vwscanw: WINDOW * &char * C_hack::va_list -> int; // implemented
  gen vw_scanw: WINDOW * &char * C_hack::va_list -> int; // generated
  gen waddch: WINDOW * chtype -> int;  // implemented
  gen waddchnstr: WINDOW * &chtype * int -> int; // implemented
  gen waddchstr: WINDOW * &chtype -> int;  // generated
  gen waddnstr: WINDOW * &char * int -> int; // implemented
  gen waddstr: WINDOW * &char -> int;  // generated
  proc waddstr: WINDOW * string = '(void)waddstr($1,$2.c_str());';
  gen wattron: WINDOW * int -> int;   // generated
  gen wattroff: WINDOW * int -> int;   // generated
  gen wattrset: WINDOW * int -> int;   // generated
  gen wattr_get: WINDOW * &attr_t * &short * address -> int; // generated
  gen wattr_on: WINDOW * attr_t * address -> int;  // implemented
  gen wattr_off: WINDOW * attr_t * address -> int; // implemented
  gen wattr_set: WINDOW * attr_t * short * address -> int; // generated
  gen wbkgd: WINDOW * chtype -> int;   // implemented
  gen wbkgdset: WINDOW * chtype -> void;   // implemented
  gen wborder: WINDOW * chtype * chtype * chtype * chtype * chtype * chtype * chtype * chtype -> int; // implemented
  gen wchgat: WINDOW * int * attr_t * short * address -> int;// implemented
  gen wclear: WINDOW -> int;    // implemented
  gen wclrtobot: WINDOW -> int;   // implemented
  gen wclrtoeol: WINDOW -> int;   // implemented
  gen wcolor_set: &WINDOW * short * address -> int;  // implemented
  gen wcursyncup: WINDOW -> void;   // implemented
  gen wdelch: WINDOW -> int;    // implemented
  gen wdeleteln: WINDOW -> int;   // generated
  gen wechochar: WINDOW * chtype -> int;  // implemented
  gen werase: WINDOW -> int;    // implemented
  gen wgetch: WINDOW -> int;    // implemented
  gen wgetnstr: WINDOW * &char * int -> int;  // implemented
  gen wgetstr: WINDOW * &char -> int;   // generated
  gen whline: WINDOW * chtype * int -> int;  // implemented
  gen winch: WINDOW -> chtype;    // implemented
  gen winchnstr: WINDOW * &chtype * int -> int;  // implemented
  gen winchstr: WINDOW * &chtype -> int;  // generated
  gen winnstr: WINDOW * &char * int -> int;  // implemented
  gen winsch: WINDOW * chtype -> int;   // implemented
  gen winsdelln: WINDOW * int -> int;   // implemented
  gen winsertln: WINDOW -> int;   // generated
  gen winsnstr: WINDOW * &char * int -> int; // implemented
  gen winsstr: WINDOW * &char -> int;  // generated
  gen winstr: WINDOW * &char -> int;   // generated
  gen wmove: WINDOW * int * int -> int;   // implemented
  gen wnoutrefresh: WINDOW -> int;   // implemented
//extern NCURSES_EXPORT(int) wprintw (WINDOW * &char * ...)  // implemented
//  GCC_PRINTFLIKE(2 * 3);
  proc wprintw: WINDOW * string = '(void)wprintw($1,$2.c_str());';
  gen wredrawln: WINDOW * int * int -> int;  // implemented
  gen wrefresh: WINDOW -> int;    // implemented
//extern NCURSES_EXPORT(int) wscanw (WINDOW * &char * ...) // implemented
//  GCC_SCANFLIKE(2 * 3);
  gen wscrl: WINDOW * int -> int;   // implemented
  gen wsetscrreg: WINDOW * int * int -> int;  // implemented
  gen wstandout: WINDOW -> int;   // generated
  gen wstandend: WINDOW -> int;   // generated
  gen wsyncdown: WINDOW -> void;   // implemented
  gen wsyncup: WINDOW -> void;    // implemented
  gen wtimeout: WINDOW * int -> void;   // implemented
  gen wtouchln: WINDOW * int * int * int -> int;  // implemented
  gen wvline: WINDOW * chtype * int -> int;  // implemented

/*
 * These are also declared in <term.h>:
 */
  gen tigetflag: &char -> int;  // implemented
  gen tigetnum: &char -> int;  // implemented
  gen tigetstr: &char -> &char;  // implemented
  gen putp: &char -> int;    // implemented

//#if NCURSES_TPARM_VARARGS
//  gen tparm: &char * ... -> &char; /* &special/
//#else
//  gen tparm: &char * long * long * long * long * long * long * long * long * long -> &char; /* &special/
//  gen tparm_varargs: &char * ... -> &char; /* &special/
//#endif

/*
 * These functions are not in X/Open * but we use them in macro definitions:
 */
  gen getattrs: WINDOW -> int;   // generated
  gen getcurx: WINDOW -> int;   // generated
  gen getcury: WINDOW -> int;   // generated
  gen getbegx: WINDOW -> int;   // generated
  gen getbegy: WINDOW -> int;   // generated
  gen getmaxx: WINDOW -> int;   // generated
  gen getmaxy: WINDOW -> int;   // generated
  gen getparx: WINDOW -> int;   // generated
  gen getpary: WINDOW -> int;   // generated

/*
 * vid_attr() was implemented originally based on a draft of X/Open curses.
 */
//#ifndef _XOPEN_SOURCE_EXTENDED
//#define vid_attr(a * pair * opts) vidattr(a)
//#endif

/*
 * These functions are extensions - not in X/Open Curses.
 */
//typedef int (*NCURSES_WINDOW_CB)(WINDOW * address);
//typedef int (*NCURSES_SCREEN_CB)(&SCREEN * address);
  gen is_term_resized: int * int -> bool;
  gen keybound: int * int -> &char;
  gen curses_version: unit -> &char;
  gen assume_default_colors: int * int -> int;
  gen define_key: &char * int -> int;
  gen key_defined: &char -> int;
  gen keyok: int * bool -> int;
  gen resize_term: int * int -> int;
  gen resizeterm: int * int -> int;
  gen set_escdelay: int -> int;
  gen set_tabsize: int -> int;
  gen use_default_colors: unit -> int;
  gen use_extended_names: bool -> int;
  gen use_legacy_coding: int -> int;
  gen use_screen: SCREEN * NCURSES_SCREEN_CB * address -> int;
  gen use_window: WINDOW * NCURSES_WINDOW_CB * address -> int;
  gen wresize: WINDOW * int * int -> int;
  proc nofilter:1;

/*
 * These extensions provide access to information stored in the WINDOW even
 * when NCURSES_OPAQUE is set:
 */
  gen wgetparent: WINDOW -> WINDOW; // generated
  gen is_cleared: WINDOW -> bool; // generated
  gen is_idcok: WINDOW -> bool;  // generated
  gen is_idlok: WINDOW -> bool;  // generated
  gen is_immedok: WINDOW -> bool; // generated
  gen is_keypad: WINDOW -> bool;  // generated
  gen is_leaveok: WINDOW -> bool; // generated
  gen is_nodelay: WINDOW -> bool; // generated
  gen is_notimeout: WINDOW -> bool; // generated
  gen is_scrollok: WINDOW -> bool; // generated
  gen is_syncok: WINDOW -> bool;  // generated
  gen wgetscrreg: WINDOW * &int * &int -> int; // generated

  // Colours
  const
    COLOR_BLACK,
    COLOR_RED,
    COLOR_GREEN,
    COLOR_YELLOW,
    COLOR_BLUE,
    COLOR_MAGENTA,
    COLOR_CYAN,
    COLOR_WHITE : short
  ;

  const A_NORMAL : attr_t;

  // Mouse stuff
  type mmask_t = "mmask_t";
  cstruct MEVENT {
    id:short;
    x:int;
    y:int;
    z:int;
    bstate: mmask_t;
  };

  const BUTTON1_RELEASED        : mmask_t;
  const BUTTON1_PRESSED         : mmask_t;
  const BUTTON1_CLICKED         : mmask_t;
  const BUTTON1_DOUBLE_CLICKED  : mmask_t;
  const BUTTON1_TRIPLE_CLICKED  : mmask_t;

  const BUTTON2_RELEASED        : mmask_t;
  const BUTTON2_PRESSED         : mmask_t;
  const BUTTON2_CLICKED         : mmask_t;
  const BUTTON2_DOUBLE_CLICKED  : mmask_t;
  const BUTTON2_TRIPLE_CLICKED  : mmask_t;

  const BUTTON3_RELEASED        : mmask_t;
  const BUTTON3_PRESSED         : mmask_t;
  const BUTTON3_CLICKED         : mmask_t;
  const BUTTON3_DOUBLE_CLICKED  : mmask_t;
  const BUTTON3_TRIPLE_CLICKED  : mmask_t;

  const BUTTON4_RELEASED        : mmask_t;
  const BUTTON4_PRESSED         : mmask_t;
  const BUTTON4_CLICKED         : mmask_t;
  const BUTTON4_DOUBLE_CLICKED  : mmask_t;
  const BUTTON4_TRIPLE_CLICKED  : mmask_t;
  const BUTTON_CTRL             : mmask_t;
  const BUTTON_SHIFT            : mmask_t;
  const BUTTON_ALT              : mmask_t;
  const ALL_MOUSE_EVENTS        : mmask_t;
  const REPORT_MOUSE_POSITION   : mmask_t;

  gen getmouse: &MEVENT -> int;
  gen ungetmouse: &MEVENT -> int;
  gen mousemask: mmask_t * &mmask_t -> mmask_t;
  gen wenclose: WINDOW * int * int -> bool;
  gen mouseinterval: int -> int;
  gen wmouse_trafo: WINDOW * &int * &int * bool -> bool;
  gen mouse_trafo: &int * &int * bool -> bool;

/* VT100 symbols begin here */
  const ACS_ULCORNER    : char;
  const ACS_LLCORNER    : char;
  const ACS_URCORNER    : char;
  const ACS_LRCORNER    : char;
  const ACS_LTEE        : char;
  const ACS_RTEE        : char;
  const ACS_BTEE        : char;
  const ACS_TTEE        : char;
  const ACS_HLINE       : char;
  const ACS_VLINE       : char;
  const ACS_PLUS        : char;
  const ACS_S1          : char;
  const ACS_S9          : char;
  const ACS_DIAMOND     : char;
  const ACS_CKBOARD     : char;
  const ACS_DEGREE      : char;
  const ACS_PLMINUS     : char;
  const ACS_BULLET      : char;
/* Teletype 5410v1 symbols begin here */
  const ACS_LARROW      : char;
  const ACS_RARROW      : char;
  const ACS_DARROW      : char;
  const ACS_UARROW      : char;
  const ACS_BOARD       : char;
  const ACS_LANTERN     : char;
  const ACS_BLOCK       : char;
/*
 * These aren't documented, but a lot of System Vs have them anyway
 * (you can spot pprryyzz{{||}} in a lot of AT&T terminfo strings).
 * The ACS_names may not match AT&T's, our source didn't know them.
 */
  const ACS_S3          : char;
  const ACS_S7          : char;
  const ACS_LEQUAL      : char;
  const ACS_GEQUAL      : char;
  const ACS_PI          : char;
  const ACS_NEQUAL      : char;
  const ACS_STERLING    : char;

/*
 * Line drawing ACS names are of the form ACS_trbl, where t is the top, r
 * is the right, b is the bottom, and l is the left.  t, r, b, and l might
 * be B (blank), S (single), D (double), or T (thick).  The subset defined
 * here only uses B and S.
 */
  const ACS_BSSB        : char;
  const ACS_SSBB        : char;
  const ACS_BBSS        : char;
  const ACS_SBBS        : char;
  const ACS_SBSS        : char;
  const ACS_SSSB        : char;
  const ACS_SSBS        : char;
  const ACS_BSSS        : char;
  const ACS_BSBS        : char;
  const ACS_SBSB        : char;
  const ACS_SSSS        : char;
/*
 * Pseudo-character tokens outside ASCII range.  The curses wgetch() function
 * will return any given one of these only if the corresponding k- capability
 * is defined in your terminal's terminfo entry.
 *
 * Some keys (KEY_A1, etc) are arranged like this:
 *    a1     up    a3
 *    left   b2    right
 *    c1     down  c3
 *
 * A few key codes do not depend upon the terminfo entry.
 */

  const KEY_CODE_YES    : int;
  const KEY_MIN     : int;
  const KEY_BREAK    : int;
  const KEY_SRESET    : int;
  const KEY_RESET    : int;
/*
 * These definitions were generated by /var/tmp/ncurses.roots/ncurses/ncurses/include/MKkey_defs.sh /var/tmp/ncurses.roots/ncurses/ncurses/include/Caps
 */
  const KEY_DOWN    : int;
  const KEY_UP     : int;
  const KEY_LEFT    : int;
  const KEY_RIGHT    : int;
  const KEY_HOME    : int;
  const KEY_BACKSPACE    : int;
  const KEY_F0     : int;
  const KEY_F1     : int = 'KEY_F(1)';
  const KEY_F2     : int = 'KEY_F(2)';
  const KEY_F3     : int = 'KEY_F(3)';
  const KEY_F4     : int = 'KEY_F(4)';
  const KEY_F5     : int = 'KEY_F(5)';
  const KEY_F6     : int = 'KEY_F(6)';
  const KEY_F7     : int = 'KEY_F(7)';
  const KEY_F8     : int = 'KEY_F(8)';
  const KEY_F9     : int = 'KEY_F(9)';
  const KEY_F10     : int = 'KEY_F(10)';
  const KEY_F11    : int = 'KEY_F(11)';
  const KEY_F12     : int = 'KEY_F(12)';
  const KEY_DL     : int;
  const KEY_IL     : int;
  const KEY_DC     : int;
  const KEY_IC     : int;
  const KEY_EIC     : int;
  const KEY_CLEAR    : int;
  const KEY_EOS     : int;
  const KEY_EOL     : int;
  const KEY_SF     : int;
  const KEY_SR     : int;
  const KEY_NPAGE    : int;
  const KEY_PPAGE    : int;
  const KEY_STAB    : int;
  const KEY_CTAB    : int;
  const KEY_CATAB    : int;
  const KEY_ENTER    : int;
  const KEY_PRINT    : int;
  const KEY_LL     : int;
  const KEY_A1     : int;
  const KEY_A3     : int;
  const KEY_B2     : int;
  const KEY_C1     : int;
  const KEY_C3     : int;
  const KEY_BTAB    : int;
  const KEY_BEG     : int;
  const KEY_CANCEL    : int;
  const KEY_CLOSE    : int;
  const KEY_COMMAND    : int;
  const KEY_COPY    : int;
  const KEY_CREATE    : int;
  const KEY_END     : int;
  const KEY_EXIT    : int;
  const KEY_FIND    : int;
  const KEY_HELP    : int;
  const KEY_MARK    : int;
  const KEY_MESSAGE    : int;
  const KEY_MOVE    : int;
  const KEY_NEXT    : int;
  const KEY_OPEN    : int;
  const KEY_OPTIONS    : int;
  const KEY_PREVIOUS    : int;
  const KEY_REDO    : int;
  const KEY_REFERENCE    : int;
  const KEY_REFRESH    : int;
  const KEY_REPLACE    : int;
  const KEY_RESTART    : int;
  const KEY_RESUME    : int;
  const KEY_SAVE    : int;
  const KEY_SBEG    : int;
  const KEY_SCANCEL    : int;
  const KEY_SCOMMAND    : int;
  const KEY_SCOPY    : int;
  const KEY_SCREATE    : int;
  const KEY_SDC     : int;
  const KEY_SDL     : int;
  const KEY_SELECT    : int;
  const KEY_SEND    : int;
  const KEY_SEOL    : int;
  const KEY_SEXIT    : int;
  const KEY_SFIND    : int;
  const KEY_SHELP    : int;
  const KEY_SHOME    : int;
  const KEY_SIC     : int;
  const KEY_SLEFT    : int;
  const KEY_SMESSAGE    : int;
  const KEY_SMOVE    : int;
  const KEY_SNEXT    : int;
  const KEY_SOPTIONS    : int;
  const KEY_SPREVIOUS    : int;
  const KEY_SPRINT    : int;
  const KEY_SREDO    : int;
  const KEY_SREPLACE    : int;
  const KEY_SRIGHT    : int;
  const KEY_SRSUME    : int;
  const KEY_SSAVE    : int;
  const KEY_SSUSPEND    : int;
  const KEY_SUNDO    : int;
  const KEY_SUSPEND    : int;
  const KEY_UNDO    : int;
  const KEY_MOUSE    : int;
  const KEY_RESIZE    : int;
  const KEY_EVENT    : int;

  const KEY_MAX     : int;

  fun LINES:1->int = "LINES";
  fun COLS:1->int = "COLS";
}

Test cases

//[ncurses_01.flx]
include "std/io/ncurses";
open Ncurses;
//$ write output to a dummy file descriptor
var term = FileSystem::pipe();
var ttype = "vt100";
var fdo = FileSystem::fdopen_output(term.(0));
var fdi = FileSystem::fdopen_input(term.(1));
var s = newterm(ttype,fdi,fdo); // get a screen
var w = newpad(80,24); // get a window
wprintw(w,"Hello World !!!"); // Hi
var r = refresh();
delscreen(s);
assert r == 0;

//[ncurses_02.flx]
include "std/io/ncurses";
open C_hack;
open Ncurses;
//$ write output to a dummy file descriptor
var w = initscr(); // get a screen
wprintw(w,"Hello World !!!\nNow Press a key."); // Hi
ignore(refresh());
ignore(wgetch(w));
ignore(endwin());

//[ncurses_03.flx]
/* Example derived from http://www.tldp.org/HOWTO/NCURSES-Programming-HOWTO */
include "std/io/ncurses";
open Ncurses;
open C_hack;

  w := initscr();          // Start curses mode
  ignore(cbreak());        // Line buffering disabled, Pass on
                         // everty thing to me
  ignore(keypad(w, true)); // I need that nifty F1

  var height = 4;
  var width = 8;
  var starty = (LINES() - height) / 2;        // Calculating for a center placement
  var startx = (COLS() - width) / 2;  // of the window
  wprintw(w,"Movement: Arrows, Size: F2 F3 F4 F5, Exit: F1");
  ignore(refresh());
  var my_win = create_newwin(height, width, starty, startx);
  var ch = getch();
  LEFT := int$ord$char$ 'j'; RIGHT := int$ord$char$ 'k';
  UP := int$ord$char$ 'i'; DOWN := int$ord$char$ 'm';
  while not ch == KEY_F1 do
    match ch with
    |$(KEY_LEFT) =>
      destroy_win(my_win); startx = startx - 1;
      my_win = create_newwin(height, width, starty,startx);
    |$(KEY_RIGHT) =>
      destroy_win(my_win); startx = startx + 1;
      my_win = create_newwin(height, width, starty,startx);
    |$(KEY_UP) =>
      destroy_win(my_win); starty = starty - 1;
      my_win = create_newwin(height, width, starty,startx);
    |$(KEY_DOWN) =>
      destroy_win(my_win); starty = starty + 1;
      my_win = create_newwin(height, width, starty,startx);
    |$(KEY_F2) =>
      destroy_win(my_win); width = if width > 2 then width - 1 else width endif;
      my_win = create_newwin(height, width, starty,startx);
    |$(KEY_F3) =>
      destroy_win(my_win); width = if COLS() > width then width + 1 else width endif;
      my_win = create_newwin(height, width, starty,startx);
    |$(KEY_F4) =>
      destroy_win(my_win); height = if height > 2 then height - 1 else height endif;
      my_win = create_newwin(height, width, starty,startx);
    |$(KEY_F5) =>
      destroy_win(my_win); height = if LINES() > height then height + 1 else height endif;
      my_win = create_newwin(height, width, starty,startx);
    |_ => {}();
    endmatch;
    ch = getch();
  done
  ignore(endwin());                   /* End curses mode                */



fun create_newwin(height:int, width:int, starty:int, startx:int) = {
  local_win := newwin(height, width, starty, startx);
  ignore(box(local_win, 0ui , 0ui));  /* 0, 0 gives default characters
                                       * for the vertical and horizontal
                                       * lines                        */
  ignore(wrefresh(local_win));                /* Show that box                */
  return local_win;
}

proc destroy_win(local_win:WINDOW) {
  /* box(local_win, ' ', ' '); : This won't produce the desired
   * result of erasing the window. It will leave it's four corners
   * and so an ugly remnant of window.
   */
  var borderch = uint$ord$char$ ' ';
  ignore(wborder(local_win,borderch ,borderch ,borderch ,borderch,
                 borderch,borderch ,borderch ,borderch));
  /* The parameters taken are
   * 1. win: the window on which to operate
   * 2. ls: character to be used for the left side of the window
   * 3. rs: character to be used for the right side of the window
   * 4. ts: character to be used for the top side of the window
   * 5. bs: character to be used for the bottom side of the window
   * 6. tl: character to be used for the top left corner of the window
   * 7. tr: character to be used for the top right corner of the window
   * 8. bl: character to be used for the bottom left corner of the window
   * 9. br: character to be used for the bottom right corner of the window
   */
  ignore(wrefresh(local_win));
  ignore(delwin(local_win));
}

//[unix_ncurses.fpc]
Description: ncurses library
provides_slib: -lncurses
provides_dlib: -lncurses
includes: '"ncurses.h"'

Tools

Contents:

Package: src/packages/buildtools.fdoc

Tools For building Felix

key file
flx_build_flxg.flx $PWD/src/tools/flx_build_flxg.flx
flx_build_prep.flx $PWD/src/tools/flx_build_prep.flx
flx_build_rtl.flx $PWD/src/tools/flx_build_rtl.flx
flx_build_boot.flx $PWD/src/tools/flx_build_boot.flx
build_boot.fpc $PWD/src/config/build_boot.fpc

Tools to build the core Felix system.

These tools are written in Felix and can be used to build a Felix installation. However of course you must first have a working installation to do this.

Building the compiler flxg

Run this one first to build the compiler. It is built directly from the repository.

//[flx_build_flxg.flx]
class BuildFlxg
{


  // remove slosh-newline
  fun pack(s:string) = {
    var slosh = false;
    var space = true;
    var out = "";
    for ch in s do
      if ch == char "\n" and slosh do slosh = false;
      elif ch == char "\\" do slosh=true;
      elif slosh do slosh=false; out+="\\"; out+=ch;
      elif ch == "\t" do out+=char ' '; space=true;
      elif ch == ' ' and space do ;
      elif ch == ' ' do out+=ch; space=true;
      else out+=ch; space=false;
      done
    done
    return out;
  }

  fun version_hook () = {
    var time = #Time::time;
    //var fmttime = fmt_time (time, "%a %d %b %Y");
    var fmttime = time.str; // Its just arbitrary text
    return
      "open Flx_version\n" +
      "let version_data: version_data_t = \n" +
      "{\n" +
      '  version_string = "' + Version::felix_version + '";\n' +
      '  build_time_float = '+ str time + ';\n'+
      '  build_time = "' + fmttime + '";\n'+
      "}\n" +
      ";;\n" +
      "let set_version () = \n" +
      "  Flx_version.version_data := version_data\n" +
      ";;\n"
    ;
  }

  fun first (a:string, b:string) => a;
  fun second (a:string, b:string) => b;
  proc build_flx_drivers()
  {
    var tmpdir = 'build/flxg-tmp';
    fun entmp (a:string) => if prefix (a,tmpdir) then a else tmpdir/a;

    C_hack::ignore$ Directory::mkdir tmpdir;

    // make the version hook file
    begin
      var path = tmpdir/"flx_version_hook";
      Directory::mkdirs path;
      var f = fopen_output (path/"flx_version_hook.ml");
      write (f, #version_hook);
      fclose f;
    end

    var db = strdict[bool]();
    typedef db_t = strdict[bool];

    var sorted_libs = Empty[string];

    fun libdflt () => (
      srcs=Empty[string],
      libs=Empty[string],
      includes=Empty[string],
      external_libs=Empty[string]
    );

    typedef libspec_t = typeof (#libdflt);

    fun exedflt () => libdflt();
    typedef exespec_t = typeof (#exedflt);

    fun lexdflt () => (flags=Empty[string]);
    typedef lexspec_t = typeof (#lexdflt);

    fun yaccflt () => (flags=Empty[string]);
    typedef yaccspec_t = typeof (#lexdflt);

    fun dypgendflt () => (flags=Empty[string]);
    typedef dypgenspec_t = typeof (#dypgendflt);

    gen ocamldep (dir:string, src:string) = {
      var result, dep = Shell::get_stdout$ list$ "ocamldep.opt", "-native","-I", Filename::dirname src, "-I", dir, "-I", tmpdir, src;
      if result != 0 do
        println$ "Ocamldep failed to process " + src;
        System::exit (1);
      done
      //println$ "Ocamldep raw return = " + dep;
      var out = dep.pack.strip;
      //println$ "Ocamldep packed return = " + out;
      var lines = filter (fun (s:string) => stl_find (s,".cmo") == stl_npos) (split(out,"\n"));
      //println$ "Ocamldep lines = " + str lines;
      var res = head lines;
      //println$ "ocamldep result=" + res;
      var pos = stl_find (res, ":");
      if pos == stl_npos do
        println$ "Cannot find ':' in string " + res;
        System::exit 1;
      done
      res = res.[pos+2 to].strip;
      //println$ "ocamldep result 2 =" + res;
      var dfiles = split(res,' ');
      //println$ "ocamldep result 3 =" + str dfiles;
      dfiles = map (fun (s:string) = { //println$ "Extension swap case '" + s+"'";
        match Filename::get_extension s with
        | ".cmi" => return Filename::strip_extension s + ".mli";
        | ".cmx" => return Filename::strip_extension s + ".ml";
        | "" => return "";
        | x => return  "ERROR" ;
        endmatch;
        })
        dfiles
      ;
      //println$ "ocamldep result 4 =" + str dfiles;
      dfiles = filter (fun (s:string) => s != "") dfiles;
      return dfiles;
    }

    variant build_kind = Library | Executable;

    gen ocaml_build(kind:build_kind, dir:string, lib:string, spec:libspec_t) =
    {
      var safe_string_flag =
        if lib == "dypgen.exe"
        then "-unsafe-string"
        else "-safe-string"
      ;
      println$ "-" * 20;
      println$ "Lib=" + lib + " in " + dir;
      println$ "Safe-string-flag=" + safe_string_flag;
      println$ "-" * 20;
      //println$ "srcs = \n    " +strcat "\n    " spec.srcs;
      println$ "libs= \n    " + strcat "\n    " spec.libs;
      println$ "includes= \n" + strcat "\n    " spec.includes;
      /*
      println$ "external libs = \n    " + strcat "\n    " spec.external_libs;
      println$ "-" * 20;
      println$ "";
      */

      // copy the list of files, processing dyp, mll, and mly files we encounter.
      var infiles = spec.srcs;
      var files = Empty[string];
      for file in infiles do
        match Filename::get_extension file with
        | ".mli" => files += file;
        | ".ml" => files += file;
        | ".dyp" => files += dypgen file;
        | ".mll" => files += ocamllex file;
        | ".mly" => var out = ocamlyacc file; files += out+".ml"; files += out+".mli";
        endmatch;
      done

      var sorted_files = Empty[string];
      begin
        // calculate dependencies
        var db = strdict[list[string]]();
        for file in files do
          var deps = ocamldep (dir,file);
          deps = filter (fun (f:string) => f in files) deps;
          db.add file deps;
          //println$ "Ocamldep : " + src + " : " + str deps;
        done

        // topological sort
        var count = 0;
        while not files.is_empty do
          ++count;
          if count > 40 do
            println$ "Invalid file or circular reference";
            System::exit 1;
          done
          var unsorted = Empty[string];
          for file in files do
            match db.get file with
            | Some dps =>
              if dps \subseteq sorted_files do
                sorted_files = file + sorted_files;
              else
                unsorted = file + unsorted;
              done
            | #None => assert false;
            endmatch;
          done
          files = unsorted;
        done
        sorted_files = rev sorted_files;
        //println$ "Library build order: " + str sorted_files;
      end

      // compile the files
      var include_flags = fold_left (fun (acc:list[string]) (a:string) => acc+"-I"+entmp a) Empty[string] spec.libs;
      for file in sorted_files do
        var path = tmpdir/(Filename::dirname file);
        Directory::mkdirs path;
        match Filename::get_extension file with
        | ".mli" =>
          println$ "Compiling MLI " + file;
          begin
            var result = Shell::system$ list(
               "ocamlc.opt",
               "-I",tmpdir,
               "-I",tmpdir/dir,
               "-I", entmp (Filename::dirname file)) +
               include_flags + safe_string_flag +
               list("-c", "-w",'yzex','-warn-error',"FPSU",
               '-o',entmp (Filename::strip_extension file) + ".cmi",
               file)
            ;
            if result != 0 do
              println$ "MLI Compile Failed : " + file;
              System::exit 1;
            done
          end
        | ".ml" =>
          println$ "Compiling ML  " + file;
          begin
            var result = Shell::system$ list(
               "ocamlopt.opt",
               "-I",tmpdir,
               "-I",tmpdir/dir,
               "-I", entmp (Filename::dirname file)) +
               include_flags + safe_string_flag +
               list("-c", "-w",'yzex','-warn-error',"FPSU",
               '-o',entmp (Filename::strip_extension file) + ".cmx",
               file)
            ;
            if result != 0 do
              println$ "ML Compile Failed : " + file;
              System::exit 1;
            done
          end
        | x => println$ "Ignoring " + file;
        endmatch;
      done

      match kind with
      | #Library =>
        begin
          // link files into library
          println$ "Linking library " + tmpdir/lib + ".cmxa";
          sorted_libs = sorted_libs + (tmpdir/lib+ ".cmxa");
          var result = Shell::system$ "ocamlopt.opt" + list(
            "-a", "-w",'yzex','-warn-error',"FPSU",
            '-o',tmpdir/lib + ".cmxa") +
            map
              (fun (s:string) => entmp (Filename::strip_extension s) + ".cmx")
              (filter (fun (s:string)=> Filename::get_extension s == ".ml") sorted_files)
          ;
          if result !=0 do
            println$ "Linking cmxa library " + tmpdir/lib+'.cmxa' + " failed";
            System::exit 1;
          done
        end
      | #Executable =>
        begin
          // link files into executable
          println$ "Linking executable " + tmpdir/lib;
          var result = Shell::system$ "ocamlopt.opt" + list(
             "-w",'yzex','-warn-error',"FPSU",
            '-o',tmpdir/lib ) + spec.external_libs + sorted_libs +
            map
              (fun (s:string) => entmp (Filename::strip_extension s) + ".cmx")
              (filter (fun (s:string)=> Filename::get_extension s == ".ml") sorted_files)
          ;
          if result !=0 do
            println$ "Linking executable " + tmpdir/lib+ " failed";
            System::exit 1;
          done
        end
      endmatch;

      // return the directory containing the library source.
      return dir;
    }

    gen ocaml_build_lib (dir:string, lib:string, spec:libspec_t) =>
      ocaml_build(Library,dir,lib,spec)
    ;

    gen ocaml_build_exe (dir:string, lib:string, spec:libspec_t) =>
      ocaml_build(Executable,dir,lib,spec)
    ;


    // src, including .mll suffix, dst: including .ml suffix
    gen ocamllex (file:string) : string =
    {
      var out = entmp (file.Filename::basename.Filename::strip_extension + ".ml");
      var result = Shell::system$ list$ 'ocamllex.opt','-o',out,file;
      if result != 0 do
        println$ "Ocamllex failed to process " + file;
        System::exit (1);
      done
      return out;
    }

    // src, including .mly suffix, dst: excluding suffices
    gen ocamlyacc(file:string) : string =
    {
      var out = entmp (file.Filename::basename.Filename::strip_extension);
      var result = Shell::system('ocamlyacc.opt','-b'+out,file);
      if result != 0 do
        println$ "Ocamlyacc failed to process " + file;
        System::exit (1);
      done
      return out;
    }

    // executable: the dypgen executable name
    // src: including .dyp suffix
    // tmpdir: directory for target .ml, .mli files
    gen dypgen(file:string) : string =
    {
      var flags = list$ "--no-mli", "--no-undef-nt", "--pv-obj", "--noemit-token-type";
      var executable = tmpdir / 'dypgen.exe';

      // Dypgen doesn't allow an output spec
      // so we process a copy of the file.
      var dyp = entmp (file.Filename::basename);
      C_hack::ignore$ FileSystem::filecopy (file, dyp);
      var result = Shell::system(executable + flags +  dyp);
      if result != 0 do
        println$ "dypgen failed to process " +file;
        System::exit (1);
      done
      return dyp.Filename::strip_extension+".ml";
    }

    gen build_dypgen() =
    {
      var path = 'src'/'compiler'/'dypgen'/'dypgen';
      var exe = ocaml_build_exe (path,'dypgen.exe',
         extend #libdflt with (srcs=mls_nodyp path,
            libs = list[string] (build_dyplib())
            ) end);
      println$ "Done, exe = " + exe;
      return exe;
    }
    //----------------------------------------------------------------------------------

    fun / (a:string, b:string) => Filename::join (a,b);

    gen mls (d:string) = {
      var files = FileSystem::regfilesin (d, RE2 '.*\\.(mli?|dyp|mll|mly)');
      return map (fun (f:string) = { return d/f;}) files;
    }

    gen mls_nodyp (d:string) = {
      var files = FileSystem::regfilesin (d, RE2 '.*\\.(mli?|mll|mly)');
      return map (fun (f:string) = { return d/f;}) files;
    }


    gen build_ocs() =
    {
      var path = ('src'/'compiler'/'ocs'/'src');
      if db.haskey path do return path; done
      db.add path true;
      return ocaml_build_lib(path, 'ocs',
          extend #libdflt with (srcs=mls path) end);
    }

    gen build_sex() =
    {
      var path = ('src'/'compiler'/'sex');
      if db.haskey path do return path; done
      db.add path true;
      return ocaml_build_lib(path, 'sex',
          extend #libdflt with (srcs=mls path,
          libs=list[string] (build_dyplib(), build_ocs())) end);
    }

    gen build_dyplib() =
    {
      var path = ('src'/'compiler'/'dypgen'/'dyplib');
      if db.haskey path do return path; done
      db.add path true;

      return ocaml_build_lib(path, 'dyp',
          extend #libdflt with (srcs=mls path) end);
    }

    gen build_flx_version() = {
        var path = ('src'/'compiler'/'flx_version');
        if db.haskey path do return path; done
        db.add path true;

        return ocaml_build_lib(path, 'flx_version',
            extend #libdflt with (srcs=mls path) end);
    }

    gen build_flx_misc() = {
        var path = 'src'/'compiler'/'flx_misc';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_misc',
            extend #libdflt with (srcs=mls path,
            libs=list[string] (build_flx_version()),
            external_libs=list[string]('str', 'unix')) end);
    }

    gen build_flx_version_hook() = {
        var path = tmpdir/'flx_version_hook';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_version_hook',
            extend #libdflt with (srcs=mls path,
            libs=list[string](build_flx_version())) end);
    }

    gen build_flx_lex() = {
        var path = 'src'/'compiler'/'flx_lex';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path,'flx_lex',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_dyplib(),
                build_ocs(),
                build_sex(),
                build_flx_version())) end);
    }

    gen build_flx_parse() = {
        var path = 'src'/'compiler'/'flx_parse';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path,'flx_parse',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_dyplib(),
                build_ocs(),
                build_sex(),
                build_flx_version(),
                build_flx_lex())) end);
    }

    gen build_flx_file() = {
        var path = 'src'/'compiler'/'flx_file';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path,'flx_file',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_dyplib(),
                build_ocs(),
                build_sex(),
                build_flx_version(),
                build_flx_misc(),
                build_flx_lex(),
                build_flx_parse()
                )) end);
    }

    gen build_flx_core() = {
        var path = 'src'/'compiler'/'flx_core';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_core',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_dyplib(),
                build_ocs(),
                build_flx_lex(),
                build_flx_parse(),
                build_flx_misc()
                ),
            external_libs=list[string]()) end);
    }

    gen build_flx_desugar() = {
        var path = 'src'/'compiler'/'flx_desugar';
        if db.haskey path do return path; done
        db.add path true;

        return ocaml_build_lib(path, 'flx_desugar',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_dyplib(),
                build_ocs(),
                build_sex(),
                build_flx_lex(),
                build_flx_parse(),
                build_flx_file(),
                build_flx_misc(),
                build_flx_core(),
                build_flx_version()
                ),
            external_libs=list[string]('unix')) end);
    }

    gen build_flx_bind() = {
        var path = 'src'/'compiler'/'flx_bind';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_bind',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_flx_lex(),
                build_flx_misc(),
                build_flx_core(),
                build_flx_desugar()),
            external_libs=list[string]()) end);
    }

    gen build_flx_frontend() = {
        var path = 'src'/'compiler'/'flx_frontend';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_frontend',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_flx_lex(),
                build_flx_misc(),
                build_flx_core())) end);
    }

    gen build_flx_opt() = {
        var path = 'src'/'compiler'/'flx_opt';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_opt',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_flx_lex(),
                build_flx_misc(),
                build_flx_core(),
                build_flx_frontend())) end);
    }

    gen build_flx_lower() = {
        var path = 'src'/'compiler'/'flx_lower';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_lower',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_flx_lex(),
                build_flx_misc(),
                build_flx_core(),
                build_flx_frontend())) end);
    }

    gen build_flx_backend() = {
        var path = 'src'/'compiler'/'flx_backend';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_backend',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_flx_lex(),
                build_flx_misc(),
                build_flx_core())) end);
    }

    gen build_flx_cpp_backend() = {
        var path = 'src'/'compiler'/'flx_cpp_backend';
        if db.haskey path do return path; done
        db.add path true;
        return ocaml_build_lib(path, 'flx_cpp_backend',
            extend #libdflt with (srcs=mls path,
            libs=list[string](
                build_flx_lex(),
                build_flx_misc(),
                build_flx_core(),
                build_flx_frontend(),
                build_flx_backend()),
            external_libs=list[string]()) end);
    }

    println$ "Build dypgen";
    C_hack::ignore$ build_dypgen();
    var libs = list (
          build_ocs(),
          build_sex(),
          build_dyplib(),
          build_flx_version(),
          build_flx_lex(),
          build_flx_parse(),
          build_flx_misc(),
          build_flx_file(),
          build_flx_core(),
          build_flx_desugar(),
          build_flx_bind(),
          build_flx_frontend(),
          build_flx_opt(),
          build_flx_lower(),
          build_flx_backend(),
          build_flx_cpp_backend(),
          build_flx_version_hook()
    );

    var external_libs = list('unix.cmxa', 'str.cmxa');
    C_hack::ignore$ libs;
    var path ='src'/'compiler'/'flxg';
    var exe = ocaml_build_exe (path,'flxg',
            extend #libdflt with (srcs=mls path,
            libs = libs,
            external_libs=external_libs) end);
    println$ "Done, exe = " + exe;
  } // end build_drivers
} // end class


BuildFlxg::build_flx_drivers();
Preparation for building.

This tools copies things out of the repository and sets up the build target directory.

//[flx_build_prep.flx]
include "std/felix/flx_cp";

class FlxPrepBuild
{

  fun / (x:string,y:string) => Filename::join(x,y);

  proc dirsetup(cmd:cmd_type)
  {
    // NOTE: unlink doesn't work on directories anyhow ...
    // We need rmdir(), but that doesn't work unless dir is empty!
    //FileSystem::unlink("trial-tmp");

    if cmd.clean_target_dir do
       println$ "Deleting target-dir=" + cmd.target_dir;
       FileSystem::unlink(cmd.target_dir);
    elif cmd.clean_target_bin_dir do
       println$ "Deleting target-bin=" + cmd.target_dir/cmd.target_bin;
       FileSystem::unlink(cmd.target_dir/cmd.target_bin);
    elif cmd.clean_target_bin_binaries do
      println$ "Cleaning binaries out of target not implemented";
    done

    C_hack::ignore$ Directory::mkdir(cmd.target_dir);
    C_hack::ignore$ Directory::mkdir(cmd.target_dir/cmd.target_bin);
    C_hack::ignore$ Directory::mkdir(cmd.target_dir/cmd.target_bin/'bin');

    // Set up the share subdirectory.
    if cmd.copy_repo do
      if cmd.repo != cmd.target_dir/'share' do
        println$ "Copy repository "+cmd.repo/'src -> ' + cmd.target_dir/'share'/'src';
        CopyFiles::copyfiles(cmd.repo/'src',
         '(.*\.(h|hpp|ml|mli|c|cpp|cxx|cc|flx|flxh|fdoc|fsyn|js|html|css|svg|png|gif|jpg|files|include|ttf))',
         cmd.target_dir/'share'/'src'/'${1}',true,cmd.debug);
      else
        println$ "Cannot copy repo because source = target";
      done
    done

    if cmd.copy_library do
      println$ "Copy Felix library";
      CopyFiles::copyfiles (cmd.target_dir/'share'/'src'/'lib', r"(.*\.(flx|flxh|fsyn|fdoc|files))",
        cmd.target_dir/'share'/'lib/${1}',true,cmd.debug);
    done

    // This is SPECIAL because "version.flx" is the only file which is both
    // shared-readonly and generated. So it has to be copied out of an
    // existing built library not the repository dir.
    // TODO: generate it using, say, flx or flxg.
    if cmd.copy_version do
      if cmd.source_dir != cmd.target_dir do
        CopyFiles::copyfiles (cmd.source_dir/'share'/'lib'/'std', '(version.flx)',
          cmd.target_dir/'share'/'lib'/'std/${1}',true,cmd.debug);
      else
        println$ "Cannot copy version because source = target";
      done
    done

    if cmd.copy_pkg_db do
      if cmd.source_dir/cmd.source_bin != cmd.target_dir/cmd.target_bin do
        println$ "Copy config db";
        CopyFiles::copyfiles(cmd.source_dir/cmd.source_bin/'config', '(.*)',
          cmd.target_dir/cmd.target_bin/'config'/'${1}',true,cmd.debug);
      else
        println$ "Cannot copy config db because source = target";
      done
    done

    if cmd.copy_config_headers do
      if cmd.source_dir/cmd.source_bin != cmd.target_dir/cmd.target_bin do
        println$ "Copy rtl config headers";
        CopyFiles::copyfiles(cmd.source_dir/cmd.source_bin/'lib', r"(.*\.(h|hpp|flx|flxh))",
          cmd.target_dir/cmd.target_bin/'lib'/'${1}',true,cmd.debug);
      else
        println$ "Cannot copy rtl config headers because source = target";
      done
    done

    // configure and db copy are exclusive
    if cmd.configure do
      println$ 'Generating Configuration';
      if cmd.compiler not in ('gcc', 'clang', 'msvc') do
        println$ 'ERROR: Configuration compiler must be gcc,clang or msvc';
        System::exit 1;
      done
      if cmd.os not in ('linux', 'macosx', 'win') do
        println$ 'ERROR: Configuration os must be linux,macosx or win';
        System::exit 1;
      done
      if cmd.bits not in ('32', '64') do
        println$ 'ERROR: Configuration bits musty be 32 or 64';
        System::exit 1;
      done
      if cmd.os == 'win' and cmd.bits == '32' do
        println$ 'ERROR: Only 64 bit windows is supported';
        System::exit 1;
      done

      // setup fpc's to copy: ORDER MATTERS!
      var fpcs = ([ '([^/]*\\.fpc)']);
      if cmd.os in ('linux','macosx') do
        fpcs +=  'unix'/'([^/]*\\.fpc)';
        fpcs +=  ('unix'+cmd.bits)/'([^/]*\\.fpc)';
      done
      fpcs += cmd.os/'([^/]*\\.fpc)';
      fpcs += (cmd.os+cmd.bits)/'([^/]*\\.fpc)';
      fpcs += cmd.os/'([^/]*\\.fpc)';

      // Felix platform macro
      var fmacs = ([cmd.os+'/([^/]*\\.flxh)']);

      // setup header files to copy
      // os/bits/compiler config
      var headers = ([(cmd.os+cmd.bits)/cmd.compiler/'rtl'/'([^/]*\\.hpp)']);
      // socket config
      headers += (cmd.os+cmd.bits)/'rtl'/'([^/]*\\.hpp)';

      // do the copying
      println$ 'Copying fpcs ..';
      for pattern in fpcs perform
        CopyFiles::copyfiles(cmd.repo/'src'/'config', pattern,
          cmd.target_dir/cmd.target_bin/'config'/'${1}',true,cmd.debug);
      println$ 'Copying platform macro ..';
      for pattern in fmacs perform
        CopyFiles::copyfiles(cmd.repo/'src'/'config', pattern,
          cmd.target_dir/cmd.target_bin/'lib'/'plat'/'${1}',true,cmd.debug);
      println$ 'Copying C++ headers ..';
      for pattern in headers perform
        CopyFiles::copyfiles(cmd.repo/'src'/'config', pattern,
          cmd.target_dir/cmd.target_bin/'lib'/'rtl'/'${1}',true,cmd.debug);

      if cmd.c_compiler != "" do begin
        println$ 'Specifying C compiler executable ' + cmd.c_compiler;
        var fn = cmd.target_dir/cmd.target_bin/'config'/"toolchain_"+cmd.compiler+"_"+cmd.os+"_c_compiler_executable.fpc";
        var txt = (["compiler: " + cmd.c_compiler]);
        save (fn,txt);
      end done

      if cmd.cxx_compiler != "" do begin
        println$ 'Specifying C++ compiler executable ' + cmd.cxx_compiler;
        var fnam = cmd.target_dir/cmd.target_bin/'config'/"toolchain_"+cmd.compiler+"_"+cmd.os+"_cxx_compiler_executable.fpc";
        var txt = (["compiler: " + cmd.cxx_compiler]);
        save (fnam,txt);
      end done
    done

    if cmd.setup_pkg != "" do
      var setupdata = load cmd.setup_pkg;
      var commands = split(setupdata,"\n");
      var lineno = 0;
      for command in commands do
        //println$ "Command=" + command;
        ++lineno;
        var hsrc, hdst = "","";
        match split (command, ">") with
        | #Empty => ;
        | Cons (h,#Empty) => hsrc = strip h;
        | Cons (h,Cons (d,#Empty)) => hsrc = strip h; hdst = strip d;
        | _ =>
           println$ "[flx_build_prep:setup-pkg] file too many > characters file: "+
           cmd.setup_pkg +"["+lineno.str+"] " + command;
        endmatch;

        if hsrc != "" do
          if hdst == "" do hdst = "${0}"; done
          println$ "Copying files " + hsrc + " > " + hdst;
          //println$ "From source directory " + cmd.source_dir;
          //println$ "To target directory " + cmd.target_dir/cmd.target_bin;
          CopyFiles::copyfiles (cmd.source_dir, hsrc,cmd.target_dir/cmd.target_bin/hdst,true, true);
        done
      done
    done
  }

  proc flx_build(cmd: cmd_type)
  {
    dirsetup(cmd);
    // copy the compiler
    var compiler_name = "flxg";
    if PLAT_WIN32 do
       compiler_name += ".exe";
    done
    if cmd.copy_compiler call CopyFiles::copyfiles(cmd.source_dir/cmd.source_bin/'bin', compiler_name,
      cmd.target_dir/cmd.target_bin/'bin'/'flxg', true, cmd.debug);

    println$ "Build Complete";
  }

  proc print_help()
  {
    println$ "flx_build_prep v2018.09.22";
    println$ "Usage: flx_build_prep ";
    println$ "";
    println$ "# locations";
    println$ "";
    println$ "  --repo=repo                 default: src";
    println$ "  --target-dir=target_dir     default: build/trial";
    println$ "  --target-bin=target_bin     default: host";
    println$ "  --source-dir=source_dir     default: build/release";
    println$ "  --source-bin=source_bin     default: host";
    println$ "";
    println$ "# configuration";
    println$ "";
    println$ "  --configure                 generate configuration";
    println$ "  --compiler=(gcc/clang/msvc) no default!";
    println$ "  --os=(linux/macosx/win)     no default!";
    println$ "  --bits=(32/64)              defaut 64";
    println$ "  --c-compiler=               default std compiler name";
    println$ "  --cxx-compiler=             default std compiler name";

    println$ "";
    println$ "# cleaning options";
    println$ "";
    println$ "  --clean-target-dir          delete entire target directory";
    println$ "  --clean-target-bin-dir      delete target sub-directory";
    println$ "  --clean-target-bin-binaries delete binaries from target sub-directory (not implemented yet)";
    println$ "";
    println$ "# copy options";
    println$ "";
    println$ "  --copy-repo                 copy src dir of repository";
    println$ "  --copy-compiler             copy compiler flxg";
    println$ "  --copy-pkg-db               copy package database";
    println$ "  --copy-config-headers       copy C++ config headers (NO LONGER OF ANY USE!)";
    println$ "  --copy-version              copy Felix version file";
    println$ "  --copy-library              copy Felix library";
    println$ "";
    println$ "# selective setup of pkg-db";
    println$ "  --setup=pkg                 setup using file";
    println$ "  --toolchain=toolchain       specify toolchain to use";
    println$ "  --debug                     do stuff verbosely";
    println$ "";
    println$ "# Environment variables";
    println$ "";
    println$ "FLX_SHELL_ECHO=1              echo all shell callouts (system, popen)";
    println$ "FLX_DEBUG_FLX=1               make 'flx' explain its processing decisions";
    println$ "BUILD_FLX_TOOLCHAIN_FAMILY=family   family=gcc or family=clang";
    println$ "";
    println$ "Purpose: setup new Felix target";
    println$ "";
    println$ "Requires repository directory $repo contain subdirectory 'src'";
    println$ "Requires directory $source_dir contain subdirectory $source_bin which contains program 'flxg'";
    println$ "Ensures target_dir contains:";
    println$ "";
    println$ "  (a) Repository source in $target_dir/share/src";
    println$ "  (b) config db, C++ headers, libraries in $target_dir/$target_bin/*";
    println$ "";
    println$ "Copies version, flxg, config db, and C++ headers from $source_dir if required";
  }

  proc setup_toolchain(var toolchain:string, pkgdir:string)
  {
    // if the toolchain is specified, fix it
    if toolchain != "" do
      begin
        println$ "Write toolchain " + toolchain + " into package " + pkgdir/'toolchain.fpc';
        Directory::mkdirs pkgdir;
        var f = fopen_output (pkgdir/'toolchain.fpc');
        write (f,"toolchain: " + toolchain +"\n");
        fclose f;
      end
      println$ "WRITING SPECIFIED TOOLCHAIN PACKAGE: ****************************";
    elif FileStat::fileexists (pkgdir/'toolchain.fpc') do
      println$ "USING EXISTING TOOLCHAIN PACKAGE: ****************************";
    else // guess toolchain and write it
      var res, os = Shell::get_stdout("uname");
      &os <- os.strip;
      var compiler_family = Env::getenv "BUILD_FLX_TOOLCHAIN_FAMILY";
      match os,compiler_family do
      | "","" => &toolchain <- "toolchain_mscv_win";
      | "Linux","" => &toolchain <- "toolchain_gcc_linux";
      | "Darwin","" => &toolchain <- "toolchain_clang_macosx";

      | "Linux","gcc" => &toolchain <- "toolchain_gcc_linux";
      | "Linux","clang" => &toolchain <- "toolchain_clang_linux";
      | "Darwin","gcc" => &toolchain <- "toolchain_gcc_macosx";
      | "Darwin","clang" => &toolchain <- "toolchain_clang_macosx";

      | _,_ =>
        println$ "No toolchain specified in toolchain.fpc or with --toolchain switch";
        println$ "  uname returns unknown OS: '" +os+'"';
        println$ "Either:";
        println$ "  (1) Set environment variable BUID_FLX_TOOLCHAIN_FAMILY=family where family=gcc or family=clang";
        println$ "  (2) Set the toolchain.fpc file to read 'toolchain:toolchain_name";
        println$ "  (3) use --toolchain=toolchain_name command line option";
        println$ "  Note:toolchain name is form 'toolchain_<family>_<os>'";
        println$ "    where os=Darwin or os=Linux or os=Win32";
        System::exit(1);
      done
      begin
        println$ "Write toolchain " + toolchain + " into package " + pkgdir/'toolchain.fpc';
        var f = fopen_output (pkgdir/'toolchain.fpc');
        write (f,"toolchain: " + toolchain +"\n");
        fclose f;
      end
      println$ "USING GUESSED TOOLCHAIN PACKAGE: ****************************";
    done
    println$ load (pkgdir/'toolchain.fpc');
  }

  typedef cmd_type = typeof (parse_args Empty[string]);

  noinline fun parse_args (args: list[string]) =
  {
     var cmd = (
       repo = '.',
       target_dir="build"/"trial",
       target_bin="host",
       source_dir="build"/"release",
       source_bin="host",
       toolchain="",

       clean_target_dir=false,
       clean_target_bin_dir=false,
       clean_target_bin_binaries=false,

       copy_repo=false,
       copy_compiler=false,
       copy_pkg_db=false,
       copy_config_headers=false,
       copy_version=false,
       copy_library=false,
       setup_pkg="",
       configure=false,
       compiler="notspecified",
       os="notspecified",
       bits="notspecified",
       c_compiler="",
       cxx_compiler="",
       debug = false
     );

     for arg in args do
       // location options
       if prefix(arg,"--repo=") do
         &cmd.repo <- arg.[7 to];
       elif prefix(arg,"--target-dir=") do
         &cmd.target_dir <- arg.[13 to];
       elif prefix(arg,"--target-bin=") do
         &cmd.target_bin <- arg.[13 to];
       elif prefix(arg,"--source-dir=") do
         &cmd.source_dir <- arg.[13 to];
       elif prefix(arg,"--source-bin=") do
         &cmd.source_bin <- arg.[13 to];
       elif prefix(arg,"--toolchain=") do
         &cmd.toolchain <- arg.[12 to];
       elif arg == "--debug" do
         &cmd.debug <- true;

       // operation options: cleaning
       elif arg == "--clean-target-dir" do
         &cmd.clean_target_dir <- true;
       elif arg == "--clean-target-bin-dir" do
         &cmd.clean_target_bin_dir <- true;
       elif arg == "--clean-target-bin-binaries" do
         &cmd.clean_target_bin_binaries <- true;

       // operation options: copying
       elif arg == "--copy-repo" do
         &cmd.copy_repo<- true;
       elif arg == "--copy-compiler" do
         &cmd.copy_compiler<- true;
       elif arg == "--copy-pkg-db" do
         &cmd.copy_pkg_db <- true;
       elif arg == "--copy-config-headers" do
         &cmd.copy_config_headers <- true;
       elif arg == "--copy-version" do
         &cmd.copy_version <- true;
       elif arg == "--copy-library" do
         &cmd.copy_library <- true;

       // configuration
       elif prefix(arg,"--configure") do
         &cmd.configure <-true;
       elif prefix(arg,"--compiler") do
         &cmd.compiler<- arg.[11 to];
       elif prefix(arg,"--os=") do
         &cmd.os<- arg.[5 to];
       elif prefix(arg,"--bits=") do
         &cmd.bits<- arg.[7 to];
       elif prefix(arg,"--c-compiler=") do
         &cmd.c_compiler<- arg.[13 to];
       elif prefix(arg,"--cxx-compiler=") do
         &cmd.cxx_compiler<- arg.[15 to];

       // special configuration package
       elif prefix(arg,"--setup=") do
         &cmd.setup_pkg <- arg.[8 to];

       // help
       elif arg == "--help" do
         print_help();
         System::exit(0);
       else
         println$ "Unknown switch " + arg;
         print_help();
         System::exit(1);
       done
     done


     return cmd;
  }

  noinline proc build_felix (xargs:list[string])
  {
    if xargs.len.int < 2 do
      print_help();
      System::exit(1);
    done
    var cmd = parse_args (tail xargs);
    println$ "flx_build_prep v2018.09.22";
    println$ "  repository       = " + cmd.repo;
    println$ "  target-dir       = " + cmd.target_dir;
    println$ "  target-bin       = " + cmd.target_bin;
    println$ "  source-dir       = " + cmd.source_dir;
    println$ "  source-bin       = " + cmd.source_bin;
    if cmd.configure do
      println$ "CONFIGURE compiler=" + cmd.compiler+", os=" + cmd.os + ", bits=" + cmd.bits;
      cmd&.toolchain <- "toolchain_" + cmd.compiler + "_" + cmd.os;
    done
    println$ "  setup-pkg        = " + cmd.setup_pkg;
    println$ "  toolchain (spec) = " + cmd.toolchain;
    flx_build (cmd);
    var target_config_dir = cmd.target_dir/cmd.target_bin/"config" ;
    setup_toolchain(cmd.toolchain,target_config_dir );
  }

}

FlxPrepBuild::build_felix (#System::args);

System::exit (0);
Build the Run Time Library (RTL)

Builds the run time library from the build target share directory. Does not look in the repository.

//[flx_build_rtl.flx]
include "std/felix/toolchain_config";
include "std/felix/toolchain_interface";
include "std/felix/flx_pkgconfig";
include "std/felix/flx_pkg"; // only for "fix2word_flags"
include "std/felix/flx_cp";
include "std/felix/flx/flx_depchk";
include "std/pthread/threadpool";
include "std/felix/flx_mklib";

class FlxRtlBuild
{

  private fun / (x:string,y:string) => Filename::join(x,y);

  proc ehandler () {
    eprintln$ "Flx_buildtools:FlxRtlBuild flx_pkgconfig temporary ehandler invoked";
    System::exit 1;
  }


  proc make_rtl (
    build:string, target:string,
    boot_package:string,
    tmpdir:string,
    static_only:bool,
    noexes:bool,
    debug: bool
  )
  {
    val pkgdir = build / target / 'config';
    val srtl = build / 'share' / 'lib' / 'rtl';
    val hrtl = build / target / 'lib' / 'rtl';
    val bin = build / target / 'bin';
    val repo = build / 'share'; // excludes "src" cause that's in the packages

    proc dbug (x:string) => if debug call println$ '[make_rtl] ' + x;
    Directory::mkdirs tmpdir;
    Directory::mkdirs hrtl;
    Directory::mkdirs srtl;
    println$ "bootpkg=" + boot_package + " build image=" + build;

    var db = FlxPkgConfig::FlxPkgConfigQuery (list[string] pkgdir);

    gen getbootfield (field:string) => db.getpkgfield1 ehandler (boot_package, field);
    // toolchain pkg 1
    var toolchain_name = db.getpkgfield1 ehandler ("toolchain","toolchain");

    var c_compiler_executable =
      db.getpkgfielddflt ehandler (toolchain_name+"_c_compiler_executable", "compiler")
    ;

    var cxx_compiler_executable =
      db.getpkgfielddflt ehandler (toolchain_name+"_cxx_compiler_executable", "compiler")
    ;


    println$ "toolchain    : " + str toolchain_name + ", c: "+ c_compiler_executable + ", c++: " + cxx_compiler_executable;

    var allpkgs = db.getclosure ehandler boot_package;
    //println$ "Closure      : " + str allpkgs;

    for pkg in allpkgs begin
      var lib = db.getpkgfielddflt ehandler (pkg,"library");
      var srcdir = db.getpkgfielddflt ehandler (pkg,"srcdir");
      println$ f"%15S %20S %20S" (pkg,lib,srcdir);
    end

    var toolchain-maker =
      Dynlink::load-plugin-func1 [toolchain_t,toolchain_config_t]
      (
        dll-name=toolchain_name,
        setup-str="",
        entry-point=toolchain_name
      )
    ;
    for pkg in allpkgs begin
      var library = db.getpkgfielddflt ehandler (pkg,"library");
      var srcdir = db.getpkgfielddflt ehandler (pkg,"srcdir");
      var src = db.getpkgfield ehandler (pkg,"src");
      if library != "" do
        if srcdir == "" do
          println$ "Package error, package " + pkg + " library " + library + " No srcdir specified";
          System::exit(1);
        done
        if src.is_empty do
          println$ "Package error, package " + pkg + " library " + library + " No src files specified";
          System::exit(1);
        done
        var src_dir =  build / 'share';
        var share_rtl = src_dir / 'lib' / 'rtl';
        var target_dir =  build / target / 'lib' / 'rtl';
        var result = FlxLibBuild::make_lib (db,toolchain-maker, c_compiler_executable, cxx_compiler_executable,src_dir, target_dir, share_rtl, pkg,tmpdir, static_only, debug) ();
        if not result do
          eprintln$ "Library build " + pkg + " failed";
          System::exit 1;
        done
      else
        println$ "------------";
        println$ "External package " + pkg;
        println$ "------------";
      done
    end

    // make drivers
    begin
      println$ "------------";
      println$ "Make drivers";
      println$ "------------";
      var srcdir = repo/"src"/"flx_drivers";
      var toolchain_config =
        (
          c_compiler_executable = c_compiler_executable,
          cxx_compiler_executable = cxx_compiler_executable,
          header_search_dirs= list[string] (hrtl, srcdir, srtl),
          macros= Empty[string],
          ccflags = Empty[string],
          library_search_dirs= list[string] ("-L"+hrtl),
          dynamic_libraries= Empty[string],
          static_libraries= Empty[string], //############ FIXME or the link won't work!
          debugln = dbug
        )
      ;
      fun prgname (file:string) => let
          dstprg = file.Filename::strip_extension + #(toolchain.executable_extension) in
          bin / dstprg
      ;

      var toolchain = toolchain-maker toolchain_config;
      println$ #(toolchain.whatami);
      proc cobj_static (s:string,dst:string) {
        var src = srcdir/s;
        println$ "Compiling [static] " + src + " -> " + dst;
        var fresh = cxx_depcheck (toolchain, src, dst);
        var result = if fresh then 0 else
          toolchain.cxx_static_object_compiler(src=src, dst=dst)
        ;
        if result != 0 do
          println$ "Driver compile "+ s + " -> " + dst +" FAILED";
          System::exit 1;
        done
      }
      proc cobj_dynamic (s:string,dst:string) {
        var src = srcdir/s;
        if static_only do
          println$ "Skipping [dynamic] " + src + " -> " + dst + " due to flag";
        else
          println$ "Compiling [dynamic] " + src + " -> " + dst;
          var fresh = cxx_depcheck (toolchain, src, dst);
          var result = if fresh then 0 else
            toolchain.cxx_dynamic_object_compiler(src=src, dst=dst)
          ;
          if result != 0 do
            println$ "Driver compile "+ s + " -> " + dst +" FAILED";
            System::exit 1;
          done
        done
      }

      // VERY CONFUSING!
      // This one is for full static linkage, RTL static linked
      cobj_static("flx_run_lib_static.cpp",hrtl/"flx_run_lib_static"+#(toolchain.static_object_extension));

      // This run is for linking an executable which uses the RTL dynamic linked
      cobj_dynamic("flx_run_lib_static.cpp",hrtl/"flx_run_lib_static"+#(toolchain.dynamic_object_extension));

      // This one is for loading a program as a DLL, i.e. for use in flx_run.exe
      cobj_dynamic("flx_run_lib_dynamic.cpp",hrtl/"flx_run_lib_dynamic"+#(toolchain.dynamic_object_extension));

      cobj_static("flx_arun_lib_static.cpp",hrtl/"flx_arun_lib_static"+#(toolchain.static_object_extension));
      cobj_dynamic("flx_arun_lib_static.cpp",hrtl/"flx_arun_lib_static"+#(toolchain.dynamic_object_extension));
      cobj_dynamic("flx_arun_lib_dynamic.cpp",hrtl/"flx_arun_lib_dynamic"+#(toolchain.dynamic_object_extension));

      cobj_static("flx_run_main.cxx",hrtl/"flx_run_main"+#(toolchain.static_object_extension));
      cobj_dynamic("flx_run_main.cxx",hrtl/"flx_run_main"+#(toolchain.dynamic_object_extension));

      cobj_static("flx_arun_main.cxx",hrtl/"flx_arun_main"+#(toolchain.static_object_extension));
      cobj_dynamic("flx_arun_main.cxx",hrtl/"flx_arun_main"+#(toolchain.dynamic_object_extension));

      proc prg(file:string) {
        var exe = prgname file;
        println$ "Linking [executable] " + exe;
        var objs = list (
          hrtl/file+"_lib_dynamic"+#(toolchain.dynamic_object_extension),
          hrtl/file+"_main"+#(toolchain.dynamic_object_extension)
        );
        var result,libs = db.query$ list("--rec","--keeprightmost",
          "--field=provides_dlib","--field=requires_dlibs",file);
        libs = FlxPkg::fix2word_flags libs;
        if result != 0 do
          println$ "Driver pkgconfig query for "+ file+" FAILED";
          System::exit 1;
        done
        if noexes do
          println$ "Skipping executable link due to flag";
        else
          result = toolchain.dynamic_executable_linker(srcs=objs+libs, dst=exe);
          if result != 0 do
            println$ "Driver link  "+ file+" FAILED";
            System::exit 1;
          done
        done
      }
      prg("flx_run");
      prg("flx_arun");
    end
  }

  proc flx_build(cmd: cmd_type)
  {
    make_rtl ( cmd.target_dir, cmd.target_bin, cmd.boot_package, cmd.tmp_dir, cmd.static_only, cmd.noexes, cmd.debug);
    println$ "Build Complete";
  }

  proc print_help()
  {
    println$ "Usage: flx_build_rtl ";
    println$ "";
    println$ "# locations";
    println$ "";
    println$ "  --pkg=bootpkg (default: flx_rtl_core)";
    println$ "  --target-dir=target_dir     default: build/trial";
    println$ "  --target-bin=target_bin     default: host";
    println$ "  --tmp-dir=tmp               default: build/rtl-tmp";
    println$ "  --static                    static link libraries only";
    println$ "  --noexes                    libraries only";
    println$ "";
    println$ "  --debug                     do stuff verbosely";
    println$ "";
    println$ "# Environment variables";
    println$ "";
    println$ "FLX_SHELL_ECHO=1              echo all shell callouts (system, popen)";
    println$ "FLX_DEBUG_FLX=1               make 'flx' explain its processing decisions";
    println$ "";
    println$ "Purpose: Build new Felix target";
    println$ "";
    println$ "Ensures target_dir contains:";
    println$ "";
    println$ "  (a) Repository source in $target_dir/share/src";
    println$ "  (b) Share library in $target_dir/share/lib";
    println$ "  (c) config db, C++ headers, libraries and executables in $target_dir/$target_bin/*";
    println$ "";
    println$ "Compiles all C++ sources to libraries and executables";
  }

  typedef cmd_type = typeof (parse_args Empty[string]);

  noinline fun parse_args (args: list[string]) =
  {
     var cmd = (
       boot_package="",
       target_dir="build"/"trial",
       target_bin="host",
       tmp_dir="build"/"rtl-tmp",
       static_only=false,
       noexes=false,
       debug = false
     );

     for arg in args do
       // location options
       if prefix(arg,"--pkg=") do
         &cmd.boot_package <- arg.[6 to];
       elif prefix(arg,"--target-dir=") do
         &cmd.target_dir <- arg.[13 to];
       elif prefix(arg,"--target-bin=") do
         &cmd.target_bin <- arg.[13 to];
       elif prefix(arg,"--tmp-dir=") do
         &cmd.tmp_dir <- arg.[10 to];
       elif arg == "--static" do
         &cmd.static_only <- true;
       elif arg == "--noexes" do
         &cmd.noexes<- true;
       elif arg == "--debug" do
         &cmd.debug <- true;

       elif arg == "--help" do
         print_help();
         System::exit(0);
       else
         println$ "Unknown switch " + arg;
         print_help();
         System::exit(1);
       done
     done
     if cmd.boot_package== "" perform &cmd.boot_package <- "flx_rtl_core";
     return cmd;
  }

  noinline proc build_felix_rtl (xargs:list[string])
  {
    if xargs.len.int < 2 do
      print_help();
      System::exit(1);
    done
    var cmd = parse_args (tail xargs);
    println$ "flx_build_rtl v1.9";
    println$ "  build-package = " + cmd.boot_package;
    println$ "  target-dir    = " + cmd.target_dir;
    println$ "  target-bin    = " + cmd.target_bin;
    println$ "  tmp-dir       = " + cmd.tmp_dir;
    println$ "  static only   = " + cmd.static_only.str;
    println$ "  no executables= " + cmd.noexes.str;
    flx_build (cmd);
  }

}

FlxRtlBuild::build_felix_rtl (#System::args);

System::exit (0);
Build everything else.

Builds the plugins and essential build tools including flx and flx_pkgconfig and all the build tools in this package.

It uses a specified build configuration file to determine what to build. The standard file is build_boot.fpc in the configuration directory.

//[build_boot.fpc]
web_plugin:      cpp2html
web_plugin:      fdoc2html
web_plugin:      fdoc_edit
web_plugin:      fdoc_button
web_plugin:      fdoc_fileseq
web_plugin:      fdoc_heading
web_plugin:      fdoc_paragraph
web_plugin:      fdoc_scanner
web_plugin:      fdoc_slideshow
web_plugin:      toc_menu
web_plugin:      fdoc_frame
web_plugin:      flx2html
web_plugin:      fpc2html
web_plugin:      ocaml2html
web_plugin:      py2html
toolchain_plugin:      toolchain_clang_linux
toolchain_plugin:      toolchain_clang_macosx
toolchain_plugin:      toolchain_iphoneos
toolchain_plugin:      toolchain_iphonesimulator
toolchain_plugin:      toolchain_gcc_linux
toolchain_plugin:      toolchain_gcc_macosx
toolchain_plugin:      toolchain_msvc_win
tool:      flx_cp
tool:      flx_ls
tool:      flx_grep
tool:      flx_replace
tool:      flx_batch_replace
tool:      flx_tangle
tool:      flx_perror
tool:      flx_gramdoc
tool:      flx_libindex
tool:      flx_libcontents
tool:      flx_mktutindex
tool:      flx_renumber
tool:      flx_iscr
tool:      flx_pretty
flx_tool: flx_find_cxx_packages
flx_tool: flx_gen_cxx_includes
flx_tool: flx_pkgconfig
flx_tool: flx_build_prep
flx_tool: flx_build_rtl
flx_tool: flx_build_boot
flx_tool: flx_build_flxg

//[flx_build_boot.flx]
include "std/felix/toolchain_config";
include "std/felix/toolchain_interface";
include "std/felix/flx_cp";
include "std/felix/flx_pkgconfig";
include "std/felix/flx_pkg"; // only for "fix2word_flags"
include "std/felix/flx/flx_plugin_client";

class FlxCoreBuild
{

  fun / (x:string,y:string) => Filename::join(x,y);

  proc ehandler () {
    eprintln$ "Flx_buildtools:FlxCoreBuild flx_pkgconfig temporary ehandler invoked";
    System::exit 1;
  }


  proc build_plugins(target_dir:string, target_bin:string, plugins:list[string])
  {
    for plugin in plugins do
      println$ "Building plugin " + plugin;
      var result = Flx_client::runflx$ list ('[flx]',
        '--test='+target_dir, '--target='+target_bin,
        '-c', '-ox',target_dir/target_bin/'lib'/'rtl'/plugin,
        target_dir/'share'/'lib'/'plugins'/plugin);
      if result != 0 do
        println$ "plugin (dynamic) build failed";
        System::exit 1;
      done

      result = Flx_client::runflx$ list ('[flx]',
        '--test='+target_dir, '--target='+target_bin,
        '-c', '--nolink','-ox', target_dir/target_bin/'lib'/'rtl'/plugin,
        target_dir/'share'/'lib'/'plugins'/plugin);
      if result != 0 do
        println$ "plugin (dynamic obj) build failed";
        System::exit 1;
      done

      result = Flx_client::runflx$ list ('[flx]',
        '--test='+target_dir, '--target='+target_bin,
        '--static','-c', '--nolink','-ox', target_dir/target_bin/'lib'/'rtl'/plugin,
        target_dir/'share'/'lib'/'plugins'/plugin);
      if result != 0 do
        println$ "plugin (static obj) build failed";
        System::exit 1;
      done
    done

  }

  proc build_exes(target_dir:string, target_bin:string, tools:list[string])
  {
    println$ "build exes";
    for exe in tools do
      var src = Filename::join ("tools",exe);
      println$ src + " -> " + exe;
      var result = Flx_client::runflx$ list ('[flx]',
        '--test='+target_dir, '--target='+target_bin,
        '--static','-c',
        '-ox', target_dir/target_bin/'bin'/exe, target_dir/'share'/'src'/src);
      if result != 0 do
        println$ "exe build failed";
        System::exit 1;
      done
    done
  }

  proc build_flx_tools (target_dir:string, target_bin:string, tools:list[string])
  {
    println$ "build flx build tools";
    for exe in tools do
      var src = Filename::join ("tools",exe);
      println$ src + " -> " + exe;
      var result = Flx_client::runflx$ list ('[flx]',
        '--test='+target_dir, '--target='+target_bin,
        '--static','-c',
        '-ox', target_dir/target_bin/'bin'/exe, target_dir/'share'/'src'/src);
      if result != 0 do
        println$ "exe build failed";
        System::exit 1;
      done
    done
  }

  proc build_flx_web (target_dir:string, target_bin:string, web_plugins:list[string])
  {
    if PLAT_WIN32 do
      var obj_extn = "_static.obj"; // HACK!!!!!!!!
    else
      var obj_extn = "_static.o"; // HACK!!!!!!!!
    done

    println$ "dflx_web  -> dflx_web object file";
    var result = Flx_client::runflx$ list ('[flx]',
      '--test='+target_dir, '--target='+target_bin,
      '--static','-c','--nolink',
      '-o', target_dir/target_bin/'lib'/'rtl'/'dflx_web'+obj_extn, target_dir/'share'/'src'/'tools'/'dflx_web');
    if result != 0 do
      println$ "dflx_web build failed";
      System::exit 1;
    done
    var web_plugin_objs =
      map
        (fun (s:string) => target_dir/target_bin/'lib'/'rtl'/s+obj_extn)
        web_plugins
    ;

    println$ "Build flx_web. Note: requires --build-web-plugins";
    println$ "flx_web  -> flx_web executable";
    result = Flx_client::runflx$
      list (
        '[flx]',
        '--test='+target_dir, '--target='+target_bin,
        '--static','-c',
        '-ox', target_dir/target_bin/'bin'/'flx_web') +
      web_plugin_objs +
      list (
        target_dir/target_bin/'lib'/'rtl'/'dflx_web' + obj_extn,
        target_dir/'share'/'src'/'tools'/'flx_web.flx')
    ;
    if result != 0 do
      println$ "exe build failed";
      System::exit 1;
    done
  }

  proc build_flx (target_dir:string, target_bin:string, toolchain_plugins:list[string])
  {
    if PLAT_WIN32 do
      var obj_extn = ".obj"; // HACK!!!!!!!!
    else
      var obj_extn = ".o"; // HACK!!!!!!!!
    done
    println$ "dflx  -> dflx object file";
    var result = Flx_client::runflx$ list ('[flx]',
      '--test='+target_dir, '--target='+target_bin,
      '-c','--nolink', '--static',
      '-o', target_dir/target_bin/'lib'/'rtl'/'dflx'+obj_extn, target_dir/'share'/'src'/'tools'/'dflx');
    if result != 0 do
      println$ "dflx build failed";
      System::exit 1;
    done

    println$ "Compile of dflx"+obj_extn+" SUCCEEDED";

    var toolchain_objects = map (fun (p:string) =>
      target_dir/target_bin/'lib'/'rtl'/p + "_static"+obj_extn)
      toolchain_plugins
    ;

    println$ "Linking dflx"+obj_extn+" with toolchains "+toolchain_objects.str;

    println$ "Build flx. Note: requires --build-toolchain-plugins";
    println$ "flx  -> flx";
    result = Flx_client::runflx$ list ('[flx]',
      '--test='+target_dir, '--target='+target_bin,
      '--static','-c',
      '-ox', target_dir/target_bin/'bin'/'flx') + toolchain_objects +
      (target_dir/target_bin/'lib'/'rtl'/'dflx' + obj_extn) +
      (target_dir/'share'/'src'/'tools'/'flx.flx')
    ;
    if result != 0 do
      println$ "exe build failed";
      System::exit 1;
    done
    println$ "Build flx: SUCCEEDED";
  }

  proc flx_build(cmd: cmd_type)
  {
    println$ "bootpkg=" + cmd.boot_package;
    var pkgdir = Filename::join (cmd.target_dir, cmd.target_bin, "config");
    var db = FlxPkgConfig::FlxPkgConfigQuery (list[string] pkgdir);
    gen getbootfields (field:string) => db.getpkgfield  ehandler (cmd.boot_package, field);
    var toolchain_plugins = getbootfields ("toolchain_plugin");
    var cygwin_toolchain_plugins = getbootfields ("cygwin_toolchain_plugin");
    var web_plugins = getbootfields ("web_plugin");
    var flx_tools = getbootfields ("flx_tool");
    var tools = getbootfields ("tool");

    // at this point, the build proceeds using host tools, but only target sources.
    if PLAT_CYGWIN do // requires cygwin dll and headers so only on Cygwin!
      if cmd.build_toolchain_plugins call
        build_plugins(cmd.target_dir, cmd.target_bin,
        toolchain_plugins+cygwin_toolchain_plugins+"flx_plugin")
      ;
      if cmd.build_flx call
        build_flx(cmd.target_dir, cmd.target_bin, toolchain_plugins+cygwin_toolchain_plugins)
      ;
    else
      if cmd.build_toolchain_plugins call
        build_plugins(cmd.target_dir, cmd.target_bin, toolchain_plugins+"flx_plugin")
      ;
      if cmd.build_flx call
        build_flx(cmd.target_dir, cmd.target_bin, toolchain_plugins)
      ;
    done

    if cmd.build_flx_tools call build_flx_tools(cmd.target_dir, cmd.target_bin, flx_tools);
    if cmd.build_web_plugins call build_plugins(cmd.target_dir, cmd.target_bin, web_plugins);
    if cmd.build_tools call build_exes(cmd.target_dir, cmd.target_bin, tools);
    if cmd.build_flx_web call build_flx_web (cmd.target_dir, cmd.target_bin, web_plugins);
    println$ "Build Complete";
  }

  proc print_help()
  {
    println$ "Usage: flx_build_boot ";
    println$ "";
    println$ "# locations";
    println$ "";
    println$ "  --pkg=bootpkg               default: build_boot";
    println$ "  --target-dir=target_dir     default: build/release";
    println$ "  --target-bin=target_bin     default: host";
    println$ "";
    println$ "";
    println$ "# compilation options";
    println$ "";
    println$ "  --build-toolchain-plugins   Felix compile the toolchain plugins";
    println$ "  --build-flx                 Felix compile flx";
    println$ "  --build-flx-tools           Felix compile flx build tools";
    println$ "  --build-web-plugins         Felix compile the webserver plugins";
    println$ "  --build-tools               Felix compile standard tools";
    println$ "  --build-flx-web             Felix compile web server executable";
    println$ "";
    println$ "  --debug                     do stuff verbosely";
    println$ "";
    println$ "# Environment variables";
    println$ "";
    println$ "FLX_SHELL_ECHO=1              echo all shell callouts (system, popen)";
    println$ "FLX_DEBUG_FLX=1               make 'flx' explain its processing decisions";
    println$ "";
    println$ "Purpose: Build new Felix target: stuff written in Felix";
    println$ "";
    println$ "Ensures target_dir contains:";
    println$ "";
    println$ "  (a) Repository source in $target_dir/share/src";
    println$ "  (b) Share library in $target_dir/share/lib";
    println$ "  (c) config db, C++ headers, libraries and executables in $target_dir/$target_bin/*";
    println$ "";
  }

  typedef cmd_type = typeof (parse_args Empty[string]);

  noinline fun parse_args (args: list[string]) =
  {
     var cmd = (
       boot_package="",
       target_dir="build"/"release",
       target_bin="host",

       build_web_plugins=false,
       build_toolchain_plugins=false,
       build_flx=false,
       build_flx_tools=false,
       build_tools=false,
       build_flx_web=false,
       debug = false
     );

     for arg in args do
       // location options
       if prefix(arg,"--pkg=") do
         &cmd.boot_package <- arg.[6 to];
       elif prefix(arg,"--target-dir=") do
         &cmd.target_dir <- arg.[13 to];
       elif prefix(arg,"--target-bin=") do
         &cmd.target_bin <- arg.[13 to];
       elif arg == "--debug" do
         &cmd.debug <- true;

       // operation options: compilation
       elif arg == "--build-web-plugins" do
         &cmd.build_web_plugins<- true;
       elif arg == "--build-toolchain-plugins" do
         &cmd.build_toolchain_plugins<- true;
       elif arg == "--build-flx" do
         &cmd.build_flx <- true;
       elif arg == "--build-flx-tools" do
         &cmd.build_flx_tools <- true;
       elif arg == "--build-tools" do
         &cmd.build_tools<- true;
       elif arg == "--build-flx-web" do
         &cmd.build_flx_web <- true;
       elif arg == "--build-all" do
         &cmd.build_web_plugins<- true;
         &cmd.build_toolchain_plugins<- true;
         &cmd.build_flx <- true;
         &cmd.build_flx_web <- true;
         &cmd.build_flx_tools <- true;
         &cmd.build_tools<- true;
       elif arg == "--help" do
         print_help();
         System::exit(0);
       else
         println$ "Unknown switch " + arg;
         print_help();
         System::exit(1);
       done
     done

     // Note: unrelated to boot package used by flx_build_rtl
     if cmd.boot_package == "" do &cmd.boot_package <- "build_boot"; done
     return cmd;
  }

  noinline proc build_felix (xargs:list[string])
  {
    if xargs.len.int < 2 do
      print_help();
      System::exit(1);
    done
    var cmd = parse_args (tail xargs);
    println$ "flx_build_boot v1.3";
    println$ "  build_package = " + cmd.boot_package;
    println$ "  target_dir    = " + cmd.target_dir;
    println$ "  target_bin    = " + cmd.target_bin;

    flx_build (cmd);
  }

}

Flx_client::setup;
FlxCoreBuild::build_felix (#System::args);

System::exit (0);

Package: src/packages/driver.fdoc

Driver and Dynamic Linker

key file
flx_run.hpp share/lib/rtl/flx_run.hpp
flx_run.include share/src/flx_drivers/flx_run.include
flx_run_main.cxx share/src/flx_drivers/flx_run_main.cxx
flx_arun_main.cxx share/src/flx_drivers/flx_arun_main.cxx
flx_run_lib_dynamic.cpp share/src/flx_drivers/flx_run_lib_dynamic.cpp
flx_run_lib_static.cpp share/src/flx_drivers/flx_run_lib_static.cpp
flx_arun_lib_dynamic.cpp share/src/flx_drivers/flx_arun_lib_dynamic.cpp
flx_arun_lib_static.cpp share/src/flx_drivers/flx_arun_lib_static.cpp
build_iphone_rtl.sh share/src/flx_drivers/build_iphone_rtl.sh
flx_drivers.py $PWD/buildsystem/flx_drivers.py
flx_arun.fpc $PWD/src/config/flx_arun.fpc
flx_run.fpc $PWD/src/config/flx_run.fpc
flx_thread_free_run.fpc $PWD/src/config/flx_thread_free_run.fpc

Driver flx_run

Entry points

This header specifies the interface for two entry points, felix_run and felix_arun. The first provides a driver function that refuses to support asynchronous I/O, and is suitable for embedded systems. The second provides asynchronous I/O support which includes support for real time clock and sockets.

Only one of these entry points will actually be defined in a given translation unit.

//[flx_run.hpp]
int felix_run(int, char**);
int felix_arun(int, char**);
Implementation

This file contains FOUR separate sets of four callback functions and a mainline.

It is designed to be included in four stub files which set the four combinations, so common code can be shared.

These are conditioned by two boolean macros:

FLX_BUILD_FOR_STATIC_LINK:
if defined, we’re static linking if not defined, we’re dynamic linking
FLX_SUPPORT_ASYNC:
if defined 0, async support is not provided if defined non-zero, async support is provided this macro must be defined

In addition we notice these macros too:

FLX_WIN32:
if defined non-zero, we’re running Win32
FLX_HAVE_MSVC:
if defined non-zero we’re using MSVC++ compiler and SDK used to decide the name of the async library dll

NOTE: The macro “FLX_STATIC_LINK” will ALSO be defined by the toolchain. This is UNRELATED to the FLX_BUILD_FOR_STATIC_LINK macro. The FLX_STATIC_LINK macro says that all unresolved externals linking the flx_(a)_run executables are to be found in libraries statically. These executables ALWAYS dynamically load Felix DLLs using dlopen/LoadLibrary.

But the exes themselves are fully statically linked (except for C/C++ standard libraries of course). The flx_(a)run exes are univeral drivers. To make them the macro FLX_BUILD_FOR_STATIC_LINK must be undefined.

The same source code is ALSO used to statically link your program into an executable. In this case again, all the object files have to be FLX_STATIC_LINK however this time we get code produced with FLX_BUILD_FOR_STATIC link defined.

Note that a flx_run that satisfies its externals from a DLL would also be possible but we don’t build one of them. That would be PATH dependent, and the PATH might be different to the one the client DLL program requires.

 #include <cstdlib>
 #include <stdio.h>
 #include <string.h>

 #include <string>

 #include "flx_world.hpp"
 #include "flx_async_world.hpp"
 #include "flx_ts_collector.hpp"
 #include "flx_eh.hpp"

 using namespace std;
 using namespace flx::rtl;
 using namespace flx::run;

 // non async drivers don't depend on faio<-demux<-winsock
 // and so aren't linked with mswsock and ws2_32
 // Cygwin doesn't use windows sockets either
 #if !FLX_CYGWIN && FLX_WIN32 && FLX_SUPPORT_ASYNC
   #include "demux_iocp_demuxer.hpp"
   // needed to perform win socket io (calls WSAInit). Must happen
   // before iocp_demuxer is instantiated and (I assume) happen
   // only once.
   // JS: No, it can be called any number of times, provided
   // the destructor WSACleanup is called same number of times
   // Use of this RAII object ensures WSAinit/Cleanup calls balance.
   // RF: Still has to happen before any socket calls. Putting it in
   // the async object which is created on demand is already too late.
   // If that's a problem then any socket creation calls would have to
   // gratuitously make async calls.
   flx::demux::winsock_initer wsinit;
 #endif

 // Actually on Cygwin it might be cygflx_async_dynamic .. not sure
 #if !FLX_CYGWIN && FLX_HAVE_MSVC
    #define FLX_ASYNC_DLL_NAME "flx_async_dynamic"
 #else
    #define FLX_ASYNC_DLL_NAME "libflx_async_dynamic"
 #endif

 #ifdef FLX_BUILD_FOR_STATIC_LINK
 extern "C" void *flx_main;
 extern void *static_create_thread_frame;
 extern void *static_flx_start;
 #endif

 namespace flx { namespace run {

:code:`init_ptr_create_async_hooker` callback #1

CALLBACK #1 init_ptr_create_async_hooker

This is a really ugly piece of hackery!

General Felix provides async I/O which is loaded and initialised on demand, i.e. on the first use.

This is done so programs not doing socket or timer I/O don’t spawn an extra thread, and programs which do do not spawn it prematurely.

Therefore the asynchronous I/O subsystem is initially represented by a NULL pointer. When its services are required, the shared library providing them is dynamically loaded by name, and the service started.

However if static linkage is being used, the code is linked in statically instead. In this case, the load step can be skipped, but the service must still be started on demand.

Furthermore, Felix provides two drivers, flx_run and flx_arun. The former driver does not permit any asynchronous I/O. This is useful on a platform where we cannot provide these services, and it’s also useful if we want to physically guarantee that such services cannot be run.

We represent these options by using two pointers. One pointer contains a function will initialises the other. The first pointer represents the service creator, and the second the actual service.

If the creator is NULL, the service can never be started. This is the variable ptr_create_async_hooker in the config. It is set to zero if async support is disabled by conditional compilation of this driver code, used to produce flx_run, the restricted version of Felix.

If async is to be supported, then if we’re static linking we set the pointer to the service initialiser create_async_hooker which has to have been statically linked in.

If we’re dynamic linking, we load the shared library FLX_ASYNC_DLL_NAME dynamically, and use dlsym() or GetProcAddress() to fetch the service creator function from its string name.

 void init_ptr_create_async_hooker(flx_config *c, bool debug_driver) {
 #if !FLX_SUPPORT_ASYNC
   if(debug_driver)
     fprintf(stderr,"[flx_run.include]: FLX_SUPPORT_ASYNC FALSE\n");
   c->ptr_create_async_hooker = 0;
 #else
   c->ptr_create_async_hooker = create_async_hooker;
   if(debug_driver)
     fprintf(stderr,"[flx_run.include]: FLX_SUPPORT_ASYNC TRUE, create_async_hooker = %p\n", create_async_hooker);
 #ifndef FLX_BUILD_FOR_STATIC_LINK
   // Try to dynamically load the felix asynchronous library

   if(debug_driver)
     fprintf(stderr,"[flx_run.include]: dymamic_link: trying to load %s\n",FLX_ASYNC_DLL_NAME);

   FLX_LIBHANDLE async_lib = ::flx::dynlink::flx_load_module_nothrow(FLX_ASYNC_DLL_NAME);

   // Error out if we couldn't load the library.
   if (async_lib == FLX_NOLIBRARY) {
     fprintf(stderr,
       "[flx_run.include]: dynamic_link: Unable to find module '%s'\n",FLX_ASYNC_DLL_NAME);
     exit(1);
   }
   // debug only ..
   else {
     if (debug_driver)
       fprintf(stderr, "[flx_run.include]: dynamic_link: module '%s' loaded!\n",FLX_ASYNC_DLL_NAME);
   }

   // Get the hooker function
   c->ptr_create_async_hooker =
     (create_async_hooker_t*)FLX_DLSYM(async_lib, create_async_hooker);

   // Error out if we couldn't find the hooker function in the
   // library.
   if (c->ptr_create_async_hooker == NULL) {
     fprintf(stderr,
       "[flx_run.include]: dynamic_link: Unable to find symbol 'create_async_hooker' in module "
       "'%s'\n",FLX_ASYNC_DLL_NAME);
     exit(1);
   }
   // debug only
   else {
     if (debug_driver)
       fprintf(stderr, "[flx_run.include]: dynamic_link: found 'create_async_hooker'!\n");
   }
 #else
   if(debug_driver)
     fprintf(stderr,"[flx_run.include]: static_link: 'create_async_hooker' SHOULD BE LINKED IN\n");
 #endif
 #endif
 }

:code:`get_flx_args_config` callback

CALLBACK #2: get_flx_args_config #2

Purpose: grabs program arguments. Prints help if statically linked.

Static and dynamic linked programs have arguments in different slots of argv because the mainline for dynamic linkage is actually flx_run executable whereas for static linkage this is the executable.

So dynamic linked programs have an extra argument which has to be skipped for compatibility of static and dynamic linkage.

int get_flx_args_config(int argc, char **argv, flx_config *c) {
#ifndef FLX_BUILD_FOR_STATIC_LINK
  c->static_link = false;
  if (argc<2)
  {
    printf("usage: flx_run [--debug] dll_filename options ..\n");
    printf("  environment variables (numbers can be decimals):\n");
    printf("  FLX_DEBUG               # enable debugging traces (default off)\n");
    printf("  FLX_DEBUG_ALLOCATIONS   # enable debugging allocator (default FLX_DEBUG)\n");
    printf("  FLX_DEBUG_COLLECTIONS   # enable debugging collector (default FLX_DEBUG)\n");
    printf("  FLX_REPORT_COLLECTIONS  # report collections (default FLX_DEBUG)\n");
    printf("  FLX_DEBUG_THREADS       # enable debugging collector (default FLX_DEBUG)\n");
    printf("  FLX_DEBUG_DRIVER        # enable debugging driver (default FLX_DEBUG)\n");
    printf("  FLX_FINALISE            # whether to cleanup on termination (default NO)\n");
    printf("  FLX_GC_FREQ=n           # how often to call garbage collector (default 1000)\n");
    printf("  FLX_MIN_MEM=n           # initial memory pool n Meg (default 10)\n");
    printf("  FLX_MAX_MEM=n           # maximum memory n Meg (default -1 = infinite)\n");
    printf("  FLX_FREE_FACTOR=n.m     # reset FLX_MIN_MEM to actual usage by n.m after gc (default 1.1) \n");
    printf("  FLX_ALLOW_COLLECTION_ANYWHERE # (default yes)\n");
    return 1;
  }
  c->filename = argv[1];
  c->flx_argv = argv+1;
  c->flx_argc = argc-1;
  c->debug = (argc > 1) && (strcmp(argv[1], "--debug")==0);
  if (c->debug)
  {
    if (argc < 3)
    {
      printf("usage: flx_run [--debug] dll_filename options ..\n");
      return 1;
    }
    c->filename = argv[2];
    --c->flx_argc;
    ++c->flx_argv;
  }
#else
  c->static_link = true;
  c->filename = argv[0];
  c->flx_argv = argv;
  c->flx_argc = argc;
  c->debug = false;

//  printf("Statically linked Felix program running\n");
#endif
  return 0;
}

A helper routine for finding the module name when static linking.

Static link executables get their full pathname in argv[0]. This has to be parsed to get the module name which is then set into the library linkage object.

For dynamic link programs the library name is passed to the library linkage loader function, which does the parsing itself.

This is a hack. It should be done in the library linkage class.

 #ifdef FLX_BUILD_FOR_STATIC_LINK
 static ::std::string modulenameoffilename(::std::string const &s)
 {
   ::std::size_t i = s.find_last_of("\\/");
   ::std::size_t j = s.find_first_of(".",i+1);
   return s.substr (i+1,j-i-1);
 }
 #endif


:code:`link_library` callback #3

CALLBACK #3: link_library

This function sets up the entry points for either a static or dynamic link program.

For static link, we provide the addresses of the compiler generated static link thunks. These are variables containing the actual entry points.

For dynamic link, we actually load the library and then use dlsym() or GetProcAddress() to find the entry points.

Once this routine is done, the flx_dynlink_t object is in the same state irrespective of linkage model.

Note the asymmetric encoding: static link uses a dedicated static link only constructor form. The dynamic link uses a default constructor and then an initialisation method. There’s no good reason for this now because I added a static_link() method (although it doesn’t check for NULLs).

::flx::dynlink::flx_dynlink_t *link_library(flx_config *c, ::flx::gc::collector::gc_profile_t *gcp) {
  ::flx::dynlink::flx_dynlink_t* library;
#ifdef FLX_BUILD_FOR_STATIC_LINK
  library = new (*gcp, ::flx::dynlink::flx_dynlink_ptr_map, false) ::flx::dynlink::flx_dynlink_t(
      modulenameoffilename(c->filename),
      (::flx::dynlink::thread_frame_creator_t)static_create_thread_frame,
      (::flx::dynlink::start_t)static_flx_start,
      (::flx::dynlink::main_t)&flx_main,
      c->debug_driver
   );
#else
  library = new (*gcp, ::flx::dynlink::flx_dynlink_ptr_map, false) ::flx::dynlink::flx_dynlink_t(c->debug_driver);
  library->dynamic_link(c->filename);
#endif
  return library;
}

}} // namespaces
Mainline
int FELIX_MAIN (int argc, char** argv)
{
//fprintf(stderr,"felix_run=FELIX_MAIN starts\n");
  int error_exit_code = 0;
  flx_config *c = new flx_config(link_library, init_ptr_create_async_hooker, get_flx_args_config);
// WINDOWS CRASHES HERE (the constructor runs)
//fprintf(stderr,"flx_config created\n");
  flx_world *world=new flx_world(c);
//fprintf(stderr,"flx_world created\n");
  try {

    error_exit_code = world->setup(argc, argv);

    if(0 != error_exit_code) return error_exit_code;

  // MAINLINE, ONLY DONE ONCE
  // TODO: simply return error_exit_code
    // We're all set up, so run felix
    world->begin_flx_code();

    // Run the felix usercode.
    error_exit_code = world->run();
    if(0 != error_exit_code) return error_exit_code;

    world->end_flx_code();

    error_exit_code = world->teardown();
  }
  catch (flx_exception_t &x) { error_exit_code = flx_exception_handler(&x); }
  catch (std::exception &x) { error_exit_code = std_exception_handler (&x); }
  catch (std::string &s) { error_exit_code = 6; fprintf(stderr, "%s\n", s.c_str()); }
  catch (flx::rtl::con_t *p) { error_exit_code = 9; fprintf(stderr, "SYSTEM ERROR, UNCAUGHT CONTINUATION %p\n",p);}

  catch (...)
  {
    fprintf(stderr, "flx_run driver ends with unknown EXCEPTION\n");
    error_exit_code = 4;
  }
  delete world;
  delete c;

  return error_exit_code;
}
Dynamic link loader with async support

Compile this with position independent code support to create a main driver object file containing flx_run startup function suitable for loading a Felix program built as a shared library.

//[flx_run_lib_dynamic.cpp]
#define FLX_SUPPORT_ASYNC 0
#define FELIX_MAIN felix_run
#include "flx_run.include"
Traditional Mainline with async support

Link this, together with translation units containing flx_arun, to create a static link executable with async support.

//[flx_arun_main.cxx]
#include "flx_run.hpp"

// to set the critical error handler
#ifdef _WIN32
#include <windows.h>
#include <stdio.h>
#endif

int main(int argc, char **argv)
{
  #ifdef _WIN32
  SetErrorMode (SEM_FAILCRITICALERRORS);
  #endif
  return felix_arun(argc, argv);
}
Traditional Mainline without async support

Link this, together with translation units containing flx_run, to create a static link executable without async support.

//[flx_run_main.cxx]
#include "flx_run.hpp"
#include "stdio.h"

// to set the critical error handler
#ifdef _WIN32
#include <windows.h>
#include <stdio.h>
#endif

int main(int argc, char **argv)
{
  #ifdef _WIN32
  SetErrorMode (SEM_FAILCRITICALERRORS);
  #endif
  //fprintf(stderr,"Felix mainline flx_run_main starts!\n");
  return felix_run(argc, argv);
}

Driver executable config

//[flx_arun.fpc]
Name: flx_arun
Description: Felix standard driver, async support
Requires: flx_async faio demux flx_pthread flx flx_gc flx_dynlink flx_strutil
flx_requires_driver: flx_arun
srcdir: src/flx_drivers
src: flx_arun_lib\.cpp|flx_arun_main\.cxx

//[flx_run.fpc]
Name: flx_run
Description: Felix standard driver, no async support
Requires: flx_pthread flx flx_gc flx_dynlink flx_strutil
srcdir: src/flx_drivers
src: flx_run_lib\.cpp|flx_run_main\.cxx

//[flx_thread_free_run.fpc]
Name: flx_thread_free_run
Description: Felix driver, no thread or async support
Description: WORK IN PROGRESS
Requires: flx flx_gc dl
srcdir: src/flx_drivers
src: flx_run_lib\.cpp|flx_run_main\.cxx

Build Code

#[flx_drivers.py]
import fbuild
from fbuild.functools import call
from fbuild.path import Path
from fbuild.record import Record
import buildsystem
from buildsystem.config import config_call

# ------------------------------------------------------------------------------

def build( phase):
    #print("[fbuild:flx_drivers.py:build (in src/packages/driver.fdoc)] ********** BUILDING DRIVERS ***********************************************")
    path = Path(phase.ctx.buildroot/'share'/'src/flx_drivers')

    #dlfcn_h = config_call('fbuild.config.c.posix.dlfcn_h',
    #    phase.platform,
    #    phase.cxx.static,
    #    phase.cxx.shared)

    #if dlfcn_h.dlopen:
    #    external_libs = dlfcn_h.external_libs
    #    print("HAVE dlfcn.h, library=" + str (external_libs))
    #else:
    #    print("NO dlfcn.h available")
    #    external_libs = []
    external_libs = []

    run_includes = [
        phase.ctx.buildroot / 'host/lib/rtl',
        phase.ctx.buildroot / 'share/lib/rtl'
    ]

    arun_includes = run_includes + [
        'src/demux',
    ] + ([], ['src/demux/win'])['win32' in phase.platform]

    # Make four object files for flx_run
    # two for async, two without
    # each pair made static and non static

    flx_run_static_static_obj = phase.cxx.static.compile(
        dst='host/lib/rtl/flx_run_lib_static',
        src=path / 'flx_run_lib_static.cpp',
        includes=run_includes,
        macros=['FLX_STATIC_LINK'],
    )

    flx_run_static_dynamic_obj = phase.cxx.shared.compile(
        dst='host/lib/rtl/flx_run_lib_static',
        src=path / 'flx_run_lib_static.cpp',
        includes=run_includes,
    )


    flx_run_dynamic_dynamic_obj = phase.cxx.shared.compile(
        dst='host/lib/rtl/flx_run_lib_dynamic',
        src=path / 'flx_run_lib_dynamic.cpp',
        includes=run_includes,
    )


    flx_arun_static_static_obj = phase.cxx.static.compile(
        dst='host/lib/rtl/flx_arun_lib_static',
        src=path / 'flx_arun_lib_static.cpp',
        includes=arun_includes,
        macros=['FLX_STATIC_LINK'],
    )

    flx_arun_static_dynamic_obj = phase.cxx.shared.compile(
        dst='host/lib/rtl/flx_arun_lib_static',
        src=path / 'flx_arun_lib_static.cpp',
        includes=arun_includes,
    )


    flx_arun_dynamic_dynamic_obj = phase.cxx.shared.compile(
        dst='host/lib/rtl/flx_arun_lib_dynamic',
        src=path / 'flx_arun_lib_dynamic.cpp',
        includes=arun_includes,
    )


    # Now, the mainline object files for static links
    flx_run_main_static= phase.cxx.static.compile(
        dst='host/lib/rtl/flx_run_main',
        src=path / 'flx_run_main.cxx',
        includes=run_includes,
        macros=['FLX_STATIC_LINK'],
    )

    flx_arun_main_static= phase.cxx.static.compile(
        dst='host/lib/rtl/flx_arun_main',
        src=path / 'flx_arun_main.cxx',
        includes=arun_includes,
        macros=['FLX_STATIC_LINK'],
    )

    # Now, the mainline object files for dynamic links
    flx_run_main_dynamic= phase.cxx.shared.compile(
        dst='host/lib/rtl/flx_run_main',
        src=path / 'flx_run_main.cxx',
        includes=run_includes,
    )

    flx_arun_main_dynamic= phase.cxx.shared.compile(
        dst='host/lib/rtl/flx_arun_main',
        src=path / 'flx_arun_main.cxx',
        includes=arun_includes,
    )


    # And then the mainline executable for dynamic links
    flx_run_exe = phase.cxx.shared.build_exe(
        dst='host/bin/flx_run',
        srcs=[path / 'flx_run_main.cxx', path / 'flx_run_lib_dynamic.cpp'],
        includes=run_includes,
        external_libs=external_libs,
        libs=[call('buildsystem.flx_rtl.build_runtime',  phase).shared],
    )

    flx_arun_exe = phase.cxx.shared.build_exe(
        dst='host/bin/flx_arun',
        srcs=[path / 'flx_arun_main.cxx', path/ 'flx_arun_lib_dynamic.cpp'],
        includes=arun_includes,
        external_libs=external_libs,
        libs=[
           call('buildsystem.flx_rtl.build_runtime',  phase).shared,
           call('buildsystem.flx_pthread.build_runtime', phase).shared,
           call('buildsystem.flx_async.build_runtime', phase).shared,
           call('buildsystem.demux.build_runtime', phase).shared,
           call('buildsystem.faio.build_runtime', phase).shared],
    )

    return Record(
        flx_run_lib_static_static=flx_run_static_static_obj,
        flx_run_lib_static_dynamic=flx_run_static_dynamic_obj,
        flx_run_lib_dynamic_dynamic=flx_run_dynamic_dynamic_obj,
        flx_arun_lib_static_static=flx_arun_static_static_obj,
        flx_arun_lib_static_dynamic=flx_arun_static_dynamic_obj,
        flx_arun_lib_dynamic_dynamic=flx_arun_dynamic_dynamic_obj,
        flx_run_main_static=flx_run_main_static,
        flx_run_main_dynamic=flx_run_main_dynamic,
        flx_run_exe=flx_run_exe,
        flx_arun_main_static=flx_arun_main_static,
        flx_arun_main_dynamic=flx_arun_main_dynamic,
        flx_arun_exe=flx_arun_exe,
    )

Package: src/packages/filetools.fdoc

File Tools

key file
flx_ls.flx $PWD/src/tools/flx_ls.flx
flx_cp_tool.flx $PWD/src/tools/flx_cp.flx
flx_grep.flx $PWD/src/tools/flx_grep.flx
flx_replace.flx $PWD/src/tools/flx_replace.flx
flx_batch_replace.flx $PWD/src/tools/flx_batch_replace.flx
flx_renumber.flx $PWD/src/tools/flx_renumber.flx
flx_cp.flx share/lib/std/felix/flx_cp.flx

File System Tools.

The tools perform basic tasks the same way on all platforms. Our tools use RE2 (Perl) regular expressions for wildcarding instead of globs. All tools treat the file system as flat: directories don’t exist. Structured filenames do. Tools creating files always auto-create directories for this reason.

Most of the tools are stubs wrapping core library functionality.

Note: the regular expressions must match completely.

File list flx_ls.

List all files in a given master directory matching the specified pattern. The resulting list is relative to the master directory.

Note: regular expressions must match completely!

//[flx_ls.flx]
fun dbg(s:string):string={ println s; return s; }
//println$ System::args ();
//println$ "argc=" + str System::argc;

var dir =
  if System::argc < 2 then Directory::getcwd()
  else System::argv 1
  endif
;

var regex =
  if System::argc < 3 then ".*"
  else System::argv 2
  endif
;

//println$ "Dir=" dir;
//println$ "Files in dir " + dir + "=";
iter (proc (s:string) { println s; }) (FileSystem::regfilesin (dir, regex));
File copy flx_cp.

This tool copies files using regular expressions with a replacement pattern. The tool is safe in that it guarrantees the copy is one-to-one and the target files do not overlap the source files. If this condition isn’t met the copy fails as a whole.

The copy is done like flx_ls scanning for structured filenames in a given master directory matching a given pattern. The destination replacement pattern is must include any required prefix (the master directory is only used for searching as an optimisation). The encoding \n where n is a digit from 0 to 9 represents a subgroup of the match.

Note: regular expressions must match completely!

//[flx_cp_tool.flx]
include "std/felix/flx_cp";

fun dbg(s:string):string={ println s; return s; }
//println$ System::args ();
//println$ "argc=" + str System::argc;

var dir = "";
var regex = "";
var target = "";
var live = true;
var verbose = false;

for var i in 1 upto System::argc do
  var arg = System::argv i;
  if arg == "--test" do live = false;
  elif arg == "-v" or arg == "--verbose" do verbose = true;
  elif arg.[0] == char "-" do
    println$ "Unknown option '" + arg+"'";
    System::exit(1);
  elif dir == "" do dir = arg;
  elif regex == "" do regex = arg;
  elif target == "" do target = arg;
  done
done

if dir == "" do println$ "Missing directory name (arg1)"; System::exit(1);
elif regex == "" do println$ "Missing regex (arg2)"; System::exit(1);
elif target == "" do println$ "Missing target (arg3)"; System::exit(1);
done

if verbose do println$ "#Dir='" + dir + "', pattern='"+regex+"', dst='"+target+"'"; done

var re = Re2::RE2 regex;
CopyFiles::copyfiles (dir, re, target, live, verbose);
System::exit(0);

//[flx_cp.flx]
class CopyFiles {
  proc processfiles
    (var process: string * string -> bool)
    (basedir:string, re:RE2, tpat:string, live:bool, verbose:bool)
  {
     var ds = StrDict::strdict[string] ();
     var sd = StrDict::strdict[string] ();
     var dirs = StrDict::strdict[bool] ();
     var n = re.NumberOfCapturingGroups;
     var v = varray[StringPiece]$ (n+1).size, StringPiece "";
//println$ "flx_cp:CopyFiles:processfiles regexp= " + re.pattern;
     // Process a single filename and add it to the pending copy queue
     proc addfile(f:string)
     {
        if Re2::Match(re, StringPiece f, 0, ANCHOR_BOTH, v.stl_begin, v.len.int)
        do
          var src = Filename::join (basedir, f);
          var replacements = Empty[string * string];
          for var k in 0 upto n do
            replacements = Cons (("${" + str k + "}",v.k.string), replacements);
          done
          dst := search_and_replace replacements tpat;

          //println$ "Copy " + src + " -> " + dst;
          sd.add src dst;

          if ds.haskey dst do
            eprintln$ "Duplicate target " + dst;
            System::exit(1);
          done
          ds.add dst src;
          iter
            (proc (x:string) { dirs.add x true; })
            (Filename::directories dst)
          ;
        done
     }

     // Recursively collect files within dir to be copied. dir is relative to basedir.
     proc rfi(dir: string)
     {
       if dir != "." and dir != ".." do
       match Directory::filesin(Filename::join (basedir,dir)) with
       | #None  => ;
       | Some files =>
         List::iter
           (proc (f:string)
           { if f != "." and f != ".." do
               var d = Filename::join (dir,f);
               val t = FileStat::filetype (Filename::join (basedir,d));
               match t with
                 | #REGULAR => addfile d;
                 | #DIRECTORY => rfi d;
                 | _ => ;
               endmatch;
             done
           }
           )
           files
         ;
       endmatch;
       done
     }
     rfi ("");

     // Check that no source file is clobbered
     match src, dst in sd.iterator do
       if sd.haskey dst do
         eprintln$ "Target clobbers src: " + dst;
         System::exit(1);
       done
     done

     // Create target directories
     match dir, _ in dirs.iterator do
       if verbose do println$ "mkdir " + dir; done
       if live do
         err:=Directory::mkdir(dir);
         if err !=0 do
           if errno != EEXIST do
             eprintln$ "Mkdir, err=" + strerror() + " .. ignoring";
           done
         done
       done
     done

     // And finally, do the actual copying
     match src, dst in sd.iterator do
       if verbose do print$ "cp " + src + "  " + dst; done
       if live do
         if process(src, dst) do
           if verbose do println " #done"; done
         else
           eprintln "COPY FAILED";
           System::exit 1;
         done
       else
         if verbose do println$ "  #proposed"; done
       done
     done
  }

  proc copyfiles(basedir:string, re:RE2, tpat:string, live:bool, verbose:bool) =>
    processfiles (FileSystem::filecopy) (basedir, re, tpat, live, verbose)
  ;

  proc copyfiles(basedir:string, re:string, tpat:string, live:bool, verbose:bool) =>
    copyfiles(basedir, RE2 re, tpat, live, verbose)
  ;
}
Searching for strings flx_grep.

This tool works like grep except the files being searched use a master directory and regular expression for selection. Any line in any of those files matching the given regexp completely are listed.

//[flx_grep.flx]
var dir =
  if System::argc < 2 then Directory::getcwd()
  else System::argv 1
  endif
;

var fregex =
  if System::argc < 3 then ".*"
  else System::argv 2
  endif
;

var lregex =
  if System::argc < 4 then ".*"
  else System::argv 3
  endif
;

var grexp = RE2 lregex;

//println$ "Dir=" dir;
//println$ "Files in dir " + dir + "=";
for file in FileSystem::regfilesin (dir, fregex) do
//  println$ file;
  var lines = load (Filename::join dir file);
  var count = 0;
  for line in split (lines,char "\n") do
    ++count;
    if line \in grexp do
      println$ file+":"+str count+": " line;
    done
  done
done
Replace substrings in a file.

This tool replaces patterns found in a single file with another pattern and outputs the result to standard output.

//[flx_replace.flx]
var filename = System::argv 1;
var re = System::argv 2;
var r = System::argv 3;

if System::argc != 4 do
  println$ "Usage: flx_replace filename regexp replacement";
  println$ "  replacement may contain \\1 \\2 etc for matching subgroups";
  System::exit 1;
done


var x = load filename;
var cre = RE2 re;
var result = search_and_replace (x, 0uz, cre, r);
print result;
Batch Replace

This program combines flx_cp and flx_replace to perform a wildcarded safe copy of a set of files from one location to another with renaming, and also replaces any lines in any of the files matching some pattern with another string specified by a replacement.

//[flx_batch_replace.flx]
include "std/felix/flx_cp";

fun dbg(s:string):string={ println s; return s; }
//println$ System::args ();
//println$ "argc=" + str System::argc;

var dir = "";
var regex = "";
var target = "";
var search = "";
var replace = "";
var live = true;
var verbose = false;

for var i in 1 upto System::argc do
  var arg = System::argv i;
  if arg == "--test" do live = false;
  elif arg == "-v" or arg == "--verbose" do verbose = true;
  elif arg.[0] == char "-" do
    println$ "Unknown option '" + arg+"'";
    System::exit(1);
  elif dir == "" do dir = arg;
  elif regex == "" do regex = arg;
  elif target == "" do target = arg;
  elif search == "" do search = arg;
  elif replace == "" do replace = arg;
  done
done

if dir == "" do println$ "Missing directory name (arg1)"; System::exit(1);
elif regex == "" do println$ "Missing regex (arg2)"; System::exit(1);
elif target == "" do println$ "Missing target (arg3)"; System::exit(1);
elif search == "" do println$ "Missing search regex (arg4)"; System::exit(1);
elif replace == "" do println$ "Missing replace spec (arg5)"; System::exit(1);
done

if verbose do println$ "#Dir='" + dir + "', pattern='"+regex+"', dst='"+target+"'"; done

var searchre = RE2 search;
gen sandr (src: string, dst:string) =
{
  var text = load src;
  var result = search_and_replace (text, 0uz, searchre, replace);
  save (dst, result);
  return true;
}

var filere = Re2::RE2 regex;
CopyFiles::processfiles sandr (dir, filere, target, live, verbose);
System::exit(0);
Renumbering.

This tool analyses a single directory looking for files whose basename matches a pattern containing a number in a fixed position.

It then renumbers all the files with a number greater or equal to a specified value, adding or subtracting a certain amount to make space in the sequence or fill a gap in it.

It was designed for document renumbering, especially Felix tutorial documents, since the Felix webserver automatically calculates Next and Prev links when it asked to display an fdoc file with a numerical suffix of two digits. However it can be used on any sequenced file set.

//[flx_renumber.flx]
// File renumbering

if System::argc < 4 do
  println "Usage: rentut dir regexp first dst";
  println "For tutorial try:";
  println r"  dir = 'src/web'";
  println r"  re = 'tut_(\d*)\\.fdoc'";
  System::exit(1);
done

s_dir := System::argv 1;
s_re := System::argv 2;
s_first := System::argv 3;
s_moveto  := System::argv 4;

first := size s_first;
moveto := size s_moveto;
re := RE2(s_re);
if first == moveto do
  println$ "src = dst, not moving anything";
  System::exit 0;
done

println$ "Renumber files in " + s_dir+ " matching "+"'"+s_re+"'"+" from " + str first + " to " + str moveto;

docs := FileSystem::regfilesin(s_dir, re);
var files = varray docs;

// direction: if first < moveto, we're moving up, so we have to start at the end and work down.
// if first > moveto, we're moving down, so we have to start at the start and work up.
comparator := if first < moveto then \gt of (string * string) else \lt of (string * string) endif;

sort comparator of (string * string) files;
println$ "Files = " + str files;
var groups : array[StringPiece,2];

iter
  (proc(var f:string){
    println f;
    res := Match(re, StringPiece f,0,ANCHOR_BOTH,C_hack::cast[+StringPiece] (&groups),2);
    if res do
      //println$ "Group 1 = " + str (groups.1);
      n := size (str (groups.1));
      if n >= first do
        m := n + moveto - first;
        s := f"%02d" m.int;
        soffset := groups.1.data - (&f).stl_begin;
        var newf = f;
        replace(&newf,soffset.size,2uz,s);
        res2 := FileSystem::rename_file(
          Filename::join (s_dir,f),
          Filename::join (s_dir,newf)
        );
        if res2 != 0 do
          println$ "Rename " + f + " -> " + newf + " failed";
        else
          println$ f + " -> " + newf;
        done
      else
        // println$ str n + " Unchanged";
      done
    else
      println "NO match";
    done
  })
files;

Package: src/packages/flx.fdoc

Flx compiler driver tool

key file
bootflx_tool.flx $PWD/src/tools/bootflx.flx
flx_tool.flx $PWD/src/tools/flx.flx
dflx_tool.flx $PWD/src/tools/dflx.flx
key file
flx_cache.flx share/lib/std/felix/flx_cache.flx
flx_flxg.flx share/lib/std/felix/flx_flxg.flx
flx_profile.flx share/lib/std/felix/flx_profile.flx
config.flx share/lib/std/felix/config.flx
flx_control.flx share/lib/std/felix/flx/flx_control.flx
flx_cmdopt.flx share/lib/std/felix/flx/flx_cmdopt.flx
flx_depvars.flx share/lib/std/felix/flx/flx_depvars.flx
flx_plugin_client.flx share/lib/std/felix/flx/flx_plugin_client.flx
flx_run.flx share/lib/std/felix/flx/flx_run.flx
flx.flx share/lib/std/felix/flx/flx.flx
bootflx.flx share/lib/std/felix/flx/bootflx.flx

Felix flx tool.

This is exactly the same as the dflx tool, it just runs the @[@f@l@x@r@u@n@}@ @l@i@b@r@a@r@y@ @f@u@n@c@t@i@o@n@ @w@i@t@h@ @c@o@m@m@a@n@d@ @l@i@n@e@ @a@r@g@u@m@e@n@t@s@. However it preloads some plugins that might be used to avoid run time loading.

//[flx_tool.flx]
// flx plugin linker
//
class FlxPluginSymbols
{

  // We have to do this dummy requirements because static
  // linking removes
  requires package "re2";
  requires package "faio";
  requires package "flx_arun";

  open Dynlink;

  // Now add all the symbols.
  proc addsymbols ()
  {
    static-link-plugin
      toolchain_clang_macosx,
      toolchain_iphoneos,
      toolchain_iphonesimulator,
      toolchain_clang_linux,
      toolchain_gcc_macosx,
      toolchain_gcc_linux,
      toolchain_msvc_win
    ;
    // flx
    static-link-symbol dflx_create_thread_frame in plugin dflx;
    static-link-symbol dflx_flx_start in plugin dflx;

  }
}

// Add the symbols
FlxPluginSymbols::addsymbols;

// Now invoke the program!
val linstance =  Dynlink::prepare_lib("dflx");
var init: cont = Dynlink::get_init linstance;

Fibres::chain init;
Command line tool dflx.

This tool just runs the runflx library function with the executable command line arguments.

//[dflx_tool.flx]
include "std/felix/flx/flx";

System::pexit$ Flx::runflx #System::args;

The flx cache manager.

Check if the flx cache is stale and deletes it if it is.

//[flx_cache.flx]
class FlxCache
{
  fun gramtime(debugln: string -> 0) (path:string, s:string) : double = {
    //println$ "Path=" + path + " file = " + s;
    fun maxtime (x:double) (s:string) => max (x, gramtime debugln (path, s));
    if s.[0]=="@".char do
      var file =
        let f = s.[1 to].strip in
        if Filename::is_absolute_filename f then f
        else Directory::mk_absolute_filename (Filename::join$ path, f)
      ;
      var filetime = FileStat::dfiletime(file,0.0);
      if filetime == 0.0 do
        println$ "Grammar include file '" + file "' doesn't exist, exiting";
        // this one is pretty fatal :-)
        System::exit 1;
      done
      debugln$ "Grammar include file '" + file + "' time=" + FileStat::strfiletime(filetime);
      var filetext = load file;
      var files = split (filetext, "\n");
      files = map strip of (string) files;
      files = filter (fun (s:string) => s != "") files;
      files = map (fun (s:string) => Filename::join (split(s,"/"))) files;
      //println$ "Files=" + files;
      return fold_left maxtime filetime files;
    else
      file = Filename::join$ path, s;
      filetime = FileStat::dfiletime(file,0.0);
      if filetime == 0.0 do
        println$ "Grammar file " + file " doesn't exist, exiting";
        // this one is pretty fatal :-)
        System::exit 1;
      done
      debugln$ "Grammar file " + file + " time=" + FileStat::strfiletime(filetime);
      return filetime;
    done
  }

  // FLX_INSTALL_DIR: root for finding standard grammar
  // STDGRAMMAR: root standard grammar key, within FLX_INSTALL_DIR
  //      usually "grammar/grammar.files"
  // FLXG: absolute filename of felix compiler executable

  // CACHE_DIR: absolute filename of binary cache
  // OUTPUT_DIR: absolute filename of text cache

  // DEFAULT_CACHE_DIR: default location of CACHE_DIR
  // DEFAULT_OUTPUT_DIR: default location of OUTPUT_DIR
  //    These defaults are used to determine if the
  //    the cache should be deleted automatically
  //    or a an interactive query used to verify.
  //    Automatic deletion requies the caches to be the default.
  // CLEAR_CACHE: switch to force clearing the cache

  typedef cache_validation_spec_t =
  (
     FLX_SHARE_DIR:string,
     GRAMMAR_DIR:string,
     STDGRAMMAR:string,
     FLXG:string,
     CACHE_DIR:string,
     OUTPUT_DIR:string,
     CLEAR_CACHE: int,
     AUTOMATON: string,
     debugln : string -> 0,
     xqt: string -> string,
     quote: string -> string
  );


  // CACHE VALIDATION
  //
  // This function validates the current cache, and if it is considered
  // stale may flush it. If the cache is the default one in the users
  // home directory the flush is done noisily but unconditionally.
  // Otherwise the user is prompted for permission.
  // The special cache locations / and . or "" are never deleted
  // in case it wipes out parts of the root, home, or current directory.

  // The validation checks the time of the flxg compiler used to build
  // it against the current flxg compiler, these must be exactly equal.
  //
  // It also checks that all the files defining the grammar are older
  // than the generated automaton.
  //
  // It does NOT check any RTL C++ libraries are up to date.
  // It does NOT check any Felix program files are up to date.
  // Therefore it does NOT guarrantee the contents of the cache are valid.
  // Rather it ensures only that the compiler and cached automaton are not stale.
  // However if they are stale the whole cache is invalidated.
  //
  // In effect this means this function ensures the parser is ready and valid
  // or non-existant. The compiler and automaton are locked together. If the compiler
  // changes the automaton must be rebuilt.

  // returns cache time
  gen validate_cache  (var spec: cache_validation_spec_t) : int * double =
  {

    // ensure the cache directory exists
    Directory::mkdirs(spec.CACHE_DIR);

    // get the OS timestamp of the flxg compiler, +inf if not found
    var flxg_time = FileStat::dfiletime(spec.FLXG, #FileStat::future_time);
    spec.debugln$ "Flxg=" + spec.FLXG;
    spec.debugln$ "Flxg_time=" + FileStat::strfiletime(flxg_time);

    // get the OS timestamp of the file flxg_time.stamp
    // this file is created with the cache
    var flxg_stamp = Filename::join spec.CACHE_DIR "flxg_time.stamp";
    var cache_time = FileStat::dfiletime(flxg_stamp,#FileStat::future_time);
    spec.debugln$ "cache_time=" + FileStat::strfiletime(cache_time);

    // get the timestamp string recorded in flxg_time.stamp
    var flxg_stamp_data = load flxg_stamp;
    //println$ "Flxg_stamp_data=" + flxg_stamp_data;

    // convert the timestamp string to a double, if there is junk
    // there or the string is empty, 0.0 is returned by atof,
    // adjust that to -inf
    var flxg_stamp_time = match flxg_stamp_data.atof with | 0.0 => #FileStat::past_time | x => x;

    spec.debugln$ "Flxg_stamp_data : " + FileStat::strfiletime(flxg_stamp_time);

    // Calculate the time of the newest text file defining the grammar
    // these are files in directory share/lib/grammar.
    var grammar_time = gramtime spec.debugln (spec.GRAMMAR_DIR, "@"+spec.STDGRAMMAR);
    spec.debugln$ "Grammar text time=" + FileStat::strfiletime (grammar_time);

    // calculate the name of the compiled grammar automaton in the cache
    var automaton_name = spec.AUTOMATON;

    // Get the timestamp of the grammar automaton or -inf if it doesn't exist.
    var automaton_time = FileStat::dfiletime(automaton_name,#FileStat::past_time);
    spec.debugln$ "Automaton " + automaton_name + " time=" + FileStat::strfiletime(automaton_time);

    // If the cache exists and the recorded compiler time stamp is not equal
    // to the current compiler time stamp, then the cache is stale
    // and should be deleted.
    if cache_time != #FileStat::future_time and flxg_stamp_time != flxg_time do
      println$ "Cache may be out of date due to compiler change!";
      println$ "Flxg compiler time stamp=" + FileStat::strfiletime(flxg_time);
      println$ "Cache time stamp        =" + FileStat::strfiletime(cache_time);

      // special safety check if the output dirs are root or current directory
      if not (
        (spec.OUTPUT_DIR == "/" or spec.OUTPUT_DIR == "" or spec.OUTPUT_DIR == ".") or
        (spec.CACHE_DIR == "/" or spec.CACHE_DIR == "" or spec.CACHE_DIR == ".")
      )
      do
        spec&.CLEAR_CACHE <- 1;
      done

    // If the automaton exists and the grammar is newer than the automaton
    // then the cache is stale and should be deleted.
    elif grammar_time > automaton_time do
      println$ "Cache may be out of date due to grammar upgrade!";
      println$ "Grammar time stamp          =" + FileStat::strfiletime(grammar_time);
      println$ "Automaton.syntax time stamp =" + FileStat::strfiletime(automaton_time);
      spec&.CLEAR_CACHE <- 1;
    done

    // FFF BE CAREFUL! The value "/" for these caches is perfectly good
    if spec.CLEAR_CACHE != 0 do
      // refuse to delete "" or "/" or ".", basic safety check
      if
        (spec.OUTPUT_DIR == "/" or spec.OUTPUT_DIR == "" or spec.OUTPUT_DIR == ".") or
        (spec.CACHE_DIR == "/" or spec.CACHE_DIR == "" or spec.CACHE_DIR == ".")
      do
        println "WILL NOT DELETE CACHES";
        println$ "output cache " + spec.OUTPUT_DIR;
        println$ "binary cache " + spec.CACHE_DIR;
        // INTENTIONAL EXIT
        System::exit(1);
      done

      println$ "Delete cache " + spec.OUTPUT_DIR;
      if PLAT_WIN32 do
          C_hack::ignore$ spec.xqt("mkdir "+spec.quote(spec.OUTPUT_DIR+"\\rubbish") +"& rmdir /Q /S " + spec.quote(spec.OUTPUT_DIR));
      else
          C_hack::ignore$ spec.xqt("rm -rf " + spec.quote(spec.OUTPUT_DIR));
      done
      println$ "Delete cache " + spec.CACHE_DIR;

      if PLAT_WIN32 do
          C_hack::ignore$ spec.xqt("mkdir "+spec.quote(spec.CACHE_DIR+"\\rubbish")+"& rd /Q /S " + spec.quote(spec.CACHE_DIR));
      else
          C_hack::ignore$ spec.xqt("rm -rf " + spec.quote(spec.CACHE_DIR));
      done

      // Make a new cache.
      Directory::mkdirs(spec.CACHE_DIR);

      // make the stamp file with the time of the current compiler.
      var f = fopen_output flxg_stamp;
      write(f, fmt(flxg_time, fixed (0,3)));
      f.fclose;
    done
    return spec.CLEAR_CACHE, cache_time;
  }

  fun cache_join (c:string, var f:string) =
  {
    //debugln$ "[cache_join] " + c + " with  " + f;
    if PLAT_WIN32 do
      if f.[1 to 3] == ":\\" do f = f.[0 to 1]+f.[2 to];
      elif f.[1] == char ":" do f = f.[0 to 1]+"\\"+f.[2 to];
      done
      if f.[0] == char "\\" do f = f.[1 to]; done
    else
      if f.[0] == char "/" do f = f.[1 to]; done
    done
      var k = Filename::join(c,f);
      //debugln$ "[cache_join] result = " + k;
      return k;
  }

}
The compiler.

A wrapper around the {flxg} command line compiler executable.

//[flx_flxg.flx]
class Flxg
{
  typedef flxg_spec_t =
  (
    INLINE:int,
    OUTPUT_DIR:string,
    BUNDLE_DIR:opt[string],
    CACHE_DIR:string,
    COMPILER_PHASE:string,
    DOREDUCE:int,
    FLXG:string,
    VERBOSE:list[string],
    STDGRAMMAR:string,
    AUTOMATON:string,
    IMPORTS:list[string],
    FLXLIBS:list[string],
    INCLUDE_DIRS:list[string],
    TIME:int,
    FORCE:int,
    FLAGS: list[string],
    filebase:string,
    use_ext:string,
    debugln: string -> 0
  );


  gen run_felix_compiler (spec:flxg_spec_t) : int =
  {
    var FLXFLAGS=spec.FLAGS  + (list[string]$ "--inline="+str(spec.INLINE));
    if spec.OUTPUT_DIR != "" do
      FLXFLAGS += '--output_dir=' + str(spec.OUTPUT_DIR);
    done
    match spec.BUNDLE_DIR with
    | Some dir =>
      FLXFLAGS += '--bundle_dir=' + dir;
    | #None=> ;
    endmatch;
    if spec.CACHE_DIR != "" do
      FLXFLAGS +="--cache_dir=" + spec.CACHE_DIR;
    done
    if spec.COMPILER_PHASE != "" do
      FLXFLAGS += '--compiler-phase=' + spec.COMPILER_PHASE;
    done
    if spec.DOREDUCE == 0 do
      FLXFLAGS += '--no-reduce';
    done
    if spec.TIME == 1 do
      FLXFLAGS += '--time';
    done
    if spec.FORCE == 1 do
      FLXFLAGS += '--force';
    done
    var cmd =
      spec.FLXG !
      spec.VERBOSE +
      FLXFLAGS +
      map (fun (s:string) => "-I"+s) spec.INCLUDE_DIRS +
      ("--syntax="+spec.STDGRAMMAR) +
      ("--automaton="+spec.AUTOMATON) +
      map (fun (s:string) => "--import="+s) spec.IMPORTS +
      spec.FLXLIBS +
      (spec.filebase + spec.use_ext)
    ;

    var CMD = catmap ' ' Shell::quote_arg cmd;
    spec.debugln$ "Felix command="+CMD;

    var result=System::system(CMD);
    if result != 0 do
      eprintln$ "Felix compilation "+CMD+" failed";
    done
    return result;
  }

}
Profile

The profile is the most basic low level configuration data, which determines where to find everything.

//[flx_profile.flx]
class FlxProfile
{
  fun dflt_profile () =
  {
    fun / (x:string, y:string) => Filename::join (x,y);
    var HOME=
      let h = Env::getenv "HOME" in
        if h!="" then h
        elif PLAT_WIN32 then Env::getenv "USERPROFILE"
        else ""
        endif
    ;
    if HOME == "" do
      eprintln$ "HOME (or USERPROFILE on WIN32) environment variable is not set.  Please set HOME before building.";
      // this one is pretty fatal :-)
      System::exit 1;
    done


    var FLX_HOME_DIR = Env::getenv("FLX_HOME_DIR",HOME/".felix");
    var FLX_CACHE_TOP = Env::getenv("FLX_CACHE_TOP",FLX_HOME_DIR/"cache");
    var FLX_PROFILE_DIR = Env::getenv("FLX_PROFILE_DIR",FLX_HOME_DIR/"config");

    var FLX_CACHE_DIR = Env::getenv("FLX_CACHE_DIR",FLX_CACHE_TOP / "binary");
    var FLX_OUTPUT_DIR = Env::getenv("FLX_OUTPUT_DIR",FLX_CACHE_TOP / "text");
    return
      (
       FLX_HOME_DIR=FLX_HOME_DIR,
       FLX_PROFILE_DIR=FLX_PROFILE_DIR,
       FLX_CACHE_DIR=FLX_CACHE_DIR,
       FLX_OUTPUT_DIR=FLX_OUTPUT_DIR
      )
    ;
  }

  typedef profile_type = typeof (#dflt_profile);
  instance Str[profile_type] {
    fun str(x:profile_type) =>
       "FLX_HOME_DIR="+x.FLX_HOME_DIR+"\n"+
       "FLX_PROFILE_DIR="+x.FLX_PROFILE_DIR+"\n"+
       "FLX_CACHE_DIR="+x.FLX_CACHE_DIR+"\n"+
       "FLX_OUTPUT_DIR="+x.FLX_OUTPUT_DIR+"\n"
    ;
  }
}
Config.

A more detailed layout configuration based on command line switches and the base profile.

//[config.flx]
include "std/version";
include "std/felix/flx_profile";



class Config {
  typedef config_type = (
    FLX_INSTALL_DIR: string,
    FLX_SHARE_DIR: string,
    FLX_TARGET_DIR: string,
    FLX_HOME_DIR: string,
    FLX_PROFILE_DIR: string,
    FLX_CACHE_DIR: string,
    FLX_OUTPUT_DIR: string,
    FLX_CONFIG_DIRS: list[string],
    FLX_LIB_DIRS: list[string],
    FLX_RTL_DIRS: list[string]
  );

  instance Str[config_type] {
    fun str (x:config_type) : string =
    {
      var s = "";
      reserve$ &s,1000;
      s+="(FLX_INSTALL_DIR="+ x.FLX_INSTALL_DIR+",\n";
      s+="FLX_SHARE_DIR="+ x.FLX_SHARE_DIR+",\n";
      s+="FLX_TARGET_DIR="+ x.FLX_TARGET_DIR+",\n";
      s+="FLX_HOME_DIR="+ x.FLX_HOME_DIR+",\n";
      s+="FLX_PROFILE_DIR="+ x.FLX_PROFILE_DIR+",\n";
      s+="FLX_CACHE_DIR="+ x.FLX_CACHE_DIR+",\n";
      s+="FLX_OUTPUT_DIR="+ x.FLX_OUTPUT_DIR+",\n";
      s+="FLX_LIB_DIRS="+ x.FLX_LIB_DIRS.str+",\n";
      s+="FLX_CONFIG_DIRS="+ x.FLX_CONFIG_DIRS.str+",\n";
      s+="FLX_RTL_DIRS="+ x.FLX_RTL_DIRS.str+")\n";
      return s;
    }
  }

  private fun / (x:string, y:string) => Filename::join (x,y);

  proc set_libs_and_rtls (x: &config_type)
  {
    x.FLX_LIB_DIRS <- list (x*.FLX_SHARE_DIR/"lib", x*.FLX_TARGET_DIR/"lib");
    x.FLX_RTL_DIRS <- list (x*.FLX_SHARE_DIR/"lib"/"rtl", x*.FLX_TARGET_DIR/"lib"/"rtl");
  }

  proc cascade_FLX_INSTALL_DIR (x: &config_type)  (y: string) = {
    x.FLX_INSTALL_DIR <- y;
    cascade_FLX_TARGET_DIR x (y/"host");
    cascade_FLX_SHARE_DIR x (y/"share");
  }

  proc cascade_FLX_TARGET_DIR (x: &config_type)  (y: string) = {
    x.FLX_TARGET_DIR <- y;
    x.FLX_CONFIG_DIRS <- list[string] (y/"config");
    set_libs_and_rtls x;
  }

  proc cascade_FLX_SHARE_DIR (x: &config_type)  (y: string) = {
    x.FLX_SHARE_DIR <- y;
    set_libs_and_rtls x;
  }

  proc cascade_FLX_HOME_DIR (x: &config_type)  (y: string) = {
    x.FLX_HOME_DIR <- y;
    x.FLX_PROFILE_DIR <- y/"config";
    x.FLX_CACHE_DIR <- y/"cache"/"binary";
    x.FLX_OUTPUT_DIR <- y/"cache"/"text";
  }

  proc copy_profile (cfg: &config_type) (profile: FlxProfile::profile_type)
  {
    cfg.FLX_HOME_DIR <- profile.FLX_HOME_DIR;
    cfg.FLX_PROFILE_DIR <- profile.FLX_PROFILE_DIR;
    cfg.FLX_CACHE_DIR <- profile.FLX_CACHE_DIR;
    cfg.FLX_OUTPUT_DIR <- profile.FLX_OUTPUT_DIR;
  }

  fun dflt_config() :config_type = {
    var profile = FlxProfile::dflt_profile();
    var cfg : config_type;
    copy_profile &cfg profile;

    // global defaults
    var PREFIX = Filename::root_subdir "usr"/"local"/"lib";

    var INSTALL_ROOT_TOPDIR= PREFIX/"felix";
    var INSTALL_ROOT = INSTALL_ROOT_TOPDIR/ ("felix-"+Version::felix_version);
    cascade_FLX_INSTALL_DIR &cfg INSTALL_ROOT;
    return cfg;
  }

  proc process_config_text (cfg:&config_type) (text:string)
  {

    var re = RE2 ("([-a-zA-Z_]+) *: *(.*)");
    var FLX_INSTALL_DIR = cfg*.FLX_INSTALL_DIR;

    var lines = split (text, char "\n");
    for line in lines do
      var found = Match (re, line);
      match found with
      | Some v when v.len.int == 3 =>
        var p = v.1;
        var a = strip v.2;
        match p with
        | "FLX_INSTALL_DIR" =>
          FLX_INSTALL_DIR = a;
//println$ "processing config text, setting FLX_INSTALL_DIR=" + a;
          cascade_FLX_INSTALL_DIR cfg a;

        | "FLX_TARGET_SUBDIR" =>
          if FLX_INSTALL_DIR != "" do
            cascade_FLX_TARGET_DIR cfg (FLX_INSTALL_DIR / a);
          else
            eprintln$ "Cannot set FLX_TARGET_SUBDIR without setting FLX_INSTALL_DIR";
            // this one is pretty fatal :-)
            System::exit 1;
          done

        | "FLX_SHARE_DIR" => cascade_FLX_SHARE_DIR cfg a;
        | "FLX_TARGET_DIR" => cascade_FLX_TARGET_DIR cfg a;
        | "FLX_HOME_DIR" => cascade_FLX_HOME_DIR cfg a;
        | "FLX_PROFILE_DIR" => cfg.FLX_PROFILE_DIR <- a;
        | "FLX_CONFIG_DIRS" => cfg.FLX_CONFIG_DIRS <- respectful_split a;
        | "FLX_CACHE_DIR" => cfg.FLX_CACHE_DIR <- a;
        | "FLX_OUTPUT_DIR" => cfg.FLX_OUTPUT_DIR <- a;
        | "FLX_LIB_DIRS" => cfg.FLX_LIB_DIRS <-  respectful_split a;
        | "FLX_RTL_DIRS" => cfg.FLX_RTL_DIRS <- respectful_split a;
        | _ => ;
        endmatch;
      | #None => ;
      endmatch;
    done
  }


  proc config_env_overrides (cfg:&config_type)
  {

    match Env::getenv ("FLX_INSTALL_DIR","") with
    | "" => ;
    | x =>
//println$ "ENVIRONMENT OVERRIDE FOR FLX_INSTALL_DIR=" + x;
      cascade_FLX_INSTALL_DIR cfg x;
    endmatch;

    match Env::getenv ("FLX_SHARE_DIR","") with
    | "" => ;
    | x => cascade_FLX_SHARE_DIR cfg x;
    endmatch;

    match Env::getenv ("FLX_TARGET_DIR","") with
    | "" => ;
    | x => cascade_FLX_TARGET_DIR cfg x;
    endmatch;

    match Env::getenv ("FLX_CONFIG_DIRS","") with
    | "" => ;
    | x => cfg.FLX_CONFIG_DIRS <- respectful_split x;
    endmatch;

    match Env::getenv ("FLX_LIB_DIRS","") with
    | "" => ;
    | x => cfg.FLX_LIB_DIRS <- respectful_split x;
    endmatch;

    match Env::getenv ("FLX_RTL_DIRS","") with
    | "" => ;
    | x => cfg.FLX_RTL_DIRS <- respectful_split x;
    endmatch;
  }

  proc process_config_text_with_env_overrides (cfg:&config_type) (text:string)
  {
    process_config_text cfg text;
    config_env_overrides cfg;
  }

  fun std_config () = {
//println$ "Setting up default config";
    var cfg = #dflt_config;
//println$ "Processing config file felix.fpc with env overrides";
    process_config_text_with_env_overrides &cfg (load (cfg.FLX_PROFILE_DIR / "felix.fpc"));
    return cfg;
  }

}
Control Record.

Just initialises the base configuration data.

//[flx_control.flx]
class FlxControl
{
proc print_options(control:control_type) {
    println$ "NOOPTIMISE         = "+str control.NOOPTIMISE;
    println$ "STATIC             = "+str control.STATIC;
    println$ "ECHO               = "+str control.ECHO;
    println$ "NOSTDLIB           = "+str control.NOSTDLIB;
    println$ "DEBUG              = "+str control.DEBUG;
    println$ "DEBUG_COMPILER     = "+str control.DEBUG_COMPILER;
    println$ "STDIMPORTS          = "+str control.STDIMPORTS;
    println$ "STDGRAMMAR         = "+str control.STDGRAMMAR;
    println$ "IMPORTS            = "+str control.IMPORTS;
    println$ "RECOMPILE          = "+str control.RECOMPILE;
    println$ "FLXG_FORCE         = "+str control.FLXG_FORCE;
    println$ "ocamls              = "+str control.ocamls;
    println$ "cpps               = "+str control.cpps;
    println$ "cppos              = "+str control.cppos;
    println$ "TIME               = "+str control.TIME;
    println$ "COMPILER_TIME      = "+str control.COMPILER_TIME;
    println$ "BUNDLE_DIR         = "+str control.BUNDLE_DIR;
    println$ "RUNIT              = "+str control.RUNIT;
    println$ "CCOMPILEIT         = "+str control.CCOMPILEIT;
    println$ "LINKIT             = "+str control.LINKIT;
    println$ "RUNONLY            = "+str control.RUNONLY;
    println$ "CXXONLY            = "+str control.CXXONLY;
    println$ "OCAMLONLY          = "+str control.OCAMLONLY;
    println$ "FELIX              = "+str control.FELIX;
    println$ "LINKER_SWITCHES    = "+str control.LINKER_SWITCHES;
    println$ "LINKER_OUTPUT_FILENAME = "+str control.LINKER_OUTPUT_FILENAME;
    println$ "FLX_INTERFACE_FILENAME = "+str control.FLX_INTERFACE_FILENAME;
    println$ "CXX_INTERFACE_FILENAME = "+str control.CXX_INTERFACE_FILENAME;
    println$ "MACROS             = "+str control.MACROS;
    println$ "SHOWCODE           = "+str control.SHOWCODE;
    println$ "USAGE              = "+control.USAGE;
    println$ "DOREDUCE           = "+str control.DOREDUCE;
    println$ "OPTIMISE           = "+str control.OPTIMISE;
}

fun init_loopctl () => struct {
    // Argument parsing loop
    var argno=1;
    var grab=1;
    var path="";
    var ext="";
    var base="";
    var dir="";
    var progname = "";
};
typedef loopctl_type = typeof (#init_loopctl);

fun dflt_control () =>
  struct {

    var PRINT_HELP=0;

    var FLXG_FORCE=0;
    var RECOMPILE=0;
    var RUNIT=1;
    var CCOMPILEIT=1;
    var LINKIT=1;
    var LINKEXE=0; // default is to link a DLL
    var FELIX=1;
    var RUNONLY=0;
    var CXXONLY=0;
    var OCAMLONLY=0;
    var ECHO=0;
    var DEBUG_FLX=false;
    var VALIDATE_CACHE=1;
    var CHECK_DEPENDENCIES=1;
    var FLX_TOOLCHAIN="";
    var FLX_TARGET_SUBDIR="";
    // --------------------------------------------------
    // processing options
    // --------------------------------------------------

    var DIST_ROOT="";
    var DEBUG=0;
    var DEBUG_COMPILER=0;
    var COMPILER_PHASE="";
    var INLINE=25;
    var COMPILER_TIME=0;
    var TIME=0;
    var NOOPTIMISE=0;
    var DOREDUCE=1;
    var TIMECMD="time -p";
    var STATIC=0;
    var STATICLIB=0;
    var SHOWCODE=0;
    var CCFLAGS=Empty[string];
    var EXTRA_CCFLAGS=Empty[string];
    var EXTRA_PACKAGES=Empty[string];
    var LINKER_SWITCHES=Empty[string];
    var MACROS=Empty[string];

    var cpps=Empty[string];
    var cppos=Empty[string];

    var ocamls=Empty[string];

    var STANDARD_INCLUDE_FILES=Empty[string];
    var EXTRA_INCLUDE_DIRS=Empty[string];
    var EXTRA_INCLUDE_FILES=Empty[string];
    var FLX_STD_LIBS=Empty[string];
    var NOSTDLIB=0;
    var STDOUT="";
    var EXPECT="";
    var CHECK_EXPECT=0;
    var SET_STDIN=0;
    var STDIN="";
    var GRAMMAR_DIR="";
    var STDGRAMMAR="";
    //var STDIMPORTS  = Cons ("plat/flx.flxh", Cons ( "concordance/concordance.flxh", Empty[string]));
    var STDIMPORTS  = (["plat/flx.flxh", "concordance/concordance.flxh"]);
    var CMDLINE_INPUT=false;
    var REPL_MODE=false;
    var AUTOMATON="";
    var IMPORTS=Empty[string];
    var USAGE = "production";
    var CLEAR_CACHE=0;
    var BUNDLE_DIR = match Env::getenv("FLX_BUNDLE_DIR") with | "" => None[string] | dir => Some dir endmatch;

    var DRIVER_EXE = ""; // dynamic linkage only
    var DRIVER_OBJS = Empty[string]; // static linkage only
    var LINK_STRINGS = Empty[string];

    var pkgs=Empty[string];
    var extra_pkgs = Empty[string];
    var FLXG = "";
    var FLXRUN = Empty[string];
    var LINKER_OUTPUT_FILENAME = "";
    var FLX_INTERFACE_FILENAME = "";
    var CXX_INTERFACE_FILENAME = "";
    var OUTPUT_FILENAME_SPECIFIED = 0;
    var OUTPUT_FILENAME_WITHOUT_EXTENSION_SPECIFIED = 0;
    var OUTPUT_DIRECTORY_SPECIFIED = 0;
    var USER_ARGS = Empty[string];
    var DLINK_STRINGS = Empty[string];
    var SLINK_STRINGS = Empty[string];
    var cache_time = 0.0;
    var INDIR = "";
    var INREGEX = "";
    var NONSTOP = 0;
    var OPTIMISE = list[string]$ "-O1";
    var FLXG_OPTIMISE= 0;
  }
;

typedef control_type = typeof (#dflt_control);
}
Command line argument parser.

Parses the command line options.

//[flx_cmdopt.flx]
// NOTE: below the string "host" is used to help find files eg flxg.
// This is a temporary hack to get Felix working after filesystem reorgnisation.

class FlxCmdOpt
{
private proc print_help() {
  println "Usage: flx [options] filename[.flx] [args ..]";
  println "options:";
  println "--cmd=text           : save text to file 'cmd.flx' and process that";
  println "--repl               : enter REPL mode saving stuff in session.flx and library.flx";
  println "--test               : use felix installation in current directory";
  println "--test=dir           : use felix installation in dir";
  println "--target=dir         : subdir of install dir containing target configuration (default 'host')";
  println "--target-dir=dir     : dir containing target configuration (default '$FLX_INSTALL_DIR/host')";
  println "--pkgconfig-path+=dir: prepend extra flx_pkgconfig search directory to standard path";
  println "--toolchain=toolchain: pick a non-default C++ compiler toolchain";
  println "--felix=file         : get installation details from file";
  println "--where              : print location of felix installation";
  println "--show               : print the felix program to stdout";
  println "-c                   : compile only, do not run";
  println "-o                   : linker output filename";
  println "-ox                  : linker output filename (without extension)";
  println "-od                  : linker output directory" ;
  println "--usage=prototype    : fast compilation at the expense of slower executables";
  println "--usage=debugging    : enable debugging aids";
  println "--usage=production   : optimised code with run time safety checks retained";
  println "--usage=hyperlight   : optimised code without run time safety checks";
  println "--static             : make standalone statically linked executable";
  println "--staticlib          : make standalone library of static objects";
  println "--nofelix            : do not run felix translator, leave C++ outputs alone";
  println "--nocc               : do not C/C++ compiler; implies --nolink";
  println "--nolink             : do not link object files to an executable";
  println "--exe                : link executable";
  println "--run-only           : run program without dependency checking or linking";
  println "--c++                : Pure C++ build, no Felix code";
  println "--ocaml              : Pure Ocaml build, no Felix code";
  println "--options            : show option set";
  println "--config             : show configuration";
  println "--version            : show felix version";
  println "--force              : force run Felix compiler";
  println "--force-compiler     : force Felix compiler to rebuild everything";
  println "--cache-dir=dir      : directory cache output from parser (*.par files), autocreated, default $HOME/.felix/cache";
  println "--output-dir=dir     : directory to hold C++ output from translator, autocreated, default $HOME/.felix/cache";
  println "                       Felix stored by absolute pathname within directory (tree directory).";
  println "--bundle-dir=dir     : directory to hold C++ output from translator, autocreated.";
  println "                       Files directly in directory by basename (flat directory).";
  println "--clean              : delete the caches first";
  println "--help               : show this help";
  println "--noinline           : force inlining off, may break things!";
  println "--inline             : aggressive inlining";
  println "--inline=999         : set inline cap to 999 'instructions'";
  println "--echo               : print shell commands before running them";
  println "--time               : print target program run time after it finishes";
  println "--compile-time       : print time for compiler phases";
  println "--nostdlib           : don't load the standard library";
  println "--nooptimise         : disable C++ compiler optimisation";
  println "--noreduce           : disable reductions (default for compilation speed)";
  println "--doreduce           : enable reductions (default for performance)";
  println "--debug              : put debug symbols in generated binaries";
  println "--debug-compiler     : make felix compiler print progress diagnostics";
  println "--debug-flx          : make flx tool print diagnostics";
  println "--stdout=file        : run program with standard output redirected to file";
  println "--expect=file        : compare stdout with expect file";
  println "--expect             : compare stdout with basename.expect";
  println "--input=file         : set standard input";
  println "--input              : set standard input to basename.input";
  println "--indir=dir          : set directory for regexp search, default current directory";
  println "--regex=pattern      : Perl regexp for batch file processing";
  println "--nonstop            : don't stop on error in batch processing";
  println "--backup             : backup working source tree to dir 'backup'";
  println "--import=file        : add an import which is prefixed to all files being translated";
  println "--import=@file       : add all the files listed in file as imports (recursive on @)";
  println "--nostdimport        : don't import the standard imports nugram.flxh and flx.flxh";
  println "--compiler-phase     : specify which phase of the compiler to run";
  println "-Idir                : add dir to search path for both felix and C++ includes";
  println "-Ldir                : add dir to linker search path";
  println "-llib                : add dir lib to linker command";
  println "-foption             : add switch to compiler command";
  println "-Woption             : add switch to compiler command";
  println "-O0                  : add switch to compiler command";
  println "-O1                  : add switch to compiler command";
  println "-O2                  : add switch to compiler command";
  println "-O3                  : add switch to compiler command";
  println "--cflags=flags       : addd flags to compiler command";
  println "-Dmac                : add macro def to C++ compiler command";
  println "-DFLX_ENABLE_TRACE   : enable compilation of trace generators (defaults off)";
  println "-DFLX_CGOTO          : use gcc indirect gotos and use assembler hack for long jumps (default on if config detects support)";
  println "";
  println "*.c *.cc *.cpp *.cxx ";
  println "                     : add files to C++ compilation (and linker) steps";
  println "*.o *.obj *.lib *.dll *.a *.so";
  println "                     : add files to linker steps";
  println "* *.flx *.fdoc       : Felix program name, terminates options and starts runtime arguments";
  println "";
  println "Environment variables";
  println "---------------------";
  println "Flx build tool";
  println "  FLX_INSTALL_DIR=dir     : overrides default installation directory (as if --test=dir)";
  println "  FLX_SHELL_ECHO=1        : show shell callouts (system,popen)";
  println "  FLX_FILE_MONITOR=1      : reports on every file open (felix and flxg)";
  println "  FLX_REPORT_FILECOPY=1   : reports on every file copy (felix)";
  println "  FLX_DEBUG_FLX=1         : debug flx (as if --debug-flx set)";
  println "";
  println "Flxg compiler";
  println "  FLX_DEBUG_PARSER=1      : emit debug info from the Felix parser";
  println "  FLX_DEBUG_COMPILER_UNIQ=1  : emit debug of uniq flow analyser, instruction and flow analysis";
  println "  FLX_DEBUG_COMPILER_UNIQ_GETSET=1  : emit debug of uniq flow analyser, instruction analysis";
  println "";
  println "Run time system (affects flx as well as any binary run)";
  println "  FLX_DEBUG               : enable debugging traces (default off)";
  println "  FLX_DEBUG_ALLOCATIONS   : enable debugging allocator (default FLX_DEBUG)";
  println "  FLX_DEBUG_COLLECTIONS   : enable debugging collector (default FLX_DEBUG)";
  println "  FLX_REPORT_COLLECTIONS  : report collections (default FLX_DEBUG)";
  println "  FLX_DEBUG_THREADS       : enable debugging collector (default FLX_DEBUG)";
  println "  FLX_DEBUG_DRIVER        : enable debugging driver (default FLX_DEBUG)";
  println "";
  println "Run time GC tuning (affects flx as well as any binary run)";
  println "  FLX_FINALISE            : whether to cleanup on termination (default NO)";
  println "  FLX_GC_FREQ=n           : how often to call garbage collector (default 1000)";
  println "  FLX_MIN_MEM=n           : initial memory pool n Meg (default 10)";
  println "  FLX_MAX_MEM=n           : maximum memory n Meg (default -1 = infinite)";
  println "  FLX_FREE_FACTOR=n.m     : reset FLX_MIN_MEM to actual usage by n.m after gc (default 1.1)";
  println "  FLX_ALLOW_COLLECTION_ANYWHERE # (default yes)";
  println "";
  println "Felix Developer debugging";
  println "  FLX_DEBUG_USTR=1        : # Show malloc/realloc/free in ustr (default no)";


}

// TODO: change the names of everything to match exactly the command line
// switches so this can be used as a response file
proc setup-from-file (debugln: string -> 0)
(
  config:&Config::config_type,
  control:&FlxControl::control_type,
  arg:string
)
{
  debugln$ "Setup file: " + arg;
  var text = load arg;
  Config::process_config_text config (text);
  debugln$ "Config[after setupfile "+arg+"] =\n" + str (*config);
  control <- FlxControl::dflt_control();
  if control*.DEBUG_FLX call FlxControl::print_options(*control);

  fun / (a:string, b:string) => Filename::join (a,b);
  var re = RE2 ("([-_a-zA-Z0-9]+) *: *(.*)");
  var lines = split (load arg,char "\n");
  for line in lines do
    match Match (re,line) with
    | Some v =>
      var field = v.1;
      var data = strip v.2;
      match field with
      | "felix-compiler" => debugln$ "set flxg " + data; control.FLXG <-data;
      | "toolchain" => debugln$ "set toolchain "+data; control.FLX_TOOLCHAIN <- data;
      | "linker-switch" => debugln$ "add linker switch "+data;
          control.LINKER_SWITCHES <- control*.LINKER_SWITCHES + data;
      | "macro-switch" => debugln$ "add macro switches "+data;
          control.MACROS <- control*.MACROS + data;
      | "optimisation-switch" => debugln$ "set C++ optimisation level "+data;
          control.OPTIMISE <- control*.OPTIMISE + data;
      // American spelling
      | "optimization-switch" => debugln$ "set C++ optimization level "+data;
          control.OPTIMISE <- control*.OPTIMISE + data;
      | "cflag" => debugln$ "add C++ cflag "+data;
          control.EXTRA_CCFLAGS <- control*.EXTRA_CCFLAGS + data;
      | "flx-include-dir" => debugln$ "add Felix include dir "+data;
          config.FLX_LIB_DIRS <- config*.FLX_LIB_DIRS + data;
      | "rtl-include-dir" => debugln$ "add Felix and C++ rtl include dir "+data;
          config.FLX_RTL_DIRS <- config*.FLX_RTL_DIRS + data;
      | "grammar-dir" => debugln$ "set Felix grammar directory "+data;
          control.GRAMMAR_DIR <- data;
      | "grammar" => debugln$ "set Felix grammar (in stdlib) "+data;
          control.STDGRAMMAR <- data;
      | "std-import" => debugln$ "set Felix standard import (in stdlib) "+data;
          control.STDIMPORTS <- data ! control*.STDIMPORTS;
      | "extra-import" => debugln$ "set Felix extra import (in stdlib) "+data;
          control.IMPORTS <- control*.IMPORTS + data;
      | "extra-cpp" => debugln$ "set Felix extra C++ file "+data;
          control.cpps <- control*.cpps + data;
      | "extra-obj" => debugln$ "set Felix extra object file "+data;
          control.cppos <- control*.cppos + data;
      | "flx-std-lib" => debugln$ "add Felix standard (cached) library "+data;
          control.FLX_STD_LIBS <- control*.FLX_STD_LIBS+ data;
      | _ => debugln$ "Unknown field " + field;
      endmatch;
    | #None => ;
    endmatch;
  done
}

private noinline proc handle_switch
(
  config:&Config::config_type,
  control:&FlxControl::control_type,
  arg:string
)
{
  proc debugln[T with Str[T]] (x:T) {
    if control*.DEBUG_FLX call fprintln (cstderr, "[flx] " + str x);
  }

  if prefix(arg,"--cmd=") do
    begin
      var text = arg.[6 to];
      save( "cmd.flx", text+";\n");
      control.CMDLINE_INPUT <- true;
      debugln("Running command '" + text + ";'");
    end
  elif arg == "--repl" do
    control.REPL_MODE <- true;
      debugln("Set REPL mode");

  elif arg == "--nostdimport" do
    debugln "No standard library import";
    // Note: currently, Felix compiler generates code that REQUIRES
    // the standard library, eg the driver passes a gc_profile_t record
    // and the compiler generates _uctor_ objects, etc etc
    control.STDIMPORTS <- list[string]();

  elif prefix(arg,"--import=") do
   debugln "Add import";
   control.IMPORTS <- control*.IMPORTS + arg.[9 to];

  elif prefix(arg,"--felix=") do
    debugln "Set install details";
    setup-from-file debugln[string] (config, control, arg.[8 to]);

  elif prefix(arg,"--target=") do
    begin
      debugln "Set target subdirectory";
      var a = arg.[9 to];
      control.FLX_TARGET_SUBDIR <- a;
//println$ "SET FLX_TARGET_SUBDIR TO " + control*.FLX_TARGET_SUBDIR;
//println$ "Current FLX_INSTALL_DIR IS " + config*.FLX_INSTALL_DIR;
      Config::cascade_FLX_TARGET_DIR config (Filename::join (config*.FLX_INSTALL_DIR, control*.FLX_TARGET_SUBDIR));
//println$ "SET FLX_TARGET_DIR TO " + config*.FLX_TARGET_DIR;
    end

  elif prefix(arg,"--target-dir=") do
    debugln "Set target configuration directory";
    Config::cascade_FLX_TARGET_DIR config arg.[13 to];

  elif prefix(arg,"--pkgconfig-path+=") do
    debugln "Prepend extra flx_pkgconfig directory to standard path";
    config.FLX_CONFIG_DIRS <- arg.[18 to] + config*.FLX_CONFIG_DIRS;

  elif prefix(arg,"--toolchain=") do
    debugln "Set toolchain";
    control.FLX_TOOLCHAIN<- arg.[12 to];

  elif prefix(arg,"--test=") do
    var a = arg.[7 to];
    debugln "Set test directory";
    Config::cascade_FLX_INSTALL_DIR config a;
    control.FLX_TARGET_SUBDIR <- "host";

  elif arg=="--test" do
    begin
      debugln "Set test directory";
      a = ".";
      Config::cascade_FLX_INSTALL_DIR config a;
      control.FLX_TARGET_SUBDIR <- "host";
    end

  elif prefix(arg,"--stdout=") do
    debugln "Redirect standard output";
    // of the Felix program only: used for saving the output
    // to a file so the test harness can compare it with an .expect file
    control.STDOUT <- arg.[9 to];

  elif arg == "--expect" do
    debugln "compare stdout with expect file (default name)";
    // of the Felix program only: used for saving the output
    // to a file so the test harness can compare it with an .expect file
    control.CHECK_EXPECT <- 1;

  elif prefix(arg,"--expect=") do
    debugln "compare stdout with expect file";
    // of the Felix program only: used for saving the output
    // to a file so the test harness can compare it with an .expect file
    control.EXPECT <- arg.[9 to];
    control.CHECK_EXPECT <- 1;

  elif arg == "--input" do
    debugln "redirect stdin to (default name)";
    control.SET_STDIN <- 1;

  elif prefix(arg,"--input=") do
    debugln "redirect stdin to file";
    control.STDIN <- arg.[8 to];
    control.SET_STDIN <- 1;


  elif arg=="--show" do
    control.SHOWCODE <- 1;

  elif arg=="--clean" do
    debugln "Clear caches";
    control.CLEAR_CACHE <- 1;

  elif arg=="--force" do
    debugln "Force recompilation";
    // of the felix code, runs Felix unless --nofelix is set
    // the C++ compiler is run unless the felix compile failed
    control.RECOMPILE <- 1;

  elif arg=="--force-compiler" do
    debugln "Force flxg compiler to rebuild everything";
    // of the felix code, runs Felix unless --nofelix is set
    // the C++ compiler is run unless the felix compile failed
    control.RECOMPILE <- 1;
    control.FLXG_FORCE<- 1;

  elif arg=="--debug-flx" do
    control.DEBUG_FLX <- true;
    control.ECHO <- 1;
    debugln "debug flx tool ON";
    control.DEBUG <- 1;

  elif arg=="--debug" do
    debugln "Enable runtime debugging";
    control.DEBUG <- 1;

  elif arg=="--debug-compiler" do
    debugln "Enable compiler debugging";
    control.DEBUG_COMPILER <- 1;

  elif prefix(arg,"--compiler-phase=") do
    debugln "Change the compiler phase";
    control.COMPILER_PHASE <- arg.[len "--compiler-phase=" to];
    control.RUNIT <- 0;

  elif arg=="--nooptimise" do
    debugln "Disable optimisation";
    control.NOOPTIMISE <- 1;
    control.DOREDUCE <- 0;
  elif arg in ("--compiler-optimise","--compiler-optimize") do
    debugln "Enable heavy flxg optimisation";
    control.FLXG_OPTIMISE  <- 1;

  elif arg=="--nostdlib" do
    debugln "Do not load standard library";
    control.NOSTDLIB <- 1;

  elif arg == "--echo" do
    debugln "Echo commands sent to system";
    control.ECHO <- 1;

  elif arg == "--noreduce" do
    debugln "do not perform reductions";
    control.DOREDUCE <- 0;

  elif arg == "--doreduce" do
    debugln "do perform reductions";
    control.DOREDUCE <- 1;


  elif arg == "--static" do
    debugln "Compile a statically linked program";
    control.STATIC <- 1;
    control.LINKEXE<- 1;

  elif arg == "--staticlib" do
    debugln "make a static link library (instead of a program)";
    control.STATIC <- 1;
    control.STATICLIB <- 1;
    control.RUNIT <- 0;
    control.LINKEXE<- 0;

  elif arg == "--exe" do
    debugln "make an executable";
    control.LINKEXE<- 1;

  elif prefix(arg,"--inline=") do
    debugln "Set inline aggressiveness";
    control.INLINE <- int(arg.[9 to]);

  elif arg == "--inline" do
    debugln "Set inline aggressiveness";
    control.INLINE <- 100;

  elif arg == "--noinline" do
    debugln "Disable inlining (NOT RECOMMENDED)";
    control.INLINE <- 0;

  elif arg == "--version" do
    debugln "Print Felix version and exit";
    print("version ");
    println(Version::felix_version);
    System::exit(0);

  elif arg == "--config" do
    println (*config);
    System::exit(0);

  elif arg == "--options" do
    FlxControl::print_options(*control);
    System::exit(0);

  elif arg == "--where" do
    debugln "Print location of install directory and exit";
    println(config*.FLX_INSTALL_DIR);
    System::exit(0);

  elif arg == "--time" do
    debugln "Time program execution and print after running";
    control.TIME <- 1;

  elif arg == "--compile-time" do
    debugln "Print time of Felix compiler phases";
    control.COMPILER_TIME <- 1;


  elif prefix(arg,"--output_dir=") or prefix(arg,"--output-dir=") do
    debugln "Set the directory for compiler generated C++ files";
    config.FLX_OUTPUT_DIR <- arg.[13 to];

  elif prefix(arg,"--bundle_dir=") or prefix(arg,"--bundle-dir=") do
    debugln "Output files needed for C++ compilation into this folder (directly by basename)";
    control.BUNDLE_DIR <- Some arg.[13 to];

  elif prefix(arg,"--cache_dir=") or prefix(arg,"--cache-dir=") do
    debugln "Set the directory for compiler generated *.par files";
    config.FLX_CACHE_DIR <- arg.[12 to];

  elif arg == "--usage=prototype" do
    debugln "Set usage prototyping";
    control.USAGE  <-  "prototype";
    control.NOOPTIMISE <- 1;
    control.OPTIMISE  <-  list[string]$ "-O1";
    control.DOREDUCE  <-  0;
    control.INLINE <- 5;

  elif arg in ("--usage=debugging","--usage=debug") do
    debugln "Set usage debugging";
    control.USAGE  <-  "debugging";
    control.NOOPTIMISE <- 1;
    control.DEBUG  <-  1;
    control.DOREDUCE <-  0;
    control.OPTIMISE  <-   list[string]$"-O0";
    control.INLINE <- 5;

  elif arg == "--usage=production" do
    debugln "Set usage production";
    control.USAGE  <-  "production";
    control.DOREDUCE  <-  1;
    control.OPTIMISE  <-   list[string]$"-O2";
    control.INLINE <- 25;
    control.FLXG_OPTIMISE <- 1;

  elif arg == "--usage=hyperlight" do
    debugln "Set usage hyperlight";
    control.USAGE  <-  "hyperlight";
    control.DOREDUCE  <-  1;
    control.OPTIMISE  <-   list[string]$"-O2";
    control.INLINE <- 100;
    control.FLXG_OPTIMISE <- 1;

  elif arg == "--help" do
    control.PRINT_HELP <- 1;

  elif arg == "-c" do
    debugln "Compile program but do not run it";
    control.RUNIT <- 0;

  elif prefix(arg,"-I") do
    debugln "Set include directories for both Felix and C/C++";
    config.FLX_LIB_DIRS<- config*.FLX_LIB_DIRS + arg.[2 to];
    config.FLX_RTL_DIRS<- config*.FLX_RTL_DIRS + arg.[2 to];

  elif arg== "--nofelix" do
    debugln "Do not translate Felix code, just compile generated C++ (used to debug at C++ level)";
    control.FELIX <- 0;

  elif arg== "--nocc" do
    debugln "Do not run the C/C++ compiler, just generate C++ source code and exit; implies -c and --nolink";
    control.CCOMPILEIT <- 0;

  elif arg== "--nolink" do
    debugln "Do not link object code to an executable, just generate and compile the C++ source code; implies -c";
    control.LINKIT <- 0;

  elif arg == "--run-only" do
    debugln "Run the binary executable without any compilation. Must exist!";
    control.FELIX <-0;
    control.CCOMPILEIT <- 0;
    control.LINKIT <- 0;
    control.LINKEXE <- 0;
    control.RUNIT <- 1;
    control.VALIDATE_CACHE <- 0;
    control.CHECK_DEPENDENCIES <- 0;
    control.RUNONLY <- 1;

  elif prefix(arg,"-l") or prefix(arg,"-L") do
    debugln "Set extra switched for linker";
    control.LINKER_SWITCHES <- control*.LINKER_SWITCHES + arg;

  elif prefix(arg,"-D") do
    debugln "Set extra macros for C++ compilation";
    control.MACROS <- control*.MACROS + arg;

  elif arg \in ("-O0", "-O1","-O2","-O3") do
    debugln$ "Set C++ compilation optimisation " + arg;
    control.OPTIMISE <-  list[string]$ arg;

  elif prefix(arg,"-f") do
    debugln$ "Set C++ compilation switch "+arg;
    control.EXTRA_CCFLAGS  <-  control*.EXTRA_CCFLAGS + arg;

  elif prefix(arg,"--cflags=") do
    {
      var flags = arg.[9 to];
      debugln$ "Set C++ compilation switch "+ flags;
      control.EXTRA_CCFLAGS  <-  control*.EXTRA_CCFLAGS + flags;
    };

  elif prefix(arg,"-W") do
    debugln$ "Set C++ warning switch "+arg;
    control.EXTRA_CCFLAGS  <-  control*.EXTRA_CCFLAGS + arg;

  elif prefix(arg,"--pkg=") do
    debugln "Add pkgconfig package to link";
    control.pkgs <-  control*.pkgs +arg.[6 to];

  elif prefix (arg,"--indir=") do
    control.INDIR  <-  arg.[8 to];
    debugln$ "Set input directory for regexp to " + control*.INDIR;

  elif prefix (arg,"--regex=") do
    control.INREGEX  <-  arg.[8 to];
    debugln$ "Set input regex to " + control*.INREGEX;

  elif arg == "--nonstop" do
    control.NONSTOP <- 1;
    debugln$ "Set batch processing mode to nonstop " + control*.NONSTOP;

  elif arg == "--c++" do
    control.CXXONLY <- 1;
    control.FELIX <- 0;
    debugln$ "C++ only, no Felix";

  elif arg == "--ocaml" do
    control.OCAMLONLY <- 1;
    control.FELIX <- 0;
    debugln$ "Ocaml only, no Felix";

// the main filename -- subsequent args are args to flx_run
  else
    eprintln$ "Unknown switch '" + arg+"'";
    System::exit 1;
  done
}


private noinline proc handle_filename
(
  ploopctl:&FlxControl::loopctl_type,
  config:&Config::config_type,
  control:&FlxControl::control_type,
  arg:string
)
{
  proc debugln[T with Str[T]] (x:T) {
    if control*.DEBUG_FLX call fprintln (cstderr, "[flx] " + str x);
  }

  ploopctl.progname <- arg;
  var path,ext = Filename::split_extension(arg);
  ploopctl.path <- path;
  ploopctl.ext <- ext;
  var dir,base = Filename::split1(ploopctl*.path);
  ploopctl.dir <- dir;
  ploopctl.base <- base;

  match check_ext $ Filename::get_extension arg with
  | "compile" =>
     control.cpps <- control*.cpps + arg;

  | "link" =>
     control.cppos <- control*.cppos + arg;

  | "felix" =>
    ploopctl.grab <- 0;

  | "none" =>
    ploopctl.grab <- 0;

  | "unknown" =>
    eprintln$ "Unknown file extension in " + arg;
    System::exit 1;

  | "ocaml" =>
    control.ocamls<- control*.ocamls + arg;

  | _ => assert false;
  endmatch
  ;
}

// --------------------------------------------------
// String Utilities
// --------------------------------------------------

// utility to classify extensions.
private fun exts () = {
  var compile_exts = list ('.cpp','.cxx','.c','.cc');
  var ocaml = list ('.mli','.ml','.cmi','cmx','.cmxa');

  var link_exts =  list ('.o','.obj','.lib','.dll','.a','.so','.dylib','.os');
  var felix_exts = list (".flx",".fdoc");
  var exts =
    map (fun (s:string) => s,"ocaml") ocaml+
    map (fun (s:string) => s,"compile") compile_exts +
    map (fun (s:string) => s,"link") link_exts +
    map (fun (s:string) => s,"felix") felix_exts +
    ("","none")
  ;
  return exts;
}

private fun check_ext (s:string) => match find #exts s with
  | Some tag => tag
  | #None => "unknown"
;

private noinline proc xparse_cmd_line
(
  config:&Config::config_type,
  control:&FlxControl::control_type,
  ploopctl:&FlxControl::loopctl_type,
  vargs: varray[string]
)
{
  proc debugln[T with Str[T]] (x:T) {
    if control*.DEBUG_FLX call fprintln (cstderr, "[flx] " + str x);
  }

  var SET_LINKER_OUTPUT = false;
  var SET_LINKER_OUTPUT_WITHOUT_EXTENSION = false;
  var SET_LINKER_OUTPUT_DIRECTORY = false;

grabbing_args: while ploopctl*.grab == 1 and ploopctl*.argno < vargs.len.int do
    var arg = vargs . (ploopctl*.argno);
    debugln$ "ARGNO="+str(ploopctl*.argno)+", arg='"+arg+"'";

    if SET_LINKER_OUTPUT do
       control.LINKER_OUTPUT_FILENAME <- arg;
       debugln$ "Set linker output file=" + control*.LINKER_OUTPUT_FILENAME;
       SET_LINKER_OUTPUT = false;
       control.OUTPUT_FILENAME_SPECIFIED <- 1;

    elif SET_LINKER_OUTPUT_WITHOUT_EXTENSION do
       control.LINKER_OUTPUT_FILENAME <- arg;
       debugln$ "Set linker output file=" + control*.LINKER_OUTPUT_FILENAME;
       SET_LINKER_OUTPUT_WITHOUT_EXTENSION = false;
       control.OUTPUT_FILENAME_WITHOUT_EXTENSION_SPECIFIED <- 1;

    elif SET_LINKER_OUTPUT_DIRECTORY do
       control.LINKER_OUTPUT_FILENAME <- arg;
       debugln$ "Set linker output directory =" + control*.LINKER_OUTPUT_FILENAME;
       SET_LINKER_OUTPUT_DIRECTORY= false;
       control.OUTPUT_DIRECTORY_SPECIFIED <- 1;


    elif arg == "-o" do
      debugln "Set linker output name (next arg)";
      SET_LINKER_OUTPUT=true;

    elif arg == "-ox" do
      debugln "Set linker output name (without extension) (next arg) ";
      SET_LINKER_OUTPUT_WITHOUT_EXTENSION=true;

    elif arg == "-od" do
      debugln "Set linker output directory (next arg) ";
      SET_LINKER_OUTPUT_DIRECTORY=true;


    elif arg == "--" do
      ploopctl.grab <- 0;

    elif not (prefix (arg,"-")) do
      handle_filename(ploopctl,config,control,arg);

    else
      handle_switch(config,control,arg);

    done
    ploopctl.argno <- ploopctl*.argno + 1;
  done

  if control*.CMDLINE_INPUT or control*.REPL_MODE do
    handle_filename(ploopctl,config,control,"cmd.flx");
  done

}

noinline proc processing_stage1
(
  config:&Config::config_type,
  control:&FlxControl::control_type,
  xloopctl:&FlxControl::loopctl_type,
  vargs:varray[string]
)
{
  fun / (x:string, y:string) => Filename::join (x,y);

  proc debugln[T with Str[T]] (x:T) {
    if control*.DEBUG_FLX call fprintln (cstderr, "[flx] " + str x);
  }

  // process environment variables
  if Env::getenv "FLX_DEBUG_FLX" != "" do
    control.DEBUG_FLX <- true;
    control.ECHO <- 1;
    debugln "debug flx tool ON";
    control.DEBUG <- 1;
  done

  xparse_cmd_line(config,control,xloopctl, vargs);
  if control*.PRINT_HELP == 1 do
    print_help;
    System::exit(0);
  done

  var xqt = dxqt (control*.ECHO==1 or control*.DEBUG_FLX);

  if control*.LINKIT == 0 and control*.STATICLIB == 1 do
    eprintln$ "Conflicting switches --nolink and --staticlib";
    System::exit 1;
  done

  debugln$ xloopctl*.grab, xloopctl*.argno, System::argc;

  // Primary filename established.
  debugln "#--------";
  debugln$ "DONE, option index = "+str(xloopctl*.argno);
  debugln$ "path="+xloopctl*.path+": dir="+xloopctl*.dir+",base="+xloopctl*.base+", ext="+xloopctl*.ext;
  debugln$ "cpps="+str control*.cpps;
  debugln$ "cppos="+str control*.cppos;

  debugln$ "ocamls="+str control*.ocamls;


  // Grab program arguments.
  while xloopctl*.argno < vargs.len.int do
    control.USER_ARGS `(+=) vargs . (xloopctl*.argno);
    pre_incr (xloopctl.argno);
  done
  debugln$ "USER_ARGS=" + str control*.USER_ARGS;

  debugln$ "config=" + str (*config);

  // Establish C++ optimisation switches.
  if control*.NOOPTIMISE == 0 do
    debugln "Set C++ compiler optimisation switches";
    control.CCFLAGS <- control*.CCFLAGS+ control*.OPTIMISE;
  else
    debugln "What, no optimisation?";
  done
  // Note we have to do it this way so the -f switches turn
  // off optimisations previously introduced (order matters)
  control.CCFLAGS <- control*.CCFLAGS + control*.EXTRA_CCFLAGS;
  debugln$ "CCFLAGS =" + str control*.CCFLAGS;

  // Establish name of Felix compiler and run time library.
  // The one in "host" is good enough for flxg, however the
  // library location MUST be changed for cross compilation.
  // FIXME!

  var dflt_flxg = "";
  var dflt_flx_run = Empty[string];
  if PLAT_WIN32 do
    dflt_flxg = Filename::join(config*.FLX_TARGET_DIR, 'bin', 'flxg.exe');
    dflt_flx_run = list$ "set", "PATH="+(Directory::mk_absolute_filename config*.FLX_TARGET_DIR)+"\\lib\\rtl;"+"%PATH%&&";
  else
    dflt_flxg = config*.FLX_TARGET_DIR+"/bin/flxg";
    // the mac uses DYLD_LIBRARY_PATH instead of LD_LIBRARY_PATH
    if PLAT_MACOSX do
      dflt_flx_run = list$ "env","DYLD_LIBRARY_PATH="+config*.FLX_TARGET_DIR+"/lib/rtl:$DYLD_LIBRARY_PATH";
    elif PLAT_CYGWIN do
      // hack: we need to set BOTH since PATH is used for load time dynamic linkage
      // but LD_LIBRARY_PATH for run time (dlopen style) dynamic linkage
      dflt_flx_run = list$ "env",
        "LD_LIBRARY_PATH="+config*.FLX_TARGET_DIR+"/lib/rtl:$LD_LIBRARY_PATH",
        "PATH="+config*.FLX_TARGET_DIR+"/lib/rtl:$PATH"
    ;
    else
      dflt_flx_run = list$ "env", "LD_LIBRARY_PATH="+config*.FLX_TARGET_DIR+"/lib/rtl:$LD_LIBRARY_PATH";
    done
  done
  control.FLXG <-
    match control*.FLXG with
    | "" => dflt_flxg
    | x => x
    endmatch
  ;
  debugln$ "FLXG = " + control*.FLXG;
  control.FLXRUN <-
    match control*.FLXRUN with
    | #Empty => dflt_flx_run
    | x => x
    endmatch
  ;
  debugln$ "FLXRUN = " + control*.FLXRUN;


  // TEMPORARY HACK: use the right stuff from the felix.fpc file
  // a bit later .. for now the OS selection macros will do ..
  fun link_strings () = {
    var DLINK_STRING = "";
    var SLINK_STRING = "";
    if PLAT_WIN32 do // MSVC
      DLINK_STRING = "/LIBPATH:"+config*.FLX_TARGET_DIR+r"\lib\rtl";
      SLINK_STRING = "/LIBPATH:"+config*.FLX_TARGET_DIR+r"\lib\rtl";
    elif PLAT_CYGWIN do // gcc on Windows
      //DLINK_STRING = "-L"+config*.FLX_TARGET_DIR+"/bin";
      DLINK_STRING = "-L"+config*.FLX_TARGET_DIR+"/lib/rtl";
      SLINK_STRING = "-L"+config*.FLX_TARGET_DIR+"/lib/rtl";
    else // Unix: gcc or clang
      DLINK_STRING = "-L"+config*.FLX_TARGET_DIR+"/lib/rtl";
      SLINK_STRING = "-L"+config*.FLX_TARGET_DIR+"/lib/rtl";
    done;
    return DLINK_STRING, SLINK_STRING;
  }


  // Get linker names.
  var d,s = link_strings();
  control.DLINK_STRINGS <-  Shell::parse d;
  control.SLINK_STRINGS <-  Shell::parse s;

  fun mkrel (d:string, f:string) =>
    if Filename::is_absolute_filename f then f else d / f endif
  ;

  var dflt_grammar_dir = config*.FLX_SHARE_DIR/"lib";

  control.GRAMMAR_DIR <-
    match control*.GRAMMAR_DIR with
    | "" => dflt_grammar_dir
    | x => Directory::mk_absolute_filename x
    endmatch
  ;
  debugln$ "GRAMMAR_DIR = " + control*.GRAMMAR_DIR;

  var dflt_grammar = Directory::mk_absolute_filename
    (Filename::join (control*.GRAMMAR_DIR,"grammar/grammar.files"))
  ;
  control.STDGRAMMAR <-
    match control*.STDGRAMMAR with
    | "" => dflt_grammar
    | x =>
      if Filename::is_absolute_filename x then x
      else Filename::join (control*.GRAMMAR_DIR, x)
    endmatch
  ;
  debugln$ "STDGRAMMAR = " + control*.STDGRAMMAR;

  var dflt_automaton =
    cache_join
    (
      config*.FLX_CACHE_DIR,
      Filename::join (control*.STDGRAMMAR, "syntax.automaton")
    )
  ;
  control.AUTOMATON <-
    match control*.AUTOMATON with
    | "" => dflt_automaton
    | x => x
    endmatch
  ;
  debugln$ "AUTOMATON = " + control*.AUTOMATON;


  // this hack forces a directory name, because executing "prog"
  // can fail if the currect directory is not on the PATH,
  // or worse, the wrong program can execute. The PATH is not
  // searched if the filename includes a / somewhere so force one in.
  // similarly for dynamic loaders looking for shared libraries
  //
  // It would probably be better to convert any relative filename
  // to an absolute one, however this only makes sense on Unix
  // since Windows has multiple "drives" it is much harder to
  // do the conversion.
  xloopctl.dir <-
    if xloopctl*.dir != "" then xloopctl*.dir
    else "."
    endif
  ;
}
}
Calculate Dependent variables.

Computes all the detailed variables needed to run the various tools from a base configuration.

//[flx_depvars.flx]
include "std/felix/flx/flx_control";

class FlxDepvars
{
typedef dvars_type = (
    filebase:string,
    cpp_filebase:string,
    args: list[string],
    use_ext:string,
    FLX_STD_LIBS: list[string],
    GRAMMAR_DIR: string,
    STDGRAMMAR: string,
    AUTOMATON: string,
    DEBUGSWITCH:list[string],
    STATIC_ENV:list[string],
    VERBOSE: list[string]
  );

gen cal_depvars(
  toolchain_maker: toolchain_config_t -> toolchain_t,
  c_compiler_executable: string,
  cxx_compiler_executable: string,
  config:Config::config_type,
  control:&FlxControl::control_type,
  loopctl:FlxControl::loopctl_type)
  : dvars_type
  =
{
  proc debugln[T with Str[T]] (x:T) {
    if control*.DEBUG_FLX call fprintln (cstderr, "[flx] " + str x);
  }
  fun / (d:string, f:string) => Filename::join (d,f);

  // case 1 of dflt
  var dflt_toolchain_config = (
      c_compiler_executable = c_compiler_executable,
      cxx_compiler_executable = cxx_compiler_executable,
      header_search_dirs = Empty[string],
      macros = Empty[string],
      library_search_dirs= Empty[string],
      ccflags= Empty[string],
      dynamic_libraries= Empty[string],
      static_libraries= Empty[string],
      debugln = debugln[string]
  );
  var tc = toolchain_maker dflt_toolchain_config;
  var EXT_LIB = #(tc.static_library_extension);
  var EXT_SHLIB = #(tc.dynamic_library_extension);
  var EXT_EXE = #(tc.executable_extension);
  var EXT_STATIC_OBJ = #(tc.static_object_extension);
  var EXT_SHARED_OBJ = #(tc.dynamic_object_extension);
  var DEBUG_FLAGS = #(tc.debug_flags);


  debugln$ "Felix package manager config directories are "+config.FLX_CONFIG_DIRS.str;
  // make a list of any *.cpp files (or other g++ options ..)

  debugln$ "FileDir= " + loopctl.dir;
  var rel_filebase = if loopctl.dir == "." then loopctl.base else Filename::join(loopctl.dir,loopctl.base);
  debugln$ "Rel_filebase= " + rel_filebase;
  debugln$ "Given Extension=" + loopctl.ext;

    // this is a hack! We should resolve the filename first.
  var use_ext = if loopctl.ext != "" then loopctl.ext else
    #{
       var flxt = FileStat::dfiletime (rel_filebase+".flx",#FileStat::past_time);
       var fdoct = FileStat::dfiletime (rel_filebase+".fdoc",#FileStat::past_time);
       return
         if flxt > fdoct then ".flx"
         elif fdoct > flxt then ".fdoc"
         else ""
       ;
    }
  ;
  debugln$ "Computed Extension=" + use_ext;
  var filebase = Directory::mk_absolute_filename$ rel_filebase;
  debugln$ "User program base is " + filebase;
  var cpp_filebase =
    match control*.BUNDLE_DIR with
    | Some dir => Filename::join(dir,Filename::basename filebase)
    | #None =>if config.FLX_OUTPUT_DIR=="" then filebase
             else cache_join(config.FLX_OUTPUT_DIR,filebase)
             endif
    endmatch;
  debugln$ "C++ file base is " + cpp_filebase;

  // if we're supposed to check output against an expect file,
  // and no stdout file name is given, then direct output
  // into the cache.
  if control*.CHECK_EXPECT != 0 and control*.STDOUT == "" do
    control.STDOUT <- cache_join (config.FLX_OUTPUT_DIR,filebase + ".stdout");
    debugln$ "Set stdout to " + control*.STDOUT;
  done

  if control*.SET_STDIN != 0 and control*.STDIN == "" do
    var stdin_name = filebase + ".input";
    if FileStat::fileexists stdin_name  do
      control.STDIN <- stdin_name;
    elif control*.INREGEX == "" do
      eprintln$ "WARNING: computed input file " + stdin_name + " doesn't exist!";
    done
    debugln$ "Set stdin to " + control*.STDIN;
  done


  // if we're supposed to check output against an expect file,
  // and no expect file name is given, then use the filebase
  // with extension .expect.
  if control*.CHECK_EXPECT != 0 and control*.EXPECT == "" do
    var expect_name = filebase + ".expect";
    if FileStat::fileexists expect_name do
      control.EXPECT <- expect_name;
    elif control*.INREGEX == "" do
      eprintln$ "WARNING: computed expect file " + expect_name + " doesn't exist!";
    done
    debugln$ "Set expect to " + control*.EXPECT;
  done


  // Find absolute pathname

  if loopctl.path == "" do
    fprint$ cstderr, ("No such felix program: "+loopctl.path+"\n");
    System::exit(1);
  done

  control.FLX_INTERFACE_FILENAME <-
    match control*.BUNDLE_DIR with
    | Some dir => Filename::join(dir,Filename::basename filebase+"_interface.flx")
    | #None => cache_join (config.FLX_OUTPUT_DIR,filebase+"_interface.flx")
    endmatch;
  debugln$ "Flx interface filename is " + control*.FLX_INTERFACE_FILENAME;

  control.CXX_INTERFACE_FILENAME <-
    match control*.BUNDLE_DIR with
    | Some dir => Filename::join(dir,Filename::basename filebase+".hpp")
    | #None => cache_join (config.FLX_OUTPUT_DIR,filebase+".hpp")
    endmatch;
  debugln$ "C++ interface filename is " + control*.FLX_INTERFACE_FILENAME;

  if control*.LINKER_OUTPUT_FILENAME == "" do
    if control*.LINKIT == 1 or control*.RUNONLY == 1 do
      if control*.STATICLIB == 1 do
        var f = filebase+EXT_LIB;
      elif control*.STATIC == 0 do // dynamic
        if control*.LINKEXE == 1 do
          f = filebase+EXT_LIB;
        else // DLL
          f = filebase+EXT_SHLIB;
        done
      else
        f = filebase+EXT_EXE;
      done
    else // No link, name specifies object file only.
      if control*.STATIC == 1 do
        f = filebase+EXT_STATIC_OBJ;
      else
        f = filebase+EXT_SHARED_OBJ;
      done
    done
    control.LINKER_OUTPUT_FILENAME <- cache_join (config.FLX_CACHE_DIR,f);
    debugln$ "Felx writing output binary to " + control*.LINKER_OUTPUT_FILENAME;
  elif control*.OUTPUT_FILENAME_WITHOUT_EXTENSION_SPECIFIED == 1 do
    if control*.LINKIT == 1 or control*.RUNONLY == 1 do
      if control*.STATICLIB == 1 do
        control.LINKER_OUTPUT_FILENAME `(+=) EXT_LIB;
      elif control*.STATIC == 0 do // dynamic
        if control*.LINKEXE == 1 do
          control.LINKER_OUTPUT_FILENAME `(+=) EXT_EXE;
        else
          control.LINKER_OUTPUT_FILENAME `(+=) EXT_SHLIB;
        done
      else
        control.LINKER_OUTPUT_FILENAME `(+=) EXT_EXE;
      done
    else // No link, name specifies object file only.
      if control*.STATIC == 1 do
        control.LINKER_OUTPUT_FILENAME `(+=) EXT_STATIC_OBJ;
      else
        control.LINKER_OUTPUT_FILENAME `(+=) EXT_SHARED_OBJ;
      done
    done
  elif control*.OUTPUT_DIRECTORY_SPECIFIED == 1 do
    var basename = Filename::basename (Filename::strip_extension filebase);
    if control*.LINKIT == 1 or control*.RUNONLY == 1 do
      if control*.STATICLIB == 1 do
        control.LINKER_OUTPUT_FILENAME <- control*.LINKER_OUTPUT_FILENAME / basename + EXT_LIB;
      elif control*.STATIC == 0 do // dynamic
        if control*.LINKEXE == 1 do
          control.LINKER_OUTPUT_FILENAME <- control*.LINKER_OUTPUT_FILENAME / basename + EXT_EXE;
        else
          control.LINKER_OUTPUT_FILENAME <- control*.LINKER_OUTPUT_FILENAME / basename + EXT_SHLIB;
        done
      else
        control.LINKER_OUTPUT_FILENAME <- control*.LINKER_OUTPUT_FILENAME / basename + EXT_EXE;
      done
    else // No link, name specifies object file only.
      if control*.STATIC == 1 do
        control.LINKER_OUTPUT_FILENAME <- control*.LINKER_OUTPUT_FILENAME / basename + EXT_STATIC_OBJ;
      else
        control.LINKER_OUTPUT_FILENAME <- control*.LINKER_OUTPUT_FILENAME / basename + EXT_SHARED_OBJ;
      done
    done
  done
  control.LINKER_OUTPUT_FILENAME <-  Directory::mk_absolute_filename control*.LINKER_OUTPUT_FILENAME;
  control.LINKER_OUTPUT_FILENAME <-
   match control*.BUNDLE_DIR with
    | Some dir => Filename::join(dir,Filename::basename control*.LINKER_OUTPUT_FILENAME)
    | #None => control*.LINKER_OUTPUT_FILENAME
    endmatch;
  debugln$ "Linker output filename " + control*.LINKER_OUTPUT_FILENAME;


  val args = control*.USER_ARGS;
  debugln$ "Target program args = "+args.str;

  if control*.NOSTDLIB == 1 do
    var FLX_STD_LIBS=Empty[string];
  else
    match control*.FLX_STD_LIBS with
    | #Empty => FLX_STD_LIBS = list[string] ("std");
    | x => FLX_STD_LIBS = x;
    endmatch;
  done
  debugln$ "Felix standard (cached) libraries: " + str FLX_STD_LIBS;

  var STDGRAMMAR = Directory::mk_absolute_filename control*.STDGRAMMAR;
  var GRAMMAR_DIR = Directory::mk_absolute_filename control*.GRAMMAR_DIR;
  var AUTOMATON = Directory::mk_absolute_filename control*.AUTOMATON;

  var DEBUGSWITCH=Empty[string];
  if control*.DEBUG == 1 do DEBUGSWITCH=list[string]$ "--debug"; done

  var STATIC_ENV=Empty[string];
  if control*.DEBUG == 1 do STATIC_ENV=list[string] ("env","FLX_DEBUG=1"); done

  debugln$ "RECOMPILE="+str control*.RECOMPILE;
  debugln$ "RUNIT="+str control*.RUNIT;

  var VERBOSE = Empty[string];
  if control*.DEBUG_COMPILER == 1 do
    VERBOSE=list[string] "-v";
    debugln "Compiler debugging on";
  else
    VERBOSE=list[string]$  "-q";
    debugln "Compiler debugging off";
  done

  if control*.DEBUG==1 do
    control.CCFLAGS <- control*.CCFLAGS+DEBUG_FLAGS;
  done


  return struct {
    var filebase=filebase;
    var cpp_filebase=cpp_filebase;
    var args = args;
    var use_ext = use_ext;
    var FLX_STD_LIBS=FLX_STD_LIBS;
    var AUTOMATON=AUTOMATON;
    var GRAMMAR_DIR=GRAMMAR_DIR;
    var STDGRAMMAR=STDGRAMMAR;
    var DEBUGSWITCH=DEBUGSWITCH;
    var STATIC_ENV=STATIC_ENV;
    var VERBOSE = VERBOSE;
  };

} // fun cal_depvars
} // class FlxDepvars
The execution manager.

This part of the flx tool is responsible for calculating dependencies and actually running the external compilers.

//[flx_run.flx]
include "std/felix/flx/flx_depchk";
include "std/felix/flx/flx_control";
include "std/felix/flx/flx_depvars";

gen dxqt(DBG:bool) (cmd:string) = {
  if DBG call fprintln (cstderr, "cmd="+cmd);
  var now = #Time::time;
  var result,output = Shell::get_stdout(cmd);
  if result == 0 do
    n :=
      match find_first_of (output, char "\n") with
      | Some n => n
      | #None => output.len
      endmatch
    ;
    output = output.[to n]; // first line excluding newline
    var elapsed = #Time::time - now;
    if DBG call fprintln (cstderr, "Popen:Elapsed: " + fmt (elapsed, fixed(9,3)) + ", output='"+output+"'");
  else
    if DBG call eprintln "COMMAND FAILED";
    fprint$ cstderr, ("Error "+repr(result)+" executing command " + cmd + "\n");
    System::pexit result;
  done
  return output;
}

proc xdebugln[T with Str[T]] (d:bool) (x:T) {
  if d call fprintln (cstderr, "[flx] " + str x);
}

// CLEAR_CACHE is set to 1 if the cache is reset
proc check_cache(
  config:&Config::config_type,
  control:&FlxControl::control_type)
{
  var cc,ct = validate_cache (
    FLX_SHARE_DIR = config*.FLX_SHARE_DIR,
    AUTOMATON = control*.AUTOMATON,
    GRAMMAR_DIR = control*.GRAMMAR_DIR,
    STDGRAMMAR = control*.STDGRAMMAR,
    FLXG = control*.FLXG,
    CACHE_DIR = config*.FLX_CACHE_DIR,
    OUTPUT_DIR = config*.FLX_OUTPUT_DIR,
    CLEAR_CACHE= control*.CLEAR_CACHE,
    debugln = xdebugln[string] (control*.DEBUG_FLX),
    xqt = dxqt (control*.ECHO == 1 or control*.DEBUG_FLX),
    quote = Shell::quote_arg
  );
  control.CLEAR_CACHE <- cc;
  control.cache_time <-  ct;
}

object processing_env(
  toolchain_maker: toolchain_config_t -> toolchain_t,
  c_compiler_executable: string,
  cxx_compiler_executable: string,
  config:Config::config_type,
  var control:FlxControl::control_type,
  dvars:FlxDepvars::dvars_type)
=
{
  proc debugln[T with Str[T]] (x:T) {
    if control.DEBUG_FLX call fprintln (cstderr, "[flx] " + str x);
  }

  proc echoln[T with Str[T]] (x:T) {
    if control.ECHO == 1 call fprintln (cstderr, "[flx] " + str x);
  }

  // case 2 of dflt
  var dflt_toolchain_config = (
      c_compiler_executable = c_compiler_executable,
      cxx_compiler_executable = cxx_compiler_executable,
      header_search_dirs = Empty[string],
      macros = Empty[string],
      library_search_dirs= Empty[string],
      ccflags= Empty[string],
      dynamic_libraries= Empty[string],
      static_libraries= Empty[string],
      debugln = debugln[string]
  );

  proc showtime(msg:string, t0:double)
  {
    if control.TIME == 1 do
      var elapsed = #Time::time - t0;
      var minutes = floor (elapsed / 60.0);
      var seconds = elapsed - minutes * 60.0;
      println$ "[flx] Time : " + fmt(minutes,fixed(2,0))+"m" + fmt(seconds,fixed(4,1)) + "s for " + msg;
    done
  }


  method gen system(cmd:string):int= {
    var now = #Time::time;
    if control.ECHO==1 do fprintln$ cstderr, cmd; done
    var result = System::system(cmd);
    var elapsed = #Time::time - now;
    if control.ECHO==1 do
      fprintln$ cstderr, "System:Elapsed: " + fmt (elapsed, fixed (8,3)) +
        ", Result code " + str(result)
      ;
    done
    return result;
  }

//----------------------------------------------------------------------------
// CALPACKAGES
//----------------------------------------------------------------------------

  var calpackages_run = false;

/*
  proc ehandler () {
    eprintln$ "Flx: calpackages : failed, temporary ehandler invoked";
    System::exit 1;
  }
*/
  proc calpackages (ehandler:1->0)
  {
    debugln$ "[flx:calpackages] Calculating package requirements (calpackages_run="+str calpackages_run +")";
    if not calpackages_run  do
      var tc = toolchain_maker dflt_toolchain_config;
      var x = FlxPkg::map_package_requirements ehandler
      (
         FLX_TARGET_DIR = config.FLX_TARGET_DIR,
         FLX_CONFIG_DIRS = config.FLX_CONFIG_DIRS,
         EXT_EXE = #(tc.executable_extension),
         EXT_STATIC_OBJ = #(tc.static_object_extension),
         EXT_DYNAMIC_OBJ = #(tc.dynamic_object_extension),
         STATIC = control.STATIC,
         LINKEXE = control.LINKEXE,
         SLINK_STRINGS = control.SLINK_STRINGS,
         DLINK_STRINGS = control.DLINK_STRINGS,
         LINKER_SWITCHES = control.LINKER_SWITCHES,
         cpp_filebase = dvars.cpp_filebase,
         EXTRA_PACKAGES = control.pkgs
      );
      //control.EXTRA_CCFLAGS = control.EXTRA_CCFLAGS + x.CFLAGS;
      &control.CCFLAGS <- control.CCFLAGS + x.CFLAGS;
      &control.EXTRA_INCLUDE_FILES <- x.INCLUDE_FILES;
      &control.DRIVER_EXE <- x.DRIVER_EXE;
      &control.DRIVER_OBJS <- x.DRIVER_OBJS;
      &control.LINK_STRINGS <- x.LINK_STRINGS;
      //println$ "LINK STRINGS = " + x.LINK_STRINGS;
      calpackages_run = true;
    done
  }

  fun find_cxx_pkgs (src:string) : list[string] =
  {
    debugln$ "[flx:find_cxx_pkgs] Scanning " + src + " for package requirements";
    var out = Empty[string];
    var pat = RE2('.*@requires package ([A-Za-z][A-Za-z0-9_-]*).*');
    var f = fopen_input_text src;
    if valid f do
      for line in f do
        var result = Match (pat,line);
        match result do
        | #None => ;
        | Some v => out = v.1  + out;
        done
      done
      fclose f;
    else
      eprintln("Can't find C++ source file " + src);
      System::exit(1);
    done
    out = rev out;
    if out != Empty[string] call
      eprintln$ "[flx] C++ file "+src+" requires packages " + str (out);
    return out;
  }

//----------------------------------------------------------------------------
// FELIX COMPILATION
//----------------------------------------------------------------------------

  // max time of Felix source files: #FileStat::future_time if any missing
  fun cal_time_from_flxdepfile (debugln: string->0, df: string):double=
  {
    fun maxf (x: double) (f:string) =
    {
      if f == "" do return x; done
      var ext = Filename::get_extension f;
      var ft = if ext != "" then FileStat::dfiletime (f,#FileStat::past_time) else
        max (FileStat::dfiletime (f+".fdoc", #FileStat::past_time), FileStat::dfiletime (f+".flx",#FileStat::past_time))
      ;
      debugln$ ("Time "+f+" = "+ FileStat::strfiletime ft);
      ft = if ft == #FileStat::past_time then #FileStat::future_time else ft; // missing dependency
      return max (x,ft);
    }

    fun cal_files_time (fs: list[string])=> fold_left maxf #FileStat::past_time fs;

    var deptext = load_text df;
    var lines = split (deptext, "\n");
    debugln$ "Deps=" + str(lines);
    var deptime =
      let ft = cal_files_time lines in
      if ft == #FileStat::past_time then #FileStat::future_time else ft endif
    ;
    debugln$ "Deptime=" + FileStat::strfiletime(deptime);
    return deptime;
  }

  fun cal_cxx_uptodate(debugln:string -> 0, OUTPUT_DIR:string, f:string)=
  {
    val depfilename = cache_join (OUTPUT_DIR, f+".dep");
    debugln$ "Dependency file name = " + depfilename;
    var depfiletime = FileStat::dfiletime (depfilename, #FileStat::future_time);
    if depfiletime == #FileStat::future_time do
      debugln$ "Dependency file doesn't exist";
      return false;
    done

    var deptime = cal_time_from_flxdepfile (debugln, depfilename);
    debugln$ "dep time = " + FileStat::strfiletime deptime;
    debugln$ "depfile time = " + FileStat::strfiletime depfiletime;
    var cxx_uptodate = deptime < depfiletime;
    debugln$ "cxx generated by flxg is = " + if cxx_uptodate then "" else " NOT " endif + "uptodate";
    return cxx_uptodate;
  }

  gen check_cxx_uptodate () : bool =
  {
    debugln "Check Felix->C++ uptodate";
    if control.RECOMPILE == 1 do
      debugln$ "Felix->C++ dependency checking skipped due to switch RECOMPILE=1: forced not uptodate";
      return false;
    elif control.CHECK_DEPENDENCIES == 1 do
      debugln "Checking Felix->C++ dependencies since CHECK_DEPENDENCIES=1 to see if the cxx is uptodate";
      return cal_cxx_uptodate (debugln[string], config.FLX_OUTPUT_DIR, dvars.filebase);
    else
      debugln$ "Felix->C++ dependency checking skipped due to switch CHECK_DEPENDENCIES=0: forced uptodate";
      return true;
    done
  }

  gen run_felix_compiler_if_required (ehandler:1->0) : int =
  {
    var result = 0;
    var uptodate = check_cxx_uptodate ();
    debugln$ "[run_felix_compiler_if_required] Uptodate=" + uptodate.str;
    if not uptodate do
      debugln$ "Running flxg because target is not uptodate";
      var t0 = #Time::time;
      result = Flxg::run_felix_compiler
      (
        INLINE=control.INLINE,
        OUTPUT_DIR=config.FLX_OUTPUT_DIR,
        BUNDLE_DIR=control.BUNDLE_DIR,
        CACHE_DIR=config.FLX_CACHE_DIR,
        COMPILER_PHASE= control.COMPILER_PHASE,
        DOREDUCE=control.DOREDUCE,
        FLXG = control.FLXG,
        VERBOSE = dvars.VERBOSE,
        // NOTE: BUG: Not passing grammar directory to compiler!
        // flxg expects file in standard library
        STDGRAMMAR = "@"+control.STDGRAMMAR,
        AUTOMATON = control.AUTOMATON,
        IMPORTS = control.STDIMPORTS + control.IMPORTS,
        FLXLIBS = dvars.FLX_STD_LIBS,
        INCLUDE_DIRS = config.FLX_LIB_DIRS,
        filebase = dvars.filebase,
        use_ext = dvars.use_ext,
        TIME = control.COMPILER_TIME,
        FORCE = control.FLXG_FORCE,
        FLAGS = if control.FLXG_OPTIMISE == 0 then Empty[string] else list[string] "--optimise" endif,
        debugln = if control.ECHO==1 then echoln[string] else debugln[string] endif
      );
      showtime("Felix flxg   : "+dvars.cpp_filebase, t0);
      if result == 0 do
        debugln$ "Felix compilation succeeded";
        calpackages ehandler;
        FlxPkg::write_include_file(dvars.cpp_filebase, control.EXTRA_INCLUDE_FILES);
      done
    else
      debugln$ "skipping flxg because output is uptodate";
    done
    return result;
  }
//----------------------------------------------------------------------------
// C++ COMPILATION
//----------------------------------------------------------------------------

  // C++ dynamic (one file)
  gen cxx_compile_dynamic1 (ehandler:1->0) (src:string, dst:string) : int =
  {
    var t0 = #Time::time;
    var pkgs = find_cxx_pkgs src;
    control&.extra_pkgs <- control.extra_pkgs + pkgs;
    var pkg_cflags = Empty[string];
    if pkgs != Empty[string] do
      eprintln$ "[flx:cxx_compile_dynamic1] Adding packages " + str pkgs;
      var PKGCONFIG_PATH=map
         (fun (s:string) => "--path+="+s)
         config.FLX_CONFIG_DIRS
      ;
      var allargs = PKGCONFIG_PATH+"--field=cflags"+"--keepleftmost"+pkgs + control.pkgs;
      var ret,mycflags = FlxPkgConfig::flx_pkgconfig(allargs);
      if ret != 0 do
        eprintln$ "[flx:cxx_compile_dynamic1] Error " + str ret + " executing flx_pkgconfig, args=" + str allargs;
        // FIXME
        //System::exit (1);
        throw_continuation ehandler;
      done
      pkg_cflags = mycflags;
    done
    var tc = toolchain_maker
      extend dflt_toolchain_config with
      (
        ccflags = /* ccflags + */ control.CCFLAGS + pkg_cflags,
        header_search_dirs = config.FLX_RTL_DIRS+control.EXTRA_INCLUDE_DIRS,
        macros = control.MACROS,
        debugln = if control.ECHO==1 then echoln[string] else debugln[string] endif
      )
      end
    ;
    if control.RECOMPILE==1 or not cxx_depcheck (tc,src,dst) do
      var result = tc.cxx_dynamic_object_compiler (dst=dst,src=src);
      showtime("Dynamic c++  : "+src, t0);
      return result;
    else
      return 0;
    done
  }

  // C++ dynamic (many files)
  gen cxx_compile_dynamic (ehandler:1->0) : int =
  {
    var EXT_SHARED_OBJ = #((toolchain_maker dflt_toolchain_config).dynamic_object_extension);
    if
      control.CXXONLY == 0 and (
      control.LINKIT == 1 or
      control.OUTPUT_FILENAME_SPECIFIED == 0 and
      control.OUTPUT_FILENAME_WITHOUT_EXTENSION_SPECIFIED == 0)
    do
//println$ "Compiling thunk";
      var result = cxx_compile_dynamic1 ehandler
      (
        dvars.cpp_filebase+"_static_link_thunk.cpp",
        dvars.cpp_filebase+"_static_link_thunk"+EXT_SHARED_OBJ
      );
      if result != 0 return result;
    done

    if control.CXXONLY == 0 do
      if control.LINKIT == 0 do
        result = cxx_compile_dynamic1 ehandler (dvars.cpp_filebase+".cpp", control.LINKER_OUTPUT_FILENAME);
        if result != 0 return result;
      else
        result = cxx_compile_dynamic1 ehandler (dvars.cpp_filebase+".cpp", dvars.cpp_filebase+EXT_SHARED_OBJ);
        if result != 0 return result;
      done
    done

    for src in control.cpps do
      var dst = Filename::strip_extension src + EXT_SHARED_OBJ;
      result = cxx_compile_dynamic1 ehandler (src,dst);
      if result != 0 return result;
      += (&control.cppos, dst);
    done
    return 0;
  }

  // C++ static (one file)
  gen cxx_compile_static (ehandler:1->0) : int =
  {
    // we only need the thunk if we're linking OR -o switch was NOT specified
    // i.e. skip compiling the thunk the output name was specified and
    // represents an object file (or library archive?)
//println$ "cxx_compile_static";
    var EXT_STATIC_OBJ = #((toolchain_maker dflt_toolchain_config).static_object_extension);
    if
      control.CXXONLY == 0 and (
      control.LINKIT == 1 or
      control.OUTPUT_FILENAME_SPECIFIED == 0 and
      control.OUTPUT_FILENAME_WITHOUT_EXTENSION_SPECIFIED == 0)
    do
//println$ "Compiling thunk";
      var result = cxx_compile_static1 ehandler
      (
        dvars.cpp_filebase+"_static_link_thunk.cpp",
        dvars.cpp_filebase+"_static_link_thunk"+EXT_STATIC_OBJ
      );
      if result != 0 return result;
    done

    for src in control.cpps do
      var dst = Filename::strip_extension src +EXT_STATIC_OBJ;
      result = cxx_compile_static1 ehandler (src,dst);
      if result != 0 return result;
      += (&control.cppos,dst);
    done

    if control.CXXONLY == 0 do
      if control.LINKIT == 0 do
  //println$ "Compile only " + control.LINKER_OUTPUT_FILENAME;
        // compile only
        return cxx_compile_static1 ehandler
          (dvars.cpp_filebase+".cpp",control.LINKER_OUTPUT_FILENAME);
      else
        // compile and link
  //println$ "Compile and link " + dvars.cpp_filebase+EXT_STATIC_OBJ;
        return cxx_compile_static1 ehandler
          (dvars.cpp_filebase+".cpp",dvars.cpp_filebase+EXT_STATIC_OBJ);
      done
    else
      return 0;
    done
  }

  // C++ static (many files)
  gen cxx_compile_static1 (ehandler:1->0) (src: string, dst: string) : int =
  {
//println$ "cxx_compile_static1: " + src " -> " + dst;
    var t0 = #Time::time;
    var pkgs = find_cxx_pkgs src;
    control&.extra_pkgs <- control.extra_pkgs + pkgs;
    var pkg_cflags = Empty[string];
    if pkgs != Empty[string] do
      eprintln$ "[flx:cxx_compile_static1] Adding packages " + str pkgs;
      var PKGCONFIG_PATH=map
         (fun (s:string) => "--path+="+s)
         config.FLX_CONFIG_DIRS
      ;
      var allargs = PKGCONFIG_PATH+"--field=cflags"+"--keepleftmost"+pkgs+control.pkgs;
      var ret,mycflags = FlxPkgConfig::flx_pkgconfig(allargs);
      if ret != 0 do
        eprintln$ "[flx:cxx_compile_static1] Error " + str ret + " executing flx_pkgconfig, args=" + str allargs;
        // FIXME
        System::exit (1);
      done
      pkg_cflags = mycflags;
    done

    var tc = toolchain_maker
      extend dflt_toolchain_config with
      (
        ccflags = /*ccflags + */ control.CCFLAGS + pkg_cflags,
        header_search_dirs = config.FLX_RTL_DIRS+control.EXTRA_INCLUDE_DIRS,
        macros = control.MACROS,
        debugln = if control.ECHO==1 then echoln[string] else debugln[string] endif
      )
      end
    ;
    if control.RECOMPILE==1 or not cxx_depcheck (tc,src,dst) do
      var result = tc.cxx_static_object_compiler (dst=dst,src=src);
      showtime("Static c++   : "+src,t0);
      if result != 0 do
        eprintln$ "[flx] C++ compilation "+src+" failed";
      done
      return result;
    else
      return 0;
    done

  }

  // C++ (many files)
  gen run_cxx_compiler_if_required (ehandler:1->0) : int =
  {
    var result = 0;
    if control.STATIC == 0 do
      debugln "Dynamic linkage";
      result = cxx_compile_dynamic ehandler;
    else
      debugln "Static linkage";
      result = cxx_compile_static ehandler;
    done
    return result;
  }

 gen ocaml_compile1 (ehandler:1->0) (deps:list[string], s:string) = {
    var xqt = dxqt (control.ECHO == 1 or control.DEBUG_FLX);
    var result = xqt("ocamlopt.opt -c " + cat " " deps + " "+ s);
    C_hack::ignore(result);
    return 0;
 }

 gen ocaml_compile (ehandler:1->0) = {
    var deps = Empty[string];
    for src in control.ocamls do
      if suffix(src,".cmi")
      or suffix(src,".cmx")
      do
        deps+=src;
      else
        var result = ocaml_compile1 ehandler (deps,src);
        if result != 0 return result;
        if suffix(src,".mli") do
          deps+= src.[..-5]+".cmi";
        elif suffix(src,".ml") do
          deps+= src.[..-4]+".cmi";
        done
      done
    done
    return 0;
 }

 gen run_ocaml_compiler_if_required (ehandler:1->0) : int =
 {
   return ocaml_compile ehandler;
 }

/*

  gen check_run_if_required_and_uptodate() : bool  =
  {

    if control.RECOMPILE == 0 and control.RUNIT == 1 and control.CLEAR_CACHE == 0 do
      var uptodate = #check_cxx_uptodate and #check_binary_uptodate;
      if control.STATIC == 0 do
        if uptodate do
          debugln$ "Running dynamically linked binary";
          return true;
        else
          debugln$ "Dynamically linked binary out of date or non-existant";
        done
      else
        if uptodate do
          debugln$ "Running statically linked binary";
          return true;
        else
          debugln$ "Statically linked binary out of date or non-existant";
        done
      done
    done
    return false;

  }
  gen run_with_calpackages () : int =
  {
    if control.STATIC == 0 do
      return #run_dynamic_with_calpackages;
    else
      return #run_program_static;
    done
  }
*/

//----------------------------------------------------------------------------
// LINKAGE
//----------------------------------------------------------------------------

  // ------------------------------------------------------------------
  // Link shared library (dll)
  // ------------------------------------------------------------------
  gen cxx_link_shared_library (ehandler:1->0) : int =
  {
    var t0 = #Time::time;
    var pkg_dstrings= Empty[string];
    var pkgs = control.extra_pkgs;
    if pkgs != Empty[string] do
      eprintln$ "[flx:cxx_link_shared_library] Adding packages " + str pkgs;
      var PKGCONFIG_PATH=map
         (fun (s:string) => "--path+="+s)
         config.FLX_CONFIG_DIRS
      ;
      var allargs = PKGCONFIG_PATH+"-r"+"--field=provides_dlib"+"--field=requires_dlibs"+"--keepleftmost"+pkgs + control.pkgs;
      var ret,mydstrings = FlxPkgConfig::flx_pkgconfig(allargs);
      if ret != 0 do
        eprintln$ "[flx:cxx_link_shared_library] Error " + str ret + " executing flx_pkgconfig, args=" + str allargs;
        // FIXME
        //System::exit (1);
        throw_continuation ehandler;
      done
      pkg_dstrings = FlxPkg::fix2word_flags mydstrings;
    done

    var tc = toolchain_maker
      extend dflt_toolchain_config with
      (
        dynamic_libraries = control.LINK_STRINGS+pkg_dstrings, // a bit of a hack ..
        debugln = if control.ECHO==1 then echoln[string] else debugln[string] endif
      )
      end
    ;
    var EXT_SHARED_OBJ = #(tc.dynamic_object_extension);
    if control.CXXONLY == 0 do
      var result = tc.dynamic_library_linker
        (
          dst=control.LINKER_OUTPUT_FILENAME,
          srcs= control.cppos + (dvars.cpp_filebase+EXT_SHARED_OBJ)
        )
      ;
    else
      result = tc.dynamic_library_linker
        (
          dst=control.LINKER_OUTPUT_FILENAME,
          srcs= control.cppos
        )
      ;
    done

    showtime("Dynamic link : "+control.LINKER_OUTPUT_FILENAME,t0);
    if result != 0 do
      eprintln$ "[flx] C++ clink "+control.LINKER_OUTPUT_FILENAME+" failed";
    done
    return result;
  }

  gen cxx_link_shared_library_with_calpackages (ehandler:1->0) : int =
  {
    calpackages ehandler;
    return cxx_link_shared_library ehandler;
  }

  // ------------------------------------------------------------------
  // Link shared exe
  // ------------------------------------------------------------------
  gen cxx_link_shared_exe (ehandler:1->0) : int =
  {
    var t0 = #Time::time;
    var pkg_dstrings= Empty[string];
    var pkgs = control.extra_pkgs;
    if pkgs != Empty[string] do
      eprintln$ "[flx:cxx_link_shared_exe] Adding packages " + str pkgs;
      var PKGCONFIG_PATH=map
         (fun (s:string) => "--path+="+s)
         config.FLX_CONFIG_DIRS
      ;
      var allargs = PKGCONFIG_PATH+"-r"+"--field=provides_dlib"+"--field=requires_dlibs"+"--keepleftmost"+pkgs + control.pkgs;
      var ret,mydstrings = FlxPkgConfig::flx_pkgconfig(allargs);
      if ret != 0 do
        eprintln$ "[flx:cxx_link_shared_exe] Error " + str ret + " executing flx_pkgconfig, args=" + str allargs;
        // FIXME
        //System::exit (1);
        throw_continuation ehandler;
      done
      pkg_dstrings = FlxPkg::fix2word_flags mydstrings;
    done
    var tc = toolchain_maker
      extend dflt_toolchain_config with
      (
        //ccflags = ccflags + control.CCFLAGS + control.LINK_STRINGS,
        dynamic_libraries = control.LINK_STRINGS + pkg_dstrings, // a bit of a hack
        debugln = if control.ECHO==1 then echoln[string] else debugln[string] endif
      )
      end
    ;
    println$ "Toolchain loaded " + #(tc.whatami);
/*
println$ "flx, prior to calling toolchain: DRIVER OBJS = " + control.DRIVER_OBJS.str;
println$ "flx, prior to calling toolchain: cppos = " + control.cppos.str;
*/
    var EXT_DYNAMIC_OBJ = #(tc.dynamic_object_extension);
    if control.CXXONLY == 0 do
      var result = tc.dynamic_executable_linker
        (
          dst=control.LINKER_OUTPUT_FILENAME,
          srcs=
            control.DRIVER_OBJS +
            control.cppos +
            (dvars.cpp_filebase+"_static_link_thunk"+EXT_DYNAMIC_OBJ) +
            (dvars.cpp_filebase+EXT_DYNAMIC_OBJ)
        )
      ;
    else
      result = tc.dynamic_executable_linker
        (
          dst=control.LINKER_OUTPUT_FILENAME,
          srcs=
            control.cppos
        )
      ;
    done
    showtime("Dynamic executable link  : "+control.LINKER_OUTPUT_FILENAME,t0);
    if result != 0 do
      eprintln$ "[flx] C++ dynamic executable link "+control.LINKER_OUTPUT_FILENAME+" failed";
    done
    return result;
  }

  gen cxx_link_shared_exe_with_calpackages(ehandler:1->0) :  int =
  {
    calpackages ehandler;
    return cxx_link_shared_exe ehandler;
  }

  // ------------------------------------------------------------------
  // Link static exe
  // ------------------------------------------------------------------
  gen cxx_link_static_exe (ehandler:1->0) : int =
  {
    var t0 = #Time::time;
    var pkg_sstrings= Empty[string];
    var pkgs = control.extra_pkgs;
    if pkgs != Empty[string] do
      eprintln$ "[flx:cxx_link_static] Adding packages " + str pkgs;
      var PKGCONFIG_PATH=map
         (fun (s:string) => "--path+="+s)
         config.FLX_CONFIG_DIRS
      ;
      var allargs = PKGCONFIG_PATH+"-r"+"--field=provides_slib"+"--field=requires_slibs"+"--keepleftmost"+pkgs + control.pkgs;
      var ret,mysstrings = FlxPkgConfig::flx_pkgconfig(allargs);
      if ret != 0 do
        eprintln$ "[flx:cxx_link_static] Error " + str ret + " executing flx_pkgconfig, args=" + str allargs;
        // FIXME
        //System::exit (1);
        throw_continuation ehandler;
      done
      pkg_sstrings = FlxPkg::fix2word_flags mysstrings;
    done
    var tc = toolchain_maker
      extend dflt_toolchain_config with
      (
        //ccflags = ccflags + control.CCFLAGS + control.LINK_STRINGS,
        static_libraries = control.LINK_STRINGS + pkg_sstrings, // a bit of a hack
        debugln = if control.ECHO==1 then echoln[string] else debugln[string] endif
      )
      end
    ;
    var EXT_STATIC_OBJ = #(tc.static_object_extension);
    if control.CXXONLY == 0 do
      var result = tc.static_executable_linker
        (
          dst=control.LINKER_OUTPUT_FILENAME,
          srcs=
            control.DRIVER_OBJS +
            control.cppos +
            (dvars.cpp_filebase+"_static_link_thunk"+EXT_STATIC_OBJ) +
            (dvars.cpp_filebase+EXT_STATIC_OBJ)
        )
      ;
    else
      result = tc.static_executable_linker
        (
          dst=control.LINKER_OUTPUT_FILENAME,
          srcs=
            control.cppos
        )
      ;
    done
    showtime("Static executable link  : "+control.LINKER_OUTPUT_FILENAME,t0);
    if result != 0 do
      eprintln$ "[flx] C++ static executable link "+control.LINKER_OUTPUT_FILENAME+" failed";
    done
    return result;
  }

  gen cxx_link_static_exe_with_calpackages(ehandler:1->0) :  int =
  {
    calpackages ehandler;
    return cxx_link_static_exe ehandler;
  }

  // ------------------------------------------------------------------
  // Link static (archive) library
  // ------------------------------------------------------------------

  gen cxx_static_library (ehandler:1->0) : int =
  {
    var t0 = #Time::time;
    var tc = toolchain_maker
      extend dflt_toolchain_config with
      (
        //ccflags = ccflags + control.CCFLAGS,
        debugln = if control.ECHO==1 then echoln[string] else debugln[string] endif
      )
      end
    ;
    var EXT_STATIC_OBJ = #(tc.static_object_extension);
    if control.CXXONLY == 0 do
      var result = tc . static_library_linker
        (
          srcs=control.cppos + (dvars.cpp_filebase+EXT_STATIC_OBJ) ,
          dst=control.LINKER_OUTPUT_FILENAME
        )
      ;
    else
      result = tc . static_library_linker
        (
          srcs=control.cppos,
          dst=control.LINKER_OUTPUT_FILENAME
        )
      ;
    done
    showtime("Static lib   : "+control.LINKER_OUTPUT_FILENAME,t0);
    if result != 0 do
      eprintln$ "[flx] C++ static library link "+control.LINKER_OUTPUT_FILENAME+" failed";
    done
    return result;
  }



  // Assumes C++ generated by flxg (using timestamp of dep file)
  // Assumes command line C++ file includes older than the argument (fixme!)
  gen check_binary_uptodate () : bool =
  {
    fun maxf (t:double) (f:string) => max (t, FileStat::dfiletime (f, #FileStat::future_time));

    debugln "Check C++->binary uptodate";
    if control.RECOMPILE == 1 do
      debugln$ "C++->binary dependency checking skipped due to switch RECOMPILE=1: forced not uptodate";
      return false;
    elif control.CHECK_DEPENDENCIES == 1 do
      debugln "Checking C++->binary dependencies since CHECK_DEPENDENCIES=1 to see if the output is uptodate";

      var xtime = FileStat::dfiletime(control.LINKER_OUTPUT_FILENAME,#FileStat::past_time);
      val depfilename = cache_join (config.FLX_OUTPUT_DIR, dvars.filebase+".dep");
      var flx_srctime = FileStat::dfiletime (depfilename,#FileStat::future_time);
      var cpp_srctime = fold_left maxf #FileStat::past_time control.cpps;
      var obj_srctime = fold_left maxf #FileStat::past_time control.cppos;
      var deptime = max (max (flx_srctime, cpp_srctime), obj_srctime);
      var uptodate = xtime > deptime;


      debugln$ "Extra c++ sources  "+ str control.cpps;
      debugln$ "Extra object files "+ str control.cppos;

      debugln$ "Extra ocaml files  "+ str control.ocamls;

      debugln$ "Filebase = " + dvars.filebase;

      debugln$ "cache   time = " + FileStat::strfiletime (control.cache_time);
      debugln$ "flx_src time = " + FileStat::strfiletime (flx_srctime);
      debugln$ "cpp_src time = " + FileStat::strfiletime (cpp_srctime);
      debugln$ "obj_src time = " + FileStat::strfiletime (obj_srctime);

      debugln$ "dep     time = " + FileStat::strfiletime (deptime);
      debugln$ "Binary  time = " + FileStat::strfiletime (xtime) + " for " + control.LINKER_OUTPUT_FILENAME;
      debugln$ "output is " + if uptodate then "" else " NOT " endif + " up to date";
      return uptodate;
    else
      debugln$ "C++->binary dependency checking skipped due to switch CHECK_DEPENDENCIES=0: forced uptodate";
      return true;
    done
  }


  gen run_linker_if_required(ehandler:1->0) : int =
  {
    var result = 0;
    if control.CCOMPILEIT == 0 do
      debugln "C++ compilation (and linking and running) skipped by switch";
    else
      var uptodate = #check_binary_uptodate;
      if uptodate do
        debugln "Linking skipped because binary is uptodate";
      else
        if control.STATIC == 0 do
          debugln "Dynamic linkage";
          if control.LINKEXE == 1 do
            result = cxx_link_shared_exe_with_calpackages ehandler;
          else
            result = cxx_link_shared_library_with_calpackages ehandler;
          done
        else
          debugln "Static linkage";
          if control.STATICLIB == 1 do
            result = cxx_static_library ehandler;
          else
            result = cxx_link_static_exe_with_calpackages ehandler;
          done
        done
      done
    done
    return result;
  }



/*
  method gen runit() : int = {
    var immediate_run = #check_run_if_required_and_uptodate;
    if immediate_run do
      debugln$ "Uptodate so run immediately";
      return #run_with_calpackages;
    else
      var result = #run_felix_compiler_if_required;
      if result != 0 return result;
      return #run_cxx_and_exe_as_required;
    done
  }
*/
//----------------------------------------------------------------------------
// EXECUTION
//----------------------------------------------------------------------------

  gen run_program_dynamic (ehandler:1->0) : int =
  {
    var result = 0;
    if control.CXXONLY == 0 do
      var xargs =
        control.DRIVER_EXE +
        dvars.DEBUGSWITCH +
        control.LINKER_OUTPUT_FILENAME +
        dvars.args
      ;
      var CMD = strcat ' ' control.FLXRUN + ' ' + catmap ' ' Shell::quote_arg xargs;
      if control.STDOUT != "" do CMD=CMD+" > " +Shell::quote_arg(control.STDOUT); done
      if control.STDIN != "" do CMD=CMD+" < " +Shell::quote_arg(control.STDIN); done
      debugln$ "Run command="+CMD;
      var t0 = #Time::time;
      result = system(CMD);
      showtime("Dynamic Run : "+control.LINKER_OUTPUT_FILENAME,t0);
    else
      println$ "Cannot run C++ dynamic library " + control.LINKER_OUTPUT_FILENAME;
    done
    return result;
  }

  gen run_program_static (ehandler:1->0) : int =
  {
    var result = 0;
    var CMD =
      catmap ' ' Shell::quote_arg ( dvars.STATIC_ENV + control.LINKER_OUTPUT_FILENAME + dvars.args )
    ;

    if control.STDOUT != "" do CMD=CMD + " > "+Shell::quote_arg(control.STDOUT); done
    if control.STDIN != "" do CMD=CMD+" < " +Shell::quote_arg(control.STDIN); done
    debugln$ "Run command="+CMD;
    var t0 = #Time::time;
    result=system(CMD);
    showtime("Static Run   : "+control.LINKER_OUTPUT_FILENAME,t0);
    return result;
  }


  gen run_dynamic_with_calpackages (ehandler:1->0) : int =
  {
    calpackages ehandler;
    return run_program_dynamic ehandler;
  }

  gen run_program_if_required (ehandler:1->0) : int =
  {
    var result = 0;
    if control.STATIC == 0 do
      debugln$ "Running dynamic program";
      result = run_dynamic_with_calpackages ehandler;
    else
      // NOTE: since Felix sets environment variable for plugin loads ..
      // doesn't even a static program need calpackages?
      debugln$ "Running static program";
      result = run_program_static ehandler;
    done
    return result;
  }
//----------------------------------------------------------------------------
// OUTPUT VERIFICATION
//----------------------------------------------------------------------------

  gen check_output_if_required () : int =
  {
    var result = 0;
    var expected = control.EXPECT;
    var output = control.STDOUT;

    // possible bug in flx, if either missing it should have been
    // set by default based on program name
    if output == "" do
      eprintln$ "[flx] No output file given??";
      result = 1;
    elif expected == "" do
      eprintln$ "[flx] No expect file given??";
      result = 1;
    else

      // note load never fails, at worse loads empty string.
      var output_text = load_text (output);
      var expected_text = load_text (expected);
      var bresult = output_text == expected_text;
      if not bresult do
        eprintln$ "[flx] Output " + output + " doesn't match expected " + expected;
        result = 1;
      done
    done
    return result;
  }
//----------------------------------------------------------------------------
// ORDER OF OPERATION
//----------------------------------------------------------------------------

  method gen runit(ehandler:1->0) : int = {
    var result = 0;
    if control.FELIX == 1 do
      result = run_felix_compiler_if_required ehandler;
      if result != 0 return result;
    else
      debugln$ "Felix compilation skipped by switch";
    done

    // we should run this on demand? And split up calculations
    // for driver (needed to run dynamic program) and headers etc
    // (needed after flxg to complete C++ code gen) and link stuff
    // (needed for linkage)
    calpackages ehandler;
    if control.LINKER_OUTPUT_FILENAME != "" do
       Directory::mkdirs (Filename::dirname control.LINKER_OUTPUT_FILENAME);
    done

    if control.CCOMPILEIT == 1 do
      result = run_cxx_compiler_if_required ehandler;
      if result != 0 return result;
    else
      debugln "C++ compilation (and linking and running) skipped by switch";
    done

    if control.CCOMPILEIT == 1 do // use this switch for Ocaml compiles too
      result = run_ocaml_compiler_if_required ehandler;
    else
      debugln "Ocaml compilation skipped by switch";
    done

    if control.LINKIT == 1 do
      result = run_linker_if_required ehandler;
      if result != 0 return result;
    else
      debugln "Link step skipped by switch";
    done

    if control.RUNIT == 1 do
      result = run_program_if_required ehandler;
      if result != 0 return result;
    else
      debugln "Running program skipped by switch";
    done

    if control.EXPECT != "" do
      result = #check_output_if_required;
      if result != 0 return result;
    done
    return result;
  }

}
The {flx} tool.
//[flx.flx]
include "std/felix/config";

include "std/felix/flx_cache";
include "std/felix/flx_pkg";
include "std/felix/flx_flxg";
include "std/felix/flx_cxx";

include "std/felix/flx/flx_control";
include "std/felix/flx/flx_cmdopt";
include "std/felix/flx/flx_depvars";
include "std/felix/flx/flx_run";
include "std/felix/toolchain_config";
include "std/felix/toolchain_interface";

open FlxCache;

fun startlib (x:string) =
{
   return x in RE2(" *(fun|proc|var|val|gen|union|struct|typedef).*\n");
}

// MOVE LATER!
proc repl()
{

nextline:>
  print "> "; fflush stdout;
  var text = readln stdin;
  if feof(stdin) return;

  if startlib(text) goto morelibrary;
  goto executable;

morelibrary:>
  print ".. "; fflush stdout;
  var more = readln stdin;
  if feof(stdin) return;

  if more == "\n" goto saveit;
  text += more;
  goto morelibrary;

saveit:>
  var dlibrary = load("library.flx");
  dlibrary += text;
  save("library.flx",dlibrary);
  goto nextline;

executable:>
   var session = load("session.flx");
   session += text;
   save ("session.flx", session);
   dlibrary = load("library.flx");
   var torun = dlibrary + text;
   save ("cmd.flx", torun);
}


// Felix version of THIS program (NOT the one being installed
// if you're using flx to install Felix)


class Flx
{
  gen flx_processing
  (
    config:&Config::config_type,
    control:&FlxControl::control_type,
    loopctl:&FlxControl::loopctl_type,
    args:list[string]
  ) : int =
  {
    var result = 0;
    fun / (a:string, b:string) => Filename::join (a,b);
    FlxCmdOpt::processing_stage1 (config,control,loopctl,varray[string] args);
    if control*.VALIDATE_CACHE == 1 do
      check_cache(config, control);
    done
    if
      loopctl*.base == "" and
      control*.INREGEX == ""
      and not control*.CMDLINE_INPUT
    do
      if control*.CLEAR_CACHE != 1 do
        println "usage: flx [options] filename";
        // TOP LEVEL FLX, OK
        System::exit(1);
      done
      // TOP LEVEL FLX, OK
      System::exit(0);
    done

    var pkgconfig = FlxPkgConfig::FlxPkgConfigQuery$ config*.FLX_CONFIG_DIRS;
    proc ehandler () {
      eprintln$ "Flx: default ehandler: temporary ehandler invoked";
      System::exit 1;
    }

    var toolchain_name =
      // toolchain pkg 1
      if control*.FLX_TOOLCHAIN == "" then pkgconfig.getpkgfield1 ehandler ("toolchain", "toolchain")
      else control*.FLX_TOOLCHAIN
    ;

    var c_compiler_executable =
      pkgconfig.getpkgfielddflt ehandler (toolchain_name+"_c_compiler_executable", "compiler")
    ;

    var cxx_compiler_executable =
      pkgconfig.getpkgfielddflt ehandler (toolchain_name+"_cxx_compiler_executable", "compiler")
    ;


    var toolchain_maker =
       match toolchain_name with
       | x =>
         Dynlink::load-plugin-func1 [toolchain_t,toolchain_config_t] ( dll-name=x, setup-str="")
       endmatch
    ;

    //println$ "[flx] Toolchain set to " + toolchain_name;

    if control*.INREGEX != "" do

      begin
        //control.USER_ARGS <- Shell::quote_arg(loopctl*.progname) + ' ' + control*.USER_ARGS;
        // this is a hack because -- argument translates to empty program name ..
        // and also if there is no name in that slot ..
        if loopctl*.progname != "" do
          control.USER_ARGS <- loopctl*.progname ! control*.USER_ARGS;
        done
        if control*.INDIR == "" do control.INDIR <- "."; done
        var regex = RE2 control*.INREGEX;
        if not regex.ok do
          eprintln$ "Malformed regex " + control*.INREGEX;
          result = 1;
          goto endoff;
        done
        var files = FileSystem::regfilesin (control*.INDIR, regex);
        var n = files.len.int;
        println$ "Processing " + files.len.str + " files";
        var i = 1;
        var pass = 0;
        var fail = 0;
        files = sort files;
        for file in files do
          var arg = Filename::join (control*.INDIR, file);
          var path,ext = Filename::split_extension(arg);
          loopctl.path <- path;
          loopctl.ext <- ext;
          var dir,base = Filename::split1(loopctl*.path);
          loopctl.dir <- dir;
          loopctl.base <- base;
          // temporary hack, to force reset of the linker filename, stdout, and expect
          // file names in cal_depvars so they depend on the current file.
          control.LINKER_OUTPUT_FILENAME <- "";
          control.STDOUT <- "";
          control.EXPECT <- "";
          control.STDIN <- "";
          var dvars = FlxDepvars::cal_depvars(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,control,*loopctl);
          println$ f"Processing [%02d/%02d]: %S" (i, n, file);
          var pe = processing_env(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,*control,dvars);
          call_with_trap {
            proc ehandler() {
              eprintln("BATCH MODE ERROR HANDLER");
              result = 1;
              goto err;
             }
             result = pe.runit(ehandler);
           err:>
          };
          if result == 0 do ++pass; else ++fail; done
          if control*.NONSTOP==0 and  result != 0 goto endoff;
          ++i;
          collect();
        done
        println$ f"Batch result (%02d OK + %02d FAIL)/%2d" (pass, fail,n);
      end
    elif control*.REPL_MODE do
      begin
        again:>
        repl();
        if not feof (stdin) do
          var dvars = FlxDepvars::cal_depvars(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,control, *loopctl);
          var pe = processing_env(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,*control,dvars);
          result = pe.runit(ehandler);
          goto again;
        else
          println$ "Bye!";
          // TOP LEVEL REPL, OK
          System::exit 0;
        done
      end
    else
      begin
        if control*.SHOWCODE == 1 do
            var prg =
              (if dvars.use_ext == "" then "// No file "+dvars.filebase+".(flx|fdoc) found"
              else load(dvars.filebase+"."+dvars.use_ext)
            );
            print prg;
        done
        var dvars = FlxDepvars::cal_depvars(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,control, *loopctl);
        var pe = processing_env(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,*control,dvars);
        result = pe.runit(ehandler);
      end
    done
endoff:>
    return result;
  }

  gen runflx(args:list[string]) : int =
  {
    var config = #Config::std_config;
    var control = #FlxControl::dflt_control;
    var loopctl = #FlxControl::init_loopctl;
    return flx_processing(&config, &control, &loopctl, args);
  }
}
Bootflx

This is supposed to be the same as the standard flx tool, except it includes all the required source code which means it takes a very long time to compile.

//[bootflx.flx]
include "std/felix/config";

include "std/felix/flx_cache";
include "std/felix/flx_pkg";
include "std/felix/flx_flxg";
include "std/felix/flx_cxx";

include "std/felix/flx/flx_control";
include "std/felix/flx/flx_cmdopt";
include "std/felix/flx/flx_depvars";
include "std/felix/flx/flx_run";
include "std/felix/toolchain_config";
include "std/felix/toolchain_interface";


include "std/felix/toolchain/clang_macosx";
include "std/felix/toolchain/clang_iOS_generic";
include "std/felix/toolchain/clang_linux";
include "std/felix/toolchain/gcc_macosx";
include "std/felix/toolchain/gcc_linux";
include "std/felix/toolchain/msvc_win";


open FlxCache;

// Felix version of THIS program (NOT the one being installed
// if you're using flx to install Felix)


class BootFlx
{
  gen flx_processing
  (
    config:&Config::config_type,
    control:&FlxControl::control_type,
    loopctl:&FlxControl::loopctl_type,
    args:list[string]
  ) : int =
  {
    var result = 0;
    fun / (a:string, b:string) => Filename::join (a,b);
    FlxCmdOpt::processing_stage1 (config,control,loopctl,varray[string] args);
    if control*.VALIDATE_CACHE == 1 do
      check_cache(config, control);
    done

    if loopctl*.base == "" and control*.INREGEX == "" do
      if control*.CLEAR_CACHE != 1 do
        println "usage: flx [options] filename";
        // TOP LEVEL FLX, OK
        System::exit(1);
      done
      // TOP LEVEL FLX, OK
      System::exit(0);
    done

    proc ehandler () {
      eprintln$ "BOOTFLX: Flx_pkgconfig getpkgfiled1 failed, temporary ehandler invoked";
      System::exit 1;
    }
    var dbdir = config*.FLX_TARGET_DIR / "config";
    var pkgconfig = FlxPkgConfig::FlxPkgConfigQuery$ list[string] dbdir;
    var toolchain_name =
      // toolchain pkg 2
      if control*.FLX_TOOLCHAIN == "" then pkgconfig.getpkgfield1 ehandler ("toolchain", "toolchain")
      else control*.FLX_TOOLCHAIN
    ;

    var c_compiler_executable = "";
    c_compiler_executable =
      pkgconfig.getpkgfielddflt ehandler (toolchain_name+"_c_compiler_executable", "compiler")
    ;

    var cxx_compiler_executable = "";
    cxx_compiler_executable =
      pkgconfig.getpkgfielddflt ehandler (toolchain_name+"_cxx_compiler_executable", "compiler")
    ;


    var toolchain_maker =
       match toolchain_name with

       | "toolchain_clang_macosx" => toolchain_clang_macosx
       // not required in bootstrap, but the ONLY way to check for type errors ..
       | "toolchain_iphoneos" => toolchain_clang_apple_iPhoneOS_armv7_arm64
       | "toolchain_iphonesimulator" => toolchain_clang_apple_iPhoneSimulator

       | "toolchain_clang_linux" => toolchain_clang_linux
       | "toolchain_gcc_macosx" => toolchain_gcc_macosx
       | "toolchain_gcc_linux" => toolchain_gcc_linux
       | "toolchain_msvc_win" => toolchain_msvc_win
       | x =>
         Dynlink::load-plugin-func1 [toolchain_t,toolchain_config_t] ( dll-name=x, setup-str="")
       endmatch
    ;
    if control*.INREGEX != "" do

      begin
        control.USER_ARGS <- Shell::quote_arg(loopctl*.progname) + ' ' + control*.USER_ARGS;
        if control*.INDIR == "" do control.INDIR <- "."; done
        var regex = RE2 control*.INREGEX;
        if not regex.ok do
          eprintln$ "Malformed regex " + control*.INREGEX;
          result = 1;
          goto endoff;
        done
        var files = FileSystem::regfilesin (control*.INDIR, regex);
        var n = files.len.int;
        println$ "Processing " + files.len.str + " files";
        var i = 1;
        for file in files do
          var arg = Filename::join (control*.INDIR, file);
          var path,ext = Filename::split_extension(arg);
          loopctl.path <- path;
          loopctl.ext <- ext;
          var dir,base = Filename::split1(loopctl*.path);
          loopctl.dir <- dir;
          loopctl.base <- base;
          // temporary hack, to force reset of the linker filename, stdout, and expect
          // file names in cal_depvars so they depend on the current file.
          control.LINKER_OUTPUT_FILENAME <- "";
          control.STDOUT <- "";
          control.EXPECT <- "";
          var dvars = FlxDepvars::cal_depvars(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,control,*loopctl);
          println$ f"Processing [%02d/%02d]: %S" (i, n, file);
          var pe = processing_env(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,*control,dvars);
          result = pe.runit(ehandler);
          if result != 0 goto endoff;
          ++i;
        done
      end
    else
      begin
        if control*.SHOWCODE == 1 do
            var prg =
              (if dvars.use_ext == "" then "// No file "+dvars.filebase+".(flx|fdoc) found"
              else load(dvars.filebase+"."+dvars.use_ext)
            );
            print prg;
        done
        var dvars = FlxDepvars::cal_depvars(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,control, *loopctl);
        var pe = processing_env(toolchain_maker,c_compiler_executable, cxx_compiler_executable, *config,*control,dvars);
        result = pe.runit(ehandler);
      end
    done
endoff:>
    return result;
  }

  gen runflx(args:list[string]) : int =
  {
println$ "[bootflx] " + strcat " " args;
    var config = #Config::std_config;
    var control = #FlxControl::dflt_control;
    var loopctl = #FlxControl::init_loopctl;
    return flx_processing(&config, &control, &loopctl, args);
  }
}
Plugin Client.

Flx is also available as a plugin. This wrapper loads it on demand so it is easy to call flx from any Felix program.

//[flx_plugin_client.flx]
class Flx_client {
  var runflx : list[string] -> int;
  proc setup ()
  {
    runflx = Dynlink::load-plugin-func1 [int,list[string]] ( dll-name="flx_plugin", setup-str="");
  }
}
Bootstrap Felix.

The same as the ordinary flx command, except the standard toolchains are compiled in directly.

//[bootflx_tool.flx]
include "std/felix/flx/bootflx";
println$ "BOOTFLX";
System::pexit$ BootFlx::runflx #System::args;

Package: src/packages/flx_doc.fdoc

Felix documentation tools.

key file
flx_gramdoc.flx $PWD/src/tools/flx_gramdoc.flx
flx_libcontents.flx $PWD/src/tools/flx_libcontents.flx
flx_libindex.flx $PWD/src/tools/flx_libindex.flx
flx_mktutindex.flx $PWD/src/tools/flx_mktutindex.flx
flx_fdoc2sphinx.flx $PWD/src/tools/flx_fdoc2sphinx.flx

Documentation tools for Felix.

These tools are designed to extract and build documentation from Felix libraries. Most no longer work properly due to the move to packaging technology and require upgrading.

Document the Grammar.

Generates an index of non-terminals used in the grammar.

//[flx_gramdoc.flx]
var ishtml = System::argv 1 == "--html";
var dir =  Filename::join ("src", "lib", "grammar");
var fregex = ".*\\.flxh";

open Regdef;
regdef anychar = perl (".");

regdef letter = charset "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
regdef digit = charset "0123456789";
regdef id1 = letter | "_";
regdef id2 = id1 | digit | "-" | "'";
regdef id = id1 id2* "?"?;

regdef spaces = " "*;
regdef prio =  "[" id "]";

regdef production = group(spaces ? id prio ? spaces ? ":=" spaces ? anychar*) "=>#" anychar*;
regdef dssl = spaces group ("syntax" spaces id) anychar*;

var lregex = (regexp (dssl | production)) . render;
var lgrep = RE2 lregex;

var n = NumberOfCapturingGroups(lgrep)+1;
var v = varray[StringPiece] (n.size,StringPiece "");

var scomment = RE2 " *//[$] (.*)";
var vcomment = varray[StringPiece] (2.size, StringPiece "");

if ishtml do
  println$ "<html><body>";
  println$ "<h1>Felix Syntax</h1>";
  println$ "<pre>";
done

for file in FileSystem::regfilesin (dir, fregex) do
  var href = "/share/lib/grammar/"+file; // URL always uses Unix filenames
  if ishtml do
    println$ '<hr/><a href="'+href+'">'+file+'</a>';
  else
    println$ "-" * 20;
    println$ file;
  done
  var lines = load (Filename::join dir file);
  var count = 0;
  var comments = Empty[string];
  for line in split (lines,char "\n") do
    ++count;
    var commentry = Match (scomment, StringPiece line, 0, ANCHOR_BOTH, vcomment.stl_begin, 2);
    if commentry do
       comments = Cons (vcomment . 1 . string.strip, comments);
    else

      var m = Match (lgrep, StringPiece line, 0, ANCHOR_BOTH, v.stl_begin,n);
      if m do
        var syn = v.1.string.strip;
        var prod = v.2.string.strip;
        if ishtml do
          if syn != "" do
            println$ "";
            println$  f"%04d" count + ":  " + '<a href="'+href+'#'+f"%04d" count+'">'+syn+'</a>';
            for cline in rev comments do println$ "           "+cline; done
            comments = Empty[string];
          else
            println$ f"%04d" count + ":    " + '<a href="'+href+'#'+f"%04d" count+'">'+ prod +'</a>';
            for cline in rev comments do println$ "           "+ cline; done
            comments = Empty[string];
          done
        else
          if syn != "" do
            println$ "";
            println$ f"%04d" count + ":  " + syn;
            for cline in rev comments do println$ "           "+cline; done
            comments = Empty[string];
          else
            println$ f"%04d" count + ":    " + prod;
            for cline in rev comments do println$ "           "+ cline; done
            comments = Empty[string];
          done
        done // html
      done
    done
  done
done

if ishtml do
  println$ "</pre></body></html>";
done
Library contents table.

Lists symbols per file.

//[flx_libcontents.flx]
var ishtml = System::argv 1 == "--html";
var dir =  Filename::join ("src", "lib", "std");

include "plugins/fdoc-interface";
var  xlat_fdoc = Dynlink::load-plugin-func2 [fdoc_t, string, string] (
    dll-name="fdoc2html", setup-str="", entry-point="fdoc2html"
  );


var fregex = ".*\\.(flx|fdoc)";
open Regdef;
regdef anychar = perl (".");

regdef letter = charset "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
regdef digit = charset "0123456789";
regdef id1 = letter | "_";
regdef id2 = id1 | digit | "-" | "'";
regdef id = id1 id2*;

regdef tex = "\\" letter*;
regdef symbol1 = "+-*/%^";
regdef symbol = symbol1 | symbol1 symbol1 | symbol1 symbol1 symbol1;
regdef name = id | symbol;
regdef spaces = " "*;
regdef vlist =  "[" spaces id (spaces "," spaces id)* spaces "]";

regdef adjective = "pure" | "inline" | "noinline" | "pod" | "open" | "virtual";
regdef binder = "fun" | "proc" | "gen" | "class" | "union" | "struct" | "type" | "typedef" | "ctor" (spaces vlist)?;

regdef indent2 = "  ";

regdef classbind= group ("class" | "open class");
regdef otherbind= indent2 ? group (adjective* spaces binder);

// Group 1 = class
// Group 2 = other
// group 3 = identifier
regdef decl = (classbind | otherbind) spaces group (name) anychar*;

var emptystring = "";
var emptystringpiece = StringPiece emptystring;

var lregex = decl . render;
var lgrep = RE2 lregex;
var n = NumberOfCapturingGroups(lgrep)+1;
var v = varray[StringPiece] (n.size,emptystringpiece);

var extract = RE2 " *([^={]*) *(=|{|;).*";
var n2 = NumberOfCapturingGroups(extract)+1;
var v2 = varray[StringPiece] (n2.size,emptystringpiece);

var scomment = RE2 " *//[$](.*)";
var vcomment = varray[StringPiece] (2.size, emptystringpiece);

if ishtml do
  println$ "<html><body>";
  println$ "<h1>Felix Library Contents</h1>";
done

var files = FileSystem::regfilesin (dir, fregex);
files = files.sort;

for file in files do
  var href = "/share/lib/std/"+file; // URL always uses Unix filenames
  if ishtml do
    println$ '<hr/><a href="'+href+'">'+file+'</a>';
  else
    println$ file;
  done
  var lines = load (Filename::join dir file);
  var count = 0;
  var comments = Empty[string];
  for line in split (lines,char "\n") do
    ++count;
    var spl = StringPiece line;
    var commentry = Match (scomment, spl, 0, ANCHOR_BOTH, vcomment.stl_begin, 2);
    if commentry do
       comments = Cons (vcomment . 1 . string, comments);
    else

      match lgrep line with
      | Some v =>
        var sym = v.3;
        var dfn = "";
        var m2 = Match (extract, spl, 0, ANCHOR_BOTH, v2.stl_begin, n2);
        if m2 do
          dfn = v2 . 1 . string . strip;
        else
          dfn = line . strip;
        done
        if ishtml do
          if prefix (dfn, "class") or prefix (dfn, "open class") do
            println$ "";
            println$  "<pre>"+ f"%04d" count + ":  " + '<a href="'+href+'#'+f"%04d" count+'">'+dfn +'</a></pre>';
            //for cline in rev comments do println$ "           "+cline; done
            var txt = "";
            for cline in rev comments do txt += cline+"\n"; done
            var result = xlat_fdoc (txt, "dummy");
            var html = #(result.html_raw);
            if txt != "" do
              println$ "<div style='font-family:sans-serif; font-size:12pt; "+
              "margin-left:100; margin-right:100; top:5; color:#406040'>" + html + "</div>";
            done
            comments = Empty[string];
          else
            println$ "<pre>"+f"%04d" count + ":    " + '<a href="'+href+'#'+f"%04d" count+'">'+ dfn +'</a></pre>';
            //for cline in rev comments do println$ "           "+ cline; done
            txt = "";
            for cline in rev comments do txt += cline+"\n"; done
            result = xlat_fdoc (txt, "dummy");
            html = #(result.html_raw);
            if txt != "" do
              println$ "<div style='font-family:sans-serif; font-size:10pt; " +
              "margin-left:100; margin-right:100; top:2; color:#404040; '>" + html + "</div>";
            done
            comments = Empty[string];
          done
        else
          if prefix (dfn, "class") or prefix (dfn, "open class") do
            println$ "";
            println$ f"%04d" count + ":  " + dfn;
            for cline in rev comments do println$ "           "+cline; done
            comments = Empty[string];
          else
            println$ f"%04d" count + ":    " + dfn;
            for cline in rev comments do println$ "           "+ cline; done
            comments = Empty[string];
          done
        done
      | #None => ;
      endmatch; //d grexp
    done
  done
done

if ishtml do
  println$ "</body></html>";
done
Library index table.

Lists symbols alphabetically.

//[flx_libindex.flx]
var ishtml = System::argv 1 == "--html";
var dir =  Filename::join ("src", "lib", "std");
var fregex = ".*\\.(flx|fdoc)";
var lregex = "^ *(virtual|noinline)* *(proc|fun|class|ctor|gen) *(([A-Z]|[a-z])([A-Z]|[a-z]|[0-9]|-|_)*[?]?).*";
var lgrep = RE2 lregex;
var n = NumberOfCapturingGroups(lgrep)+1;
var v = varray[StringPiece] (n.size,StringPiece "");

var grexp = RE2 lregex;
var extract = RE2 " *([^={]*) *(=|{|;).*";
var n2 = NumberOfCapturingGroups(extract)+1;
var v2 = varray[StringPiece] (n2.size,StringPiece "");
var v2a = varray[StringPiece] (n2.size,StringPiece "");

typedef data_t = (file:string, line:int, dfn:string);
instance Str[data_t] {
  fun str (d:data_t) => d.file + "<"+d.line.str+">:"+d.dfn;
}

var index = #strdict[list[data_t]];

for file in FileSystem::regfilesin (dir, fregex) do
  //println$ file;
  var text = load (Filename::join dir file);
  var count = 0;
  var lines = split (text, char "\n");
  for line in lines do
    ++count;
    if line != "" do
      var m = Match (grexp, StringPiece line, 0, ANCHOR_BOTH, v.stl_begin,n);
      if m do
        var sym = v.3.string;
        var dfn = "";
        var m2 = Match (extract, StringPiece line, 0, ANCHOR_BOTH, v2.stl_begin, n2);
        if m2 do
          m2 = Match (extract, StringPiece line, 0, ANCHOR_BOTH, v2a.stl_begin, n2);
          if m2 do
            dfn = v2a . 1 . string . strip;
          else
            dfn = v2 . 1 . string . strip;
          done
        else
          dfn = line . strip;
        done
        //println$ file, count, sym,dfn;
        var data = (file=file, line=count, dfn=dfn);
        //val old_data =index.get_dflt(sym,Empty[data_t]);
        //val new_data = Cons (data, old_data);
        //val new_data =Cons (data,index.get_dflt(sym,Empty[data_t]));
        //index.add sym new_data;
        index.add sym (var Cons (data,index.get_dflt(sym,Empty[data_t])));
      done
    done
  done
done

//println$ "------------------";
if ishtml do
  var ctrl = char " ";
  println$ "<html><body>";
  println$ "<h1>Felix library Index</h1>";
  println$ "<pre>";
  match key,value in index do
    var newctrl = char key;
    if ctrl != newctrl do
      println$ "<hr/>";
      ctrl = newctrl;
    done
    println$ key;
    match  (file=xfile,line=xline,dfn=xdfn) in value do
     var href = "/share/lib/std/" + xfile;
     println$ '  <a href="'+href+ "#"+f"%04d" xline + '">' + xfile + ":"+ str xline + "</a>: " + xdfn;
    done
  done
  println$ "</pre></body></html>";
else
  match key,value in index do
    println$ key;
    match  (file=xfile,line=xline,dfn=xdfn) in value do
     println$ "  " + xfile + ":"+ str xline + ": " + xdfn;
    done
  done
done
Make tutorial index pages.

Synthesises an index page for tutorial groups with specified heading and pattern match.

//[flx_mktutindex.flx]
var dirname = System::argv_dflt 1 "src/web/tut";
var homepage = System::argv_dflt 2 "";

if dirname == "--help" do
  println "Usage flx_mktutindex directory homepage";
  println "  Makes src/web/tutname_index.fdoc for files in src/web/tutname_\\d*\\.fdoc";
  System::exit 0;
done

proc make_index (prefix:string)
{
  re := RE2(prefix+"_\\d*\\.fdoc");
  var docs = FileSystem::regfilesin(dirname, re);
  docs = sort docs;
  iter println of (string) docs;
  f := fopen_output(Filename::join (dirname,prefix+"_index.fdoc"));
  if homepage != "" do
    writeln$ f,
     "<p><a href='"+homepage+"'>Up</a></p>"
    ;
  done

  writeln$ f,"@h1 "+prefix +" Index";
  var abstract = load (Filename::join (dirname, prefix + "_abstract.html"));
  if abstract != "" do
    writeln$ f,abstract;
  done
  writeln$ f,"<ul>";
  iter (proc (x:string) { writeln$ f, mkentry x; }) docs;
  writeln$ f,"</ul>";
  fclose f;

  fun mkentry(x:string):string =
  {
    var hline = "\n";
    begin // find first non-blank line
      f := fopen_input(Filename::join (dirname,x));
      while hline == "\n" do
        hline = f.readln;
      done
      fclose f;
    end
    scan:for var i in 0uz upto hline.len - 1uz do
      if hline.[i]== char ' ' do break scan; done
    done
    title := hline.[i to].strip;
    html := '<li><a href="' + Filename::basename x + '">' + title + '</a></li>';
    return html;
  }
}

var re = RE2(".*_01.fdoc");
var samples = FileSystem::regfilesin(dirname, re);
for name in samples do
  var prefix = name.[0 to -8];
  make_index prefix;
done

//[flx_fdoc2sphinx.flx]
open Regdef;

// command translation
regdef ident_r = perl("[A-Za-z_][A-Za-z_0-9]*");
regdef fkey_r = ident_r "." ident_r;
regdef cmd_name_r = perl("[A-Za-z_][A-Za-z_0-9]*| *");
regdef spc_r = " " *;
regdef any_r = perl(".*");
regdef cmd_r = "@" group(cmd_name_r) spc_r group(any_r);
regdef tangler_r = "@tangler" spc_r group(fkey_r) spc_r  "=" spc_r group(any_r);
regdef url_r = group(any_r) '<a href="' group(any_r) '">' group(any_r) "</a>" group(any_r);

// top level class
regdef class_r = ("open" spc_r)? ("class"|"module") spc_r group(ident_r) any_r;

// nested in class, exactltly 2 spaces in
regdef def_r ="ctor"|"fun"|"proc"|"gen"|"type"|"union"|"struct"|"cstruct"|"const"|"header"|"typedef";
regdef adj_r = "virtual" | "inline";
regdef fun_r = "  " (adj_r spc_r)? group(def_r) spc_r group(ident_r) any_r;

var cmd_R = RE2 (render cmd_r);
var tangler_R = RE2 (render tangler_r);
var url_R = RE2 (render url_r);
var fun_R = RE2 (render fun_r);
var class_R = RE2 (render class_r);

typedef markup_t = (`Txt | `At | `Code | `Slosh | `Math | `MathSlosh);
fun code_fixer (a:string): string =
{
  var out = "";
  var mode = (#`Txt) :>> markup_t;
  for ch in a do
    match mode with
    | `Txt =>
      if ch == char "@" do
        mode = (#`At) :>> markup_t;
      elif ch == char "\\" do
        mode = (#`Slosh) :>> markup_t;
      else
        out += ch;
      done

    | `Slosh =>
      if ch == char "(" do
        mode = (#`Math) :>> markup_t;
        out += ":math:`";
      else
        out += "\\" + ch;
        mode = (#`Txt) :>> markup_t;
      done

    | `Math =>
      if ch == char "\\" do
        mode = (#`MathSlosh) :>> markup_t;
      else
        out+= ch;
      done

    | `MathSlosh =>
       if ch == ")" do
         out+="` ";
         mode = (#`Txt) :>> markup_t;
       else
         out+="\\" + ch;
         mode = (#`Math) :>> markup_t;
       done

    | `At =>
      if ch == char "{" do
        out += " :code:`";
        mode = (#`Code) :>> markup_t;
      else
       out += "@"+ch;
      done

    | `Code =>
      if ch == char "}" do
        out += "`";
        mode = (#`Txt) :>> markup_t;
      else
        out += ch;
      done
    endmatch;
  done
  return out;
}


fun url_fixer (a:string) =>
  match Match (url_R, a) with
  | None => a
  | Some grp => grp.1 + "`" + grp.3 + " <" + grp.2 + ">`_" + grp.4
;

fun code_markup(a:string) => code_fixer (url_fixer a);

fun lexer_from_filename (var s:string) : string =
{
  s = strip s;
  var lexer =
    match s.Filename::get_extension with
    | (".cpp" | ".cxx" | ".hpp")  =>  "cpp"
    | (".flx" | ".fdoc" | ".fsyn")  =>  "felix"
    | (".fpc") => "fpc"
    | (".c" | ".h") => "c"
    | (".py") => "python"
    | _ => "text"
    endmatch
  ;
  return lexer;
}


typedef mode_t = (`Doc | `Code | `Tangler);

fun process_file (f: string): string =
{
  var tanglers = Empty[string * string];

  var code_buf = Empty[string];
  var prefix = "";
  var out = "";
  proc emit_code () {
    var b = rev code_buf;
    for l in b do
      var rc = Match (class_R, l);
      var rf = Match (fun_R, l);
      chainmatch rc with
      | Some grp =>
        out+= ".. index:: " + grp.1+"(class)" + "\n";
      ormatch rf with
      | Some grp =>
        out+= ".. index:: " + grp.2+"("+grp.1+")" + "\n";
      | None => ;
      endmatch;
    done
    out += prefix;
    for l in b perform out += "  " + l + "\n";
    code_buf = Empty[string];
    mode = (#`Doc) :>> mode_t;
  }

  proc println[T with Str[T]] (x:T) => out += x.str + "\n";

  var mode : mode_t = (#`Doc) :>> mode_t;
  nextline: for line in split (f, char "\n") do
    var cmd = Match (tangler_R, line);
    match cmd with
    | Some grp =>
      mode = (#`Tangler) :>> mode_t;
      tanglers = (grp.1,grp.2) ! tanglers;
      continue nextline;

    | None =>
      match mode with
      | `Tangler =>
        var tab = rev tanglers;
        tanglers = Empty[string * string];
        var lkey,lfile = fold_left
          (fun (lkey:int,lfile:int) (key:string,file:string) =>
             max (lkey, key.len.int), max (lfile, file.len.int)
          )
          (10,20)
          tab
        ;
        var tabline = "=" * lkey + " " + "=" * lfile;
        println$ tabline;
        println$
          ("key" + " " * lkey).[0..lkey] +
          ("file" + " " * lfile).[0..lfile]
        ;
        println$ tabline;
        for item in tab do
          var key,file = item;
          println$
            (key + " " * lkey).[0..lkey] +
            (file + " " * lfile).[0..lfile]
          ;
        done
        println$ tabline;
        mode = (#`Doc) :>> mode_t;
      | _ => ;
      endmatch;
    endmatch;

    cmd = Match (cmd_R, line);
    match cmd with
    | Some grp =>
      var c = grp.1;
      var a = grp.2;
      if c == "title" do
        println$ "";
        match mode with
        | `Code () => emit_code();
        | _ => ;
        endmatch;
        a = code_markup a;
        println$ "=" * a.len.int;
        println$ a;
        println$ "=" * a.len.int;
        println$ "";

      elif c == "h1" do
        println$ "";
        match mode with
        | `Code () => emit_code();
        | _ => ;
        endmatch;
        a = code_markup a;
        println$ a;
        println$ "=" * a.len.int;
        println$ "";

      elif c == "h2" do
        a = code_markup a;
        println$ "";
        match mode with
        | `Code => emit_code();
        | _ => ;
        endmatch;
        println$ a;
        println$ "-" * a.len.int;
        println$ "";

      elif c == "image" do
        println$ "";
        match mode with
        | `Code => emit_code();
        | _ => ;
        endmatch;
        println$ "";
        println$ ".. image:: " + a;
        println$ "";


      elif c == "tangle" do
        println$ "";
        var lexer = lexer_from_filename a;
        prefix = ".. code-block:: "+lexer + "\n\n";
        prefix += "";
        if lexer in ("c","cpp","felix","fpc") do
          prefix += "  //[" + a + "]\n";
        elif lexer == "python" do
          prefix += "  #["+a+"]\n";
        done
        mode = (#`Code) :>> mode_t;
      else
        match mode with
        | `Code => emit_code();
        | _ => ;
        endmatch;
      done


    | None =>
      match mode with
      | `Doc =>
         println$ code_markup line;
      | `Code => code_buf = line ! code_buf;
      endmatch;
    endmatch;
  done
  if not code_buf.is_empty call emit_code();
  return out;
}


include "std/felix/flx_cp";

var dir = "src/packages";
var regex = "(.*).fdoc";
var target = "doc/packages/${1}.rst";
var live = true;
var verbose = true;

gen sandr (src: string, dst:string) =
{
  var text = load src;
  var result = process_file (text);
  result = "Package: " + src + "\n\n"+result;
  save (dst, result);
  return true;
}

var filere = Re2::RE2 regex;
CopyFiles::processfiles sandr (dir, filere, target, live, verbose);
System::exit(0);

Package: src/packages/flx_pkgconfig.fdoc

The configuration database manager flx_pkgconfig.

key file
flx_pkg.flx share/lib/std/felix/flx_pkg.flx
flx_pkgconfig.flx share/lib/std/felix/flx_pkgconfig.flx
flx_pkgconfig_core.flx share/lib/std/felix/flx_pkgconfig_core.flx
flx_pkgconfig_export.flx share/lib/std/felix/flx_pkgconfig_export.flx
flx_pkgconfig_query.flx share/lib/std/felix/flx_pkgconfig_query.flx
flx_pkgconfig_query_interface.flx share/lib/std/felix/flx_pkgconfig_query_interface.flx
flx_pkgconfig_tool.flx $PWD/src/tools/flx_pkgconfig.flx

Command Line Interface

Provides function to handle generic shell style call with parsed arguments, supporting calls from either inside ordinary Felix code or from a stub execuatble which just parses the command line.

This code always returns, it cannot fail EXCEPT if –help is given.

//[flx_pkgconfig_core.flx]
class FlxPkgConfig_core
{
  open Lexer;

  gen flx_pkgconfig (args:list[string]) : int * list[string] =
  {
    proc print_help {
      println$ "flx_pkgconfig [options] pkg pkg ...";
      println$ "  returns code 1 if any packages are missing unless --noerror is specified";
      println$ "  prints package or field list to standard output on one line";
      println$ "options: (follows GNU conventions)";
      println$ "  --path=dirname        set database directory name";
      println$ "  --path+=dirname       append database directory name";
      println$ "  --extension=fpc       set resource descriptor extensions,";
      println$ "                          default 'fpc' use 'pc' for pkgconfig databases";
      println$ "  -h";
      println$ "  --hide                only process first package in path with a given name";
      println$ "                          default, process all occurences";
      println$ "  --list                list available packages from specified set";
      println$ "  --missing             list missing packages from specified set";
      println$ "  --noerror             do not return 1 because of missing packages";
      println$ "  -r";
      println$ "  --rec                 form transitive closure of specified set based on Requires field";
      println$ "  --rec=field           form transitive closure of specified set based on specified field";
      println$ "  -b";
      println$ "  --backwards           process specified packages in reverse order";
      println$ "  --field=field         collate values of field in package set";
      println$ "  --keepleftmost        remove duplicate values in output keeping only leftmost occurrence";
      println$ "  --keeprightmost       remove duplicate values in output keeping only rightmost occurrence";
      println$ "  --keepall             keep duplicate values in output";
      println$ "  @filename             Replace with arguments from filename, one line per argument";
    }

    proc pre_incr:&lex_iterator = "++*$1;";

    variant token_t = Str of string | Cmd of string | Eos;

    fun lexit(ini:lex_iterator, finish:lex_iterator): lex_iterator * token_t=
    {
      //println$ "lexit input='" + string_between(ini,finish)+"'";

      var start = ini;

      // already at end
      if start == finish do
        return start, Eos;

      // eat white space
      elif *start == char(' ') do
        ++start;
        while start != finish and *start == char(' ') do ++start; done;
        return start,Eos;

      // double quoted string
      elif *start == char('"') do
        ++start;
        p1 := start;
        while start != finish and *start != char('"') do ++start; done;
        if start == finish do
          return start,Str (string_between(p1,start));
        else
          return start+1,Str (string_between(p1, start));
        done;

      // single quoted string
      elif *start == char("'") do
        ++start;
        p2 := start;
        while start != finish and *start != char("'") do ++start; done;
        if start == finish do
          return start,Str (string_between(p2,start));
        else
          return start+1,Str (string_between(p2, start));
        done;

      elif *start == char("`") do
        ++start;
        p3 := start;
        while start != finish and *start != char("`") do ++start; done;
        if start == finish do
          return start,Cmd (string_between(p3,start));
        else
          return start+1,Cmd (string_between(p3, start));
        done;


      done;
      // identifier
      p4 := start;
      while start != finish and *start != char(" ")  do ++start; done;
      return start,Str (string_between(p4,start));
    }

    fun lexstr(s':string): list[string] =
    {
      var s = s';
      val first = start_iterator s;
      val finish = end_iterator s;
      var current = first;
      var words = Empty[string];
      while current != finish do
        match lexit(current,finish) with
        | next,token=>
          {
            current = next;
            match token with
            | Eos => ;
            | Str lexeme => if lexeme != "" perform words = Cons(lexeme,words);
            | Cmd cmd =>
              var res,s = System::get_stdout cmd;
              var recres = lexstr s.strip;
              words = rev recres + words;
            endmatch;
          }
        endmatch;
      done
      //println$ "Words='" + str(rev words)+"'";
      return rev words;
    }

    macro val streq = eq of (string * string);

    var path=Env::getenv("PKG_CONFIG_PATH");

    // parse arguments
    var fields = Empty[string];
    var pkgs = Empty[string];

    var hide = false; // only find first file in path
    var require_pkg_exists = true; // fail if file not found
    var missing = false; // report missing packages
    var require_field_exists = false; // fail if file doesn't contain field
    var recfields = Empty[string];
    var dolist = false;
    var listkeys = false;
    var return_code = 0;
    var backwards = false;
    enum keep_t {keepall, keepleftmost, keeprightmost};
    var keep= keepleftmost;
    var extension = "fpc";

    fun is_prefix_of(p:string,w:string)=> p == w.[to len p];

    fun xfind(flags: string, c: string) =>
     match find(flags, c) with
     | #None => false
     | Some _ => true
     endmatch
    ;

    proc parse_args(args:list[string])
    {
      match args with
      | #Empty => {}
      | Cons (arg,tail) =>
        {
          fun prefix(x:string)=>is_prefix_of(x,arg);

          if prefix("--hide") do hide = true;
          elif prefix("--backwards") do backwards = true;
          elif prefix("--list") do dolist = true;
          elif prefix("--missing") do missing = true;
          elif prefix("--noerror") do require_pkg_exists = false;
          elif prefix("--keeprightmost") do keep = keeprightmost;
          elif prefix("--keepleftmost") do keep = keepleftmost;
          elif prefix("--keepall") do keep = keepall;

          elif "--field" == arg.[0 to 7] do
            fields = fields + arg.[8 to];

          elif "--extension" == arg.[0 to 11] do
            extension = arg.[12 to];

          elif "-" == arg.[0 to 1] and "-" != arg.[1 to 2] do
            flags := arg.[1 to];
            if xfind(flags, "r") do
              recfields = append_unique streq recfields "Requires";
            done;

            if xfind(flags,"h") do hide = true; done;
            if xfind(flags,"b") do backwards = true; done;
            if xfind(flags,"l") do dolist = true; done;

          elif "--rec" == arg.[0 to 5] do
            var fld = arg.[6 to];
            fld = if fld == "" then "Requires" else fld endif;
            recfields = append_unique streq recfields fld;

          // add to path
          elif "--path+" == arg.[0 to 7] do
            val x = arg.[8 to];
            if path != "" do
              path= path + ":" + x;
            else
              path= x;
            done;

          // set path
          elif "--path" == arg.[0 to 6] do
            path= arg.[7 to];

          elif "--help" == arg do
            print_help;
            // FIXME
            System::exit(0);

          elif "@" == arg.[0 to 1] do
            val data = load$ strip arg.[1 to];
            parse_args$ split(data,c" \n\r\t,");

          // ignore unknown options
          elif "-" == arg.[0 to 1] do ;

          // ignore empty arguments
          elif "" == arg do ;

          // package name
          else
            pkgs = pkgs + arg;
          done;
          parse_args(tail);
        }
      endmatch;
    }

    parse_args(args);

    //print$ "Fields   = " + str fields; endl;
    //print$ "Packages = " + str pkgs; endl;

    fun reattach_drive_letters : list[string] -> list[string] =
      | Cons (a, Cons (b, tail)) =>
          if (len(a) == size 1 and isalpha(a.[0]) and b.startswith('\\')) then
            Cons (a+':'+b, reattach_drive_letters tail)
          else
            Cons (a, reattach_drive_letters (Cons (b, tail)))
          endif
      | other => other // 1 or 0 elements left
    ;

    val dirs=reattach_drive_letters(split(path, char ':'));

    // print$ "Path = " + str dirs; endl;

    var result = Empty[string];

    fun check_id (s:string) = {
      var acc=true;
      for elt in s do acc = acc and isalphanum elt; done
      return acc;
    }

    fun get_field(line:string):string * string =>
        match find (line,char ':') with
        | #None => "",""
        | Some n =>
            strip line.[to n],
            strip line.[n+1 to]
        endmatch
      ;


    fun get_variable(line:string):string * string =>
        match find (line,char '=') with
        | #None => "",""
        | Some n =>
            let name = strip line.[to n] in
            let value = strip line.[n+1 to] in
            if check_id name then name,value else "",""
        endmatch
      ;

    proc add_val(v:string){
     result = insert_unique streq result v;
    //  result = rev$ Cons(v, rev result);
    }

    proc tail_val(v:string){
       result = append_unique streq result v;
    //  result = Cons(v, result);
    }

    proc keep_val (v:string){
      result = result + v;
    }

    proc handle_pkg (pkg:string, trace:list[string]){
//eprintln$ "Handle_pkg pkg= " + pkg + " trace= " + trace.str;
       var variables = Empty[string * string];

       if mem streq trace pkg return;
       var found = false;
       iter(proc (dir:string){
         val filename =
           if dir=="" then "." else dir endif + #Filename::sep + pkg + "."+extension
         ;
         //print filename; endl;

         // examine line of one file
         file := fopen_input filename;
         if valid file do
           if dolist do
             match keep with
             | #keepleftmost => add_val pkg;
             | #keeprightmost => tail_val pkg;
             | #keepall => keep_val pkg;
             endmatch;
           done
           var lines = Empty[string];
           var line = readln file;
           while line != "" do
             line = line.strip;
             if line != "" and line.[0] != char "#" do
               lines = Cons(line,lines);
             done
             line = readln file;
           done
           if not backwards do lines = rev lines; done;

           iter (proc (line:string)
           {
             //print line;
             def var variable, var vval = get_variable(line);
             if variable != "" do
               var bdy = search_and_replace variables vval;
               variables = Cons ( ("${"+variable+"}",bdy), variables);
             else
               def var key, var value = get_field(line);
               if listkeys call add_val key;
               var values = lexstr(value);
               values = map (search_and_replace variables) values;
               if mem streq fields key do
                 match keep with
                 | #keepleftmost => { iter add_val values; }
                 | #keeprightmost => { iter tail_val values; }
                 | #keepall => { iter keep_val values; }
                 endmatch;
               done;
//eprintln$ "Chase dependent packages key = " + key + " recfields = " + recfields.str;
               // chase dependent packages
               if mem streq recfields key do
//eprintln$ "FOUND";
                 iter (proc (s:string){
                   handle_pkg$ s,Cons(pkg,trace);
                 })
                 values;
               done
//eprintln$ "DONE  dependent packages key = " + key + " recfields = " + recfields.str;

             done
           })
           lines
           ;
           fclose file;
           found = true;
           if hide return; // only find first file in path
         done;
       })
       dirs;
       if not found do
         //eprintln$ "package not found: " + pkg;
         if require_pkg_exists do return_code = 1; done;
         if missing call add_val(pkg);
       done;
    }

    var original_pkgs = pkgs;
//eprintln$ "+++++++++++++++++++++++++";
//eprintln$ "TOP LEVEL HANDLING PACKAGES " + original_pkgs.str;
    while not is_empty pkgs do
      match pkgs with
      | #Empty => {}
      | Cons (pkg,tail) =>
        {
//eprintln$ "TOP LEVEL HANDLE ONE PACKAGE " + pkg.str;
          pkgs = tail;
          handle_pkg(pkg,Empty[string]);
//eprintln$ "DONE: TOP LEVEL HANDLE ONE PACKAGE " + pkg.str;
        }
      endmatch;
    done;
//eprintln$ "DONE: TOP LEVEL HANDLING PACKAGES " + original_pkgs.str;
//eprintln$ " ************************";

    return return_code, result;
  }
}

Tool executable.

This the actual command line tool. It depends on only the flx_pkgconfig function. It exits with the return code that function returns.

//[flx_pkgconfig_tool.flx]
include "std/felix/flx_pkgconfig";

header flx_pkgconfig_header =
"""
#include <iostream>
#include "flx_ioutil.hpp"
#include "flx_strutil.hpp"
#include "flx_rtl.hpp"
#include "flx_gc.hpp"
""";

// This KLUDGE does two independent things:
//
// (1) It stops problems with the GC preventing
// building Felix in a core build.
//
// (2) It injects the header includes required by flx_pkgconfig
// directly into flx_pkgconfig so the executable can be built
// without flx or flx_pkgconfig.
//
// The latter is essential during the Python based bootstrap
// build process. That process uses the flx_pkgconfig executable
// to translate the flx.resh file produced by compiling flx.flx
// with flxg into actual package requirements, and thence
// into the required header file.
//

proc kludge : 1 = "PTF gcp->allow_collection_anywhere=false;" requires flx_pkgconfig_header;
kludge();

// strip any trailing space off to ease bash scripting
var return_code, result = FlxPkgConfig::flx_pkgconfig (tail #System::args);

print$ strip$ cat ' ' result; endl;
System::exit return_code;

Database query object.

This code provides an object wrapper around the flx_pkgconfig CLI interface function to allow low level queries about specific fields of specific packages.

Database query object interface.
//[flx_pkgconfig_query_interface.flx]
class FlxPkgConfigQuery_interface
{
  interface FlxPkgConfigQuery_t {
    query:           list[string] -> int * list[string];
    getpkgfield:     (1->0) -> string * string -> list[string];
    getpkgfield1:    (1->0) -> string * string -> string;
    getpkgfieldopt:  (1->0) -> string * string -> opt[string];
    getpkgfielddflt: (1->0) -> string * string ->  string;
    getclosure:      (1->0) -> string -> list[string];
   }
}
Database query object implementation.

Depends on on the CLI function interface.

//[flx_pkgconfig_query.flx]
include "std/felix/flx_pkgconfig_core";
include "std/felix/flx_pkgconfig_query_interface";

class FlxPkgConfig_query
{
  object FlxPkgConfigQuery (path:list[string]) implements FlxPkgConfigQuery_interface::FlxPkgConfigQuery_t =
  {
    var paths =
      match path with
      | #Empty => Empty[string]
      | Cons (h,t) =>
        let
          fun aux (lst:list[string]) (out:list[string]) =>
          match lst with
          | #Empty => rev out
          | Cons (h,t) => aux t (("--path+="+h)!out)
          endmatch
        in
        ("--path="+h) ! aux t Empty[string]
    ;
    match path with | #Empty => assert false; | _ => ; endmatch;


    method gen query (args:list[string]) =>
      FlxPkgConfig_core::flx_pkgconfig (paths + args)
    ;

    // Get all the values of a field in a particular package
    method gen getpkgfield (ehandler:1->0) (pkg:string, field:string) : list[string] = {
      var result,values = query$ list$ ("--field="+field, pkg);
      if result != 0 do
        println$ "[FlxPkgConfigQuery: getpkgfield] Can't find package " + pkg;
        println$ "Searching in paths:";
        for path in paths do
          println$ "  " + path;
        done
        // FIXME
        // System::exit(1);
        throw_continuation ehandler;
      done
      return values;
    }

    // Get the single value of a field in a particular package.
    // Bug out if missing or multiple values.
    method gen getpkgfield1 (ehandler:1->0) (pkg:string, field:string) : string = {
      var values = getpkgfield ehandler (pkg,field);
      match values with
      | Cons (h,#Empty) => return h;
      | #Empty =>
        println$ "[FlxPkgConfigQuery: getpkgfield1] Required field " + field + " not found in package "+pkg;
        throw_continuation ehandler;

      | _ =>
        println$ "[FlxPkgConfigQuery: getpkgfield1] Multiple values for field " + field + " in " + pkg + " not allowed, got" + str values;
        throw_continuation ehandler;
      endmatch;
    }

    // Get the single value of a field in a particular package.
    // Bug out if multiple values.
    method gen getpkgfieldopt (ehandler:1->0) (pkg:string, field:string) : opt[string] = {
      var result,values = query$ list$ ("--field="+field, pkg);
      if result !=0 return None[string]; // package or field missing
      match values with
      | Cons (h,#Empty) => return Some h;
      | #Empty => return None[string];
      | _ =>
        println$ "[FlxPkgConfigQuery: getpkgfieldopt ]Multiple values for field " + field + " in " + pkg + " not allowed, got" + str values;
        throw_continuation ehandler;
      endmatch;
    }

    method gen getpkgfielddflt (ehandler:1->0) (pkg:string, field:string) : string =>
      match getpkgfieldopt ehandler (pkg, field) with
      | Some h => h
      | #None => ""
      endmatch
    ;

    //$ Get Requires closure.
    //$ Result is topologically sorted with each package listed
    //$ after ones it requires.
    method gen getclosure (ehandler:1->0) (pkg:string) : list[string] = {
      var result,values = FlxPkgConfig_core::flx_pkgconfig $ paths +
        "--keeprightmost" + "--rec" + "--list" +  pkg
      ;
      if result != 0 do
        println$ "[GetPkgConfigQuery: getclosure] missing package for closure of " + pkg;
        // FIXME
        // System::exit(1);
        throw_continuation ehandler;
      done
      return rev values;
    }
  }
}

Database Manager Library

Export thunks to support separate compilation of the flx_pkgconfig database query library. This allows the code to be dynamically loaded or statically linked against as if a foreign C library.

The support does not reach the level of a plugin, however.

Compendium class.

This class provides both of the core CLI function and the object based query wrapper, wrapped in a single include file and with a single wrapping namespace.

//[flx_pkgconfig.flx]
include "std/felix/flx_pkgconfig_core";
include "std/felix/flx_pkgconfig_query_interface";
include "std/felix/flx_pkgconfig_query";

class FlxPkgConfig
{
  inherit FlxPkgConfig_core;
  inherit FlxPkgConfigQuery_interface;
  inherit FlxPkgConfig_query;
}
Separate compilation wrapper.

This file provides the separate compilation wrapper. We provide a struct wrapper around the underlying record type, because it is a nominal type and can be exported.

//[flx_pkgconfig_export.flx]
include "std/felix/flx_pkgconfig";

export FlxPkgConfig::flx_pkgconfig of (list[string]) as "flx_pkgconfig";

export struct FlxPkgConfigQuery_struct
{
    query:           list[string] -> int * list[string];
    getpkgfield:     (1->0) -> string * string -> list[string];
    getpkgfield1:    (1->0) -> string * string -> string;
    getpkgfieldopt:  (1->0) -> string * string -> opt[string];
    getpkgfielddflt: (1->0) -> string * string ->  string;
    getclosure:      (1->0) -> string -> list[string];
}

gen mk_pkgconfig_query (a:FlxPkgConfigQuery_struct) =>
  FlxPkgConfig::FlxPkgConfigQuery (
    query=a.query,
    getpkgfield=a.getpkgfield,
    getpkgfield1=a.getpkgfield1,
    getpkgfieldopt=a.getpkgfieldopt,
    getpkgfielddflt=a.getpkgfielddflt,
    getclosure=a.getclosure
  )
;

export mk_pkgconfig_query
  of (FlxPkgConfigQuery_struct)
  as "flx_pkgconfig_query"
;

Pkg config

This code provides a class wrapper around the command line function flx_pkgconfig AND the object based query system, designed solely to simplify access from the flx tool.

This code can do a System::exit which also exits the flx process using it.

This has to be FIXED so flx can run in non-stop mode.

//[flx_pkg.flx]
include "std/felix/flx_pkgconfig";

class FlxPkg
{
  typedef pkgconfig_inspec_t = (
    FLX_CONFIG_DIRS: list[string],
    FLX_TARGET_DIR:string,
    EXT_EXE: string,
    EXT_STATIC_OBJ: string,
    EXT_DYNAMIC_OBJ: string,
    STATIC: int,
    LINKEXE: int,
    SLINK_STRINGS: list[string],
    DLINK_STRINGS: list[string],
    LINKER_SWITCHES: list[string],
    EXTRA_PACKAGES: list[string],
    cpp_filebase : string
  );

  instance Str[pkgconfig_inspec_t] {
    fun str (spec: pkgconfig_inspec_t) => spec._strr;
  }

  typedef pkgconfig_outspec_t = (
    CFLAGS: list[string],
    INCLUDE_FILES: list[string],
    DRIVER_EXE: string,
    DRIVER_OBJS: list[string],
    LINK_STRINGS: list[string]
  );

  fun fix2word_flags (fs: list[string]) = {
    //println$ "Fix2word, input=" + fs.str;
    var output =  fold_left
     (fun (acc:list[string]) (elt:string) =>
       if prefix (elt, "---") then acc + (split (elt.[2 to], char "="))
       else acc + elt
       endif
      )
      Empty[string]
      fs
    ;
    //println$ "Fix2word, output=" + output.str;
    return output;
  }


  // Model:
  // Static link exe: return the object files required, no driver exe
  // Dynamic link exe: the same
  // DLL: return the executable (flx_run) required to run the DLL
  //
  // We provide instructions to link the target binary and how to run it.

/*
  proc ehandler () {
    eprintln$ "Flx_pkgconfig: map_package_requirements: failed, temporary ehandler invoked";
    System::exit 1;
  }
*/
  gen map_package_requirements (ehandler:1->0) (spec:pkgconfig_inspec_t) : pkgconfig_outspec_t =
  {
    fun / (a:string, b:string) => Filename::join (a,b);

// println$ "MAP PACKAGE REQUIREMENTS: " + spec.str;

    var PKGCONFIG_PATH=map
       (fun (s:string) => "--path+="+s)
       spec.FLX_CONFIG_DIRS
    ;

    // to hook any extra packages found by the compiler
    var RESH = "@"+spec.cpp_filebase+".resh";

    // find all the compiler or switches
    // args are the args to flx_pkgconfig
    gen pkgconfl(args:list[string]) : list[string] =
    {
      if spec.EXTRA_PACKAGES != Empty[string] call
         eprintln$ "calpackages, EXTRA_PACKAGES = " + str spec.EXTRA_PACKAGES
      ;
      var allargs = PKGCONFIG_PATH+args+spec.EXTRA_PACKAGES + RESH;
      var ret,s = FlxPkgConfig::flx_pkgconfig(allargs);
      if ret != 0 do
        eprintln$ "[FlxPkg:map_package_requirements] Error " + str ret + " executing flx_pkgconfig, args=" + str allargs;
        // FIXME
        //System::exit (1);
        throw_continuation ehandler;
      done
      return s;
    }
    // convert list of switches to a single string
    gen pkgconfs(args:list[string]) : string => cat ' ' $ pkgconfl(args);

    var e = Empty[string];

    // find all include directories
    var CFLAGS=pkgconfl(e+'--field=cflags'+'--keepleftmost');

    // find all include files
    var INCLUDE_FILES=pkgconfl(e+'--field=includes'+'--keepleftmost');


    // find the driver package
    // not useful for C++ only
    var DRIVER_PKG=pkgconfs(e+'--field=flx_requires_driver');
    if DRIVER_PKG == "" do DRIVER_PKG="flx_run"; done

    // find the driver entity
    // not useful for C++ only
    if spec.STATIC == 0 do
      // dynamic linkage: the driver executable
      if spec.LINKEXE == 0 do
        var DRIVER_EXE= spec.FLX_TARGET_DIR/ "bin"/ DRIVER_PKG+spec.EXT_EXE;
        var DRIVER_OBJS = Empty[string];
      else
      // dynamic linkage: the object files for executable with DLL support
        DRIVER_OBJS =([
            spec.FLX_TARGET_DIR / "lib" / "rtl" / (DRIVER_PKG+"_lib_static"+ spec.EXT_DYNAMIC_OBJ),
            spec.FLX_TARGET_DIR / "lib" / "rtl" / (DRIVER_PKG+"_main"+spec.EXT_DYNAMIC_OBJ)
        ]);
        DRIVER_EXE = "";
      done
    else
      // static linkage: the object files for full static link
      DRIVER_OBJS = ([
          spec.FLX_TARGET_DIR/ "lib"/ "rtl"/ (DRIVER_PKG+"_lib_static"+ spec.EXT_STATIC_OBJ),
          spec.FLX_TARGET_DIR/ "lib"/ "rtl"/ (DRIVER_PKG+"_main"+spec.EXT_STATIC_OBJ)
      ]);
      DRIVER_EXE = "";
    done

    if spec.STATIC == 0 do
      if spec.LINKEXE == 0 do
        // Linking a DLL
        var LINK_STRINGS =
          spec.DLINK_STRINGS+
          spec.LINKER_SWITCHES+
          pkgconfl(e+'-r'+'--keeprightmost'+'--field=provides_dlib'+'--field=requires_dlibs'+DRIVER_PKG);
      else
        // Linking an EXE (with DLL support)
        LINK_STRINGS =
          spec.DLINK_STRINGS +
          spec.LINKER_SWITCHES+
          pkgconfl(e+'-r'+'--keepleftmost'+'--field=provides_dlib'+'--field=requires_dlibs'+DRIVER_PKG);
      done
    else
      // static linkage: all the libraries required by the application and driver
      // This has to be recursive to find the closure.
      // Linking an EXE (fully static)
      LINK_STRINGS =
        spec.SLINK_STRINGS+
        spec.LINKER_SWITCHES+
        pkgconfl(e+'-r'+'--keeprightmost'+'--field=provides_slib'+'--field=requires_slibs'+DRIVER_PKG);
    done
    LINK_STRINGS = fix2word_flags LINK_STRINGS;

    var result = (
      CFLAGS = CFLAGS,
      INCLUDE_FILES = INCLUDE_FILES,
      DRIVER_EXE = DRIVER_EXE,
      DRIVER_OBJS = DRIVER_OBJS,
      LINK_STRINGS = LINK_STRINGS
    );
    //println$ "Mapped requirements = " + result._strr;
    return result;
  }

  proc write_include_file(path:string, INCLUDE_FILES:list[string]) {
    var f = fopen_output(path+".includes");
    List::iter
      (proc (i:string) { writeln$ f, "#include " + i; })
      INCLUDE_FILES
    ;
    fclose f;
  }

}

Package: src/packages/flx_web.fdoc

Webserver and Plugins

key file
dflx_web.flx $PWD/src/tools/dflx_web.flx
flx_web.flx $PWD/src/tools/flx_web.flx
flx_pretty.flx $PWD/src/tools/flx_pretty.flx
key file
fpc2html.flx share/lib/plugins/fpc2html.flx
ocaml2html.flx share/lib/plugins/ocaml2html.flx
py2html.flx share/lib/plugins/py2html.flx
flx2html.flx share/lib/plugins/flx2html.flx
cpp2html.flx share/lib/plugins/cpp2html.flx
fdoc2html.flx share/lib/plugins/fdoc2html.flx
key file
fdoc_button.flx share/lib/plugins/fdoc_button.flx
fdoc_edit.flx share/lib/plugins/fdoc_edit.flx
fdoc_fileseq.flx share/lib/plugins/fdoc_fileseq.flx
fdoc_frame.flx share/lib/plugins/fdoc_frame.flx
fdoc_heading.flx share/lib/plugins/fdoc_heading.flx
fdoc_paragraph.flx share/lib/plugins/fdoc_paragraph.flx
fdoc_scanner.flx share/lib/plugins/fdoc_scanner.flx
fdoc_slideshow.flx share/lib/plugins/fdoc_slideshow.flx
plugin_common.flx share/lib/plugins/plugin_common.flx
toc_menu.flx share/lib/plugins/toc_menu.flx

Webserver

Standalone pretty printer for Felix flx format files.

//[flx_pretty.flx]
// pretty printer for *.flx files
// uses the flx2html plugin

// COPIED from dflx_web ..
class Css4Html {
flx_head := """
<style type="text/css">
body {margin:3%; }
h1 {color:gray; font-size:120%;}
h2 {color:gray; font-size:105%;}
h3 {font-size:100%;}
h4 {font-size:95%;}
h5 {font-size:95%;}
span.fstring {color:darkblue; font-style:italic; }
span.comment {font-family:arial; color:blue; font-style:italic; }
span.doccomment {font-family:arial; color:green; font-style:italic; }
span.big_keyword {color:#FF1010; }
span.small_keyword {color:#802040; }
span.qualifier {color:#A02020; }
span.library {color:#A02000; }
span.ctor {color:#406020; }
span.hack {color:#66DD00; }
span.preproc {color:#005500; }
span.embedded_c{background-color:#DDDDDD; }
span.fpc_fieldname {color:#DD0000; }
span.lineno {color:#101010; background-color:#E0E0E0; font-size:80%; font-family:"courier",monospace; font-style:normal; }
pre.flxbg {background-color:#A0FFA0; color:black; padding:2px; box-shadow:5px 5px 2px #807080; }
pre.uncheckedflxbg {background-color:#D0D0D0; color:black; padding:2px; box-shadow:5px 5px 2px #807080; }
pre.cppbg {background-color:#80FF80; color:black; }
pre.prefmtbg {background-color:#D0D0D0; color:black; }
pre.expected {background-color:#E0FF80; color:black; }
pre.input {background-color:#E08080; color:black; }
pre.inclusion {background-color:#D070D0; color:black; }
code.inclusion {background-color:#D070D0; color:black; }
.obsolete { background-color:#FFEFEF; font-size: small; color:black; }
.future { background-color:#FF8080; font-size: small; color:black; }
.implementation_detail { background-color:#E0E0E0; font-size: small; color:black;  }
.bug { background-color:#FFE0E0; font-size: small; color:black; }
.fixed{ background-color:#FFE0E0; font-size: small; color:black; }
.done { background-color:#FFE0E0; font-size: small; color:black; }
.caveat { background-color:#FF8080; color:black; }
</style>
""";
}
mathjax := '''
<script type="text/x-mathjax-config">
  MathJax.Hub.Config({
    tex2jax: {
        skipTags: ["script","noscript","style","textarea"]
    }
  });
</script>
<script type="text/javascript"
  src="http://cdn.mathjax.org/mathjax/latest/MathJax.jsconfig=TeX-AMS-MML_HTMLorMML">
</script>
''';


var xlat_felix: string * string -> bool * string;

xlat_felix = Dynlink::load-plugin-func2 [bool * string, string, string] (
  dll-name="flx2html", setup-str="", entry-point="flx2html"
);


var filename = System::argv 1;
if filename == "--style" do
  println$ Css4Html::flx_head;
elif filename == "--mathjax" do
  println$ mathjax;
else
  eprintln$ "Formatting file " + filename;
  var b = load filename;
  needs_mathjax', txt := xlat_felix (b,"");
  println$ "<pre class='flxbg'>\n"+txt+"\n</pre>";
done
Mainline for dynamic loading.

This is the actual webserver code.

//[dflx_web.flx]
if PLAT_POSIX do
PosixSignal::ignore_signal(PosixSignal::SIGPIPE);
done



class Css4Html {
flx_head := """
<style type="text/css">
body {margin:3%; font-family: sans-serif; }
h1 {color:black; font-size:120%; border-bottom: 2px solid #ddd; padding: 0 0 3px 0;}
h2 {color:#202020; font-size:105%;}
h3 {font-size:100%;}
h4 {font-size:95%;}
h5 {font-size:95%;}
span.fstring {color:darkblue; font-style:italic; }
span.comment {font-family:arial; color:blue; font-style:italic; }
span.doccomment {font-family:arial; color:green; font-style:italic; }
span.big_keyword {color:#FF1010; }
span.small_keyword {color:#802040; }
span.qualifier {color:#A02020; }
span.library {color:#A02000; }
span.ctor {color:#406020; }
span.hack {color:#66DD00; }
span.preproc {color:#005500; }
span.embedded_c{background-color:#DDDDDD; }
span.fpc_fieldname {color:#DD0000; }
span.lineno {color:#101010; background-color:#E0E0E0; font-size:80%; font-family:"courier",monospace; font-style:normal; }
pre { border: 1px solid #ccc; color: black; box-shadow:3px 3px 2px rgba(0,0,0,0.1); padding:2px; }
pre.flxbg {background-color:#C2FDC2; box-shadow:3px 3px 2px rgba(0,0,0,0.1) }
pre.uncheckedflxbg {background-color:#eee; box-shadow:3px 3px 2px rgba(0,0,0,0.1); }
pre.cppbg {background-color:#C2FDC2; }
pre.prefmtbg {background-color:#F1F1F1; }
pre.expected {background-color:hsla(74,94%,88%,1); }
pre.input {background-color:hsla(20,94%,88%,1); }
pre.inclusion {
    font-family: Arial;
    font-weight: normal;
    font-size: 0.9em;
    color: #555;
    border: none;
    box-shadow: none;
    text-align: right;
    margin: -7px 11px -12px 0;
    padding: 0;
    background-color:#fafafa;
}
code.inclusion {background-color:#D070D0; color:black; }
.obsolete { background-color:#FFEFEF; font-size: small; color:black; }
.future { background-color:#FF8080; font-size: small; color:black; }
.implementation_detail { background-color:#E0E0E0; font-size: small; color:black;  }
.bug { background-color:#FFE0E0; font-size: small; color:black; }
.fixed{ background-color:#FFE0E0; font-size: small; color:black; }
.done { background-color:#FFE0E0; font-size: small; color:black; }
.caveat { background-color:hsla(0,100%,91%,1); color:black; padding: 0.6em; }
</style>
""";
}

open Socket;
open IOStream;

open TerminalIByteStream[fd_t];
open TerminalIOByteStream[socket_t];

// this is a hack to make close work on a listener
// RF got this right the first time:
// in the abstract a listener is NOT a socket
// In fact, it is a socket server, with accept() a way to
// read new sockets off it ..
open TerminalIByteStream[socket_t];

include "web/http_response";
open HTTPResponse;
include "web/mime_type";

include "plugins/plugin_common";
include "plugins/fdoc-interface";
include "plugins/edit-interface";
include "plugins/toc_menu-interface";

proc dbg(x:string) { fprint (cstderr,x); };
fun / (x:string, y:string) => Filename::join (x,y);

requires header '#include <stdlib.h>';
fun strtod: string -> double = "strtod($1.data(),0)";
fun atoi: string -> int = "atoi($1.data())";

// command line argument processing

// -------------------------------------------------------------------------
// Setup the fixed defaults.
var arg = "";
var argno = 1;
var SHARE = #Config::std_config.FLX_SHARE_DIR;
var TARGET = #Config::std_config.FLX_TARGET_DIR;
var INSTALL_ROOT = SHARE.[to -6]; // cut off the /share suffix

var DELAY = 0.1;
var PORT=1234;

var FLX_PATH=Empty[string];
var FDOC_PATH=Empty[string];

var C_PATH=list(
  "/usr/local/include",
  "/usr/include"
);

var FLX_PKGCONFIG_PATH=Empty[string];

var FLX_WEBSERVER_PLUGIN_PATH = Empty[string];
var PLUGIN_MAP = Empty[string^3];

// -------------------------------------------------------------------------
// Set the hard coded default config.
// This sucks totally, its just a hack based on my
// local requirements. And even that screws up by
// confusing multiple gcc installs and clang installs.

var default_config = list (
  "C_PATH += /usr/include/c++/4.2.1",
  "C_PATH += /usr/include/c++/4.2.1/x86_64-apple-darwin10",

  "C_PATH += /usr/include/c++/4.6",
  "C_PATH += /usr/include/c++/4.6.3",
  "C_PATH += /usr/lib/gcc/x86_64-linux-gnu/4.6.3/include",
   ""
);

// -------------------------------------------------------------------------
// Now find the users HOME directory.
// Try to get the config string from there.
var HOME: string = Env::getenv "HOME";
println$ "Home=" + HOME;
var FLX_HOME : string= Filename::join (HOME, ".felix");
println$ "FlxHome=" + FLX_HOME;
var FLX_CONFIG : string= Filename::join (FLX_HOME,"webserver.config");
println$ "Flxconfig=" + FLX_CONFIG;
var config_data = load(FLX_CONFIG);
println$ "loaded webserver config data = " + config_data;
var config_lines = split(config_data, "\n");


// -------------------------------------------------------------------------
// If we couldn't get the webserver config string
// from the HOME directory, use the fixed default.
if len config_data == 0.size do
  println "Using default config";
  config_lines = default_config;
done

// -------------------------------------------------------------------------
// Parse the config string.
config_lines = map (strip of (string)) config_lines;
var pathext = RE2("(.*)\\+=(.*)");
var varset = RE2("(.*)=(.*)");

var result = varray[StringPiece] (4.size,StringPiece(""));
for line in config_lines do
  var match_result = Match(pathext, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
  if match_result do
    var lhs = result.1.str.strip;
    var rhs = result.2.str.strip;
    match lhs with
    | "C_PATH" => C_PATH += rhs;
    | "FLX_PATH" => FLX_PATH += rhs;
    | "FLX_PKGCONFIG_PATH" => FLX_PKGCONFIG_PATH += rhs;
    | "FLX_WEBSERVER_PLUGIN_PATH" => FLX_WEBSERVER_PLUGIN_PATH += rhs;
    | "FDOC_PATH" => FDOC_PATH += rhs;
    | _ => println$ "Unknown variable '" + lhs +"'";
    endmatch;
  else
  match_result = Match(varset, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
  if match_result do
    lhs = result.1.str.strip;
    rhs = result.2.str.strip;
    match lhs with
    | "PORT" => PORT = atoi rhs;
    | "INSTALL_ROOT" => INSTALL_ROOT = rhs;
    | _ => println$ "Unknown variable '" + lhs +"'";
    endmatch;
  done done
done

// -------------------------------------------------------------------------
// Process command line options.
// These can reset the INSTALL_ROOT
// or augment the C_PATH.
while argno<System::argc do
  arg = System::argv argno;
  println$ "ARG=" + arg;
  if prefix(arg,"--root=") do
    INSTALL_ROOT=arg.[7 to];
    SHARE = INSTALL_ROOT/"share";
    TARGET = INSTALL_ROOT/"host";

  elif prefix(arg,"--close-delay=") do
    DELAY=strtod arg.[14 to];
  elif prefix(arg,"--port=") do
    PORT=atoi arg.[7 to];
  elif prefix(arg,"--cpath=") do
    C_PATH+=arg.[8 to];
  elif prefix(arg,"--plugin-path=") do
    FLX_WEBSERVER_PLUGIN_PATH+=arg.[14 to];
  done
  ++argno;
done

// -------------------------------------------------------------------------
// Now, use the INSTALL_ROOT to augment
// the search paths.
C_PATH+= TARGET+"/lib/rtl";
C_PATH+= INSTALL_ROOT+"/share/lib/rtl";
FLX_PATH+=INSTALL_ROOT+"/share/lib";
FLX_PATH+= TARGET+"/lib";
FDOC_PATH+=INSTALL_ROOT;
FLX_PKGCONFIG_PATH+= TARGET+"/config";
FLX_WEBSERVER_PLUGIN_PATH+= TARGET+"/lib";

// -------------------------------------------------------------------------
// Print the configuation.
println$ "INSTALL_ROOT="+INSTALL_ROOT;
println$ "FLX_PATH="+str FLX_PATH;
println$ "C_PATH="+str C_PATH;
println$ "FLX_PKGCONFIG_PATH="+str FLX_PKGCONFIG_PATH;
println$ "FLX_WEBSERVER_PLUGIN_PATH="+str FLX_WEBSERVER_PLUGIN_PATH;
println$ "FDOC_PATH="+str FDOC_PATH;
println$ "DELAY="+str DELAY;
println$ "PORT="+str PORT;


// -------------------------------------------------------------------------
// Build consolidated configuration string
// for plugins.

val newline="\n";

var config = "INSTALL_ROOT = " + INSTALL_ROOT + newline;
for d in FLX_PATH do
  config += "FLX_PATH += " + d + newline;
done

for d in C_PATH do
  config += "C_PATH += " + d + newline;
done

for d in FDOC_PATH do
  config += "FDOC_PATH += " + d + newline;
done

for d in FLX_PKGCONFIG_PATH do
  config += "FLX_PKGCONFIG_PATH += " + d + newline;
done

for d in FLX_WEBSERVER_PLUGIN_PATH do
  config += "FLX_WEBSERVER_PLUGIN_PATH += " + d + newline;
done

print$ "CONSOLIDATED CONFIG:\n" + config;

// -------------------------------------------------------------------------
// Now load the plugins.

var  xlat_felix = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="flx2html", setup-str=config, entry-point="flx2html"
  );

var  xlat_fdoc = Dynlink::load-plugin-func2 [fdoc_t, string, string] (
    dll-name="fdoc2html", setup-str=config, entry-point="fdoc2html"
  );

var  xlat_fpc = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="fpc2html", setup-str=config, entry-point="fpc2html"
  );

var  xlat_py = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="py2html", setup-str=config, entry-point="py2html"
  );

var  xlat_ocaml = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="ocaml2html", setup-str=config, entry-point="ocaml2html"
  );

var  xlat_cpp = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="cpp2html", setup-str=config, entry-point="cpp2html"
  );

var editor_maker = Dynlink::load-plugin-func1 [edit-interface_t, 1] (
  dll-name="fdoc_edit", setup-str=config, entry-point="fdoc_edit"
  );

var  toc_menu = Dynlink::load-plugin-func1 [toc_menu_interface, list[int * string * string]] (
    dll-name="toc_menu", setup-str="loaded-from-fdoc_frame", entry-point="toc_menu"
  );


// MOVE THIS ELSEWHERE!

fun getline_to_url (get:string) =>
  if not startswith get "GET " then
    ""
  else
    match find (get, ' ', 4uz) with
    | #None => ""
    | Some pos => get.[4 to pos]
    endmatch
  endif
;

fun postline_to_url (get:string) =>
  if not startswith get "POST " then
    ""
  else
    match find (get, ' ', 5uz) with
    | #None => ""
    | Some pos => get.[5 to pos]
    endmatch
  endif
;


// strip off the leading http:// then split on the next /
fun split_url (inurl:string) = {
  val url =
    if startswith inurl "http://" then
      inurl.[to 7]
    else
      inurl
    endif
  ;

  return
    match find (url, '/') with
    | #None => None[string*string]
    | Some pos => Some$ url.[0 to pos], url.[pos + 1 to]
    endmatch
  ;
}

// parse balance of HTTP GET request (after gthe GET keyword)
fun parse_get_line (get:string) =>
  split_url$ getline_to_url get
;

// parse balance of HTTP GET request (after gthe GET keyword)
fun parse_post_line (get:string) =>
  split_url$ postline_to_url get
;

variant request_type = reqGET | reqPOST | reqHEAD | reqERROR;

fun parse_request_type (r:string) =>
  if startswith r "GET" then reqGET
  elif startswith r "HEAD" then reqHEAD
  elif startswith r "POST" then reqPOST
  else reqERROR
  endif
;

// fixup text by replacing < > and & characters
fun txt2html (x:string) =
{
  var out2 = "";
  for var i in 0 upto x.len.int - 1 do
    var ch = x.[i];
    if ch == char "<" do out2+="&lt;";
    elif ch == char ">" do out2+="&gt;";
    elif ch == char "&" do out2+="&amp;";
    else out2+=ch;
    done
  done

  return out2;
}

// put into <head> of document
// http://www.mathjax.org/docs/1.1/start.html#mathjax-cdn
mathjax := '''
<script type="text/x-mathjax-config">
  MathJax.Hub.Config({
    tex2jax: {
        skipTags: ["script","noscript","style","textarea"]
    }
  });
</script>
<script type="text/javascript"
  src="http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML">
</script>
''';


// functions to make responses
fun make_image_from_suffix (suffix:string, contents:string, headers:headers_t) =>
  make_image(MIMEType::mime_type_from_extension suffix,contents, headers)
;

proc serve_not_found (k:socket_t, fname:string, get:bool) {
   var eof_flag = false;
   val data = make_not_found(fname);
   write_string(k,data,&eof_flag);
}

proc serve_not_implemented (k:socket_t, fname:string) {
   var eof_flag = false;
   val data = make_not_implemented(fname);
   write_string(k,data,&eof_flag);
}


proc serve_forbidden (k:socket_t, fname:string, get:bool) {
   var eof_flag = false;
   val data = make_forbidden(fname);
   write_string(k,data,&eof_flag);
}

fun find_defs (lines:string) : darray[int * int * string] =
{

  var fregex = ".*\\.(flx|fdoc)";
  open Regdef;
  regdef anychar = perl (".");

  regdef letter = charset "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
  regdef digit = charset "0123456789";
  regdef id1 = letter | "_";
  regdef id2 = id1 | digit | "-" | "'";
  regdef id = id1 id2*;

  regdef tex = "\\" letter*;
  regdef symbol1 = "+-*/%^";
  regdef symbol = symbol1 | symbol1 symbol1 | symbol1 symbol1 symbol1;
  regdef name = id | symbol;
  regdef spaces = " "*;
  regdef vlist =  "[" spaces id (spaces "," spaces id)* spaces "]";

  regdef adjective = "pure" | "inline" | "noinline" | "pod" | "open" | "virtual";
  regdef binder = "fun" | "proc" | "gen" | "class" | "union" | "struct" | "type" | "typedef" | "ctor" (spaces vlist)?;

  regdef indent2 = "  ";

  regdef classbind= group ("class" | "open class");
  regdef otherbind= indent2 ? group (adjective* spaces binder);

  // Group 1 = class
  // Group 2 = other
  // group 3 = identifier
  regdef decl = (classbind | otherbind) spaces group (name) anychar*;

  var emptystring = "";
  var emptystringpiece = StringPiece emptystring;

  var lregex = decl . render;
  var lgrep = RE2 lregex;
  var n = NumberOfCapturingGroups(lgrep)+1;
  var v = varray[StringPiece] (n.size,emptystringpiece);

  var extract = RE2 " *([^={]*) *(=|{|;).*";
  var n2 = NumberOfCapturingGroups(extract)+1;
  var v2 = varray[StringPiece] (n2.size,emptystringpiece);

  var scomment = RE2 " *//[$](.*)";
  var vcomment = varray[StringPiece] (2.size, emptystringpiece);
  var count = 0;
  var comments = Empty[string];

  var h = darray[int * int * string] ();
  var lno = 1;
  for line in split (lines,char "\n") do
    ++count;
    var spl = StringPiece line;

    match lgrep line with
    | Some v =>
      var sym = v.3;
      var dfn = "";
      var m2 = Match (extract, spl, 0, ANCHOR_BOTH, v2.stl_begin, n2);
      if m2 do
        dfn = v2 . 1 . string . strip;
      else
        dfn = line . strip;
      done
      //println$ "DEFN: " + dfn;
      var level = if line.[0] == " " then 2 else 1 endif;
      push_back (h, (level, lno, dfn));

    | #None => ;
    endmatch; //d grexp
    ++lno;
  done // line
  return h;
}

var frame_style= """
<style>
.container {
  position: fixed;
  top:0px;
  left:0px;
  height : 100%;
  width: 100%;
  background-color: grey;
  margin: 0px;
  padding: 0px;
  border-width: 0px;
  color: #404040;
}
.maincontent {
  padding:4px;
  padding-left:8px;
  line-height:1.3em;
  color:#404040; background-color:#fafafa;
}
.maincontent h1 { margin-left:-8px; position: relative; font-family: georgia, serif; font-size: 1.8em; font-weight: normal; }
.maincontent h2 { margin-left:-8px; position: relative; margin-bottom:-5px; }
.maincontent h3 { margin-left:-8px; position: relative; margin-bottom:-5px; }
.maincontent h4 { margin-left:-8px; position: relative; margin-bottom:-5px; }
.maincontent code { color:#902030; }
.toppanel {
  position:absolute; left:0px; top:0px; height:20px; right:0px;
  background-color: #e0e0e0;
}
.bottompanel {
  position:absolute; left:0px; top:22px; bottom:0px; right:0px;
  background-color: #fafafa;
  font-size:14px;
}
.leftpanel {
  position:absolute; left:0px; top:0px; bottom:0px; width: 150px;
  background-color: #eaeaea; overflow: auto;
}
.rightpanel {
  position:absolute; right: 0px; left:160px; top:0px; bottom: 0px;
  background-color: #fafafa; overflow: auto;
}
.divider {
  position:absolute; left: 150px; top:0px; bottom:0px;
  background-color: black; width:2px;
  box-shadow: 0 0 8px #000;
}

#panemover {
    position:absolute;
    left: 150px;
    width : 10px;
    top: 0px;
    bottom: 0px;
    opacity: 0.3;
    cursor:col-resize;
}

div.m {
    margin: 0px;
    padding:0px;
    border-width:2px;
    border-color: green;
}

div.m1 {
    background-color: #86E870;
    border-style:outset;
    border-color:#ccc;
    border-width:2px 0;
    font-size:90%;
    padding: 1px 0 2px 10px;
}

div.m2 {
    background-color: #70C070;
    padding-left:15px;
    padding-top:2px;
    border-style:outset;
    border-color:green;
    border-width:0 0 1px 0;
    font-size:80%;
}

div.m1:hover, div.m2:hover {
    background-color: white;
}

#leftmargintoc a {
    text-decoration: none;
    color: #404040;
}
</style>
""";

var frame_js = """
    <script async="true">
      function dragStart(e, left, right){
        document.getElementById("panemover").style.width="70%";
        document.getElementById("panemover").style.left="50px";
        mousedown = true;
        x = e.clientX
        dragOffsetLeft =
          document.getElementById(left).getBoundingClientRect().right -
          document.getElementById(left).getBoundingClientRect().left -
          x
        ;
        dragOffsetDivider= document.getElementById("divider").getBoundingClientRect().left - x;
        dragOffsetRight = document.getElementById(right).getBoundingClientRect().left - x;
      }
      function dragRelease(){
        document.getElementById('panemover').style.width = '6px';
        document.getElementById('panemover').style.left = document.getElementById('divider').offsetLeft + 'px';
        mousedown = false;
      }
      function drag(e, left, right){
        if(!mousedown){return}
        x = e.clientX
        tmpLeft = dragOffsetLeft + x
        tmpDivider= dragOffsetDivider + x
        tmpRight = dragOffsetRight + x
        document.getElementById(left).style.width= tmpLeft + 'px';
        document.getElementById("divider").style.left= tmpDivider + 'px';
        document.getElementById(right).style.left = tmpRight + 'px';
      };
    </script>
""";

typedef code_data_t = int * int * string;
typedef menu_data_t = int * string * string;

noinline fun wrap_html (h:darray[code_data_t], out:string) :string = {
  var h3 =  fold_right
    (fun (level:int, lno:int, text:string) (lst:list[menu_data_t]) =>
      (level, text, "#line" + lno.str) + lst
    )
    h Empty[menu_data_t]
  ;
    var menu = toc_menu (h3);

    var o = "";
    reserve(&o,10000+out.len.int);

    o+=frame_style;
    o+=#(menu.get_style);
    o+=frame_js;
    o+=#(menu.get_js);

    // MAIN CONTENT
    var topcontent =
      '    <!--Main Content top navbar-->\n'  +
      '    <!--Main Content top navbar End-->\n'
    ;

    var leftcontent = #(menu.make_menu);

    var rightcontent =
      '<!--Main Content Body-->\n' +
      out +
      '<!--Main Content Body End-->\n'
    ;

    var html = """
    <div class="container">
      <div class="toppanel">
""" + topcontent + """
      </div> <!-- toppanel end -->
      <div class="bottompanel">

        <span id="divider" class="divider"></span>

        <span id="left" class="leftpanel" >
          <div class="menucontent">
""" + leftcontent + """
          </div> <!-- leftpanel contents end -->
        </span> <!-- leftpanel end -->


        <span id="right" class="rightpanel">
          <div class="maincontent">
""" + rightcontent + """
          </div> <!-- rightpanel contents end -->
          <hr>
        </span> <!-- rightpanel end -->

        <span id="panemover" style="cursor:col-resize;"
         onmousedown="dragStart(event, 'left', 'right'); return false;"
         onmousemove="drag(event, 'left', 'right');"
         onmouseout="dragRelease();"
         onmouseup="dragRelease();"
        >
        </span> <!-- panemover end -->
      </div> <!-- bottom panel end -->
    </div> <!-- container end -->
""";
    o+= html;
    return o;
}


proc serve_felix (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;

  match get_file(fname,INSTALL_ROOT,FLX_PATH) with
  | Some path =>
    val text = load path;
    println$ "Loaded felix file " + fname+", len="+str (text.len.int);
    var h =find_defs (text);
    val dirname = Filename::dirname path;
    def val needs_mathjax, val html = xlat_felix(text,dirname);
    var wrapped_html = wrap_html (h,"<pre>"+html+"</pre>");
    val data = make_html$
      "<html><head>"+Css4Html::flx_head+
       if needs_mathjax then mathjax else "" endif +
      "</head><body>"+ wrapped_html +
      "</body></html>\n\r",
      list[string*string](("Cache-control","max-age=86400"))
    ;
    write_string(k,data,&eof_flag);
  | #None =>
      serve_not_found (k,fname,get);
  endmatch;
}

proc serve_fpc (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;

  match get_file (fname, INSTALL_ROOT,FLX_PKGCONFIG_PATH) with
  | Some path =>
    val text=load path;
    println$ "Loaded fpc file " + fname+", len="+str (text.len.int);
    val dirname = Filename::dirname path;
    val data = make_html$
      "<html><head>"+Css4Html::flx_head+"</head><body><pre>"+
      (xlat_fpc (text, dirname)).1
      +"</pre></body></html>\n\r",
      list[string*string]("Cache-control","max-age=86400")
    ;
    write_string(k,data,&eof_flag);
  | #None =>
      serve_not_found (k,fname,get);
  endmatch;

}

proc serve_py (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  match get_file(fname,INSTALL_ROOT,FLX_PATH) with
  | Some path =>
    var flx = load path;
    val data = make_html$
      "<html><head>"+Css4Html::flx_head+"</head><body><pre>"+
      (xlat_py (flx,"")).1 +"</pre></body></html>\n\r",
       list[string*string](("Cache-control","max-age=86400"))
    ;
    write_string (k, data, &eof_flag);
  | #None =>
    serve_not_found (k,fname,get);
  endmatch;
}

proc serve_ocaml (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  match get_file (fname, INSTALL_ROOT,FLX_PATH) with
  | Some path =>
    var flx = load path;
    println$ f"Loaded Ocaml file %S, len=%d" (fname, flx.len.int);
    val data = make_html$
      "<html><head>"+ Css4Html::flx_head +"</head><body><pre>"+
      (xlat_ocaml (flx,"")).1
      +"</pre></body></html>\n\r",
      list[string*string](("Cache-control","max-age=86400"))
    ;
    write_string (k, data, &eof_flag);
  | #None =>
    serve_not_found (k,fname,get);
  endmatch;
}

proc serve_cpp (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  match get_file(fname,INSTALL_ROOT,C_PATH) with
  | Some path =>
    val text=load path;
println$ f"Loaded C++ file %S, len=%d" (fname, text.len.int);
    val dirname = Filename::dirname path;
    val data = make_html$
      "<html><head>"+ Css4Html::flx_head +"</head><body><pre>"+
      (xlat_cpp (text, dirname)).1
      +"</pre></body></html>\n\r",
      list[string*string](("Cache-control","max-age=86400"))
    ;
    write_string (k, data, &eof_flag);
  | #None =>
      serve_not_found (k,fname,get);
  endmatch;
}

val text_suffices = (
  "txt","py","ml","mli",
  "tex","pl","dyp",
  "why","resh","pak","ipk",
  "dep","stdout","expect"
);

proc serve_text (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  var txt = load(fname);
  println$ f"Loaded text file %S, len=%d" (fname, txt.len.int);
  val data = make_html$
    "<html><head></head><body><pre>"+
    txt
    +"</pre></body></html>\n\r",
    list[string*string](("Cache-control","max-age=86400"))
  ;
  write_string (k, data, &eof_flag);
}

proc serve_html (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  var txt = load fname;
  println$ f"Loaded html file %S, len=%d" (fname, txt.len.int);
  val data = make_html$ txt,
    list[string*string](("Cache-control","max-age=86400"))
  ;
  write_string (k, data, &eof_flag);
}

proc serve_xhtml (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  var txt = load fname;
  println$ f"Loaded xhtml file %S, len=%d" (fname, txt.len.int);
  val data = make_xhtml$ txt,
    list[string*string](("Cache-control","max-age=86400"))
  ;
  write_string (k, data, &eof_flag);
}


proc serve_fdoc (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  match get_file(fname,INSTALL_ROOT,FDOC_PATH) with
  | Some path=>
    var txt = load(path);
    //println$ "Contents=" + flx;
    var result = xlat_fdoc (txt, fname);
    var needs_mathjax = #(result.mathjax_required);
    var html = #(result.html_page);
    var title = #(result.html_title);
    val data = make_html(
      "<html><head>"+Css4Html::flx_head+
      if needs_mathjax then mathjax else "" endif +
      if title != "" then "<title>"+title+"</title>" else "" endif +
      "</head><body>"+
      html+
      "</body></html>\n\r",
      list[string*string](("Cache-control","max-age=86400"))
    );
    write_string(k,data,&eof_flag);
  | #None => serve_not_found(k,fname,get);
  endmatch;
}

proc serve_xfdoc (k:socket_t, fname:string, get:bool) {
  var eof_flag = false;
  match get_file(fname,INSTALL_ROOT,FDOC_PATH) with
  | Some path=>
    var txt = load(path);
    println$ "Serve fdoc "+fname+" as xhtml";
    //println$ "Contents=" + flx;
    var result = xlat_fdoc (txt, fname);
    var needs_mathjax = #(result.mathjax_required);
    var html = #(result.html_page);
    var title = #(result.html_title);
    val data = make_html(
      "<html><head>"+Css4Html::flx_head+
      if needs_mathjax then mathjax else "" endif +
      if title != "" then "<title>"+title+"</title>" else "" endif +
      "</head>"+
      "<body>"+ html
      "</body></html>\n\r",
      list[string*string](("Cache-control","max-age=86400"))
    );
    write_string(k,data,&eof_flag);
  | #None => serve_not_found(k,fname,get);
  endmatch;
}

proc serve_raw (k:socket_t, fname:string, suffix:string, get:bool) {
  var eof_flag = false;
  var txt = load fname;
  println$ f"Loaded raw file %S, len=%d" (fname, txt.len.int);
  var mime = MIMEType::mime_type_from_file fname;
  println$ "File " + fname + " taken to be " + str mime;
  //println$ "Contents=" + flx;
  val data = make_mime (mime,txt);
  //val data = make_raw txt;
  write_string (k, data, &eof_flag);
}

proc serve_image (k:socket_t, fname:string, suffix:string, get:bool) {
  var eof_flag = false;
  var txt = load fname;
  println$ f"Loaded image file %S, len=%d" (fname, txt.len.int);
  //println$ "Contents=" + flx;
  val data = make_image_from_suffix (suffix,txt,
    list[string*string](("Cache-control","max-age=86400"))
  );
  write_string (k, data, &eof_flag);
}

// NOTE: TRICKY! serving css to be used in a page
// is quite different to serving a css file to be
// used by some program! In the first case it has to
// to be sent verbatim. In the second it is colourised.
proc serve_css(k:socket_t, fname:string, suffix:string, get:bool) {
  var eof_flag = false;
  var txt = load fname;
  println$ f"Loaded css file %S, len=%d" (fname, txt.len.int);
  //println$ "Contents=" + flx;
  val data = make_css txt;
  write_string(k,data,&eof_flag);
}

fun mk_dir_lines (fname:string, dirs: list[string]) = {
  fun rf(f:string)=>'  <a href="/$'+ fname + '/' +f+'">'+f+'</a>';
  return
    fold_left (fun (acc: string) (f:string) =>
      match f with
      | "." => acc
      | ".." => acc
      | _ => acc + rf f + "\r\n"
      endmatch
    )
    ""
    dirs
  ;
}


fun mk_reg_lines (fname:string, files: list[string]) = {
  var eof = false;
  var s = "";
  var old_base = "";
  var base = "";
  var extn = "";
  var entry = "";
  var exts = Empty[string];
  var rest = files;

  proc hd() { chd; }
  proc chd() { exts=list(extn); old_base=base; }
  proc cft() {
    //println$ "Cft for key " + old_base + " exts=" + str exts;
    fun rf(x:string)=>
      '  <a href="/$'+ fname + '/' +old_base+x+'">'+
      if x == "" then "(none)" else x endif +
      '</a>'
    ;
    def var extn, var rest = match exts with | Cons(h,t)=> h,t endmatch;
    s+= '  <a href="/$'+ fname + '/' +old_base+extn +'">'+old_base+extn+'</a>';
    List::iter (proc (x:string){ s+=" "+rf x; }) rest;
  }
  proc ft() { cft; s+="\r\n"; }
  proc twixt() { s+="\r\n"; }
  proc cbrk () { cft; twixt; chd; }
  proc nxt() {
    match rest with
    | Cons(h,t) =>
      entry = h; rest = t;
      base,extn =
        match rfind (entry, ".") with
        | #None => entry, ""
        | Some pos => entry.[to pos], entry.[pos to]
        endmatch
      ;
    | #Empty => eof = true;
    endmatch;
  }

  //special case for empty list
  if len files == 0uz do return ""; done

  nxt;                    //prime the system
  hd;                     // head off

again:>
  nxt;
  if eof goto fin;        //check for eof
  if base == old_base do  //check for control break
    exts += extn;         // nope, same key
  else
    cbrk;                 // key changed
  done
  goto again;
fin:>
  ft;                     // foot off
  return s;
}

proc serve_directory (k:socket_t, fname:string, get:bool) {
  var dirname = Filename::basename fname;
  var eof_flag = false;
  val top = "A DIRECTORY " + fname + "\r\n";
  val flist =
    match Directory::filesin fname with
    | Some files =>
      let aux =
          fun (ls2:list[string] * list[string]) (f:string) =>
          match ls2 with | ds,rs => match FileStat::filetype (Filename::join (fname,f)) with
            | #DIRECTORY => Cons (f,ds), rs
            | #REGULAR => ds, Cons (f,rs)
            | _ => ls2
            endmatch
          endmatch
      in
      let dirs,regs = fold_left aux (Empty[string], Empty[string]) files in
      let dirs,regs = sort dirs, sort regs in
      let dir_lines = mk_dir_lines (fname,dirs) in
      let reg_lines = mk_reg_lines (fname,regs) in
        "<pre>"+
        '  <a href="/"><em>home</em></a>\r\n'+
        if dir_lines.len != 0uz then ' Directories: \r\n' + dir_lines else "" endif +
        if reg_lines.len != 0uz then ' Files: \r\n' + reg_lines else "" endif +
        "</pre>"
    | #None => "ERROR ACCESSING DIRECTORY"
    endmatch
  ;
  val page = make_html(top + flist,
    list[string*string](("Cache-control","max-age=86400"))
  );
  write_string(k,page,&eof_flag);
}


proc serve_file(s: socket_t, infname: string) => serve (s, infname, true);
proc serve_head(s: socket_t, infname: string) => serve (s,infname,false);

proc serve(s: socket_t, infname: string, get:bool)
{
  var eof_flag = false;
  // if empty string, serve index.html
  // not quite right - needs to handle directories too, so
  // not only foo.com/ -> index.html, but foo.com/images/ -> images/index.html
  var fname = if "" == infname then "share/src/web/index.html" else infname endif;

  fname =
    if fname.[0] == char "$" then fname.[1 to]
    elif fname.[0 to 3] == "%24" then fname.[3 to]
    else fname
    endif
  ;

  // set mime type depending on extension...
  // serve a "not found page" for that case (check for recursion)
  //print "serve file: "; print fname; endl;

  // figure out the filetype
  // we first check if the filename has a suffix like cpp
  // which is a trick done by us to force the filetype
  // to be "c++" for C++ standard include file names
  // which have no suffix. If we find that, we strip it
  // out of the filename too. Otherwise we just find
  // the suffix.

  var suffix = "";
  fun split_suffix (fname:string) =>
    match rfind (fname, "?") with
    | Some pos => fname.[pos + 1 to], fname.[0 to pos]
    | #None =>
        match rfind (fname, ".") with
        | #None => "",fname
        | Some pos => fname.[pos + 1 to], fname
        endmatch
    endmatch
  ;
  suffix,fname = split_suffix fname;

  if fname == "STOP" do
    run = false;
    println$ "STOP DETECTED";
  elif fname == "robots.txt" do
    serve_raw (s,INSTALL_ROOT + "/robots.txt","txt", get);
  elif suffix \in list ("flx","flxh") do
    serve_felix(s, fname, get);
  elif suffix \in list ("py") do
    serve_py(s, fname, get);
  elif suffix \in list ("ml","mli") do
    serve_ocaml(s, fname, get);
  elif suffix \in list("cpp","hpp","h","c","cc","i","cxx","rtti","includes","ctors_cpp") do
    serve_cpp(s, fname, get);
  elif suffix == "fpc" do
    serve_fpc(s, fname, get);
  elif suffix == "fdoc" do
    serve_xfdoc(s, fname, get);
  elif suffix \in ("html","htm") do
    fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
    serve_html(s,fname, get);
  elif suffix == "xhtml" do
    fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
    serve_xhtml(s,fname, get);
  elif suffix \in text_suffices do
    fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
    serve_text(s,fname, get);
  elif suffix \in ("gif","png","jpg","svg") do
    fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
    serve_image(s,fname,suffix, get);
  elif suffix == "css" do
    // path lookup for css files
    fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
    serve_css(s,fname,suffix, get);
  else
    match get_file(fname, INSTALL_ROOT,Empty[string]) with
    | #None => serve_not_found(s,fname, get);
    | Some f =>
        if prefix(fname,"/etc") do serve_forbidden(s,fname, get);
        else
        match FileStat::filetype f with
        | #REGULAR => serve_raw(s,f,suffix, get);
        | #DIRECTORY => serve_directory (s,f, get);
        | _ => serve_not_found(s,f, get);
        endmatch;
        done
    endmatch;
  done
}
val webby_port = PORT;
var run = true;

print "FLX WEB!!! listening on port "; print webby_port; endl;

// up the queue len for stress testing
var p = webby_port;
var listener: socket_t;
mk_listener(&listener, &p, 10);

var clock = Faio::mk_alarm_clock();

// noinline is necessary to stop the closure being
// inlined into the loop, preventing the socket variable k
// being duplicated as it must be [a bug in Felix]
noinline proc handler (var k:socket_t) ()
{
  //dbg$ "Spawned fthread running for socket "+str k+"\n";
  // should spawn fthread here to allow for more io overlap
  //dbg$ "here we go .. read a line\n";

  var line: string;
  get_line(k, &line);  // should be the GET line.
  //dbg$ "Got a line from socket " + str k + "\n";
  //cat(s, DEVNULL);


  // now I need to parse the GET line, get a file name out of its url
  // (e.g. unqualfied -> index.html and name/flx.jpg -> flx.jpg
  var req = parse_request_type line;

  match req with
  | #reqGET =>
    match parse_get_line line with
    | Some (base, file) =>
      print "file="; print file; endl;
      serve_file(k,file);
    | #None => println$ "BAD GET line: '"+line+"'";
    endmatch;
  | #reqHEAD =>
    match parse_get_line line with
    | Some (base, file) =>
      print "file="; print file; endl;
      serve_head(k,file);
    | #None => println$ "BAD HEAD line: '"+line+"'";
    endmatch;
  | #reqPOST =>
    println$ "Unsupported POST; line: '"+line+"'";
  | #reqERROR =>
    println$ "BAD request line: '"+line+"'";
  endmatch;

broken:>

  // we've only read the GET line, so let's flush out the rest of
  // the http request so we don't get connection reset errors when
  // we close the socket. shutting down stops cat blocking (?)
  //Faio_posix::shutdown(s, 1); // disallow further sends.
  //cat(s, DEVNULL);

  //fprint$ cstderr,"fthread socket "+str k+" close delay ..\n";
  Faio::sleep(clock,DELAY); // give OS time to empty its buffers
  //fprint$ cstderr,"fthread socket "+str k+" shutdown now\n";

// try this:
// Advised by: koettermarkus@gmx.de, MANY THANKS!

  gen hack_recv: socket_t * &char * int * int -> int = "recv($1,$2,$3,$4)";

  var buf:char ^1025;
  var counter = 0;
  var extra = 0;
  shutdown(k,1); // shutdown read
retry:>
  var b = hack_recv(k,C_hack::cast[&char] (&buf),1024,0);
  //println$ "Error code " + str b + " from read after shutdown";
  if b > 0 do
    extra += b;
    if extra > 2000 do
      println$ "Read too many extraneous bytes from OS buffer";
      goto force_close;
     done;
   goto retry;
  elif b == -1 do
    ++counter;
    if counter > 200 do
      println "Timeout waiting for write buffers to be flushed";
      goto force_close;
    done;
    Faio::sleep(clock,0.1); // 100 ms
    goto retry;
  done;
  assert b==0;

force_close:>
  Socket::shutdown(k,2);
  ioclose(k);
  //fprint$ stderr,"fthread "+str k+" terminating!\n";
};

spawn_fthread { while run do Faio::sleep(clock, 60.0); collect(); done };
while run do
  var s: socket_t;
  //dbg$ "Waiting for connection\n";
  accept(listener, &s);  // blocking
  //dbg$ "got connection "+str s + "\n";  // error check here

  // hmm - spawning an fthread is blocking the web server. don't know why
  //dbg$ "spawning fthread to handle connection "+str s+"\n";
  var h = handler s;
  spawn_fthread  h;
 //collect(); // this hangs everything, no idea why!
done

println "WEB SERVER FINNISHED?";
println$ "Closing listener socket " + str listener;
iclose (listener);
Mainline with preloaded plugins.
//[flx_web.flx]
// webserver plugin linker

class WebserverPluginSymbols
{

  // We have to do this dummy requirements because static
  // linking removes
  requires package "re2";
  requires package "faio";
  requires package "flx_arun";

  open Dynlink;

  // Now add all the symbols.
  proc addsymbols ()
  {
    static-link-plugin
      fdoc2html,
      flx2html,
      fpc2html,
      py2html,
      ocaml2html,
      cpp2html,
      fdoc_scanner,
      fdoc_slideshow,
      fdoc_heading,
      fdoc_fileseq,
      fdoc_paragraph,
      fdoc_button,
      fdoc_frame,
      fdoc_edit,
      toc_menu
    ;
    // webserver
    static-link-symbol dflx_web_create_thread_frame in plugin dflx_web;
    static-link-symbol dflx_web_flx_start in plugin dflx_web;

  }
}

// Add the symbols
WebserverPluginSymbols::addsymbols;

// Now invoke the webserver!
println$ "Running webserver";
val linstance =  Dynlink::prepare_lib("dflx_web");
println$ "Webserver prepared";
var init: cont = Dynlink::get_init linstance;

Fibres::chain init;

Language Translators.

Felix Package Config fpc format.
//[fpc2html.flx]

var FLX_PKGCONFIG_PATH = Empty[string];
var INSTALL_ROOT = "";
var C_PATH = Empty[string];
var FLX_PATH = Empty[string];

fun get_file (var fname:string, path:list[string]) = {
  if fname.[0] == char "$" do fname = fname.[1 to]; done
  if FileStat::fileexists fname do return Some fname;
  else
    var f = Filename::join(INSTALL_ROOT,fname);
    if FileStat::fileexists f do return Some f;
    else return FileSystem::find_in_path (fname, path);
    done
  done
}



module Fpc2Html
{
fun xlat_fpc(t:string, dir:string) : bool * string =
{
println$ "formatting fpc data";
  var out = "";
  val lines = split(t,"\n");
  iter handle_line lines;
  return false, out;

  proc handle_line(s:string) {
    match split(s,":") with
    | Cons(fn,Cons(fv,Empty))  =>
      {
        out+= "<span class=fpc_fieldname>"+fn+": </span>";
        if fn in ("Requires","flx_requires_driver") do
          var pkgs=split$ fv.strip, " ";
          iter handle_pkg pkgs;
          out+="\n";
        elif fn == "includes" do
          var includes=split$ fv.strip, " ";
          iter handle_include includes;
          out+="\n";
        else out+= fv+"\n";
        done;
      }
    | x => { out+=s + "\n"; }
    endmatch;
  }
  proc handle_pkg(s:string) {
    match get_file(s+".fpc",FLX_PKGCONFIG_PATH) with
    | Some path => { out += '<a href="/$' + path + '">' + s + '</a> '; }
    | #None => { out += s + " "; }
    endmatch;
  }
  proc handle_include(s:string) {
    var n = s;
    while n.[0] in (char '"', char '<', char "'") do n=n.[1 to]; done
    while n.[-1] in (char '"',char '>',char "'") do n=n.[to -1]; done
    match get_file(n,C_PATH) with
    | Some path => { out += '<a href="/$' + path + '">' + s + '</a> '; }
    | #None => { out += s + " "; }
    endmatch;
  }
}
}

eprintln$ Version::felix_version+"Fpc2html initialisation";

fun setup(config_data:string) = {
  var config_lines = split(config_data, "\n");
  config_lines = map (strip of (string)) config_lines;
  var pathext = RE2("(.*)\\+=(.*)");
  var varset = RE2("(.*)=(.*)");
  var plugin_spec = RE2 " *extension (.*)->(.*)::(.*)";

  var result = varray[StringPiece] (4.size,StringPiece(""));
  for line in config_lines do
    var match_result = Match(pathext, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      var lhs = result.1.str.strip;
      var rhs = result.2.str.strip;
      match lhs with
      | "FLX_PATH" => FLX_PATH += rhs;
      | "C_PATH" => C_PATH += rhs;
      | "FLX_PKGCONFIG_PATH" => FLX_PKGCONFIG_PATH += rhs;
      | _ => ;
      endmatch;
    else
    match_result = Match(varset, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      lhs = result.1.str.strip;
      rhs = result.2.str.strip;
      match lhs with
      | "INSTALL_ROOT" => INSTALL_ROOT = rhs;
      | _ => ;
      endmatch;
    done done
  done
  return 0;
}


export fun setup of (string) as "fpc2html_setup";
export fun Fpc2Html::xlat_fpc of (string * string) as "fpc2html";
Ocaml
//[ocaml2html.flx]
// Ocaml
module Ocaml2Html {
private val big_keywords =
  "module",
  "functor",
  "open",
  "type",
  "class",
  "struct",
  "end",
  "val",
  "inherit",
  "exception"
;
private val small_keywords =
  "if", "then", "else", "elif", "endif", "do", "done",
  "let", "in", "for", "while", "to", "upto","downto",
  "try","match","with","fun","function",
  "begin","end"
;

private val qualifiers =
  "virtual", "private"
;
private val hack = "C_hack","C_hack"; // to make it an array we need 2 components


fun xlat_ocaml(t:string, dir:string) : bool * string =
{
  var out = "";
  proc write_string(t:string)
  {
   out += t;
  }

  variant state_t =
    | sot // start of token
    | id // processing identifier
    | num // in a number
    | dq // processing double quote string
    | ccomment // a C style comment
  ;
  fun str(s:state_t) => match s with
  | #sot => "sot"
  | #id => "id"
  | #num => "num"
  | #dq => "dq"
  | #ccomment => "ccomment"
  endmatch;

  var i = 0; var s:state_t;
  var ch = t.[i];
  proc next() { ch = t.[i]; ++i; }
  fun ahead (j:int)=> t.[i + j - 1];

  var b = "";
  var last_id = "";
  var last_op = "";
  proc cp() { b += ch; }
  proc ws() {
     write_string('<span class=fstring>'+b+"</span>");
  }
  proc w() {
    //println$ "Token["+str s+"]="+b;
    match s with
    | #dq => ws;
    | #ccomment => write_string('<span class=comment>'+b+"</span>");
    | #id =>
        last_id = b;
        if b in big_keywords do write_string('<span class=big_keyword>'+b+"</span>");
        elif b in small_keywords do write_string('<span class=small_keyword>'+b+"</span>");
        elif b in qualifiers do write_string('<span class=qualifier>'+b+"</span>");
        elif isupper b.[0] do write_string('<span class=ctor>'+b+"</span>");
        else write_string(b); done
    | _ =>
        last_op=b;
        if b == "<" do b = "&lt;";
        elif b == ">" do b = "&gt;";
        elif b == "&" do b = "&amp;";
        done;
        write_string(b);
    endmatch;
    b = "";
  }


  goto nextt;

contin:> // copy char and continue
  cp();
  goto nextch;

overrun:> // one past last char of token
  w();
  s = sot;
  goto thisch;

lastch:> // last char of token
  cp();
  w();

nextt:>  // new token on next char
  s = sot;

nextch:> // next char
  next();

thisch:> // same char, reconsider it
  //println$ "Considering char " + str(ord(ch));
  if isnull ch goto fin; // out of data
  match s with
  | #sot =>
      if isidstart ch do s = id; goto contin;
      elif isdigit ch do s = num; goto contin;
      elif isdq ch do s = dq; goto contin;
      elif ch == char "(" do
        if ahead(1) == char "*" do cp; next; s = ccomment; goto contin;
        else goto lastch;
        done
      else cp; w; goto nextt;
      done

  | #id =>
      if iscamlidcont ch do goto contin;
      else goto overrun;
      done
  | #num =>
      if isnumeric ch do goto contin;
      else goto overrun;
      done
  | #dq =>
      if isdq ch do goto lastch;
      elif ch== char "<" do b+="&lt;"; goto nextch;
      elif ch== char ">" do b+="&gt;"; goto nextch;
      elif ch== char "&" do b+="&amp;"; goto nextch;
      else goto contin;
      done
   // comments
  | #ccomment => // doesn't handle nested comments yet
      if ch == char "*" and ahead(1) == char ")" do
        cp;
        goto lastch;
      else goto contin;
      done
  endmatch
  ;
  println$ "Unexpected drop thru";

fin:>
   println "outof data";
   w(); // whatever is left over gets written
   return false, out;
}
}


eprintln$ Version::felix_version+"ocaml2html initialisation";

fun setup(x:string) = {
  C_hack::ignore(x); // which means, don't ignore it!
  return 0;
}

export fun setup of (string) as "ocaml2html_setup";
export fun Ocaml2Html::xlat_ocaml of (string * string) as "ocaml2html";
Python
//[py2html.flx]

// Python
module Py2Html {
private val big_keywords =
  "def",
  "class",
  "import"
;
private val small_keywords =
  "if", "while", "for", "return", "in", "from","else","elsif","except","try",
  "not","with","raise"
;

private val qualifiers =
  "None", "True", "False", "pass","self"
;


fun xlat_py(t:string, dir:string) : bool * string =
{
  var out = "";
  proc write_string(t:string)
  {
   out += t;
  }

  variant state_t =
    | sot // start of token
    | id // processing identifier
    | num // in a number
    | sq // processing single quote string
    | dq // processing double quote string
    | sq3 // processing single quote string
    | dq3 // processing double quote string
    | cppcomment // a C++ style comment
  ;
  fun str(s:state_t) => match s with
  | #sot => "sot"
  | #id => "id"
  | #num => "num"
  | #sq => "sq"
  | #dq => "dq"
  | #sq3 => "sq3"
  | #dq3 => "dq3"
  | #cppcomment => "cppcomment"
  endmatch;

  var i = 0; var s:state_t;
  var ch = t.[i];
  proc next() { ch = t.[i]; ++i; }
  fun ahead (j:int)=> t.[i + j - 1];
  fun issq3() =>
    ch == char "'" and
    ahead(1) == char "'" and
    ahead(2) == char "'"
  ;
  fun isdq3() =>
    ch == char '"'  and
    ahead(1) == char '"' and
    ahead(2) == char '"'
  ;

  var b = "";
  var last_id = "";
  var last_op = "";
  proc cp() { b += ch; }
  proc ws() {
     write_string('<span class=fstring>'+b+"</span>");
  }
  proc w() {
    //println$ "Token["+str s+"]="+b;
    match s with
    | #dq =>  ws;
    | #sq =>  ws;
    | #sq3 =>  ws;
    | #dq3 =>  ws;
    | #cppcomment => write_string('<span class=comment>'+b+"</span>");
    | #id =>
        last_id = b;
        if b in big_keywords do write_string('<span class=big_keyword>'+b+"</span>");
        elif b in small_keywords do write_string('<span class=small_keyword>'+b+"</span>");
        elif b in qualifiers do write_string('<span class=qualifier>'+b+"</span>");
        else write_string(b); done
    | _ =>
        last_op=b;
        if b == "<" do b = "&lt;";
        elif b == ">" do b = "&gt;";
        elif b == "&" do b = "&amp;";
        done;
        write_string(b);
    endmatch;
    b = "";
  }


  goto nextt;

contin:> // copy char and continue
  cp();
  goto nextch;

overrun:> // one past last char of token
  w();
  s = sot;
  goto thisch;

lastch:> // last char of token
  cp();
  w();

nextt:>  // new token on next char
  s = sot;

nextch:> // next char
  next();

thisch:> // same char, reconsider it
  //println$ "Considering char " + str(ord(ch));
  if isnull ch goto fin; // out of data
  match s with
  | #sot =>
      if isidstart ch do s = id; goto contin;
      elif isdigit ch do s = num; goto contin;
      elif issq3() do cp; next; cp; next; s = sq3; goto contin;
      elif isdq3() do cp; next; cp; next; s = dq3; goto contin;
      elif issq ch do s = sq; goto contin;
      elif isdq ch do s = dq; goto contin;
      elif ch == char "#" do s = cppcomment; goto contin;
      else cp; w; goto nextt;
      done

  | #id =>
      if isalphanum ch do goto contin;
      else goto overrun;
      done
  | #num =>
      if isnumeric ch do goto contin;
      else goto overrun;
      done
  // single quoted strings
  | #sq =>
      if issq ch do goto lastch;
      elif ch== char "<" do b+="&lt;"; goto nextch;
      elif ch== char ">" do b+="&gt;"; goto nextch;
      elif ch== char "&" do b+="&amp;"; goto nextch;
      else goto contin;
      done
  | #dq =>
      if isdq ch do goto lastch;
      elif ch== char "<" do b+="&lt;"; goto nextch;
      elif ch== char ">" do b+="&gt;"; goto nextch;
      elif ch== char "&" do b+="&amp;"; goto nextch;
      else goto contin;
      done
   // triple quoted strings
  | #sq3 =>
      if issq3() do cp; next; cp; next; cp; w; goto nextt;
      elif ch== char "<" do b+="&lt;"; goto nextch;
      elif ch== char ">" do b+="&gt;"; goto nextch;
      elif ch== char "&" do b+="&amp;"; goto nextch;
      else goto contin;
      done
  | #dq3 =>
      if isdq3() do cp; next; cp; next; cp; w; goto nextt;
      elif ch== char "<" do b+="&lt;"; goto nextch;
      elif ch== char ">" do b+="&gt;"; goto nextch;
      elif ch== char "&" do b+="&amp;"; goto nextch;
      else goto contin;
      done
   // comments
  | #cppcomment =>
      if iseol ch do goto lastch;
      else goto contin;
      done
  endmatch
  ;
  println$ "Unexpected drop thru";

fin:>
   println "outof data";
   w(); // whatever is left over gets written
   return false, out;
}
}

eprintln$ Version::felix_version+"Py2html initialisation";

fun setup(x:string) = {
  C_hack::ignore(x); // which means, don't ignore it .. :)
  return 0;
}

export fun setup of (string) as "py2html_setup";
export fun Py2Html::xlat_py of (string * string) as "py2html";
Felix flx format.
//[flx2html.flx]
include "./plugin_common";

// fixup text by replacing < > and & characters
fun txt2html (x:string) =
{
  var out2 = "";
  for var i in 0 upto x.len.int - 1 do
    var ch = x.[i];
    if ch == char "<" do out2+="&lt;";
    elif ch == char ">" do out2+="&gt;";
    elif ch == char "&" do out2+="&amp;";
    else out2+=ch;
    done
  done

  return out2;
}

var INSTALL_ROOT = "";
var FLX_PKGCONFIG_PATH = Empty[string];
var FLX_PATH = Empty[string];
var FLX_WEBSERVER_PLUGIN_PATH = Empty[string];

var xlat_cpp: string * string -> bool * string;

// stick line numbers in front of each line (for hyperlinking source refs)
fun lc (x:string) = {
  var lines = rev
    match rev_split (x,"\n") with
    | Cons ("",t) => t
    | x => x
    endmatch
  ;

  var result = "";
  reserve (&result, len x + 50.size * len lines);
  var count = 0;
  for line in lines do
    ++count;
    result += '<span class="lineno" id=line'+count.str+'></span>';
    result += '  ' +line+'\n';
  done
  return result;
}

// Felix
module Flx2Html {
private val big_keywords =
  ("export",'generate extern "C" wrapper'),
  ("macro","prefix for macro definitions"),
  ("module","Define a module namespace"),
  ("cfun","Define a C function"),
  ("cproc","Define a C procedure"),
  ("fun","Define a function with no side-effects"),
  ("enum","Elaborate an enumeration, a simple sum type"),
  ("cenum","Lift an enumeration of integers from C"),
  ("cflags","Lift an enumeration of flags from C"),
  ("gen","Define a generator, a function with side-effects returning a value"),
  ("proc","Define a procedure, a function with side-effects not returning a value"),
  ("ctor","Define a value constructor or conversion operator for a type"),
  ("type","Define a primitive type by binding to a C type"),
  ("ctypes","Define a set of primitive type by binding to C types with the same name"),
  ("union","Define a union of variants (alternatives)"),
  ("struct","Define a structure"),
  ("cstruct","Provide a model for an existing C struct"),
  ("typedef","Define an alias for a type expression"),
  ("var","Define a mutable variable"),
  ("val","Define an immutable value"),
  ("class","Define a type class"),
  ("const","Bind a Felix symbol to a C expression"),
  ("instance","Provide an instance of a typeclass"),
  ("header","Specify C code to be inserted into header file"),
  ("body","Specify C code to be inserted into implementation file"),
  ("include","Include a Felix file"),
  ("spawn_fthread","Spawn a cooperative fibre"),
  ("spawn_pthread","Spawn a pre-emptive thread"),
  ("reduce", "Specify a reduction"),
  ("axiom", "Specify core semantics"),
  ("assert", "Run time assertion"),
  ("open", "Open a module or class"),
  ("inherit","Inherit symbols into a module or typeclass"),
  ("rename","create a new name for a symbol"),
  ("use","put the basename of a qualified name in the current scope"),
  ("SCHEME","Define Scheme symbols"),
  ("syntax","define domain specific sublanguage module"),
  ("regdef","define named regular expression"),
  ("literal","define literal"),
  ("priority","Define order of syntactic priority symbols"),
  ("requires","specify requirements"),
  ("object","define an object factory"),
  ("interface","define an object interface"),
  ("try","try block"),
  ("catch","catch handler"),
  ("endtry","end of try block"),
  ("halt", "terminate program with message")
;

private val small_keywords =
  ("if","conditional"),
  ("then","conditional"),
  ("else","conditional"),
  ("elif","conditional"),
  ("endif","conditional"),
  ("do","imperative code begins"),
  ("done","end of body"),
  ("extend","define an object interface"),
  ("begin","end of extension"),
  ("end","end of extension"),
  ("in", "membership operator, function mem"),
  ("for", "for loop"),
  ("while","while loop"),
  ("to", "substring range separator"),
  ("upto","upwards counting for loop"),
  ("downto","downwards counting for loop"),
  ("typematch","type match expression"),
  ("match","match statement or expression"),
  ("endmatch","end a match statement or expression"),
  ("with", "type-class constraint"),
  ("return","return"),
  ("yield","return a value saving the current location for future resumption"),
  ("goto","jump to label"),
  ("goto-indirect","jump to code address"),
  ("branch-and-link","low level exchange of control"),
  ("call","call a procedure"),
  ("jump","tail call of function"),
  ("loop","self-tail call"),
  ("package","specifies an abstract package name"),
  ("when", "predicative type constraint or precondition"),
  ("result","value of function return used in post condition"),
  ("expect","post condition"),
  ("for","for loop"),
  ("ident","identifier macro"),
  ("noexpand","inhibit macro expansion"),
  ("typesetof","a set of types"),
  ("code","literal C code insertion"),
  ("extends","extend an object or interface with extra methods"),
  ("implements","specify what interfaces an object implements"),
  ("encoder","serialisation encoder"),
  ("decoder","serialisation decoder"),
  ("caseno","Integer index of value of a sum type"),
  ("case","Sum type selector"),
  ("proj","Product projection"),
  ("let","let binder"),
  ("label_address","code address at a label"),
  ("and","logical conjunction"),
  ("or","logical disjunction"),
  ("not","logical negation"),
  ("implies","logical implication"),
  ("until","loop until condition is met"),
  ("invariant","establish invariant for object methods")
;

private val qualifiers =
  ("method", "A function depending only on its parameters"),
  ("pure", "A function depending only on its parameters"),
  ("virtual", "Type of a function to be provided in type class instances"),
  ("inline", "Function or procedure which should be inlined if possible"),
  ("noinline", "Function or procedure which must not be inlined"),
  ("private", "Symbol visible only in enclosing module or typeclass namespace"),
  ("incomplete","A type which must not be instantiated"),
  ("callback","A C wrapper for a Felix callback"),
  ("pod","A Plain Old Data type, which needs no finalisation"),
  ("_gc_pointer","A Felix heap allocated pointer"),
  ("_gc_type","Type of object pointed to"),
  ("scanner","names C routine which scans a data structure for pointers"),
  ("finaliser","names C routine which finalises an object"),
  ("_repr_","Refer to the representation of a Felix abstract type"),
  ("noreturn","specify C code doesn't return")
;

private val dlibrary =
  ("any", "Type a non-returning function returns"),
  ("void", "Type with no values, returning void indicates a procedure"),
  ("unit", "Type with one values (), the empty tuple"),
  ("tiny", "binding of C signed char type"),
  ("utiny", "binding of C unsigned char type"),
  ("short", "binding of C short type"),
  ("ushort", "binding of C unsigned short type"),
  ("int", "binding of C int type"),
  ("uint", "binding of C unsigned int type"),
  ("long", "binding of C long type"),
  ("ulong", "binding of C unsigned long type"),
  ("vlong", "binding of C long long type"),
  ("uvlong", "binding of C unsigned long long type"),
  ("int8", "binding of C int8_t type"),
  ("int16", "binding of C int16_t type"),
  ("int32", "binding of C int32_t type"),
  ("int64", "binding of C int64 type"),
  ("uint8", "binding of C uint8_t type"),
  ("uint16", "binding of C uint16_t type"),
  ("uint32", "binding of C uint32_t type"),
  ("uint64", "binding of C uint64 type"),
  ("char", "binding of C char type"),
  ("uchar", "binding of C int32_t type used for Unicode character set"),
  ("intptr", "binding of C intptr_t type"),
  ("uintptr", "binding of C unsigned type corresponding to intptr_t type"),
  ("maxint", "binding of C maxint_t type"),
  ("umaxint", "binding of C unsigned type corresponding to maxint_t type"),
  ("size", "binding of C size_t type"),
  ("ssize", "binding of C signed type corresponding to size_t type"),
  ("float", "binding of C float type"),
  ("double", "binding of C double float type"),
  ("ldouble", "binding of C long double type"),
  ("string", "binding of C++ string type"),
  ("ptrdiff", "binding of C ptrdiff_t type"),
  ("intmax", "binding of C intmax_t type"),
  ("uintmax", "binding of C uintmax_t type"),
  ("wchar", "binding of C uintmax_t type"),
  ("fcomplex", "binding of C++ complex&lt;float&gt; type"),
  ("dcomplex", "binding of C++ complex&lt;double&gt; type"),
  ("lcomplex", "binding of C++ complex&lt;long double&gt; type"),
  ("byte", "special binding of C unsigned char type"),
  ("address", "special binding of C void* type"),

  ("opt", "option type: Some x or None"),
  ("list", "functional, singly linked list"),
  ("array", "array type, a tuple of all components the same type"),
  ("varray", "array with dynamically variable limit up to a fixed bound"),
  ("darray", "array with unbounded dynamically variable limit"),
  ("sarray", "unbounded sparse array"),
  ("bsarray", "bounded sparse array"),

  ("str", "Convert a value to a string"),
  ("print", "Print a string to standard output"),
  ("println", "Print a string to standard output with newline appended"),
  ("write", "Print a string to a stream"),
  ("write", "Print a string to a stream with newline appended"),
  ("readln", "Read a string from a stream including trailing newline"),

  ("iter", "call procedure on each element of data structure"),
  ("map", "return data structure with function applied to each value"),
  ("fold_left", "accumulated values of data structure from left into initial value using function"),
  ("fold_right", "accumulated values of data structure from right into initial value using function"),
  ("rev", "return data structure with elements reversed"),
  ("len", "number of elements in data structure"),
  ("true", "truth value"),
  ("false", "false value")
;

private val hack = "C_hack","C_hack"; // to make it an array we need 2 components


fun valof[N](x:array[string * string,N],key:string) =>
  match find (fun (kv:string * string)=> kv.(0) == key) x with
  | Some (k,v) => v
  | #None => ""
  endmatch
;

fun xlat_felix(t:string, dir:string): bool * string =
{
  var needs_mathjax = false;
  var mathcount = 0;
  var out = "";
  proc write_string(t:string)
  {
   out += t;
  }

  variant state_t =
    | sot // start of token
    | id // processing identifier
    | texid // processing identifier
    | num // in a number
    | sq // processing single quote string
    | dq // processing double quote string
    | sq3 // processing single quote string
    | dq3 // processing double quote string
    | ccomment of int // a C style comment
    | cppcomment // a C++ style comment
    | cppfdoc // a documentation comment  //$
    | mathmode // TeX math mode
    | mathid // TeX math mode, Felix id
    | mathtexid // TeX math mode, TeX id
  ;
  fun str(s:state_t) => match s with
  | #sot => "sot"
  | #id => "id"
  | #texid => "texid"
  | #num => "num"
  | #sq => "sq"
  | #dq => "dq"
  | #sq3 => "sq3"
  | #dq3 => "dq3"
  | ccomment n => "ccomment_"+ str n
  | #cppcomment => "cppcomment"
  | #cppfdoc => "doccomment"
  | #mathmode => "mathmode"
  | #mathid => "mathid"
  | #mathtexid => "mathid"
  endmatch;

  var i = 0; var s:state_t;
  var ch = t.[i];
  proc next() { ch = t.[i]; ++i; }
  fun ahead (j:int)=> t.[i + j - 1];
  fun issq3() =>
    ch == char "'" and
    ahead(1) == char "'" and
    ahead(2) == char "'"
  ;
  fun isdq3() =>
    ch == char '"'  and
    ahead(1) == char '"' and
    ahead(2) == char '"'
  ;

  var b = "";
  var fdocb = "";
  var last_id = "";
  var last_texop = "";
  var last_op = "";
  var last_key = "";

  proc cp() { b += ch; }
  proc cpfdoc() { fdocb += ch; }

  proc ws() {
    if last_id == "include" do // hackery
      var n = b;
      while n.[0] == char "'" or n.[0] == char '"' do n = n.[1 to]; done
      while n.[-1] == char "'" or n.[-1] == char '"' do n = n.[to -1]; done
      if n.[0] == '.' do
        var rel_flx = Filename::join (dir, n.[1 to]);
        if FileStat::fileexists rel_flx do
          write_string('<a href="/$'+rel_flx+'" >' + b + '</a>') ;
        else
          write_string('<span class="fstring">'+txt2html b+"</span>");
        done
      else
        var try_flx = n+ ".flx";
        var resolve_flx = get_file (try_flx, INSTALL_ROOT,FLX_PATH);
        var try_fdoc = n+ ".fdoc";
        var resolve_fdoc= get_file (try_fdoc, INSTALL_ROOT,FLX_PATH);
        var flx_time,flx_file = match resolve_flx with | Some f => FileStat::filetime f,f | #None => 0.0,"";
        var fdoc_time,fdoc_file = match resolve_fdoc with | Some f => FileStat::filetime f,f | #None => 0.0,"";
        if flx_time > fdoc_time do
          write_string('<a href="/$'+flx_file+'" >' + b + '</a>') ;
        elif fdoc_time > flx_time do
          write_string('<a href="/$'+fdoc_file+'" >' + b + '</a>') ;
        else
          write_string('<span class="fstring">'+txt2html b+"</span>");
        done
      done
    elif last_key in ("header","body") do
      n = b;
      var quote = '"""';
      if prefix(b,quote) do n = b.[3 to -3]; goto unstring; done
      quote = "'''";
      if prefix(b,quote) do n = b.[3 to -3]; goto unstring; done
      quote = "'";
      if prefix(b,quote) do n = b.[1 to -1]; goto unstring; done
      quote = '"';
      if prefix(b,quote) do n = b.[1 to -1]; goto unstring; done
      // shouldn't happen ..
unstring:>
      val c = (xlat_cpp (n,dir)).1;
      write_string(quote+'<span class="embedded_c">' + c + '</span>'+quote);
    elif last_key == "package" do
       println$ "Package: " + b;
       n = b;
      while n.[0] == char "'" or n.[0] == char '"' do n = n.[1 to]; done
      while n.[-1] == char "'" or n.[-1] == char '"' do n = n.[to -1]; done
      n+=".fpc";
println$ "Package file basename is " + n;
      match get_file(n,INSTALL_ROOT,FLX_PKGCONFIG_PATH) with
      | Some f => { write_string('<a href="/$'+f+'" >' + txt2html b + '</a>') ; }
      | #None => {
          println$ "Can't find "+n+" in path " + str FLX_PKGCONFIG_PATH;
          write_string('<span class="fstring">'+txt2html b+"</span>");
        }
      endmatch;
    else
     write_string('<span class="fstring">'+txt2html b+"</span>");
    done
  }
  proc wfdoc() {
    write_string ('<span class="doccomment">' + txt2html fdocb + "</span>\n");
    fdocb = ""; b="";
  }
  proc w() {
    last_texop = "";
    //println$ "Token["+str s+"]="+b;
    match s with
    | #dq => { ws; }
    | #sq => { ws; }
    | #sq3 => { ws; }
    | #dq3 => { ws; }
    | ccomment _ => { write_string('<span class="comment">'+txt2html b+"</span>"); }
    | #cppcomment => { write_string('<span class="comment">'+txt2html b.[to -1]+"</span>\n"); }
    | #texid => { write_string (
        '<span class="tex_symbol" title="'+b+'">\\(' + txt2html b + '\\)</span>'
        );
        needs_mathjax = true;
      }  // format with MathJax
    | #mathmode => { needs_mathjax = true; write_string b; }
    | #mathid => { needs_mathjax = true; write_string b; }
    | #mathtexid => { needs_mathjax = true; last_texop = b; write_string b; }
    | #id =>
      {
        last_id = b;
        // this is a bit hacky but I can't see another way!
        var bv=valof(big_keywords,b);
        var sv=valof(small_keywords,b);
        var qv=valof(qualifiers,b);
        var lv=valof(dlibrary,b);
        if   bv != "" do last_key=b; write_string('<span class="big_keyword" title="'+bv+'">'+b+"</span>");
        elif sv != "" do last_key=b; write_string('<span class="small_keyword" title="'+sv+'">'+b+"</span>");
        elif qv != "" do write_string('<span class="qualifier" title="'+qv+'">'+b+"</span>");
        elif lv != "" do write_string('<span class="library" title="'+lv+'">'+b+"</span>");
        elif b in hack do write_string('<span class="hack">'+b+"</span>");
        else write_string(b); done
      }
    | _ =>
      {
        last_op=b;
        if b == ";" do last_key = ""; done
        if b == "<" do b = "&lt;";
        elif b == ">" do b = "&gt;";
        elif b == "&" do b = "&amp;";
        done;
        write_string(b);
      }
    endmatch;
    b = "";
  }


  goto nextt;

continfdoc:>
  cpfdoc;
  goto nextch;

contin:> // copy char and continue
  cp;
  goto nextch;

overrun:> // one past last char of token
  w;
  s = sot;
  goto thisch;

lastfdoc:>
  wfdoc;
  goto nextt;

lastch:> // last char of token
  cp;
  w;

nextt:>  // new token on next char
  s = sot;

nextch:> // next char
  next;

thisch:> // same char, reconsider it
  //println$ "Considering char " + str(ord(ch));
  if isnull ch goto fin; // out of data
  match s with
  | #sot =>
      if isidstart ch do s = id; goto contin;
      elif ch == char "\\" and isletter (ahead(1)) do cp; next; s = texid; goto contin;
      elif ch == char "\\" and ahead(1) in (char "(", char "[")  do
        cp; next; s=mathmode; ++mathcount; goto contin;
      elif isdigit ch do s = num; goto contin;
      elif issq3() do cp; next; cp; next; s = sq3; goto contin;
      elif isdq3() do cp; next; cp; next; s = dq3; goto contin;
      elif issq ch do s = sq; goto contin;
      elif isdq ch do s = dq; goto contin;
      elif ch == char "/" do
        if ahead(1) == char "/" do
          if ahead(2) == char "$" do
            next; next; next;
            s = cppfdoc;
          else cp; next; s = cppcomment;
          done
          goto contin;
        elif ahead(1) == char "*" do cp; next; s = ccomment 1; goto contin;
        else goto lastch;
        done
      else cp; w; goto nextt;
      done

  | #mathmode =>
     if ch == char "\\" do
       if ahead (1) == char ")" do
         --mathcount;
         if mathcount == 0 do
           // EXIT MATH MODE
           cp; next; cp; w; goto nextt;
         else
          next; b+="}"; goto nextch;
         done
       elif ahead (1) == char "(" do
          ++mathcount;
          b+="{";
          next; goto nextch;
       elif ahead (1) == char "]" do
         --mathcount;
         if mathcount == 0 do
           // EXIT MATH MODE
           cp; next; cp; w; goto nextt;
         else
          cp; next; cp; b+="}"; goto nextch;
         done
       elif ahead (1) == char "[" do
          ++mathcount;
          b+="{";
          cp; next; cp; goto nextch;
       elif ahead (1) == (char "{") do
         b+="{"; cp; next; cp; goto nextch;
       elif ahead (1)  == (char "}") do
         cp; next; cp; b+="}"; goto nextch;
       elif isletter (ahead(1)) do
         cp; s = mathtexid; goto nextch;
       else
         goto contin;
       done
     // add {} around () and [] so TeX sees a group
     elif ch in (char "(", char "[") do
       b+="{"; cp; goto nextch;
     elif ch in (char ")", char "]") do
       cp; b+="}"; goto nextch;

     elif isidstart ch do
       w;
       if not (isflxidcont (ahead 1)) do
         goto contin; // leave one character identifiers "as is"
                      // so default typeface is mathit
       else
         s = mathid;
         var mathfont =
           if last_texop in (
             "\\mathit",   // math italic
             "\\mathfrak", // fraktur
             "\\mathcal",  // caligraphic
             "\\mathrm",   // roman
             "\\mathbf",   // bold
             "\\mathscr",  // script
             "\mathbb",    // blackboard bold
             "\mathsf",    // sans-serif
             "\\pmb"       // poor mans bold
           )
           then last_texop else "\\mathtt"
         ;
         b="{"+mathfont+"{\\text{";
         goto contin;
       done
     else
       goto contin;
     done
  | #mathtexid =>
      if isletter ch goto contin;
      w;
      s = mathmode;
      goto thisch;

  | #mathid =>
      if isflxidcont ch goto contin;
      b+="}}}";
      w; s = mathmode;
      goto thisch;

  | #texid =>
      if isletter ch do goto contin;
      else
        goto overrun;
      done
  | #id =>
      if isflxidcont ch do goto contin;
      else goto overrun;
      done
  | #num =>
      if isnumeric ch do goto contin;
      else goto overrun;
      done
  // single quoted strings
  | #sq =>
      if issq ch do goto lastch; done
      goto contin;
  | #dq =>
      if isdq ch do goto lastch; done
      goto contin;
   // triple quoted strings
  | #sq3 =>
      if issq3() do cp; next; cp; next; cp; w; goto nextt; done
      goto contin;
  | #dq3 =>
      if isdq3() do cp; next; cp; next; cp; w; goto nextt; done
      goto contin;
   // comments
  | #cppfdoc =>
     if iseol ch do goto lastfdoc;
     else goto continfdoc;
     done

  | #cppcomment =>
      if iseol ch do goto lastch;
      else goto contin;
      done
  | ccomment n =>
      if ch == char "*" and ahead(1) == char "/" do
        if n == 1 do
          cp; next;
          goto lastch;
        else
          s = ccomment (n - 1);
          goto contin;
        done
      elif ch == char "/" and ahead(1) == char "*" do
        s = ccomment (n + 1);
        goto contin;
      else
        goto contin;
      done
  endmatch;

  println$ "Unexpected drop thru";

fin:>
   //println "outof data, final write ..";
   w(); // whatever is left over gets written
   return needs_mathjax, lc out;
}
}


eprintln$ Version::felix_version+" flx2html initialisation";

fun setup(config_data:string) = {
  var config_lines = split(config_data, "\n");
  config_lines = map (strip of (string)) config_lines;
  var pathext = RE2("(.*)\\+=(.*)");
  var varset = RE2("(.*)=(.*)");
  var plugin_spec = RE2 " *extension (.*)->(.*)::(.*)";

  var result = varray[StringPiece] (4.size,StringPiece(""));
  for line in config_lines do
    var match_result = Match(pathext, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      var lhs = result.1.str.strip;
      var rhs = result.2.str.strip;
      match lhs with
      | "FLX_PATH" => FLX_PATH += rhs;
      | "FLX_PKGCONFIG_PATH" => FLX_PKGCONFIG_PATH += rhs;
      | "FLX_WEBSERVER_PLUGIN_PATH" => FLX_WEBSERVER_PLUGIN_PATH += rhs;
      | _ => ;
      endmatch;
    else
    match_result = Match(varset, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      lhs = result.1.str.strip;
      rhs = result.2.str.strip;
      match lhs with
      | "INSTALL_ROOT" => INSTALL_ROOT = rhs;
      | _ => ;
      endmatch;
    done done
  done

  xlat_cpp = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="cpp2html", setup-str=config_data, entry-point="cpp2html"
  );

  return 0;
}

export fun setup of (string) as "flx2html_setup";
export fun Flx2Html::xlat_felix of (string * string) as "flx2html";
C and C++ code.
//[cpp2html.flx]
include "./plugin_common";

var C_PATH = Empty[string];
var INSTALL_ROOT = "";


module Cpp2Html {
// C++ and C
val cpp_big_keywords =
  "class",
  "struct",
  "union",
  "namespace",
  "typedef",
  "enum",
  "template"
;

val cpp_small_keywords =
  "if", "while", "until","do","for","return","goto","std"
;

val cpp_qualifiers =
  "virtual", "inline", "static", "extern", "public","private","protected",
  "int","long","unsigned","float","double","char","short","signed","void","size_t",
  "const","volatile","typename"
;

val cpp_preproc =
  "define","if","endif","else","include","ifdef","ifndef"
;

fun xlat_cpp(t:string, dir:string) : bool * string=
{
  var out = "";
  proc write_string(t:string)
  {
    out += t;
  }

  variant state_t =
    | sot // start of token
    | id // processing identifier
    | num // in a number
    | sq // processing single quote string
    | dq // processing double quote string
    | angle // processing <filename> string
    | ccomment // a C style comment
    | cppcomment // a C++ style comment
  ;
  fun str(s:state_t) => match s with
  | #sot => "sot"
  | #id => "id"
  | #num => "num"
  | #sq => "sq"
  | #dq => "dq"
  | #angle => "angle"
  | #ccomment=> "ccomment"
  | #cppcomment => "cppcomment"
  endmatch;

  var i = 0; var s:state_t;
  var ch = t.[i];
  proc next() { ch = t.[i]; ++i; }
  fun ahead (j:int)=> t.[i + j - 1];

  var b = "";
  var last_id = "";
  var last_op = "";
  proc cp() { b += ch; }
  proc ws() {
    if last_id == "include" do // hackery
      var n = b;
      while n.[0] == char '<' or n.[0] == char '"' do n = n.[1 to]; done
      while n.[-1] == char '>' or n.[-1] == char '"' do n = n.[to -1]; done
      var x = b;
      if x.[0] == char "<" do x = "&lt;" + x.[1 to]; done
      if x.[-1] == char ">" do x = x.[to -1] + "&gt;"; done
      match get_file(n,INSTALL_ROOT,Cons(dir,C_PATH)) with
      | Some f =>
          // the $ is so we know we have resolved the filename
          // we can't use just / because it means the server root
          // and we can't use // because firefox thinks it means
          // the website name is empty
          // the trailing cpp tells us the filetype is C/C++
          write_string('<a href="/$'+f+'" >' + x + '</a>');
      | #None => write_string('<span class="fstring">'+x+"</span>");
      endmatch;
    else
     write_string('<span class="fstring">'+b+"</span>");
    done
  }
  proc w() {
    //println$ "Token["+str s+"]="+b;
    match s with
    | #dq => ws;
    | #sq => ws;
    | #ccomment=> write_string('<span class="comment">'+b+"</span>");
    | #cppcomment=> write_string('<span class="comment">'+b+"</span>");
    | #id =>
        last_id = b;
        if b in cpp_big_keywords do write_string('<span class="big_keyword">'+b+"</span>");
        elif b in cpp_small_keywords do write_string('<span class="small_keyword">'+b+"</span>");
        elif b in cpp_qualifiers do write_string('<span class="qualifier">'+b+"</span>");
        elif last_op == "#" and b in cpp_preproc do write_string('<span class="preproc">'+b+"</span>"); last_op="";
        else write_string(b); done
    | #angle => ws;
    | _ =>
        last_op=b;
        if b == "<" do b = "&lt;";
        elif b == ">" do b = "&gt;";
        elif b == "&" do b = "&amp;";
        done;
        write_string(b);
    endmatch;
    b = "";
  }


  goto nextt;

contin:> // copy char and continue
  cp();
  goto nextch;

overrun:> // one past last char of token
  w();
  s = sot;
  goto thisch;

lastch:> // last char of token
  cp();
  w();

nextt:>  // new token on next char
  s = sot;

nextch:> // next char
  next();

thisch:> // same char, reconsider it
  //println$ "Considering char " + str(ord(ch));
  if isnull ch goto fin; // out of data
  match s with
  | #sot =>
      if isidstart ch do s = id; goto contin;
      elif isdigit ch do s = num; goto contin;
      elif issq ch do s = sq; goto contin;
      elif isdq ch do s = dq; goto contin;
      elif ch == char "/" do
        if ahead(1) == char "/" do cp; next; s = cppcomment; goto contin;
        elif ahead(1) == char "*" do cp; next; s = ccomment; goto contin;
        else goto lastch;
        done
      elif ch == char "<" and last_id == "include" do
        s = angle; goto contin;
      else cp; w; goto nextt;
      done

  | #id =>
      if isalphanum ch do goto contin;
      else goto overrun;
      done
  | #num =>
      if isnumeric ch do goto contin;
      else goto overrun;
      done
  // single quoted strings
  | #sq =>
      if issq ch do goto lastch;
      elif ch== char "<" do b+="&lt;"; goto nextch;
      elif ch== char ">" do b+="&gt;"; goto nextch;
      elif ch== char "&" do b+="&amp;"; goto nextch;
      else goto contin;
      done
  | #dq =>
      if isdq ch do goto lastch;
      elif ch== char "<" do b+="&lt;"; goto nextch;
      elif ch== char ">" do b+="&gt;"; goto nextch;
      elif ch== char "&" do b+="&amp;"; goto nextch;
      else goto contin;
      done

  // <bracket> form
  | #angle =>
      if ch == char ">" do goto lastch;
      else goto contin;
      done

  // comments
  | #cppcomment =>
      if iseol ch do goto lastch;
      else goto contin;
      done
  | #ccomment => // doesn't handle nested comments yet
      if ch == char "*" and ahead(1) == char "/" do
        cp;
        goto lastch;
      else goto contin;
      done
  endmatch
  ;
  println$ "Unexpected drop thru";

fin:>
   w(); // whatever is left over gets written
   return false, out;
}
}
eprintln$ Version::felix_version+ " cpp2html initialisation";

fun setup(config_data:string) = {
  var config_lines = split(config_data, "\n");
  config_lines = map (strip of (string)) config_lines;
  var pathext = RE2("(.*)\\+=(.*)");
  var varset = RE2("(.*)=(.*)");
  var plugin_spec = RE2 " *extension (.*)->(.*)::(.*)";

  var result = varray[StringPiece] (4.size,StringPiece(""));
  for line in config_lines do
    var match_result = Match(pathext, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      var lhs = result.1.str.strip;
      var rhs = result.2.str.strip;
      match lhs with
      | "C_PATH" => C_PATH += rhs;
      | _ => ;
      endmatch;
    else
    match_result = Match(varset, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      lhs = result.1.str.strip;
      rhs = result.2.str.strip;
      match lhs with
      | "INSTALL_ROOT" => INSTALL_ROOT = rhs;
      | _ => ;
      endmatch;
    done done
  done

  return 0;
}

export fun setup of (string) as "cpp2html_setup";
export fun Cpp2Html::xlat_cpp of (string * string) as "cpp2html";
Top level Felix fdoc format.

Handles both original fdoc format Felix programs and also fdoc format flx_iscr.py package format. Note the former are real Felix programs.

//[fdoc2html.flx]

open Regdef; // required

include "./plugin_common";

include "./slideshow-interface";
var slideshow-maker  : (string->0) -> slideshow_t;

include "./paragraph-interface";
var paragraph-maker : (string->0) -> paragraph-control_t;

include "./heading-interface";
var heading-maker : paragraph-control_t * (string->0) -> heading-control_t;

include "./fileseq-interface";
var fileseq-maker : string -> fileseq-control_t;

include "./scanner-interface";
var fdocscanner-maker : unit -> fdocscanner-control_t;

include "./button-interface";
var button-factory-maker : unit -> button-factory_t;

include "./fdoc-frame-interface";
var fdoc_frame_maker : fdoc_frame_data_t -> fdoc_frame_t;

include "./fdoc-interface";

var xlat_cpp: string * string -> bool * string;
var xlat_felix: string * string -> bool * string;
var xlat_ocaml: string * string -> bool * string;
var xlat_python: string * string -> bool * string;

// felix document
var INSTALL_ROOT="";
var FLX_PATH = Empty[string];
var FDOC_PATH = Empty[string];
var FLX_PKGCONFIG_PATH = Empty[string];
var FLX_WEBSERVER_PLUGIN_PATH = Empty[string];
var PLUGIN_MAP = Empty[string^3];


fun get_flx (fname:string) = {
  var flx =
    match get_file(fname,INSTALL_ROOT,FLX_PATH) with
    | Some name => load(name)
    | #None => f"NO FILE %S FOUND IN %S" (fname, str FLX_PATH)
    endmatch
  ;
  //println$ "Loaded felix file " + fname+", len="+str (flx.len.int);
  return flx;
}

// fixup text by replacing < > and & characters
fun txt2html (x:string) =
{
  var out2 = "";
  for var i in 0 upto x.len.int - 1 do
    var ch = x.[i];
    if ch == char "<" do out2+="&lt;";
    elif ch == char ">" do out2+="&gt;";
    elif ch == char "&" do out2+="&amp;";
    else out2+=ch;
    done
  done

  return out2;
}


proc boreq(l:&bool, r:bool) { l <- *l or r; }

val markdown_code1 = RE2 ("(@{([^}]*)})");
val markdown_code2 = RE2 (r"(@glossary\(([^)]*)\))");
fun markdown (s:string):string= {
  var x = s;
  C_hack::ignore(GlobalReplace(&x, markdown_code1, StringPiece ("<code>\\2</code>")));
  C_hack::ignore(GlobalReplace(&x, markdown_code2, StringPiece ("<a href='/share/src/web/ref/glossary.fdoc#\\2'>\\2</a>")));
  return x;
}

val timeout = Filename::join (#Config::std_config.FLX_TARGET_DIR, "bin", "flx_timeout"+#(Filename::executable_extension));

gen safer_popen(cmd:string)=>
  Process::popen_in(timeout+" -t 15 " + cmd + " 2>&1")
;

// helper definitions
regdef optwhite = ' '*;
regdef white = ' '+;
regdef felt= perl ("\\$?[A-Za-z._][-A-Za-z0-9_.]*");
regdef fname = (felt "/")* felt;

// A tangler definition looks like:
// @tangler name = filename
regdef tangler_def_regdef =
  "tangler" white group (felt) optwhite "="
  optwhite group (fname) optwhite
;

// To set the output we just use
// @tangle name
regdef tangler_use_regdef =
  "tangle" white group (felt) optwhite
;
var tangler_def_re2 = RE2 (Regdef::render tangler_def_regdef);
var tangler_use_re2 = RE2 (Regdef::render tangler_use_regdef);

object xlat_fdoc (t:string, filename:string) implements fdoc_t = {

  method fun whatami () => "Translator for " + filename;
  method fun mathjax_required () => needs_mathjax;
  method fun html_raw () => out;
  method fun html_page () => page;
  method fun html_title () => title;
  var title = filename;
  var slideshow = slideshow-maker write_string of (string);
  //eprintln$ "FDOC make slidehow .. " + #(slideshow.whatami);

  var paragraph = paragraph-maker write_string of (string);
  //eprintln$ "FDOC make paragraph .. " + #(paragraph.whatami);

  var heading = heading-maker (paragraph, write_string of (string));
  //eprintln$ "FDOC make heading .. " + #(heading.whatami);

  var fileseq = fileseq-maker (filename);
  //eprintln$ "FDOC make fileseq .. " + #(fileseq.whatami);

  var fdocscanner = fdocscanner-maker ();
  //eprintln$ "FDOC make scanner .. " + #(fdocscanner.whatami);

  var fdoc_frame_data :fdoc_frame_data_t = (heading=heading, button-factory=#button-factory-maker,fileseq=fileseq);
  var fdoc_frame = fdoc_frame_maker fdoc_frame_data;


  var needs_mathjax = false;
  var out = "";
  proc write_string(t:string)
  {
    out += t;
  }

  fun split_first (x:string, c:string):string*string =>
    match find_first_of (x, c) with
      | Some n => (strip(x.[to n]),strip(x.[n+1 to]))
      | _ => (x,"")
    endmatch
  ;

  var tanglers = strdict[string] ();

  proc def_tangler (id:string, filename:string)
  {
    match get tanglers id with
    | Some _ =>
      println$ "Duplicate definition of tangler " + id;
    | #None =>
      println$ "Add tangler id=" + id + " filename=" + filename;
      add tanglers id filename;
    endmatch;
  }

  // paragraphs
  proc sp () { paragraph.sp (); }
  proc sp (cls:string) { paragraph.sp-clas cls; }
  proc ep () { paragraph.ep (); }
  proc bp () { paragraph.bp (); }

  // headings
  proc h(n:int, txt:string) {
    heading.head (#(fileseq.docnum), n, markdown txt);
  }

//---------------------------------------------------
  // main loop
  var inp = fdocscanner.fdoc_scan t;
  gen get_text () =>
    match #inp with
    | Some (Text x) => x
    | _ => ""
    endmatch
  ;
next:>
  var entry = #inp;
  match entry with
  | Some (Cmd cmdline) => handle_cmd cmdline; goto next;
  | Some (Text x) =>
    for para in fdocscanner.psplit x do
      bp;
      write_string(markdown para);
    done
    ep;
    goto next;

  | #None =>
    ep;
    heading.finalise();

    slideshow.finalise();
    if #(slideshow.active) do
      eprintln$ "Slideshow Active";
    else
      //eprintln$ "Slideshow NOT active";
    done
  endmatch;

  var page =
   if #(slideshow.active)  then out
   else fdoc_frame.make_frame out
   endif
  ;

//---------------------------------------------------

  // preformat
  proc inline_pre(b:string)
  {
    sp;
    write_string('<pre class="prefmtbg">');
    write_string(txt2html b);
    write_string("</pre>");
    ep;
  }

  proc inline_expect(b:string)
  {
    sp;
    write_string('<pre class="expected">');
    write_string(txt2html b);
    write_string("</pre>");
    ep;
  }

  proc inline_input(b:string)
  {
    sp;
    write_string('<pre class="input">');
    write_string(txt2html b);
    write_string("</pre>");
    ep;
  }



  proc inline_cpp (b:string)
  {
    sp;
    write_string("<pre class='cppbg'>");
    write_string((xlat_cpp(b,"")).1); // no parent!
    write_string("</pre>");
    ep;
  }

  proc inline_felix (b:string)
  {
    sp;
    write_string("<pre class='flxbg'>");
    needs_mathjax', txt := xlat_felix (b,"");
    needs_mathjax |= needs_mathjax';
    write_string(txt); // no parent!
    write_string("</pre>");
    ep;
  }

  proc inline_felix_unchecked (b:string)
  {
    sp;
    write_string("<pre class='uncheckedflxbg'>");
    needs_mathjax', txt := xlat_felix (b,"");
    needs_mathjax |= needs_mathjax';
    write_string(txt); // no parent!
    write_string("</pre>");
    ep;
  }


  proc inline_ocaml(b:string)
  {
    sp;
    write_string("<pre class='flxbg'>");
    needs_mathjax', txt := xlat_ocaml(b,"");
    needs_mathjax |= needs_mathjax';
    write_string(txt); // no parent!
    write_string("</pre>");
    ep;
  }

  proc inline_python(b:string)
  {
    sp;
    write_string("<pre class='flxbg'>");
    needs_mathjax', txt := xlat_python(b,"");
    needs_mathjax |= needs_mathjax';
    write_string(txt); // no parent!
    write_string("</pre>");
    ep;
  }



  proc felix_file (rest:string)
  {
      var re1 = RE2('(.*) "(.*)" "(.*)"');
      var re2 = RE2('(.*) "(.*)"');
      var v1 = varray(4uz, StringPiece "");
      var v2 = varray(4uz, StringPiece "");
      var v3 = varray(4uz, StringPiece "");
      var matched1 = Match(re1, StringPiece(rest),0,ANCHOR_BOTH,v1.stl_begin, v1.len.int);
      var matched2 = Match(re2, StringPiece(rest),0,ANCHOR_BOTH,v2.stl_begin, v2.len.int);
      if matched1 do
        var fname = v1.1.string.strip;
      elif matched2 do
        fname = v2.1.string.strip;
      else
        fname = rest;
      done
      var flx = get_flx(fname);
      if matched1 do
        var p1 = match find(flx,v1.2.string) with
        | Some i => i.int
        | #None => 0
        endmatch;
        flx = flx.[p1 to];
        var p2 = match find(flx,v1.3.string) with
        | Some i => i.int
        | #None => flx.len.int - 1
        endmatch;
        flx = flx.[to p2];
      elif matched2 do
        var re3 = RE2(v2.2.string);
        var matched3 = Match(re3,StringPiece(flx),0,UNANCHORED,v3.stl_begin, v3.len.int);
        if matched3 do
          flx = v3.1.string;
        done
      done
      needs_mathjax', html := xlat_felix (flx,"");
      needs_mathjax |= needs_mathjax';
      write_string("<pre class='inclusion'>\n"+fname+"</pre>\n");
      write_string("<pre class='flxbg'>");
      write_string(html);
      write_string("</pre>");
  }

  proc flx_and_expect (fname:string)
  {
    var flx = get_flx(fname+".flx");
    needs_mathjax', html := xlat_felix (flx,"");
    needs_mathjax |= needs_mathjax';
    write_string("<pre class='inclusion'>"+fname+".flx</pre>\n");
    write_string("<pre class='flxbg'>");
    write_string(html);
    write_string("</pre>\n");
    heading.add_button fname;
    write_string(heading.tree_button(fname,fname+"_d"));
    write_string("<code class='inclusion'>  "+fname+".expect</code>\n");
    var xpected = get_flx(fname+".expect");
    write_string("<pre id='"+fname+"_d' class='expected' style='display:none'>");
    write_string(xpected);
    write_string("</pre>");
  }

  proc extern_cpp (fname:string)
  {
    var flx = get_flx(fname);
    write_string("<pre class='inclusion'>\n"+fname+"</pre>\n");
    write_string("<pre class='cppbg'>");
    write_string((xlat_cpp (flx,"")).1);
    write_string("</pre>");
  }

  proc extern_ocaml (fname:string)
  {
    var flx = get_flx(fname);
    write_string("<pre class='inclusion'>\n"+fname+"</pre>\n");
    write_string("<pre class='cppbg'>");
    write_string((xlat_ocaml(flx,"")).1);
    write_string("</pre>");
  }

  proc extern_python(fname:string)
  {
    var flx = get_flx(fname);
    write_string("<pre class='inclusion'>\n"+fname+"</pre>\n");
    write_string("<pre class='cppbg'>");
    write_string((xlat_python(flx,"")).1);
    write_string("</pre>");
  }

  proc handle_cmd (b:string)
  {
//println$ "CMD=@"+b;
    match Match (tangler_def_re2, b) with
    | Some v => def_tangler (v.1, v.2);
    | #None =>
      match Match (tangler_use_re2, b) with
      | Some s =>
        println$ "Tangle id=" + s.1;
        match get tanglers s.1 with
        | Some x =>
          println$ "Tangler filename=" + x;
          var xtn = Filename::get_extension x;
          println$ "Extension=" + xtn;
          if xtn in (".flx",".flxh",".fsyn") do
            write_string("<pre class='inclusion'>\n"+x+"</pre>\n");
            println$ "flx ....";
            inline_felix (#get_text);
          elif xtn in (".cxx",".cpp",".hpp",".c",".cc",".h") do
            write_string("<pre class='inclusion'>\n"+x+"</pre>\n");
            println$ "cpp ....";
            inline_cpp (#get_text);
          else
            write_string("<pre class='inclusion'>\n"+x+"</pre>\n");
            println$ "pre ....";
            inline_pre (#get_text);
          done
        | #None =>
          println$ "Can't find tangler '" + s.1+"'";
          inline_pre (#get_text);
        endmatch;
      | #None =>
        if b == "felix" do inline_felix (#get_text);
        elif b == "felix-unchecked" do inline_felix_unchecked (#get_text);
        elif prefix (b,"felix ") do felix_file (strip (b.[6 to]));
        elif prefix (b,"flx-and-expect ") do flx_and_expect (strip(b.[15 to]));

        elif b == "c++" do inline_cpp (#get_text);
        elif prefix (b,"c++") do extern_cpp ( strip(b.[4 to]));

        elif b == "ocaml" do inline_ocaml (#get_text);
        elif prefix (b,"ocaml") do extern_ocaml( strip(b.[6 to]));

        elif b == "python" do inline_python(#get_text);
        elif prefix (b,"python") do extern_python( strip(b.[7 to]));


        elif b=="p" do bp;
        elif b=="pre" do inline_pre (#get_text);
        elif b=="expect" do inline_expect (#get_text);
        elif b=="input" do inline_input(#get_text);
        elif b=="obsolete" do ep; sp 'obsolete'; write_string("<em>Obsolete</em> ");
        elif b=="caveat" do ep; sp 'caveat'; write_string("<em>Caveat: </em> ");
        elif b=="impl" do ep; sp 'implementation_detail'; write_string("<em>Implementation Detail: </em>");
        elif b=="future" do ep; sp 'future'; write_string("<em>In future: </em>");
        elif b=="note" do ep; sp 'bug'; write_string("<em>Note: </em>");
        elif b=="bug" do ep; sp 'bug'; write_string("<em>Bug: </em>");
        elif b=="fixed" do ep; sp 'fixed'; write_string("<em>Fixed: </em>");
        elif b=="done" do ep; sp 'done'; write_string("<em>Done: </em>");
        elif b=="mathjax" do needs_mathjax = true;

        elif prefix (b,"title") do title = strip(b.[5 to]);

        elif prefix(b,"h1") do h(1,b.[3 to]);
        elif prefix(b,"h2") do h(2,b.[3 to]);
        elif prefix(b,"h3") do h(3,b.[3 to]);
        elif prefix(b,"h4") do h(4,b.[3 to]);
        elif prefix(b,"h5") do h(5,b.[3 to]);

        // external image
        elif prefix(b,"image") do
          var img = split_first(b.[6 to],"|");
          write_string("<img src='"+img.(0)+"' style='"+img.(1)+"'></img>");

        // arbitrary shell command
        elif prefix(b,"sh") do
          var cmd = b.[3 to];
          var fout = safer_popen(cmd);
          if valid fout do
            var output = load fout;
            var result = Process::pclose fout;
            println$ "Ran cmd=" + cmd;
            //println$ "Output = " + output;
            write_string("<pre>");
            write_string output;
            write_string("</pre>");
          else
            println$ "Unable to run shell command '" + cmd "'";
            write_string("Failed cmd: " + b);
          done

        // slideshow
        elif slideshow.check-slide-commands b do ;
        elif b == "" do ;
        else
          println$ "Unable to understand @command '"+b+"'";
        done
      endmatch;
    endmatch;
  }
}

eprintln$ Version::felix_version +  " fdoc2html initialisation";

fun setup(config_data:string) = {
  var config_lines = split(config_data, "\n");
  config_lines = map (strip of (string)) config_lines;
  var pathext = RE2("(.*)\\+=(.*)");
  var varset = RE2("(.*)=(.*)");
  var plugin_spec = RE2 " *extension (.*)->(.*)::(.*)";

  var result = varray[StringPiece] (4.size,StringPiece(""));
  for line in config_lines do
    var match_result = Match(pathext, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      var lhs = result.1.str.strip;
      var rhs = result.2.str.strip;
      match lhs with
      | "FLX_PATH" => FLX_PATH += rhs;
      | "FDOC_PATH" => FDOC_PATH += rhs;
      | "FLX_PKGCONFIG_PATH" => FLX_PKGCONFIG_PATH += rhs;
      | "FLX_WEBSERVER_PLUGIN_PATH" => FLX_WEBSERVER_PLUGIN_PATH += rhs;
      | _ => ;
      endmatch;
    else
    match_result = Match(varset, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      lhs = result.1.str.strip;
      rhs = result.2.str.strip;
      match lhs with
      | "INSTALL_ROOT" => INSTALL_ROOT = rhs;
      | _ => ;
      endmatch;
    else
    match_result = Match(plugin_spec, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,4);
    if match_result do
      var extn = result.1.str.strip;
      var lib = result.2.str.strip;
      var entry = result.3.str.strip;
      PLUGIN_MAP = Cons ((extn, lib, entry), PLUGIN_MAP);
    done done done
  done

  xlat_felix = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="flx2html", setup-str=config_data, entry-point="flx2html"
  );

  xlat_cpp = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="cpp2html", setup-str=config_data, entry-point="cpp2html"
  );

  xlat_ocaml = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="ocaml2html", setup-str=config_data, entry-point="ocaml2html"
  );

  xlat_python = Dynlink::load-plugin-func2 [bool * string, string, string] (
    dll-name="py2html", setup-str=config_data, entry-point="py2html"
  );


  slideshow-maker  = Dynlink::load-plugin-func1 [slideshow_t, (string->0)] (dll-name="fdoc_slideshow");

  paragraph-maker = Dynlink::load-plugin-func1 [paragraph-control_t, (string->0)] (dll-name="fdoc_paragraph");

  heading-maker = Dynlink::load-plugin-func2 [heading-control_t, paragraph-control_t , (string->0)] (dll-name="fdoc_heading");

  fileseq-maker = Dynlink::load-plugin-func1 [fileseq-control_t,string] (dll-name="fdoc_fileseq");

  fdocscanner-maker = Dynlink::load-plugin-func0 [fdocscanner-control_t] (dll-name="fdoc_scanner");

  button-factory-maker = Dynlink::load-plugin-func0 [button-factory_t] (dll-name="fdoc_button");

  fdoc_frame_maker = Dynlink::load-plugin-func1 [fdoc_frame_t,fdoc_frame_data_t] (dll-name="fdoc_frame");

  return 0;
}

export fun setup of (string) as "fdoc2html_setup";
export fun xlat_fdoc of (string * string) as "fdoc2html";

Decorator Interfaces.

Web page architecture layout and decorators.

//[button-interface.flx]
interface button-spec_t {
  id: string;
  text: string;
  onclick: string;
}

interface button-factory_t {
  whatami: 1 -> string;
  get-jscript: 1 -> string;
  make-button: button-spec_t -> string;
}

//[toc_menu-interface.flx]

interface toc_menu_interface {
  whatami: 1 -> string;
  get_style: 1-> string;
  get_js: 1-> string;
  make_menu: 1 -> string;
}

//[edit-interface.flx]

interface edit-interface_t {
  whatami: 1 -> string;
  get_header: string * string -> string;
  get_body : string * string * string -> string;
}

//[fdoc-frame-interface.flx]
include "./heading-interface";
include "./button-interface";
include "./fileseq-interface";

typedef fdoc_frame_data_t = (
  heading: heading-control_t,
  button-factory: button-factory_t,
  fileseq: fileseq-control_t
);

interface fdoc_frame_t {
  whatami : 1 -> string;
  make_frame: string -> string;
}

//[fdoc-interface.flx]
interface fdoc_t {
  whatami : 1 -> string;
  html_raw : 1 -> string;
  html_page : 1 -> string;
  html_title: 1 -> string;
  mathjax_required: 1 -> bool;
}

//[fileseq-interface.flx]
interface fileseq-control_t {
  whatami: 1 -> string;
  shownav: 1 -> string;
  docnum: 1 -> string;
  get-jscript: 1 -> string;
}

//[heading-interface.flx]
interface heading-control_t {
  whatami: 1 -> string;
  get_headings: 1 -> list[int * string];
  head : string * int * string -> 0;
  tree_button : string * string -> string;
  add_button: string -> 0;
  emit-buttons: 1 -> string;
  emit-js: 1 -> string;
  finalise: 1 -> 0;
}

//[paragraph-interface.flx]
interface paragraph-control_t {
  whatami: 1 -> string;
  sp : 1 -> 0;
  sp-clas : string -> 0;
  ep : 1 -> 0;
  bp : 1 -> 0;
}

//[scanner-interface.flx]
// split up an fdoc into a stream of commands and text
variant fdoc-data_t =
  | Cmd of string
  | Text of string
;

interface fdocscanner-control_t {
  whatami: 1 -> string;
  fdoc_scan : string -> 1 ->  opt[fdoc-data_t];
  psplit : string -> 1 -> opt[string];
}

//[slideshow-interface.flx]
interface slideshow_t {
  whatami : 1 -> string;
  check-slide-commands : string -> bool;
  finalise: 1 -> 0;
  active : 1 -> bool;
}

Decorator Implementations.

//[fdoc_button.flx]
//$ Make buttons in a consistent style
include "./button-interface";

fun setup(config_data:string) = {
  eprintln$ "Setup fdoc_button " + config_data;
  return 0;
}

val jscript = """
<script>
function mouseover(id)
{
  var elt = document.getElementById(id);
  elt.style.display="none";
  var elt2 = document.getElementById(id+"_mo");
  elt2.style.display="inline";
}

function mouseout(id)
{
  var elt = document.getElementById(id+"_mo");
  elt.style.display="none";
  var elt2 = document.getElementById(id);
  elt2.style.display="inline";
}

</script>
""";

object fdoc_button () implements button-factory_t = {

  method fun whatami () => "button factory";

  method fun get-jscript () => jscript;

  val sz = 65,30; // frame size
  val bz = 60,20; // button size
  val bp = 4,6; // button pos in frame
  val cr = 4,40; // corner radii
  val st = 2,"black"; // border stroke thickness and colour
  val fc = "blue",0.2; // fill colour and opacity
  val hfc = "red",0.2; // hilight colour and opacity
  val tp = 13,21; // text position in frame
  val tc = "black"; // text colour
  val fz = "12px"; // font size

  fun rect (bz: int^2, cr:int^2, st: int * string, fc: string * double) (bp:int^2) =>
    '<rect '+
      'x="'+bp.0.str+'px" y="'+bp.1.str+'px" '+
      'rx="'+cr.0.str+'px" ry="'+cr.1.str+'px" '+
      'width="'+bz.0.str+'px" height="'+bz.1.str+'px" '+
      'style='+
        '"'+
          'fill:'+fc.0+';opacity:'+fc.1.str+';'+
          'stroke:'+st.1+';stroke-width:'+st.0.str+
       '"'+
     '/>'
  ;
  fun text (tc:string, txt:string) (tp:int^2) =>
    '<text x="'+tp.0.str+'px" y="'+tp.1+'px" fill="'+tc+
    '" style="font-size:'+fz+';">'+txt+'</text>'
  ;
  fun span (id:string) (txt:string) =>
    '<span id="'+id+'">' + txt + '</span>'
  ;

  fun span_hide (id:string) (txt:string) =>
    '<span id="'+id+'" style="display:none">' + txt + '</span>'
  ;

  fun svg (sz:int^2) (txt:string) =>
    '<svg height="'+sz.1.str+'px" width="' + sz.0.str + 'px">' + txt + '</svg>'
  ;

  method fun make-button (b:button-spec_t) =>
  """<span style="position:relative; bottom:6px"
  onmouseover="mouseover('"""+b.id+"""')"
  onmouseout="mouseout('"""+b.id+"""')"
  onclick=\""""+b.onclick+"""('"""+b.id+"""')"
  >""" +

   span b.id (
    svg sz ( rect (bz,cr,st,fc) bp + text (tc,b.text) tp )
   ) +
   span_hide (b.id+"_mo") (
    svg sz ( rect (bz,cr,st,hfc) bp + text (tc,b.text) tp )
   )
   +
  '</span>'
  ;
}

export fun setup of (string) as "fdoc_button_setup";
export fun fdoc_button of (unit) as "fdoc_button";

//[fdoc_edit.flx]
include "./edit-interface";

fun setup(config_data:string) = {
  eprintln$ "Setup fdoc_edit " + config_data;
  return 0;
}

var mime-to-file =
  list (
    ("text/x-felix", "flx_codemirror/mode/felix/felix.js"),
    ("text/x-ocaml", "codemirror/mode/mllike/mllike.js"),
    ("text/x-csrc", "codemirror/mode/clike/clike.js"),
    ("text/x-c++src", "codemirror/mode/clike/clike.js"),
    ("text/x-python", "codemirror/mode/python/python.js"),
    ("text/html", "codemirror/mode/htmlmixed/htmlmixed.js"),
    ("application/xml", "codemirror/mode/xml/xml.js"),
    ("text/s-tex", "codemirror/mode/stex/stex.js"),
    ("text/css", "codemirror/mode/css/css.js")
  )
;

object fdoc_edit () implements edit-interface_t = {
  method fun whatami () => "fdoc edit";
  method fun get_header (filename:string, mimetype:string) =>
    let modefile =
       match Assoc_list::find mime-to-file mimetype with
       | Some f => f
       | #None => "flx_codemirror/felix/felix.js"
       endmatch
    in

    "<title>"+filename+"</title>" +
    '''
    <link rel="stylesheet" href="/share/src/codemirror/lib/codemirror.css">
    <link rel="stylesheet" href="/share/src/codemirror/addon/fold/foldgutter.css">
    <script src="/share/src/codemirror/lib/codemirror.js"></script>
    <script src="/share/src/'''+modefile+'''"></script>
    <script src="/share/src/codemirror/addon/edit/matchbrackets.js"></script>
    <script src="/share/src/codemirror/addon/fold/foldcode.js"></script>
    <script src="/share/src/codemirror/addon/fold/foldgutter.js"></script>
    <script src="/share/src/codemirror/addon/fold/brace-fold.js"></script>
    <script src="/share/src/codemirror/addon/fold/comment-fold.js"></script>
    <style>.CodeMirror {border: 2px inset #dee; height:auto; }</style>
    <style>.CodeMirror-scroll {overflow-x: hidden; overflow-y:auto; }</style>
    '''
  ;
  method fun get_body (id:string, mime:string, text:string) =>
   '<form action="doedit" method="post" enctype="text/plain">'+
   '<input type="submit" value="Save"><br>'+
   '<textarea id="'+id+'" name="code">'+
   text +
   '</textarea></form>' +
    '''
    <script>
      var editor = CodeMirror.fromTextArea(document.getElementById("'''+id+'''"), {
        lineNumbers: true,
        lineWrapping: true,
        matchBrackets: true,
        smartIndent: false,
        viewportMargin: Infinity,
        extraKeys: {"Ctrl-Q": function(cm){ cm.foldCode(cm.getCursor()); }},
        foldGutter:true,
        gutters: ["CodeMirror-linenumbers", "CodeMirror-foldgutter"],
        mode: "'''+mime+'''"
      });
    </script>
    '''
  ;

}

export fun setup of (string) as "fdoc_edit_setup";
export fun fdoc_edit of (unit) as "fdoc_edit";

//[fdoc_fileseq.flx]
include "./fileseq-interface";

include "./button-interface";
var button-factory : unit -> button-factory_t;

fun setup(config_data:string) = {
  eprintln$ "Setup fdoc_fileseq " + config_data;
  button-factory = Dynlink::load-plugin-func0 [button-factory_t] (dll-name="fdoc_button");
  return 0;
}

object fdoc_fileseq (filename: string) implements fileseq-control_t =
{
  var button = #button-factory;
  method fun whatami()=> "Filename sequence navigation object";
  method fun get-jscript() => "<script> function nop(dummy) {} </script>";

  fun calnav() =
  {
    val relfile = match (filename,'/').split.rev with | Cons(h,_) => h | #Empty => "";
    var lpos = relfile.len.int;
    while lpos > 0 and not isdigit(relfile.[lpos - 1]) do
       --lpos;
    done
    assert lpos == 0 or relfile.[lpos - 1].isdigit;
    var fpos = lpos;
    while fpos > 0 and isdigit(relfile.[fpos - 1]) do --fpos; done
    assert fpos == 0 or relfile.[fpos].isdigit;
    val digits =
      if fpos >=0 and lpos > fpos then
        relfile.[fpos to lpos]
      else ""
    ;

    val n = digits.len.int;
    val v = digits.int;
    val vnext = v + 1;
    val vprev = v - 1;
    var snext = (f"%010d" vnext).[10-n to];
    var sprev= (f"%010d" vprev).[10-n to];

    snext = relfile.[to fpos] + snext + relfile.[lpos to];
    sprev = relfile.[to fpos] + sprev + relfile.[lpos to];
    docindex := relfile.[to fpos] + "index" + relfile.[lpos to];

    return
      if digits == "" then
        None[int],None[string],None[string],docindex
      elif vprev > 0 then
        Some v,Some sprev, Some snext,docindex
      else
        Some v,None[string], Some snext,docindex
    ;
  }

  method fun shownav() =>
    match calnav() with
    | _,Some sprev, Some snext, docindex =>
        "<a href='"+sprev+"'>"+button.make-button(id="prev", text="Prev", onclick="nop")+"</a> " +
        "<a href='"+snext+"'>"+button.make-button(id="next", text="Next", onclick="nop")+"</a> " +
        "<a href='"+docindex+"'>"+button.make-button(id="index", text="Index", onclick="nop")+"</a> "
    | _,#None, Some snext, docindex =>
       "<a href='"+snext+"'>"+button.make-button(id="next", text="Next", onclick="nop")+"</a> "+
       "<a href='"+docindex+"'>"+button.make-button(id="index", text="Index", onclick="nop")+"</a>"
    | _,#None, #None,_ => ""
    endmatch
  ;

  method fun docnum()=>
    match calnav() with
    | #None,_,_,_ => ""
    | Some v,_,_,_ => str v + "."
  ;

}

export fun setup of (string) as "fdoc_fileseq_setup";
export fun fdoc_fileseq of (string) as "fdoc_fileseq";

//[fdoc_frame.flx]
include "./fdoc-frame-interface";
include "./toc_menu-interface";

fun setup (config_data:string) = {
  eprintln$ "Setup fdoc_frame v1.4 " + config_data;
  return 0;
}

var frame_style= """
<style>
body {margin:3%; font-family: sans-serif; }
h1 {color:black; font-size:120%; border-bottom: 2px solid #ddd; padding: 0 0 3px 0;}
h2 {color:#202020; font-size:105%;}
h3 {font-size:100%;}
h4 {font-size:95%;}
h5 {font-size:95%;}
span.fstring {color:darkblue; font-style:italic; }
span.comment {font-family:arial; color:blue; font-style:italic; }
span.doccomment {font-family:arial; color:green; font-style:italic; }
span.big_keyword {color:#FF1010; }
span.small_keyword {color:#802040; }
span.qualifier {color:#A02020; }
span.library {color:#A02000; }
span.ctor {color:#406020; }
span.hack {color:#66DD00; }
span.preproc {color:#005500; }
span.embedded_c{background-color:#DDDDDD; }
span.fpc_fieldname {color:#DD0000; }
span.lineno {color:#101010; background-color:#E0E0E0; font-size:80%; font-family:"courier",monospace; font-style:normal; }
pre { border: 1px solid #ccc; color: black; box-shadow:3px 3px 2px rgba(0,0,0,0.1); padding:2px; }
pre.flxbg {background-color:#C2FDC2; box-shadow:3px 3px 2px rgba(0,0,0,0.1) }
pre.uncheckedflxbg {background-color:#eee; box-shadow:3px 3px 2px rgba(0,0,0,0.1); }
pre.cppbg {background-color:#C2FDC2; }
pre.prefmtbg {background-color:#F1F1F1; }
pre.expected {background-color:hsla(74,94%,88%,1); }
pre.input {background-color:hsla(20,94%,88%,1); }
pre.inclusion {
    font-family: Arial;
    font-weight: normal;
    font-size: 0.9em;
    color: #555;
    border: none;
    box-shadow: none;
    text-align: right;
    margin: -7px 11px -12px 0;
    padding: 0;
    background-color:#fafafa;
}
code.inclusion {background-color:#D070D0; color:black; }
.obsolete { background-color:#FFEFEF; font-size: small; color:black; }
.future { background-color:#FF8080; font-size: small; color:black; }
.implementation_detail { background-color:#E0E0E0; font-size: small; color:black;  }
.bug { background-color:#FFE0E0; font-size: small; color:black; }
.fixed{ background-color:#FFE0E0; font-size: small; color:black; }
.done { background-color:#FFE0E0; font-size: small; color:black; }
.caveat { background-color:hsla(0,100%,91%,1); color:black; padding: 0.6em; }
.container {
  position: fixed;
  top:0px;
  left:0px;
  height : 100%;
  width: 100%;
  background-color: grey;
  margin: 0px;
  padding: 0px;
  border-width: 0px;
  color: #404040;
}
.maincontent {
  padding:4px;
  padding-left:8px;
  line-height:1.3em;
  color:#404040; background-color:#fafafa;
}
.maincontent h1 { margin-left:-8px; position: relative; font-family: georgia, serif; font-size: 1.8em; font-weight: normal; }
.maincontent h2 { margin-left:-8px; position: relative; margin-bottom:-5px; }
.maincontent h3 { margin-left:-8px; position: relative; margin-bottom:-5px; }
.maincontent h4 { margin-left:-8px; position: relative; margin-bottom:-5px; }
.maincontent code { color:#902030; }
.toppanel {
  position:absolute; left:0px; top:0px; height:20px; right:0px;
  background-color: #e0e0e0;
}
.bottompanel {
  position:absolute; left:0px; top:22px; bottom:0px; right:0px;
  background-color: #fafafa;
  font-size:14px;
}
.leftpanel {
  position:absolute; left:0px; top:0px; bottom:0px; width: 150px;
  background-color: #eaeaea; overflow: auto;
}
.rightpanel {
  position:absolute; right: 0px; left:160px; top:0px; bottom: 0px;
  background-color: #fafafa; overflow: auto;
}
.divider {
  position:absolute; left: 150px; top:0px; bottom:0px;
  background-color: black; width:2px;
  box-shadow: 0 0 8px #000;
}

#panemover {
    position:absolute;
    left: 150px;
    width : 10px;
    top: 0px;
    bottom: 0px;
    opacity: 0.3;
    cursor:col-resize;
}

div.m {
    margin: 0px;
    padding:0px;
    border-width:2px;
    border-color: green;
}

div.m1 {
    background-color: #86E870;
    border-style:outset;
    border-color:#ccc;
    border-width:2px 0;
    font-size:90%;
    padding: 1px 0 2px 10px;
}

div.m2 {
    background-color: #70C070;
    padding-left:15px;
    padding-top:2px;
    border-style:outset;
    border-color:green;
    border-width:0 0 1px 0;
    font-size:80%;
}

div.m1:hover, div.m2:hover {
    background-color: white;
}

#leftmargintoc a {
    text-decoration: none;
    color: #404040;
}
</style>
""";

var frame_js = """
    <script async="true">
      function dragStart(e, left, right){
        document.getElementById("panemover").style.width="70%";
        document.getElementById("panemover").style.left="50px";
        mousedown = true;
        x = e.clientX
        dragOffsetLeft =
          document.getElementById(left).getBoundingClientRect().right -
          document.getElementById(left).getBoundingClientRect().left -
          x
        ;
        dragOffsetDivider= document.getElementById("divider").getBoundingClientRect().left - x;
        dragOffsetRight = document.getElementById(right).getBoundingClientRect().left - x;
      }
      function dragRelease(){
        document.getElementById('panemover').style.width = '10px';
        document.getElementById('panemover').style.left = document.getElementById('divider').offsetLeft + 'px';
        mousedown = false;
      }
      function drag(e, left, right){
        if(!mousedown){return}
        x = e.clientX
        tmpLeft = dragOffsetLeft + x
        tmpDivider= dragOffsetDivider + x
        tmpRight = dragOffsetRight + x
        document.getElementById(left).style.width= tmpLeft + 'px';
        document.getElementById("divider").style.left= tmpDivider + 'px';
        document.getElementById(right).style.left = tmpRight + 'px';
      };
    </script>
""";

var  toc_menu = Dynlink::load-plugin-func1 [toc_menu_interface, list[int * string * string]] (
    dll-name="toc_menu", setup-str="loaded-from-fdoc_frame", entry-point="toc_menu"
  );


object fdoc_frame (d:fdoc_frame_data_t) implements fdoc_frame_t =
{
  method fun whatami () => "fdoc_frame maker";

  method fun make_frame (out:string) :string = {
    var o = "";
    reserve(&o,10000+out.len.int);
    var h2 = #(d.heading.get_headings);
    var h3 = map (fun (level:int, heading:string) => level, heading, '#'+heading+'_h') h2;
    var menu = toc_menu (h3);

    o+=frame_style;
    o+=#(menu.get_style);
    o+=frame_js;
    o+=#(menu.get_js);

    o+=#(d.heading.emit-js);
    o+=#(d.button-factory.get-jscript);
    o+=#(d.fileseq.get-jscript);

    // MAIN CONTENT
    var topcontent =
      '    <!--Main Content top navbar-->\n'  +
      #(d.heading.emit-buttons) +
      #(d.fileseq.shownav) +
      '    <!--Main Content top navbar End-->\n'
    ;

    var leftcontent = #(menu.make_menu);

    var rightcontent =
      '<!--Main Content Body-->\n' +
      out +
      '<!--Main Content Body End-->\n'
    ;

    var html = """
    <div class="container">
      <div class="toppanel">
""" + topcontent + """
      </div> <!-- toppanel end -->
      <div class="bottompanel">
        <span id="divider" class="divider"></span>

        <span id="left" class="leftpanel" >
          <div class="menucontent">
""" + leftcontent + """
          </div> <!-- leftpanel contents end -->
        </span> <!-- leftpanel end -->

        <span id="right" class="rightpanel">
          <div class="maincontent">
""" + rightcontent + """
          </div> <!-- rightpanel contents end -->
          <hr>
        </span> <!-- rightpanel end -->

        <span id="panemover" style="cursor:col-resize;"
         onmousedown="dragStart(event, 'left', 'right'); return false;"
         onmousemove="drag(event, 'left', 'right');"
         onmouseout="dragRelease();"
         onmouseup="dragRelease();"
        >
        </span> <!-- panemover end -->
      </div> <!-- bottom panel end -->
    </div> <!-- container end -->
""";
    o+= html;
    return o;
  }

}
export fun setup of (string) as "fdoc_frame_setup";
export fun fdoc_frame of (fdoc_frame_data_t) as "fdoc_frame";

//[fdoc_heading.flx]
include "./paragraph-interface";
include "./heading-interface";

include "./button-interface";
var button-factory : unit -> button-factory_t;


val js1 =
"""
<script type="text/javascript">

function expand(but,id)
{
  var n = document.getElementById(id).style;
  var button = document.getElementById(but);
  button.src = "/share/src/web/images/minus.gif";
  button.alt = "-";
  n.display = "block";
}
function collapse(but,id)
{
  var n = document.getElementById(id).style;
  var button = document.getElementById(but);
  button.src = "/share/src/web/images/plus.gif";
  button.alt = "+";
  n.display = "none";
}
function toggle(button,id)
{
  var n = document.getElementById(id).style;
  if (n.display == "none")
  {
    button.src = "/share/src/web/images/minus.gif";
    button.alt = "-";
    n.display = "block";
  }
  else
  {
    button.src = "/share/src/web/images/plus.gif";
    button.alt = "+";
    n.display = "none";
  }
}
var allbuttons = [
""";
val js2 =
"""
];
function expand_all(dummy)
{
  for (i in allbuttons)
  {
    expand(allbuttons[i], allbuttons[i]+"_d");
  }
}
function collapse_all(dummy)
{
  for (i in allbuttons)
  {
    collapse(allbuttons[i], allbuttons[i]+"_d");
  }
}
</script>
""";

fun escape_sp(h: string) => map (fun (c: char) => if c == ' ' then '_'.char else c) h;

fun setup(config_data:string) = {
  button-factory = Dynlink::load-plugin-func0 [button-factory_t] (dll-name="fdoc_button");
  eprintln$ "Setup fdoc_heading " + config_data;
  return 0;
}


object fdoc_heading (paragraph: paragraph-control_t, write_string: string -> 0) implements heading-control_t =
{
  var button = #button-factory;

  method fun whatami () => "Heading object";
  var hstack = 0; // number of open <div>s
  var hnums = varray[int] (size 5,1);
  var all_buttons = "";
  var htree = Empty[int * string];

  method fun get_headings () => rev htree;

  method fun emit-buttons() =>
   button.make-button(id="expand", text="Expand", onclick="expand_all") +
   button.make-button(id="collapse", text="Collapse", onclick="collapse_all")
  ;

  method fun emit-js() => js1 + all_buttons + js2;

  // bid is the button id, cid is the stuff which is controlled by it
  method fun tree_button(bid:string, cid:string)=>
    "<img src='/share/src/web/images/minus.gif' id='"+bid+"' onclick='toggle(this,\""+cid+"\")' alt='+'/>"
  ;

  method proc add_button (fname: string) {
    all_buttons = if all_buttons != "" then all_buttons + ',\n' else '' endif + '"' + fname + '"';
  }

  proc edivs(n:int) {
    while hstack > n do
      write_string("</div>");
      --hstack;
      set (hnums,hstack,1);
     done
     if hstack == n do
       --hstack;
       write_string("</div>");
       set(hnums,hstack,hnums.hstack+1);
     done
  }

  fun hnum() = {
    var s = ""; var i:int;
    for i in 0 upto hstack - 2 do
      s+=str(hnums.i) + ".";
    done
    return s + str(hnums.(hstack - 1));
  }

  method proc head(docnum: string, n:int, txt:string) {
    #(paragraph.ep);
    edivs(n);
    add_button txt;
    tb:=tree_button(txt,escape_sp(txt)+"_d");
    ++hstack;
    htree = Cons ( (n,txt), htree);
    write_string("<h"+str n+" id='"+escape_sp(txt)+"_h'>"+tb+" "+docnum+hnum()+" "+ txt+"</h"+str n+">" +
     "<div id='"+escape_sp(txt)+"_d' style='display:block'>\n");
  }

  method proc finalise () {
   edivs(1);
  }
}

export fun setup of (string) as "fdoc_heading_setup";
export fun fdoc_heading of (paragraph-control_t * (string->0)) as "fdoc_heading";

//[fdoc_paragraph.flx]
include "./paragraph-interface";

fun setup(config_data:string) = {
  eprintln$ "Setup fdoc_paragraph" + config_data;
  return 0;
}


object fdoc_paragraph (write_string: string -> 0) implements paragraph-control_t =
{
  method fun whatami () => "Paragraph object";
  var pstate = false;
  proc start_p () { write_string("<p>"); pstate=true; }
  proc start_p (cls:string) { write_string("<p class='"+cls+"'>"); pstate=true; }
  proc end_p () { write_string("</p>"); pstate=false; }
  proc break_p () { write_string("</p><p>"); }
  method proc sp-clas (cls: string) { if not pstate do start_p cls; done }
  method proc sp() { if not pstate do start_p; done }
  method proc ep() { if pstate do end_p; done }
  method proc bp() { if pstate do end_p; done start_p; }
}

export fun setup of (string) as "fdoc_paragraph_setup";
export fun fdoc_paragraph of (string->0) as "fdoc_paragraph";

//[fdoc_scanner.flx]
include "./scanner-interface";

fun setup(config_data:string) = {
  eprintln$ "Setup fdoc_scanner " + config_data;
  return 0;
}


object fdoc_scanner () implements fdocscanner-control_t = {
  method fun whatami () => "Scanner object";

  method gen fdoc_scan (var inp:string) () : opt[fdoc-data_t] = {
    var lines = split (inp,"\n");
    var out = "";
    String::reserve (&out,inp.len);
    for line in lines do
      if line.[0]=='@' and line.[1] != "{" do
        if out !=""  do
           yield Some (Text out);
           out = "";
        done
        yield Some (Cmd$ strip(line.[1 to]));
      else
        out+=line;
        out+="\n";
      done
    done;
    if out != "" do
      yield Some (Text out);
    done
    return None[fdoc-data_t];
  }

  // split up doc text into a stream of paragraphs
  method gen psplit (var inp:string) () : opt[string] = {
    var lines = split(inp,"\n");
    var out = "";
    String::reserve (&out,inp.len);
    for line in lines do
      // accumulate non-blank lines
      if line != "" do
        out += line;
        out += "\n";

      else // emit accumulated lines
        if out != "" do
          yield Some out;
          out = "";
        done
      done
    done
    if out != "" do
      yield Some out;
      out = ""; // no semantics but release memory
    done
    return None[string];
  }
}


export fun setup of (string) as "fdoc_scanner_setup";
export fun fdoc_scanner of (unit) as "fdoc_scanner";

//[fdoc_slideshow.flx]


val slideshow_js = """
<button id="start" onclick="start_slides()">Start</button>
<button id="stop" onclick="stop_slides()" disabled="true">Stop</button>
<button id="reset" onclick="reset_slides()">Reset</button>
<button id="next" onclick="skip_to_next()">Next</button>
<span id="goose" style="position:absolute; right:50px;">Slideshow Ready</span>
<script>
var slides = new Array();
var slideno = 0;
var lineno = 0;
var nslides = 0;
slides[0]=0;

var interval_handle;
function enable (slide, line) {
  var elt = document.getElementById("slide-section-"+slide+","+line)
  elt.style.display="";
  var n = elt.innerHTML.length;
  interval_handle = setTimeout(showframe, 7000+25 * n);
}

function disable (slide, line) {
  document.getElementById("slide-section-"+slide+","+line).style.display="none";
}

function disable_slide (slide) {
  for (i = 1; i <= slides[slide]; i = i + 1) disable(slide,i);
}

function nextslide() {
  slideno = slideno + 1;
  if (slideno > nslides ) { reset_slides();}
  lineno = 1;
}

function nextline() {
  lineno = lineno + 1;
  if (lineno > slides[slideno]) { nextslide(); }
}

function showline() {
  if (slideno == 0) {
    document.getElementById("goose").innerHTML="READY";
  }
  else {
    document.getElementById("goose").innerHTML="SLIDE " + (slideno) + ", LINE " + (lineno) +"";
    enable (slideno, lineno);
  }
}

function showframe(){
  oldslide = slideno;
  oldline = lineno;
  nextline();
  if (oldslide != slideno) {
    disable_slide(oldslide);
    setTimeout(showline,2000);
  }
  else showline();
}

function skip_to_next() {
  clearTimeout(interval_handle);
  disable_slide (slideno);
  nextslide();
  showline();
}

function start_slides() {
  document.body.style.background="black";
  document.body.style.color="white";
  document.getElementById("start").disabled=true;
  document.getElementById("stop").disabled=false;
  document.getElementById("reset").disabled=false;
  showframe();
}

function stop_slides() {
  document.body.style.background="white";
  document.body.style.color="black";
  document.getElementById("start").disabled=false;
  document.getElementById("stop").disabled=true;
  document.getElementById("reset").disabled=false;
  clearTimeout(interval_handle);
}

function reset_slides() {
  document.getElementById("reset").disabled=true;
  disable_slide(slideno);
  stop_slides();
  slideno = 0;
  lineno = 0;
  showline();
}

</script>
""";

include "./slideshow-interface";

fun setup(config_data:string) = {
  eprintln$ "Setup fdoc_slideshow " + config_data;
  return 0;
}


object fdoc_slideshow (var write_string: string -> 0) implements slideshow_t =
{
  method fun whatami () => "Slideshow object";
  var slideshow-used = false;
  var slide_count = 0;
  var slide_section_count = 0;

  proc end_slide_section() { write_string("\n</div>"); }
  proc end_slide() {
    write_string("</div>\n<script>\nslides["+str slide_count+"]=" + str slide_section_count + ";\n</script>\n");
  }
  proc start_slide() {
    write_string('\n<div class="slide" id="slide-'+str slide_count+'">\n');
  }
  proc start_slide_section() {
    write_string('\n<div class="slide-section" id="slide-section-'+
      str slide_count+","+str slide_section_count+'" style="display:none">\n');
  }

  method fun check-slide-commands (b:string) : bool =
  {
    if b == "slideshow" do
      slideshow-used = true;
      write_string (slideshow_js);
      slide_count = 0;
      slide_section_count = 0;
      return true;
    elif b == "slide" do
      if slide_count != 0 do
        end_slide_section();
        end_slide();
      done
      slide_count = slide_count + 1;
      slide_section_count = 1;
      start_slide();
      start_slide_section();
      //s = doc;
      return true;
    elif b == "section" do
      if slide_section_count != 0 do
        end_slide_section();
      done
      slide_section_count = slide_section_count + 1;
      start_slide_section();
      //s = doc;
      return true;
    else
      return false;
    done
  }

  method proc finalise() =
  {
    if slide_count > 0 do
      end_slide_section();
      end_slide();
      write_string("\n<script>nslides = " + str slide_count + ";</script>\n");
    done
  }
  method fun active () => slideshow-used;
};

export fun setup of (string) as "fdoc_slideshow_setup";
export fun fdoc_slideshow of (string->0) as "fdoc_slideshow";

//[plugin_common.flx]
open class WebserverPluginCommon
{
  fun get_file (var fname:string, INSTALL_ROOT:string, path:list[string]) = {
//println$ "Search for file " + fname;
    if fname.[0] == char "$" do fname = fname.[1 to]; done
    if FileStat::fileexists fname do
      //println$ "Found as " + fname;
      return Some fname;
    else
      var f = Filename::join(INSTALL_ROOT,fname);
      if FileStat::fileexists f do
        // println$ "Found in root as " + f;
        return Some f;
      else
        var result = FileSystem::find_in_path (fname, path);
        //match result with
        //| Some f => println$ "Found in path as " + f;
        //| #None => println$ "Not found in path " + str path;
        //endmatch;
        return result;
      done
    done
  }
}

//[toc_menu.flx]
include "./toc_menu-interface";

fun setup (config_data:string) = {
  eprintln$ "Setup toc_menu v1.1 " + config_data;
  return 0;
}

var menu_js = """
<script type="text/javascript">

  function mexpand(id)
  {
    var n = document.getElementById(id).style;
    n.display = "block";
  }

  function mcollapse(id)
  {
    var n = document.getElementById(id).style;
    n.display = "none";
  }

  var counter_max = 0;
  function mshow(id,loc)
  {
    var i;
    for(i=1; i<=counter_max; ++i)
      mcollapse("menu"+String(i));
    mexpand(id);
    window.location.replace(loc);
  }
</script>
""";

var menu_style = """
<style>
div.m {
    margin: 0px;
    padding:0px;
    border-width:2px;
    border-color: green;
}

div.m1 {
    background-color: #86E870;
    border-style:outset;
    border-color:#ccc;
    border-width:2px 0;
    font-size:90%;
    padding: 1px 0 2px 10px;
}

div.m2 {
    background-color: #70C070;
    padding-left:15px;
    padding-top:2px;
    border-style:outset;
    border-color:green;
    border-width:0 0 1px 0;
    font-size:80%;
}

div.m1:hover, div.m2:hover {
    background-color: white;
}

#leftmargintoc a {
    text-decoration: none;
    color: #404040;
}


</style>
""";

fun escape_sp(h: string) => map (fun (c: char) => if c == ' ' then '_'.char else c) h;


object toc_menu (h:list[int * string * string]) implements toc_menu_interface =
{
  method fun whatami () => "toc_menu maker";
  method fun get_style () => menu_style;
  method fun get_js() => menu_js;
  method fun make_menu() =
  {
    // LEFT MARGIN
    var leftcontent ='  <!--Left Margin Toc-->\n';
      leftcontent +='  <div id="leftmargintoc">\n';

      // Contents body
        leftcontent+='    <!--Left Margin Toc Main Contents-->\n';

        proc head1(level:int, text:string, link:string) {
          leftcontent+= """      <div class=m1 onclick="mshow('menu"""+ counter.str+"""','"""+link+"""')"> """;
          leftcontent+= '''<a href="'''+escape_sp(link)+'''">''';
          leftcontent+= text + "</a></div>\n";
          leftcontent+= """      <div class=sm id=menu"""+counter.str+""">\n""";
        }
        proc foot1() { leftcontent+="      </div>\n"; }
        proc break1(level:int, text:string,link:string) {foot1(); ++counter; head1(level,text,link); }

        var counter = 0;
        iter proc (level:int,text:string, link:string)
          {
            //println$ i,s;
            if level == 1 do // first level meny entry
              if counter == 0 do ++counter; head1 (level, text, link);
              else break1 (level,text,link);
              done
            elif level == 2 do // second level menu entry
              leftcontent+="      <div class=m2>";
              leftcontent+='''<a href="'''+escape_sp(link)+'''">'''+text+'''</a></div>\n''';
            done
          }
          h
        ;
        if counter >= 1 do  foot1; done;
        leftcontent+="    <script>counter_max="+counter.str+";</script>\n";

      leftcontent+='  </div>\n'; // leftmargintoc end
      leftcontent+='  <!--End Left Margin Toc-->\n';
    return leftcontent;
  }

}

export fun setup of (string) as "toc_menu_setup";
export fun toc_menu of (list[int * string * string]) as "toc_menu";

Package: src/packages/programmer.fdoc

programmer utilities

key file
flx_perror.flx $PWD/src/tools/flx_perror.flx
flx_tangle.flx $PWD/src/tools/flx_tangle.flx 
//[flx_tangle.flx]
//$ flx_tangle --inoutdir --indir=indir --outdir=outdir pattern ...
//$ processes the file indir/basename.fdoc and generates
//$ the files:
//$
//$   outdir/basename.flx by collating everything
//$      between @felix and subsequent @ command.
//$
//$   outdir/basename.expect by collating everything
//$      between @expect and subsequent @ command.
//$
//$   outdir/basename.input by collating everything
//$      between @input and subsequent @ command.
//$
//$ If indidr is specified and outdir is not, the outdir
//$ remains the default current directory.
//$
//$ If inoutdir is specified, indir and outdir are set
//$ to it, and indir and outdir should not be specified.
//$
//$ If no patterns are specified '.*' is used, i.e. all fdoc files
//$ in the input directory (recursively).
//$

include "std/control/schannels";
include "std/control/chips";
open BaseChips;

// --- COMMAND LINE PROCESSING --------------------------------

val cmdspec : cmdspec_t =
  (
    split-key-value-spec= Empty[string * string],
    multi-valued-keys-spec= Empty[string],
    single-valued-keys-spec= list("--inoutdir","--indir","--outdir"),
    switches-spec= list("--help","--linenos","--verbose"),
    short-switch-map-spec = list [char * string] (char "v","--verbose")
  )
;

proc print_help =>
  println$ "Usage: flx_tangle [-v] [--indir=indir] [--outdir=outdir] [--inoutdir=inoutdir] [--linenos] [regexp1 ...]"
;

val inargs = #System::args;

val outargs = parse-cmdline cmdspec inargs;

// --- Check for option conflicts
var keys = outargs.single-valued-keys;
if
  ("--inoutdir" in keys) and
  (
    ("--indir" in keys) or
    ("--outdir" in keys)
  )
do
  println$ "Cannot specify --inoutdir with --indir or --outdir";
  print_help;
  System::exit 1;
done

// --- Check for help command
if "--help" in outargs.switches do
  print_help;
  System::exit 0;
done

var verbose = "--verbose" in outargs.switches;

// ----- SETUP CONTROL ARGUMENTS ------------------------
var patterns =
  match outargs.positional with
  | _ ! (_ ! _ as tail) => tail
  | _ ! Empty => list ".*"
;

var indir = keys.get_dflt ("--indir", keys.get_dflt ("--inoutdir", ".") );
var outdir = keys.get_dflt ("--outdir",  keys.get_dflt ("--inoutdir", "."));
var linenos = "--linenos" in outargs.switches;

// --- FILE SCAN --------------------------------
for base in patterns do
  var files = FileSystem::regfilesin(indir, base+"\\.fdoc");
  println$ "Base = " + base + " : " files.len.str + " files";
  for file in files do
    var infile = Filename::join (indir, file);
    var outbase = Filename::join (outdir, Filename::strip_extension file);
    save_tangle (infile, outbase);
  done
done

// ---- PIPELINE ---------------------------------
// Source device.
chip filesrc (file:string)
  connector io
     pin out:%>string
{
  var data = load file;
  for line in split(data,"\n") do write (io.out, line+"\n"); done
  write(io.out,"");
}

// Tangling transducer.
chip tangle (filename:string) (tag:string)
  connector io
    pin inp: %<string
    pin out: %>string
{
  var lineno=1;
moredoc:>
  var x = read io.inp;
  ++lineno;
  if x == "" goto finish;
  if strip x != "@"+tag goto moredoc;

  if tag == "felix" and linenos do
    write(io.out,"#line " + lineno.str+ " " + '"'+filename+'"\n');
  done
morefelix:>
  x = read io.inp;
  ++lineno;
  if x == "" goto finish;
  if x.[0] == char "@" goto moredoc;
  write(io.out,x);
  goto morefelix;

finish:>
  write (io.out,"");
}

// Concentrating transducer.
chip grab (out:%>string)
  connector io
    pin inp:%<string
{
  var s = "";
morelines:>
  var x = read io.inp;
  if x == "" goto finish;
  s+=x;
  goto morelines;

finish:>
  write(out,s);
}

// Pipeline controller.
proc save_tangle (infile:string, outbase:string)
{
  // Check modification times of files to
  // see if we actually need to do anything.
  var itime = FileStat::filetime infile;
  var flx-time = FileStat::filetime$ outbase+".flx";
  var xpect-time = FileStat::filetime$ outbase+".expect";
  var input-time = FileStat::filetime$ outbase+".input";
  if flx-time <= itime do

    // Run processing pipeline.
    var iflx,oflx = #mk_ioschannel_pair[string];
    var ixpect,oxpect = #mk_ioschannel_pair[string];
    var iinput,oinput = #mk_ioschannel_pair[string];
    #(filesrc infile |-> tangle infile "felix" |-> grab oflx);
    #(filesrc infile |-> tangle infile "expect" |-> grab oxpect);
    #(filesrc infile |-> tangle infile "input" |-> grab oinput);
    var flx-result  = read iflx;
    var xpect-result  = read ixpect;
    var input-result  = read iinput;

    // If there's a non-trivial result, generate output file.
    if flx-result != "" or xpect-result != "" or input-result != "" do
      if verbose call
         println$ "Tangle      : " + infile + " -> " +outbase+ "(.flx,.expect,.input)";

      // Make sure the directories in the path exist.
      Directory::mkdirs$ Filename::dirname outbase;

      if flx-result != "" do
        var ofile = fopen_output$ outbase+".flx";
        write (ofile,flx-result);
        fclose ofile;
      done

      if xpect-result != "" do
        ofile = fopen_output$ outbase+".expect";
        write (ofile,xpect-result);
        fclose ofile;
      done

      if input-result != "" do
        ofile = fopen_output$ outbase+".input";
        write (ofile,input-result);
        fclose ofile;
      done
    else
      if verbose call
        println$ "No Code    : " + infile;
    done
  else
    if verbose call
      println$   "Up-to-date : " + infile + " -> " +outbase +"(.flx,.expect,.input)";
  done
}

//[flx_perror.flx]
val e = int (System::argv 1);
println$ "Errno " + str e + " " + Errno::strerror e.Errno::errno_t;

Package: src/packages/toolchain.fdoc

C and C++ toolchains

key file
flx_find_cxx_packages.flx $PWD/src/tools/flx_find_cxx_packages.flx
flx_gen_cxx_includes.flx $PWD/src/tools/flx_gen_cxx_includes.flx
key file
toolchain_config.flx share/lib/std/felix/toolchain_config.flx
toolchain_interface.flx share/lib/std/felix/toolchain_interface.flx
flx_cxx.flx share/lib/std/felix/flx_cxx.flx
flx_depchk.flx share/lib/std/felix/flx/flx_depchk.flx
flx_mklib.flx share/lib/std/felix/flx_mklib.flx
key file
gcc_linux.flx share/lib/std/felix/toolchain/gcc_linux.flx
gcc_macosx.flx share/lib/std/felix/toolchain/gcc_macosx.flx
clang_linux.flx share/lib/std/felix/toolchain/clang_linux.flx
clang_macosx.flx share/lib/std/felix/toolchain/clang_macosx.flx
clang_iOS_generic.flx share/lib/std/felix/toolchain/clang_iOS_generic.flx
msvc_win.flx share/lib/std/felix/toolchain/msvc_win.flx
cygwin.fpc $PWD/src/config/cygwin.fpc
cygwin.flx share/lib/std/cygwin/cygwin.flx
key file
toolchain_gcc_linux.flx share/lib/plugins/toolchain_gcc_linux.flx
toolchain_gcc_macosx.flx share/lib/plugins/toolchain_gcc_macosx.flx
toolchain_clang_linux.flx share/lib/plugins/toolchain_clang_linux.flx
toolchain_clang_macosx.flx share/lib/plugins/toolchain_clang_macosx.flx
toolchain_iphoneos.flx share/lib/plugins/toolchain_iphoneos.flx
toolchain_iphonesimulator.flx share/lib/plugins/toolchain_iphonesimulator.flx
toolchain_msvc_win.flx share/lib/plugins/toolchain_msvc_win.flx
flx_plugin.flx share/lib/plugins/flx_plugin.flx
key file
build_flx_rtl_gcc_linux.fpc $PWD/src/config/build_flx_rtl_gcc_linux.fpc
build_flx_rtl_gcc_macosx.fpc $PWD/src/config/build_flx_rtl_gcc_macosx.fpc
build_flx_rtl_clang_linux.fpc $PWD/src/config/build_flx_rtl_clang_linux.fpc
build_flx_rtl_clang_macosx.fpc $PWD/src/config/build_flx_rtl_clang_macosx.fpc
build_flx_rtl_clang_iphoneos.fpc $PWD/src/config/build_flx_rtl_clang_iphoneos.fpc
build_flx_rtl_msvc_win.fpc $PWD/src/config/build_flx_rtl_msvc_win.fpc

Find C++ packages.

Doesn’t really belong here but had to go somewhere!

Scans a C or C++ files and produces a list of required packages on standard output. To be redirected to a *.resh file.

Felix compiler generates *.resh file for Felix generated C++, and puts the #include “filename.includes” into filename.hpp. For C++ only builds, the user has to put the #include in themselves. The resulting C++ won’t work. This tool makes the filename.resh file which can then be fed to flx_pkgconfig along with a request for the include field, to help generate the include file.

//[flx_find_cxx_packages.flx]

// FIXME: this function cut and paste from flx.fdoc
// hidden inside an object

  fun find_cxx_pkgs (src:string) : list[string] =
  {
    //eprintln$ "[flx_find_cxx_pkgs] Scanning " + src + " for package requirements";
    var out = Empty[string];
    var pat = RE2('.*@requires package ([A-Za-z][A-Za-z0-9_-]*).*');
    var f = fopen_input_text src;
    if valid f do
      for line in f do
        var result = Match (pat,line);
        match result do
        | #None => ;
        | Some v => out = v.1  + out;
        done
      done
      fclose f;
    else
      eprintln("Can't find C++ source file " + src);
      System::exit(1);
    done
    out = rev out;
    //if out != Empty[string] call
    //  eprintln$ "[flx_find_cxx_packages] C++ file "+src+" requires packages " + str (out);
    return out;
  }



var filename = System::argv_dflt 1 "";
if filename == "" do
  println$ "Usage: flx_find_cxx_packages filename.cxx > filename.resh";
  System::exit 1;
done

var pkgs = find_cxx_pkgs filename;

for pkg in pkgs perform println$ pkg;

//[flx_gen_cxx_includes.flx]
include "std/felix/flx_pkgconfig";

var pkgconfig_flags = tail #System::args;
//println$ "Args to flx_gen_cxx_includes=" + pkgconfig_flags.str;

var infile = stdin;
var pkgdata = load infile;
var pkgs = split (pkgdata, "\n");
pkgs = filter (fun (x:string) => x != "") pkgs;
//for pkg in pkgs perform println$ "PKG=" +  pkg;
//var err, result = System::get_stdout("flx_pkgconfig " + cat " " pkgconfig_flags + " --field=includes " + cat " " pkgs);
var allargs = pkgconfig_flags + "--field=includes" + pkgs;
//println$ "Calling flx_pkgconfig with args = " + allargs.str;
var err,result = FlxPkgConfig::flx_pkgconfig(allargs);

if err == 0 do
  //println$ "Result = " + result;
  //var files = split (result," "); // won't work on Windows well ... spaces .. ugg
  var files = result;
  for file in files perform println$ "#include " + file;
else
  eprintln$ "Error " + err.str + " running flx_pkgconfig";
done

Toolchain support

//[toolchain_config.flx]

typedef toolchain_config_t = (
  c_compiler_executable: string,
  cxx_compiler_executable: string,
  header_search_dirs: list[string],
  macros : list[string],
  library_search_dirs: list[string],
  ccflags: list[string],
  dynamic_libraries: list[string],
  static_libraries: list[string],
  debugln : string -> void
);

//[toolchain_interface.flx]
interface toolchain_t {
  whatami : 1 -> string;
  host_os : 1 -> string;
  target_os : 1 -> string;
  cxx_compiler_vendor : 1 -> string;

  // Note: this information is available for
  // the host platform in the Filename class.
  // and for any platform using the Filename_class[os]
  // class. The methods below, however, reflect a cross-compilation
  // target filesystem. For example, on Linux with shared libs .so
  // you can target Windows with shared libs .dll if you have a
  // cross compiler.
  //
  // This toolchain facility should be separated from
  // the compiler object, even though the extensions are primarily
  // about compiler product file names, because other tools may wish
  // to assist building by, for example, deleting all object files.
  // Currently you'd have to instantiate a toolchain object to find
  // this information, needlessly providing dummy header files,
  // macros, etc, which are primarily useful to compilers.
  dependency_extension: 1 -> string;
  executable_extension : 1 -> string;
  static_object_extension: 1 -> string;
  dynamic_object_extension: 1 -> string;
  static_library_extension: 1 -> string;
  dynamic_library_extension: 1 -> string;
  pathname_separator : 1 -> string;
  get_base_c_compile_flags: 1 -> list[string];
  get_base_cxx_compile_flags: 1 -> list[string];

  cxx_dependency_generator : (src:string) -> int * string;
  c_dependency_generator : (src:string) -> int * string;
  dependency_parser : string -> list[string];

  cxx_static_object_compiler : (dst:string,src: string) -> int;
  cxx_static_library_object_compiler : (dst:string,src: string) -> int;
  c_static_object_compiler : (dst:string,src: string) -> int;
  static_library_linker : (dst:string,srcs:list[string]) -> int;
  static_executable_linker : (dst:string,srcs:list[string]) -> int;
  dynamic_executable_linker : (dst:string,srcs:list[string]) -> int;

  cxx_dynamic_object_compiler : (dst:string,src: string) -> int;
  c_dynamic_object_compiler : (dst:string,src: string) -> int;
  dynamic_library_linker : (dst:string,srcs: list[string]) -> int;

  debug_flags : 1 -> list[string];
}

Generic C/C++ compiler

For compilers with a gcc like command line interface: gcc and clang basically.

//[flx_cxx.flx]
class CxxCompiler
{
  typedef cxx_dep_spec_t =
  (
    CCDEP: string,
    CCFLAGS: list[string],
    INCLUDE_DIRS: list[string],
    MACROS: list[string],
    debugln: string -> 0
  );
  fun mkinc (s:string) => "-I" + s;
  fun mkincs (ss:list[string]) => map mkinc ss;

  fun mkmac (s:string) => "-D" + s;
  fun mkmacs (ss:list[string]) => map mkmac ss;

  //---------------------------------------------------------------
  // Generating #include dependencies
  //---------------------------------------------------------------

  gen generic_cxx_gen_deps (spec: cxx_dep_spec_t) (src:string) : int * string =
  {
    var cmd=
      spec.CCDEP !
      spec.CCFLAGS +
      mkincs spec.INCLUDE_DIRS +
      mkmacs spec.MACROS +
      src
    ;
    var CMD = catmap ' ' Shell::quote_arg cmd;
    spec.debugln$ "C++ generate dependencies : " + CMD;
    var result, data = System::get_stdout(CMD);
    if result != 0 do
      eprintln $ "C++ command="+CMD + " FAILED";
    done
    return result, data;
  }

  // parse the "make" file generated by gcc -M
  // GIGO: this routine can't fail, but it can return rubbish
  gen generic_dependency_parser (data:string) : list[string] =
  {
    var pcolon = match find (data ,':') with | Some i => i+1uz | #None => 0uz;
    var txt = data.[pcolon to];
    txt = search_and_replace (txt,'\\\n','');
    var files = respectful_split txt;
    files = map Directory::mk_absolute_filename files;
    return files;
  }

  //---------------------------------------------------------------
  // Compiling object files for dynamic links
  //---------------------------------------------------------------

  typedef cxx_dynamic_spec_t =
  (
    CCOBJ_DLLIB: string,
    CCFLAGS: list[string],
    INCLUDE_DIRS: list[string],
    MACROS: list[string],
    SPEC_OBJ_FILENAME:string,
    debugln: string -> 0
  );

  gen generic_cxx_compile_for_dynamic (spec: cxx_dynamic_spec_t) (src:string, dst:string) : int =
  {
    var cmd=
      spec.CCOBJ_DLLIB !
      spec.CCFLAGS +
      mkincs spec.INCLUDE_DIRS +
      mkmacs spec.MACROS +
      src
    ;
    var CMD = catmap ' ' Shell::quote_arg cmd + ' ' +
      (spec.SPEC_OBJ_FILENAME+Shell::quote_arg dst)
    ;
   spec.debugln$ "C++ compile: " + CMD;
    var result = System::system(CMD);
    if result != 0 do
      eprintln $ "C++ command="+CMD + " FAILED";
    done
    return result;
  }


  //---------------------------------------------------------------
  // Compiling object files for static links
  //---------------------------------------------------------------

  typedef cxx_compile_static_t =
  (
    CCOBJ_STATIC_LIB:string,
    CCFLAGS:list[string],
    INCLUDE_DIRS:list[string],
    MACROS:list[string],
    SPEC_OBJ_FILENAME:string,
    debugln: string -> 0
  );

  gen generic_cxx_compile_for_static
    (spec:cxx_compile_static_t)
    (src:string, dst:string) : int =
  {
    var cmd=
      spec.CCOBJ_STATIC_LIB !
      spec.CCFLAGS +
      mkincs spec.INCLUDE_DIRS +
      mkmacs spec.MACROS +
      src
    ;
    var CMD = catmap ' ' Shell::quote_arg cmd + ' ' +
      (spec.SPEC_OBJ_FILENAME+Shell::quote_arg dst)
    ;

    spec.debugln$ "C++ command="+CMD;
    var result=System::system(CMD);

    if result != 0 do
      eprintln$ "C++ compilation "+src+" failed";
    done
    return result;

  }


  //---------------------------------------------------------------
  // Making a shared library or DLL
  //---------------------------------------------------------------

  typedef link_lib_dynamic_spec_t =
  (
    CCLINK_DLLIB: string,
    CCFLAGS: list[string],
    EXT_SHARED_OBJ:string,
    SPEC_EXE_FILENAME: string,
    LINK_STRINGS: list[string],
    debugln: string -> 0
  );

  gen generic_link_lib_dynamic
    (spec:link_lib_dynamic_spec_t)
    (cppos: list[string],
    LINKER_OUTPUT_FILENAME:string)
  : int =
  {
    var cmd =
      spec.CCLINK_DLLIB !
      spec.CCFLAGS +
      cppos
    ;
    // This weird shit is because Unix use -o filename (space)
    // But Windows uses /Fefilename (no space)
    var CMD = catmap ' ' Shell::quote_arg cmd + ' ' +
      spec.SPEC_EXE_FILENAME+Shell::quote_arg LINKER_OUTPUT_FILENAME+ ' ' +
      catmap ' ' Shell::quote_arg spec.LINK_STRINGS
    ;
    spec.debugln$ "Link command="+CMD;
    var result = System::system(CMD);
    if result != 0 do
      eprintln $ "Dynamic link command="+CMD + " FAILED";
    done
    return result;
  }


  //---------------------------------------------------------------
  // Making a executable which uses shared libraroes
  //---------------------------------------------------------------

  typedef generic_link_exe_dynamic_t =
  (
    CCLINK_STATIC: string, // yeah, weird, but it means linker for executables ..
    CCFLAGS: list[string],
    SPEC_EXE_FILENAME: string,
    LINK_STRINGS: list[string],
    debugln: string->0
  );

  gen generic_link_exe_dynamic
    (spec:generic_link_exe_dynamic_t)
    (cppos:list[string], LINKER_OUTPUT_FILENAME:string) : int =
  {
/*
println$ "[generic_link_exe_dynamic] cppos=" + cppos.str;
println$ "[generic_link_exe_dynamic] link strings=" + spec.LINK_STRINGS.str;
*/
    var CMD =
        Shell::quote_arg spec.CCLINK_STATIC + ' ' +
        catmap ' ' Shell::quote_arg spec.CCFLAGS + ' ' +
        (spec.SPEC_EXE_FILENAME+Shell::quote_arg(LINKER_OUTPUT_FILENAME)) + ' ' +
        catmap ' ' Shell::quote_arg cppos + ' ' +
        catmap ' ' Shell::quote_arg spec.LINK_STRINGS
    ;

    spec.debugln$ "Link command="+CMD;
    var result=System::system(CMD);
    if result != 0 do
      eprintln$ "Link command="+CMD+ " FAILED";
    done
    return result;
  }

  //---------------------------------------------------------------
  // Making a fully linked statically executable
  //---------------------------------------------------------------

  typedef generic_link_exe_static_t =
  (
    CCLINK_STATIC: string,
    CCFLAGS: list[string],
    SPEC_EXE_FILENAME: string,
    LINK_STRINGS: list[string],
    debugln: string->0
  );

  gen generic_link_exe_static
    (spec:generic_link_exe_static_t)
    (cppos:list[string], LINKER_OUTPUT_FILENAME:string) : int =
  {
    var CMD =
        Shell::quote_arg spec.CCLINK_STATIC + ' ' +
        catmap ' ' Shell::quote_arg spec.CCFLAGS + ' ' +
        (spec.SPEC_EXE_FILENAME+Shell::quote_arg(LINKER_OUTPUT_FILENAME)) + ' ' +
        catmap ' ' Shell::quote_arg cppos + ' ' +
        catmap ' ' Shell::quote_arg spec.LINK_STRINGS
    ;

    spec.debugln$ "Link command="+CMD;
    var result=System::system(CMD);
    if result != 0 do
      eprintln$ "Link command="+CMD+ " FAILED";
    done
    return result;
  }

  //---------------------------------------------------------------
  // Making a library archive
  //---------------------------------------------------------------
  typedef generic_lib_static_t =
  (
    CCLINK_STATIC_LIB: string,
    CCFLAGS : list[string],
    SPEC_LIB_FILENAME: string,
    debugln: string->0
  );

  gen generic_static_library
    (spec:generic_lib_static_t)
    (cppos:list[string], LINKER_OUTPUT_FILENAME:string) : int =
  {
    var CMD =
        Shell::quote_arg(spec.CCLINK_STATIC_LIB) + ' ' +
        catmap ' ' Shell::quote_arg spec.CCFLAGS + ' ' +
        (spec.SPEC_LIB_FILENAME+Shell::quote_arg(LINKER_OUTPUT_FILENAME)) + ' ' +
        catmap ' ' Shell::quote_arg cppos
    ;

    spec.debugln$ "Library archive command="+CMD;
    var result=System::system(CMD);
    if result != 0 do
      eprintln$ "Library archive command="+CMD+ " FAILED";
    done
    return result;
  }


}

Dependency Checker

The dependency checker is used to examine a single C or C++ source file and check if the file, or any of dependencies, has changed. To do this it records a dependency file with a “.d” suffix as its output which lists all the files which are depended on as well as the command line switches used to invoke the compiler. The dependent file list is generated by the underlying compiler, which must support this ability.

//[flx_depchk.flx]
include "std/felix/toolchain_interface";

  gen cxx_depcheck (tc: toolchain_t, src:string, dst:string) : bool =
  {
    fun == (a:list[string], b:list[string]) =
    {
      match a,b with
      | #Empty,Empty => return true;
      | Cons (h1,t1), Cons (h2,t2) =>
         if h1 != h2 do
           return false;
         done
         return t1 == t2; // tail call
      | _ =>return false;
      endmatch;
    }

    fun maxf (t:double) (f:string) => max (t, FileStat::dfiletime (f, #FileStat::future_time));

    var new_switches = cat ' ' #(tc.get_base_cxx_compile_flags);

    var result, deps = tc.cxx_dependency_generator (src=src);
    if result != 0 do
      println$ "[flx_depchk] C++ Dependency generator FAILED on " + src;
      return false;
    done
    var newdeps = tc.dependency_parser deps;
    var depfile = dst + ".d";
    var olddeptxt = load depfile;
    var old_switches, olddeps =
      match filter (fun (s:string)=> s != "") (split (olddeptxt,"\n")) with
      | h ! t => h,t
      | _ => "",Empty[string]
    ;

    var samedeps = new_switches == old_switches and newdeps == olddeps;
    //if not samedeps do
    //  println$ "DEPS CHANGED";
    //  println$ "Old deps = " + olddeps.str;
    //  println$ "New deps = " + newdeps.str;
    //done
    save$ depfile, new_switches ! newdeps;
    var fresh = samedeps and #{
      var t = fold_left maxf #FileStat::past_time newdeps;
      return t < FileStat::dfiletime (dst, #FileStat::past_time);
    };
    //println$ "[flx] Output " + dst + " is " + if fresh then "FRESH" else "STALE" endif;
    return fresh;
  }

  gen c_depcheck (tc: toolchain_t, src:string, dst:string) : bool =
  {
    fun == (a:list[string], b:list[string]) =
    {
      match a,b with
      | #Empty,Empty =>  return true;
      | Cons (h1,t1), Cons (h2,t2) =>
         if h1 != h2 do
           return false;
         done
         return t1 == t2; // tail call
      | _ => return false;
      endmatch;
    }

    fun maxf (t:double) (f:string) =>
      max(t, FileStat::dfiletime (f, #FileStat::future_time))
    ;

    var new_switches = cat ' ' #(tc.get_base_c_compile_flags);
    var result, deps = tc.c_dependency_generator (src=src);
    if result != 0 do
      println$ "[flx_depchk] C Dependency generator FAILED on " + src;
      return false;
    done
    var newdeps = tc.dependency_parser deps;
    var depfile = dst + ".d";
    var olddeptxt = load depfile;
    var old_switches, olddeps =
      match filter (fun (s:string)=> s != "") (split (olddeptxt,"\n")) with
      | h ! t => h,t
      | _ => "",Empty[string]
    ;

    var samedeps = new_switches == old_switches and newdeps == olddeps;
    save$ depfile, new_switches ! newdeps;
    var fresh = samedeps and #{
      var t = fold_left maxf #FileStat::past_time newdeps;
      return t < FileStat::dfiletime (dst, #FileStat::past_time);
    };
    //println$ "[flx] Output " + dst + " is " + if fresh then "FRESH" else "STALE" endif;
    return fresh;
  }

Library Builder

Builds a complete library from a flx_pkgconfig database specification. Used by the flx_build_rtl tool.

//[flx_mklib.flx]
include "std/felix/toolchain_config";
include "std/felix/flx_pkg"; // only for "fix2word_flags"
include "std/felix/flx_cp";
include "std/felix/flx/flx_depchk";

class FlxLibBuild
{
  private fun / (x:string,y:string) => Filename::join(x,y);

  noinline gen make_lib
  (
    db: FlxPkgConfig::FlxPkgConfigQuery_t,
    toolchain-maker: toolchain_config_t -> toolchain_t,
    c_compiler_executable: string,
    cxx_compiler_executable: string,
    src_dir:string,
    target_dir:string,
    share_rtl:string,
    pkg:string,
    tmpdir:string,
    static_only:bool,
    debug: bool
  ) () : bool =
  {
    proc dbug (x:string) => if debug call println$ '[make_lib: '+pkg+']' x;

    proc ehandler () {
      eprintln$ "toolchain: make_lib failed, temporary ehandler invoked";
      System::exit 1;
    }


    println$ "------------";
    println$ "Make lib " + pkg;
    println$ "------------";
    var srcdir = db.getpkgfielddflt ehandler (pkg,"srcdir");
    var srcpath = src_dir / srcdir;
println$ "[make_lib] source directory " + srcpath;

    var build_includes= db.getpkgfield ehandler (pkg,"build_includes");
    var result3,ddeps= db.query$ list$ pkg, "--keepleftmost", "--field=requires_dlibs";
    ddeps = FlxPkg::fix2word_flags ddeps;
    var deps = db.getpkgfield ehandler (pkg,"Requires");
    var result,depdlibs =  db.query("--field=provides_dlib"+deps); // packaged dlibs
    var macros = db.getpkgfield ehandler (pkg,"macros");
    var result2,ccflags = db.query$ list$ pkg, "--keepleftmost", "--field=cflags";
    var toolchain_config =
      (
        c_compiler_executable = c_compiler_executable,
        cxx_compiler_executable = cxx_compiler_executable,
        header_search_dirs= list[string] (target_dir, srcpath, share_rtl)+build_includes,
        macros= macros,
        ccflags = ccflags,
        library_search_dirs= list[string] ("-L"+target_dir), // HACK!!!
        dynamic_libraries= ddeps+depdlibs,
        static_libraries= Empty[string],
        debugln = dbug
      )
    ;
    var toolchain = toolchain-maker toolchain_config;
    println$ #(toolchain.whatami);

    // THIS DOES NOT SEEM RIGHT, we're copying headers from share/src
    // into share/lib/rtl
    //
    // previously we copied into host/lib/rtl but that's even wronger
    // because only calculated configuration headers go there
    //
    // the thing is, the share directory is supposed to be read-only,
    // and the files in it immutable, so the contents should already
    // have been put there direct from the repository
    //
    // of course, for add on packages, share may need updating ..
    // its all confusing :)
    //
    // Leave this in there for now because demux is not actually packaged.
    // the fbuild process has put stuff in share already though!

    var headers = db.getpkgfielddflt ehandler (pkg,"headers");
    if headers == "" do headers = r".*\.h(pp)?"; println$ "copying all header files"; done
    var hsrc, hdst = "","";
    match split (headers, ">") with
    | #Empty => ;
    | Cons (h,#Empty) => hsrc = h;
    | Cons (h,Cons (d,#Empty)) => hsrc = h; hdst = d;
    | _ => println$ "Header file too many > characters " + headers;
    endmatch;

    if hdst == "" do hdst = "${0}"; done
    println$ "Copying headers " + hsrc + " > " + hdst;
    CopyFiles::copyfiles (srcpath, hsrc,share_rtl/hdst,true, true);

    var pats = db.getpkgfield ehandler (pkg,"src");
    var pat = catmap '|' (fun (x:string)=>"("+x+")") pats;
  //println$ "Finding Sources in "+srcpath;
  //println$ "Matching pattern "+pat;
    var files = FileSystem::regfilesin (srcpath,pat);
  //println$ "Sources = " + str files;
    if not static_only
    do
      begin
        fun objname (file:string) => let
            dstobj = file.Filename::strip_extension + #(toolchain.dynamic_object_extension) in
            tmpdir/ dstobj
        ;

        for file in files do
          var srcfile = srcpath/ file;
          var dst = objname file;
          Directory::mkdirs (Filename::dirname dst);
          match Filename::get_extension srcfile with
          | x when x == ".cc" or x == ".cpp" =>
            var fresh = cxx_depcheck (toolchain, srcfile, dst);
            if fresh do
              println$ "C++: Up to date [dynamic] " + file " -> " + objname file;
              result = 0;
            else
              println$ "C++: Compiling  [dynamic] " + file " -> " + objname file;
              result = toolchain.cxx_dynamic_object_compiler (src=srcfile, dst=dst);
            done
          | ".c" =>
            fresh = c_depcheck (toolchain, srcfile, dst);
            if fresh do
              println$ "C:   Up to date [dynamic] " + file " -> " + objname file;
              result = 0;
            else
              println$ "C:   Compiling  [dynamic] " + file " -> " + objname file;
              result = toolchain.c_dynamic_object_compiler (src=srcfile, dst=dst) ;
            done

          | x =>
            println$ "Unknown extension " + x;
            goto bad;
          endmatch
          ;
          if result != 0 do
            println$ "Compiler result " + str result;
            goto bad;
          done
        done

        var objs = map objname files;
        var libname =
          let dlib_root = db.getpkgfield1 ehandler (pkg,"provides_dlib") in
          if prefix (dlib_root,"-l") then "lib"+dlib_root.[2 to]
          elif prefix (dlib_root,"/DEFAULTLIB:") then dlib_root.[12 to]
          else dlib_root
          endif
          +#(toolchain.dynamic_library_extension)
        ;
        var dstlib = target_dir/libname;
        println$ "Dynamic Linking library " + dstlib;
        //println$ "  Source object files = " + objs.str;
        result = toolchain.dynamic_library_linker(srcs=objs, dst=dstlib);
        if result != 0 do
          println$ "Linker result " + str result;
          goto bad;
        done
      end
    done

    begin
      fun objname (file:string) => let
          dstobj = file.Filename::strip_extension + #(toolchain.static_object_extension) in
          tmpdir/ dstobj
      ;

      for file in files do
        var srcfile = srcpath/ file;
        var dst = objname file;
        Directory::mkdirs (Filename::dirname dst);
        match Filename::get_extension srcfile with
        | x when x == ".cc" or x == ".cpp" =>
          var fresh = cxx_depcheck (toolchain, srcfile, dst);
          if fresh do
            println$ "C++: Up to date [static] " + file " -> " + objname file;
            result = 0;
          else
            println$ "C++: Compiling [static] " + file " -> " + objname file;
            result = toolchain.cxx_static_library_object_compiler (src=srcfile, dst=dst);
          done
        | ".c" =>
          fresh = c_depcheck (toolchain, srcfile, dst);
          if fresh do
            println$ "C:   Up to date [static] " + file " -> " + objname file;
            result = 0;
          else
            println$ "C:   Compiling [static] " + file " -> " + objname file;
            result = toolchain.c_static_object_compiler (src=srcfile, dst=dst);
          done
        | x => println$
          "Unknown extension " + x;
          println$ "Compiler result " + str result;
          goto bad;
        endmatch
        ;
        if result != 0 do
          println$ "Compiler result " + str result;
          goto bad;
        done
      done

      var objs = map objname files;
      var libname =
        let dlib_root = db.getpkgfield1 ehandler (pkg,"provides_slib") in
        if prefix (dlib_root,"-l") then  "lib"+dlib_root.[2 to]
        elif prefix (dlib_root,"/DEFAULTLIB:") then dlib_root.[12 to]
        else dlib_root
        endif
        +#(toolchain.static_library_extension);
      ;
      var dstlib = target_dir/libname;
      println$ "Static Linking Library " + dstlib;
      //println$ "  Source object files = " + objs.str;
      result = toolchain.static_library_linker(srcs=objs, dst=dstlib);
      if result != 0 do
        println$ "Linker result " + str result;
        goto bad;
      done
    end
    return true;
bad:>
    return false;
  }
}

Toolchains

Toolchains for specific vendor compilers and operating system combinations.

Each specific toolchain is an object which implements the toolchain interface.

Object for gcc on Linux
//[gcc_linux.flx]
include "std/felix/toolchain_interface";
include "std/felix/toolchain_config";
include "std/felix/flx_cxx";

object toolchain_gcc_linux (config:toolchain_config_t) implements toolchain_t =
{

  var cxx_compile_warning_flags = list$ "-w",
    "-Wfatal-errors",
    "-Wno-invalid-offsetof",
    "-Wno-parentheses",
    "-Wno-unused-variable",
    "-Wno-unused-label",
    "-Wno-unused-function",
    "-Wno-sign-compare",
    "-Wno-missing-braces"
  ;
  var c_compile_warning_flags = list[string]$ "-w", "-Wfatal-errors";

  var c_compiler = let x = config.c_compiler_executable in if x == "" then "gcc" else x;
  var cxx_compiler = let x = config.cxx_compiler_executable in if x == "" then "g++" else x;
  var linker = cxx_compiler;

  var ccflags_for_dynamic_link = list[string] ("-shared");
  var base_c_compile_flags =
    "-D_POSIX" ! "-g" ! "-c" ! "-O1" ! "-fno-common"
    ! "-fno-strict-aliasing" ! (c_compile_warning_flags+config.ccflags)
  ;
  var base_cxx_compile_flags =
    "-D_POSIX" ! "-g"! "-c" ! "-O1" ! "-fno-common"
    ! "-fno-strict-aliasing" ! "-std=gnu++14" ! (cxx_compile_warning_flags+config.ccflags)
  ;

  method fun whatami () => "toolchain_gcc_linux (version 2)";
  method fun host_os () => "LINUX";
  method fun target_os () => "LINUX";
  method fun cxx_compiler_vendor () => "GNU";

  method fun dependency_extension () => ".d";
  method fun executable_extension () => "";
  method fun static_object_extension () => "_static.o";
  method fun dynamic_object_extension () => "_dynamic.o";
  method fun static_library_extension () => ".a";
  method fun dynamic_library_extension () => ".so";
  method fun pathname_separator () => "/";
  method fun debug_flags () =>list[string] "-g";
  method fun get_base_c_compile_flags () => base_c_compile_flags;
  method fun get_base_cxx_compile_flags () => base_cxx_compile_flags;

// Boilerplate

  method gen c_dependency_generator (spec:(src:string)) =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=c_compiler,
          CCFLAGS = "-MM" ! "-D_POSIX" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result, data;
  }

  method gen cxx_dependency_generator (spec:(src:string)) =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=cxx_compiler,
          CCFLAGS = "-MM" ! "-D_POSIX" ! "-std=gnu++14" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result, data;
  }

  method gen dependency_parser (data:string) : list[string] =>
     CxxCompiler::generic_dependency_parser data
  ;

  method gen c_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
  // case 2 of dflt
      (
        CCOBJ_STATIC_LIB = c_compiler,
        CCFLAGS = "-fvisibility=hidden" ! base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen c_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = c_compiler,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = "-fvisibility=hidden" !"-g"! "-c" ! "-O1" ! "-fno-common"! "-fno-strict-aliasing"
          ! "-D_POSIX" ! "-std=gnu++14" ! "-D_GLIBCXX_USE_CXX11_ABI=1"
          ! (cxx_compile_warning_flags+config.ccflags),
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen cxx_static_library_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = "-fvisibility=hidden" ! "-D_GLIBCXX_USE_CXX11_ABI=1"!base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = "FLX_STATIC_LINK"+config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen cxx_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = linker,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! "-D_GLIBCXX_USE_CXX11_ABI=1"! base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen static_library_linker (spec:(dst:string, srcs:list[string])): int =
  {
    var result =
      CxxCompiler::generic_static_library
      (
        CCLINK_STATIC_LIB = "ar",
        CCFLAGS = list[string]("-rcs"),
        SPEC_LIB_FILENAME = "",
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen static_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_static
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.static_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen dynamic_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_dynamic
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen dynamic_library_linker (spec:(dst:string,srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_lib_dynamic
      (
        CCLINK_DLLIB = linker,
        CCFLAGS = ccflags_for_dynamic_link,
        EXT_SHARED_OBJ = #dynamic_library_extension,
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }
}
Object for gcc on OSX
//[gcc_macosx.flx]
include "std/felix/toolchain_interface";
include "std/felix/toolchain_config";
include "std/felix/flx_cxx";

object toolchain_gcc_macosx (config:toolchain_config_t) implements toolchain_t =
{

  var cxx_compile_warning_flags = list$ "-w",
    "-Wfatal-errors",
    "-Wno-invalid-offsetof"
  ;
  var c_compile_warning_flags = list[string]$ "-w","-Wfatal-errors";

  var c_compiler = let x = config.c_compiler_executable in if x == "" then "gcc" else x;
  var cxx_compiler = let x = config.cxx_compiler_executable in if x == "" then "g++" else x;
  var linker = cxx_compiler;

  var ccflags_for_dynamic_link = list[string] ("-dynamiclib");

  var base_c_compile_flags =
    "-g"! "-c" ! "-O1" ! "-fno-common"! "-fno-strict-aliasing" ! (c_compile_warning_flags+config.ccflags)
  ;
  var base_cxx_compile_flags =
    "-g"! "-c" ! "-O1" ! "-std=c++14" ! "-fno-common"! "-fno-strict-aliasing" !(cxx_compile_warning_flags+config.ccflags)
  ;

  method fun whatami () => "toolchain_gcc_macosx (version 2)";
  method fun host_os () => "OSX";
  method fun target_os () => "OSX";
  method fun cxx_compiler_vendor () => "GNU";

  method fun dependency_extension () => ".d";
  method fun executable_extension () => "";
  method fun static_object_extension () => "_static.o";
  method fun dynamic_object_extension () => "_dynamic.o";
  method fun static_library_extension () => ".a";
  method fun dynamic_library_extension () => ".dylib";
  method fun pathname_separator () => "/";
  method fun debug_flags () => list[string] "-g";
  method fun get_base_c_compile_flags () => base_c_compile_flags;
  method fun get_base_cxx_compile_flags () => base_cxx_compile_flags;

// Boilerplate

  method gen c_dependency_generator (spec:(src:string)) =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=c_compiler,
          CCFLAGS = "-MM" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result , data;
  }

  method gen cxx_dependency_generator (spec:(src:string)) =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=cxx_compiler,
          CCFLAGS = "-MM" ! '-std=c++14' ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result, data;
  }

  method gen dependency_parser (data:string) : list[string] =>
     CxxCompiler::generic_dependency_parser data
  ;

  method gen c_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = c_compiler,
        CCFLAGS = base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen c_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = c_compiler,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen cxx_static_library_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = "FLX_STATIC_LINK" + config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = linker,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen static_library_linker (spec:(dst:string, srcs:list[string])): int =
  {
    var result =
      CxxCompiler::generic_static_library
      (
        CCLINK_STATIC_LIB = "ar",
        CCFLAGS = list[string]("-rcs"),
        SPEC_LIB_FILENAME = "",
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen static_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_static
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.static_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen dynamic_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_dynamic
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }


  method gen dynamic_library_linker (spec:(dst:string,srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_lib_dynamic
      (
        CCLINK_DLLIB = linker,
        CCFLAGS = ccflags_for_dynamic_link,
        EXT_SHARED_OBJ = #dynamic_library_extension,
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }
}
Object for clang on Linux
//[clang_linux.flx]
include "std/felix/toolchain_interface";
include "std/felix/toolchain_config";
include "std/felix/flx_cxx";

object toolchain_clang_linux (config:toolchain_config_t) implements toolchain_t =
{

  var cxx_compile_warning_flags = list$  "-w",
    "-Wfatal-errors",
    "-Wno-invalid-offsetof",
    "-Wno-logical-op-parentheses",
    "-Wno-bitwise-op-parentheses",
    "-Wno-parentheses-equality",
    "-Wno-parentheses",
    "-Wno-return-stack-address",
    "-Wno-tautological-compare",
    "-Wno-return-type-c-linkage",
    "-Wno-unused-variable",
    "-Wno-unused-function",
    "-Wno-c++11-narrowing",
    "-Wno-missing-braces"
  ;
  var c_compile_warning_flags = list[string]$ "-w","-Wfatal-errors";

  var c_compiler = let x = config.c_compiler_executable in if x == "" then "clang" else x;
  var cxx_compiler = let x = config.cxx_compiler_executable in if x == "" then "clang++" else x;
  var linker = cxx_compiler;

  var ccflags_for_dynamic_link = list[string] ("-shared");

  var base_cxx_compile_flags =
     "-std=c++14"! "-g"! "-c" ! "-O1" ! "-fno-common"! "-fno-strict-aliasing" ! (cxx_compile_warning_flags+config.ccflags)
  ;

  var base_c_compile_flags =
     "-g"! "-c" ! "-O1" ! "-fno-common"! "-fno-strict-aliasing" ! (c_compile_warning_flags+config.ccflags)
  ;


  method fun whatami () => "toolchain_clang_linux (version 2)";
  method fun host_os () => "LINUX";
  method fun target_os () => "LINUX";
  method fun cxx_compiler_vendor () => "clang";

  method fun dependency_extension () => ".d";
  method fun executable_extension () => "";
  method fun static_object_extension () => "_static.o";
  method fun dynamic_object_extension () => "_dynamic.o";
  method fun static_library_extension () => ".a";
  method fun dynamic_library_extension () => ".so";
  method fun pathname_separator () => "/";
  method fun debug_flags () => list[string] "-g";
  method fun get_base_c_compile_flags () => base_c_compile_flags;
  method fun get_base_cxx_compile_flags () => base_cxx_compile_flags;

// Boilerplate

  method gen c_dependency_generator (spec:(src:string)) =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=c_compiler,
          CCFLAGS = "-MM" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result, data;
  }

  method gen cxx_dependency_generator (spec:(src:string)) =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=cxx_compiler,
          CCFLAGS = "-MM" ! "-std=c++14" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result, data;
  }

  method gen dependency_parser (data:string) : list[string] =>
     CxxCompiler::generic_dependency_parser data
  ;

  method gen c_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = c_compiler,
        CCFLAGS = base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen c_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = c_compiler,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen cxx_static_library_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = "FLX_STATIC_LINK" + config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = linker,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen static_library_linker (spec:(dst:string, srcs:list[string])): int =
  {
    var result =
      CxxCompiler::generic_static_library
      (
        CCLINK_STATIC_LIB = "ar",
        CCFLAGS = list[string]("-rcs"),
        SPEC_LIB_FILENAME = "",
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen static_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_static
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.static_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen dynamic_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_dynamic
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }


  method gen dynamic_library_linker (spec:(dst:string,srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_lib_dynamic
      (
        CCLINK_DLLIB = linker,
        CCFLAGS = ccflags_for_dynamic_link,
        EXT_SHARED_OBJ = #dynamic_library_extension,
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }
}
Object for clang on OSX
//[clang_macosx.flx]
include "std/felix/toolchain_interface";
include "std/felix/toolchain_config";
include "std/felix/flx_cxx";

object toolchain_clang_macosx (config:toolchain_config_t) implements toolchain_t =
{

  var cxx_compile_warning_flags = list$
    "-w", // turn off all the warnings (but not hard errors)
    "-Wfatal-errors", // stop compiling on the first hard error
    "-Wno-return-type-c-linkage",
    "-Wno-invalid-offsetof"
  ;
  var c_compile_warning_flags = list$ "-w",
    "-Wfatal-errors",
    "-Wno-array-bounds"
  ;
  var c_compiler = let x = config.c_compiler_executable in if x == "" then "clang" else x;
  var cxx_compiler = let x = config.cxx_compiler_executable in if x == "" then "clang++" else x;
  var linker = cxx_compiler;

  var ccflags_for_dynamic_link = list[string] ("-dynamiclib");
  var base_c_compile_flags =
    "-g"! "-c" ! "-O1" ! "-fno-common"! "-fno-strict-aliasing" ! (c_compile_warning_flags+config.ccflags)
  ;

  var base_cxx_compile_flags =
    "-g"! "-c" ! "-O1" ! "-fno-common"! "-fno-strict-aliasing" ! "-std=c++14" ! (cxx_compile_warning_flags+config.ccflags)
  ;

  method fun whatami () => "toolchain_clang_macosx (version 2)";
  method fun host_os () => "OSX";
  method fun target_os () => "OSX";
  method fun cxx_compiler_vendor () => "clang";

  method fun dependency_extension () => ".d";
  method fun executable_extension () => "";
  method fun static_object_extension () => "_static.o";
  method fun dynamic_object_extension () => "_dynamic.o";
  method fun static_library_extension () => ".a";
  method fun dynamic_library_extension () => ".dylib";
  method fun pathname_separator () => "/";
  method fun debug_flags () => list[string] "-g";
  method fun get_base_c_compile_flags () => base_c_compile_flags;
  method fun get_base_cxx_compile_flags () => base_cxx_compile_flags;

// Boilerplate

  method gen c_dependency_generator (spec:(src:string)) : int * string =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=c_compiler,
          CCFLAGS = "-MM" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result,  data;
  }

  method gen cxx_dependency_generator (spec:(src:string)) : int * string =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=cxx_compiler,
          CCFLAGS = "-MM" ! "-std=c++14" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result, data;
  }

  method gen dependency_parser (data:string) : list[string] =>
     CxxCompiler::generic_dependency_parser data
  ;

  method gen c_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = c_compiler,
        CCFLAGS = base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen c_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = c_compiler,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen cxx_static_library_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = "FLX_STATIC_LINK"+config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = linker,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen static_library_linker (spec:(dst:string, srcs:list[string])): int =
  {
    var result =
      CxxCompiler::generic_static_library
      (
        CCLINK_STATIC_LIB = "ar",
        CCFLAGS = list[string]("-rcs"),
        SPEC_LIB_FILENAME = "",
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen static_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_static
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.static_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen dynamic_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_dynamic
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }


  method gen dynamic_library_linker (spec:(dst:string,srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_lib_dynamic
      (
        CCLINK_DLLIB = linker,
        CCFLAGS = ccflags_for_dynamic_link,
        EXT_SHARED_OBJ = #dynamic_library_extension,
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }
}
Cygwin interface.
//[cygwin.flx]
class Cygwin
{
  requires package "cygwin";

  // outputs absolute filenames: src,dst
  private gen p_cygwin_to_win: +char * +char * size -> int =
     "cygwin_conv_path(CCP_POSIX_TO_WIN_A || CCP_ABSOLUTE,$1,$2,$3)"
  ;
  private gen p_win_to_cygwin: +char * +char * size -> int =
    "cygwin_conv_path(CCP_WIN_TO_POSIX)A || CCP_ABSOLUTE,$1,$2,$3)"
  ;

  // This function should ALWAYS work
  fun cygwin_to_win (var s:string) =
  {
     var outbuf : +char;
     var psiz = p_cygwin_to_win (s.cstr,outbuf,0uz);
     outbuf = array_alloc[char] psiz;
     var err = p_cygwin_to_win (s.cstr,outbuf,psiz.size);
     assert err == 0; // hackery!
     var t = string outbuf;
     free outbuf;
     return t;
  }

  // This function has two kinds of output:
  // if the win filename is inside C:/cygwin we get name relative to /
  // if the filename is outside, we get /cygdrive/driveletter/rest-of-path
  fun win_to_cygwin(var s:string) =
  {
     var outbuf : +char;
     var psiz = p_win_to_cygwin(s.cstr,outbuf,0uz);
     outbuf = array_alloc[char] psiz;
     var err = p_win_to_cygwin(s.cstr,outbuf,psiz.size);
     assert err == 0; // hackery!
     var t = string outbuf;
     free outbuf;
     return t;
  }
}
Cygwin config
//[cygwin.fpc]
Descriptrion: Cygwin Dll
provides_dlib: -L/usr/bin -lcygwin
includes: '"sys/cygwin.h"'
Object for MSVC++ on Windows
//[msvc_win.flx]
include "std/felix/toolchain_interface";
include "std/felix/toolchain_config";
include "std/felix/flx_cxx";

object toolchain_msvc_win (config:toolchain_config_t) implements toolchain_t =
{

  var c_compiler = let x = config.c_compiler_executable in if x == "" then "cl" else x;
  var cxx_compiler = let x = config.cxx_compiler_executable in if x == "" then "cl" else x;
  var linker = cxx_compiler;

  var base_c_compile_flags = Empty[string];
  var base_cxx_compile_flags = Empty[string];

  method fun whatami () => "toolchain_msvc_win (version 2)";
  method fun host_os () => "Win32";
  method fun target_os () => "Win32";
  method fun cxx_compiler_vendor () => "microsoft";

  method fun dependency_extension () => ".d";
  method fun executable_extension () => ".exe";
  method fun static_object_extension () => "_static.obj";
  method fun dynamic_object_extension () => "_dynamic.obj";
  method fun static_library_extension () => ".lib";
  method fun dynamic_library_extension () => ".dll";
  method fun pathname_separator () => "\\";
  method fun debug_flags () => list[string] "-g";
  method fun get_base_c_compile_flags () => base_c_compile_flags;
  method fun get_base_cxx_compile_flags () => base_cxx_compile_flags;

  var include_switches = map (fun (s:string) => "/I"+s) config.header_search_dirs;
  include_switches = include_switches + filter
    (fun (s:string)=> prefix (s,"/I") or prefix (s,"-I"))
    config.ccflags
  ;

  var macros = map (fun (s:string) => "/D"+s) config.macros;
  // for executable
  var static_link_strings =
    let fun fixup (s:string) => if prefix (s,"-L") then "/LIBPATH:"+s.[2 to] else s in
    map fixup (config.library_search_dirs + config.static_libraries)
  ;
  // for DLL
  var dynamic_link_strings =
    let fun fixup (s:string) => if prefix (s,"-L") then "/LIBPATH:"+s.[2 to] else s in
    map fixup (config.library_search_dirs + config.dynamic_libraries)
  ;

  gen xpopen(cmd:list[string]) = {
    //var CMD = catmap ' ' Shell::quote_arg cmd;
    var CMD = strcat ' ' cmd;
    var result, data = System::get_stdout(CMD);
    if result != 0 do
      eprintln $ "Shell command="+CMD + " FAILED";
    done
    return result, data;
  }

  gen shell(cmd:list[string]) = {
    var CMD = catmap ' ' Shell::quote_arg cmd;
    var result = System::system(CMD);
    if result != 0 do
      eprintln $ "Shell command="+CMD + " FAILED";
    done
    return result;
  }

  proc checkwarn (result:int, text:string)
  {
    if result != 0 do
       print text;
    else
      for line in split(text,char "\n") do
        if
          stl_find (line,"warning") != stl_npos or
          stl_find (line, "note:") != stl_npos
        do
          eprintln$ line;
        done
      done
    done
  }

// Boilerplate

  method gen c_dependency_generator (spec:(src:string)) : int * string =
  {
    var cmd :list[string] = ("cl.exe" ! "/nologo" ! "/MDd" ! "/Zs" ! "/showIncludes" ! "/c" ! "/Tc"+spec.src ! macros) +
       include_switches;
    var result,text =xpopen cmd;
    return result,text;
  }

  method gen cxx_dependency_generator (spec:(src:string)) : int * string =
  {
    var cmd : list[string] = ("cl.exe" ! "/nologo" ! "/wd4190" ! "/MDd" ! "/Zs" ! "/showIncludes" ! "/c" ! "/EHs" ! macros) +
      include_switches + (spec.src ! Empty[string]);
    var result,text =xpopen cmd;
    return result,text;
  }

  method gen dependency_parser (data:string) : list[string] = {
   var lines = split (data, "\n");
   var files = Empty[string];
   for line in lines do
     if prefix (line, "Note: including file: ") do
       var name = strip (line.[22 to]);
       if not prefix (name,"C:\\Program Files")
       and not prefix (name,"c:\\program files")
       do
         if name not in files do
           files = name ! files;
         done
       done
     done
   done
   return rev files;
  }

  method gen c_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result,text = xpopen$ ("cl.exe" ! "/nologo" ! "/DFLX_STATIC_LINK" ! "/MDd" ! "/Zi" ! "/c" ! "/Tc"+spec.src ! macros) +
      include_switches + ("/Fo"+spec.dst);
    checkwarn(result,text);
    return result;
  }

  method gen c_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result,text =xpopen$ ("cl.exe" ! "/nologo" ! "/MDd" ! "/Zi" ! "/c" ! "/Tc"+spec.src ! macros) +
       include_switches + ("/Fo"+spec.dst);
    checkwarn(result,text);
    return result;
  }


  method gen cxx_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result,text =xpopen$ ("cl.exe" ! "/nologo" ! "/wd4190" ! "/DFLX_STATIC_LINK" ! "/MDd" ! "/Zi" ! "/c" ! "/EHs" ! macros) +
      include_switches + spec.src + ("/Fo"+spec.dst);
    checkwarn(result,text);
    return result;
  }

  method gen cxx_static_library_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result,text =xpopen$ ("cl.exe" ! "/nologo" ! "/wd4190" ! "/DFLX_STATIC_LINK" ! "/MDd" ! "/Zi" ! "/c" ! "/EHs" ! macros) +
       include_switches + (spec.src ! ("/Fo"+spec.dst) ! Empty[string]);
    checkwarn(result,text);
    return result;
  }

  method gen cxx_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result,text =xpopen$ ("cl.exe" ! "/nologo" ! "/wd4190" ! "/MDd" ! "/Zi" ! "/c" ! "/EHs" ! macros) +
      include_switches + (spec.src ! ("/Fo"+spec.dst) ! Empty[string]);
    checkwarn(result,text);
    return result;
  }

  method gen static_library_linker (spec:(dst:string, srcs:list[string])): int =
  {
    var result,text =xpopen$ "lib.exe" ! "/OUT:"+spec.dst ! spec.srcs;
    checkwarn(result,text);
    return result;
  }

  method gen static_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    // Windows requires the object files before the /link and the libraries after
    // our generic interface can't deal with that so we have to parse ..
    var link_specs = Empty[string];
    var obj_specs = Empty[string];
    for term in spec.srcs + static_link_strings do
      if prefix (term, "/DEFAULTLIB:") do link_specs += term;
      elif prefix (term, "/LIBPATH:") do link_specs += term;
      elif suffix (term, ".obj") or suffix (term, ".obj") do obj_specs += term;
      else
        obj_specs += term; // dunno what to do with it!
      done
    done
    var result,text =xpopen$  "cl.exe" ! "/nologo" ! "/DFLX_STATIC_LINK" ! "/MDd" ! obj_specs + ("/Fe"+spec.dst) + "/link" + link_specs;
    checkwarn(result,text);
    return result;
  }

  method gen dynamic_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    // Windows requires the object files before the /link and the libraries after
    // our generic interface can't deal with that so we have to parse ..
    var link_specs = Empty[string];
    var obj_specs = Empty[string];
    for term in spec.srcs + static_link_strings do
      if prefix (term, "/DEFAULTLIB:") do link_specs += term;
      elif prefix (term, "/LIBPATH:") do link_specs += term;
      elif suffix (term, ".obj") or suffix (term, ".obj") do obj_specs += term;
      else
        obj_specs += term; // dunno what to do with it!
      done
    done
    var result,text = xpopen$ "cl.exe" ! "/nologo" ! "/MDd" ! obj_specs + ("/Fe"+spec.dst) + "/link" + link_specs;
    checkwarn(result,text);
    return result;
  }

  method gen dynamic_library_linker (spec:(dst:string,srcs:list[string])) : int =
  {
    var result,text =xpopen$  "cl.exe" ! "/nologo" ! "/MDd" ! spec.srcs + ("/Fe"+spec.dst) +  "/link" + "/DLL" + dynamic_link_strings;
    checkwarn(result,text);
    return result;
  }
}
Object for clang on iOS
//[clang_iOS_generic.flx]
include "std/felix/toolchain_interface";
include "std/felix/toolchain_config";
include "std/felix/flx_cxx";

object toolchain_clang_apple_iOS_maker (sdk_tag:string, archs:list[string])
  (config:toolchain_config_t) implements toolchain_t =
{
  //eprintln$ "toolchain_clang_apple_iOS_maker sdk=" + sdk_tag + ", arches=" + archs.str;
  gen get (s:string):string = {
    var err, res = System::get_stdout s;
    if err != 0 do
      var msg = "Abort: Error executing shell command " + s;
      eprintln$ msg;
      System::abort;
    done
    return res;
  }

  var clang = strip(get("xcrun --sdk " + sdk_tag + " --find clang"));
  var clangxx = strip(get("xcrun --sdk " + sdk_tag + " --find clang++"));
  var sdk = strip(get("xcrun --sdk " + sdk_tag + " --show-sdk-path"));

  //eprintln$ "C compiler " + clang;
  //eprintln$ "C++ compiler " + clangxx;
  //eprintln$ "sdk path " + sdk;

  var cxx_compile_warning_flags = list$
    "-w", // turn off all the warnings (but not hard errors)
    "-Wfatal-errors", // stop compiling on the first hard error
    "-Wno-return-type-c-linkage",
    "-Wno-invalid-offsetof"
  ;
  var c_compile_warning_flags = list$ "-w",
    "-Wfatal-errors",
    "-Wno-array-bounds"
  ;

  var c_compiler = clang;
  var cxx_compiler = clangxx;
  var linker = clangxx;
  var archlist = rev (fold_left (fun (acc:list[string]) (arch:string) => arch ! "-arch" ! acc) Empty[string] archs);

  var ccflags_for_dynamic_link = list[string]("-dynamiclib", "-isysroot", sdk) + archlist;
  var base_c_compile_flags =
    "-g"! "-c" ! "-isysroot" ! sdk ! "-O1" !
    "-fno-common"! "-fno-strict-aliasing" ! "-fembed-bitcode" !
    (archlist + c_compile_warning_flags+config.ccflags)
  ;
  var base_cxx_compile_flags =
    "-g"! "-c" ! "-isysroot" ! sdk ! "-O1" !
    "-fno-common"! "-fno-strict-aliasing" ! "-fembed-bitcode" ! "-std=c++14" !
    (archlist + cxx_compile_warning_flags+config.ccflags)
  ;

  method fun whatami () => "toolchain_clang_apple_iOS sdk="+sdk_tag+", archs="+cat "," archs;
  method fun host_os () => "OSX";
  method fun target_os () => "iOS";
  method fun cxx_compiler_vendor () => "clang";

  method fun dependency_extension () => ".d";
  method fun executable_extension () => "";
  method fun static_object_extension () => "_static.o";
  method fun dynamic_object_extension () => "_dynamic.o";
  method fun static_library_extension () => ".a";
  method fun dynamic_library_extension () => ".dylib";
  method fun pathname_separator () => "/";
  method fun debug_flags () => list[string] "-g";
  method fun get_base_c_compile_flags () => base_c_compile_flags;
  method fun get_base_cxx_compile_flags () => base_cxx_compile_flags;

// Boilerplate

  method gen c_dependency_generator (spec:(src:string)) : int * string =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=c_compiler,
          CCFLAGS = "-isysroot" ! sdk ! "-MM" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result,  data;
  }

  method gen cxx_dependency_generator (spec:(src:string)) : int * string =
  {
     var result, data =
       CxxCompiler::generic_cxx_gen_deps
       (
          CCDEP=cxx_compiler,
          CCFLAGS = "-std=c++14" ! "-isysroot" ! sdk ! "-MM" ! config.ccflags,
          INCLUDE_DIRS=config.header_search_dirs,
          MACROS=config.macros,
          debugln = config.debugln
       )
       (spec.src)
     ;
     return result, data;
  }

  method gen dependency_parser (data:string) : list[string] =>
     CxxCompiler::generic_dependency_parser data
  ;

  method gen c_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = c_compiler,
        CCFLAGS = base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen c_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = c_compiler,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_c_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_static_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen cxx_static_library_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_static
      (
        CCOBJ_STATIC_LIB = cxx_compiler,
        CCFLAGS = base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = "FLX_STATIC_LINK"+config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }


  method gen cxx_dynamic_object_compiler (spec:(dst:string, src:string)) : int =
  {
    var result =
      CxxCompiler::generic_cxx_compile_for_dynamic
      (
        CCOBJ_DLLIB = linker,
        CCFLAGS = "-fPIC" ! "-fvisibility=hidden" ! base_cxx_compile_flags,
        INCLUDE_DIRS = config.header_search_dirs,
        MACROS = config.macros,
        SPEC_OBJ_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.src, spec.dst)
    ;
    return result;
  }

  method gen static_library_linker (spec:(dst:string, srcs:list[string])): int =
  {
    var result =
      CxxCompiler::generic_static_library
      (
        CCLINK_STATIC_LIB = "libtool",
        CCFLAGS = list[string]("-static"),
        SPEC_LIB_FILENAME = "-o ",
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen static_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_static
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.static_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }

  method gen dynamic_executable_linker  (spec:(dst:string, srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_exe_dynamic
      (
        CCLINK_STATIC = linker,
        CCFLAGS = Empty[string],
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }


  method gen dynamic_library_linker (spec:(dst:string,srcs:list[string])) : int =
  {
    var result =
      CxxCompiler::generic_link_lib_dynamic
      (
        CCLINK_DLLIB = linker,
        CCFLAGS = ccflags_for_dynamic_link,
        EXT_SHARED_OBJ = #dynamic_library_extension,
        SPEC_EXE_FILENAME = "-o ",
        LINK_STRINGS = config.library_search_dirs + config.dynamic_libraries,
        debugln = config.debugln
      )
      (spec.srcs, spec.dst)
    ;
    return result;
  }
}

gen toolchain_clang_apple_iPhoneOS_armv7_arm64 (config:toolchain_config_t) : toolchain_t =>
  toolchain_clang_apple_iOS_maker ("iphoneos",(["armv7","arm64"])) config
;

gen toolchain_clang_apple_iPhoneSimulator (config:toolchain_config_t) : toolchain_t = {
  return toolchain_clang_apple_iOS_maker ("iphonesimulator",(["x86_64","i386"])) config;
}

Toolchain Plugins

These are wrappers around the toolchain objects previously defined which convert them from objects into plugins, that is, which provide the architectural support for separate compilation and loading of binary shared libraries (DLLs).

The MSVC++ plugin for Windows is missing because the object implementing it is only a stub.

iPhone Plugin
//[toolchain_iphoneos.flx]
include "std/felix/toolchain/clang_iOS_generic";

// varies macosx vs linus,  gcc vs clang

export fun toolchain_clang_apple_iPhoneOS_armv7_arm64 of (toolchain_config_t) as "toolchain_iphoneos";

fun setup(config_data:string) = {
   C_hack::ignore (config_data); // due to bug in Felix
  eprintln$ "Setup toolchain iphoneos " + config_data;
  return 0;
}

export fun setup of (string) as "toolchain_iphoneos_setup";

//[toolchain_iphonesimulator.flx]
include "std/felix/toolchain/clang_iOS_generic";

// varies macosx vs linus,  gcc vs clang

export fun toolchain_clang_apple_iPhoneSimulator of (toolchain_config_t) as "toolchain_iphonesimulator";

fun setup(config_data:string) = {
   C_hack::ignore (config_data); // due to bug in Felix
  eprintln$ "Setup toolchain iphonesimulator " + config_data;
  return 0;
}

export fun setup of (string) as "toolchain_iphonesimulator_setup";
Plugin for gcc on Linux
//[toolchain_gcc_linux.flx]
include "std/felix/toolchain/gcc_linux";

export fun toolchain_gcc_linux of (toolchain_config_t) as "toolchain_gcc_linux";

fun setup(config_data:string) = {
   C_hack::ignore (config_data); // due to bug in Felix
  //eprintln$ "Setup toolchain gcc_linux " + config_data;
  return 0;
}

export fun setup of (string) as "toolchain_gcc_linux_setup";
Plugin for gcc on OSX
//[toolchain_gcc_macosx.flx]
include "std/felix/toolchain/gcc_macosx";

export fun toolchain_gcc_macosx of (toolchain_config_t) as "toolchain_gcc_macosx";

fun setup(config_data:string) = {
   C_hack::ignore (config_data); // due to bug in Felix
  //eprintln$ "Setup toolchain gcc+macosx " + config_data;
  return 0;
}

export fun setup of (string) as "toolchain_gcc_macosx_setup";
Plugin for clang on Linux
//[toolchain_clang_linux.flx]
include "std/felix/toolchain/clang_linux";

// varies macosx vs linus,  gcc vs clang

export fun toolchain_clang_linux of (toolchain_config_t) as "toolchain_clang_linux";


fun setup(config_data:string) = {
   C_hack::ignore (config_data); // due to bug in Felix
  //eprintln$ "Setup toolchain clang_linux " + config_data;
  return 0;
}

export fun setup of (string) as "toolchain_clang_linux_setup";
Plugin for clang on OSX
//[toolchain_clang_macosx.flx]
include "std/felix/toolchain/clang_macosx";

// varies macosx vs linus,  gcc vs clang

export fun toolchain_clang_macosx of (toolchain_config_t) as "toolchain_clang_macosx";

fun setup(config_data:string) = {
   C_hack::ignore (config_data); // due to bug in Felix
  //eprintln$ "Setup toolchain clang_macosx " + config_data;
  return 0;
}

export fun setup of (string) as "toolchain_clang_macosx_setup";
MSVC++ Plugin for Win32
//[toolchain_msvc_win.flx]
include "std/felix/toolchain/msvc_win";

// varies macosx vs linus,  gcc vs clang

export fun toolchain_msvc_win of (toolchain_config_t) as "toolchain_msvc_win";

fun setup(config_data:string) = {
   C_hack::ignore (config_data); // due to bug in Felix
  //eprintln$ "Setup toolchain msvc_win " + config_data;
  return 0;
}

export fun setup of (string) as "toolchain_msvc_win_setup";

Flx Plugin

A wrapper around “flx” command.

//[flx_plugin.flx]
include "std/felix/flx/flx";
export fun flx_plugin_setup(x:string)=>0;
export fun flx_plugin (args:list[string]) = { return Flx::runflx (args); }

Package: src/packages/concordance.fdoc

key file
concordance.flxh share/lib/concordance/concordance.flxh
concordance.ml $PWD/src/compiler/flx_core/flx_concordance.ml
concordance_check.flx $PWD/concordance_check.flx

Concordance

Concordance

The concordance allows the Felix compiler flxg to access symbols defined in the library.

Currently only C bindings are supported. The requirements of the form @r@e@q@u@i@r@e@s@ @i@n@d@e@x@ @2@0@1@@@ @o@r@ @@@r@e@q@u@i@r@e@s@ @i@n@d@e@x@ @n@a@m@e@@@ @a@r@e@ @a@d@d@e@d to the bindings. The macro processor will try to replaced named indices with literal integers by using the usual macro processing process.

The compiler will then add the symbols to the symbol table with the specified numerical index. Values in the range 200-2000 are currenly reserved for the concordance indices.

The compiler itself contains an Ocaml file which binds symbolic names to integers, allowing the compiler to find specified symbols in the symbol table without doing the usual name based lookup.

To make this work, we put all the macros we need in a single file to ease maintenance. The compiler will be told to load this file by the command line harness.

Down the track, the compiler concordance.ml file will have to be here too, and down the track again, a single Python program will be used to generate both concordance files, thereby ensuring that, in fact, they agree.

Felix library concordance macros

macro val FLX_CONCORDANCE_LOADED=true;
// put other things here later when it is working.
macro val TYPE_tiny     = 100;
macro val TYPE_short    = 101;
macro val TYPE_int      = 102;
macro val TYPE_long     = 103;
macro val TYPE_vlong    = 104;
macro val TYPE_utiny    = 105;
macro val TYPE_ushort   = 106;
macro val TYPE_uint     = 107;
macro val TYPE_ulong    = 108;
macro val TYPE_uvlong   = 109;

macro val TYPE_intmax   = 110;
macro val TYPE_uintmax  = 111;
macro val TYPE_size     = 112;
macro val TYPE_ssize    = 113;

macro val CONST_zero    = 200;
macro val FUN_isneg     = 201;
macro val FUN_isnonneg  = 202;
macro val PROC_decr     = 203;

macro val FUN_land      = 210;
macro val FUN_lor       = 211;
macro val FUN_lnot      = 212;

macro val TYPE_int8     = 300;
macro val TYPE_int16    = 301;
macro val TYPE_int32    = 302;
macro val TYPE_int64    = 303;
macro val TYPE_uint8    = 304;
macro val TYPE_uint16   = 305;
macro val TYPE_uint32   = 306;
macro val TYPE_uint64   = 307;

macro val TYPE_uintptr  = 308;
macro val TYPE_intptr   = 309;
macro val TYPE_address  = 310;
macro val TYPE_byte     = 311;
macro val TYPE_ptrdiff  = 312;

macro val TYPE_cbool    = 400;
macro val TYPE_char     = 401;
macro val TYPE_string   = 402;

macro val TYPE_float    = 403;
macro val TYPE_double   = 404;
macro val TYPE_ldouble  = 405;
macro val TYPE_fcomplex = 406;
macro val TYPE_dcomplex = 407;
macro val TYPE_lcomplex = 408;

//[concordance_check.flx]
// if this compiles it should run.
println$ "Checking concordance is loaded";
println$ "Concordance loaded = " + FLX_CONCORDANCE_LOADED.str;

let flx_tiny=100
let flx_short=101
let flx_int=102
let flx_long=103
let flx_vlong=104
let flx_utiny=105
let flx_ushort=106
let flx_uint=107
let flx_ulong=108
let flx_uvlong=109
let flx_zero_int = 200
let flx_isneg_int =201
let flx_isnonneg_int =202
let flx_decr_int = 203
let flx_land = 210
let flx_lor = 211
let flx_lnot = 212

Indices and tables