2.2. Code

Support table.
filebaselanguagenamespacefunction
rtl/flx_i18nC++flx::rtl::i18nutf8 codec support
rtl/flx_strutilC++flx::rtl::strutilPython style substring support
rtl/flx_ioutilC++flx::rtl::ioutilStandard IO support
lib/stdFelixStandard Library
lib/stlFelixSTL support
Start cpp section to rtl/flx_ioutil.hpp[1 /1 ]
     1: #line 57 "./lpsrc/flx_lib.ipk"
     2: #ifndef FLX_IOUTIL
     3: #define FLX_IOUTIL
     4: #include <string>
     5: #include <cstdio>
     6: #include "flx_rtl_config.hpp"
     7: 
     8: namespace flx { namespace rtl { namespace ioutil {
     9:   RTL_EXTERN std::string load_file (std::FILE *);
    10:   RTL_EXTERN std::string load_file (std::string);
    11:   RTL_EXTERN std::string readln(std::FILE*);
    12:   RTL_EXTERN void write (std::FILE *, std::string);
    13:   RTL_EXTERN void writeln (std::FILE *, std::string);
    14: }}}
    15: #endif
    16: 
End cpp section to rtl/flx_ioutil.hpp[1]
Start cpp section to rtl/flx_ioutil.cpp[1 /1 ]
     1: #line 74 "./lpsrc/flx_lib.ipk"
     2: #include <cstdio>
     3: #include <string>
     4: #include "flx_ioutil.hpp"
     5: namespace flx { namespace rtl { namespace ioutil {
     6:   using namespace std;
     7: 
     8:   string load_file (FILE *fi)
     9:   {
    10:     if (fi)
    11:     {
    12:       string x = "";
    13:       char buffer[512];
    14:       while (fgets(buffer,512,fi))
    15:         x = x + string(buffer);
    16:       fclose(fi);
    17:       return x;
    18:     }
    19:     else return "";
    20:   }
    21: 
    22:   string load_file (string f)
    23:   {
    24:     char const *fname = f.data();
    25:     FILE *fi = fopen(fname,"rt");
    26:     if (fi)
    27:     {
    28:       string x = "";
    29:       char buffer[512];
    30:       while (fgets(buffer,512,fi))
    31:         x = x + string(buffer);
    32:       fclose(fi);
    33:       return x;
    34:     }
    35:     else return "";
    36:   }
    37: 
    38:   // includes newline if present
    39:   // null string indicates end of file
    40:   string readln (FILE *fi)
    41:   {
    42:     if(fi)
    43:     {
    44:       string x = "";
    45:       char buffer[513];
    46:       buffer[512]='\0';
    47:       int n;
    48:       while
    49:       (
    50:         !(
    51:           (n=x.size()) &&
    52:           x[n-1]=='\n'
    53:         )
    54:         &&
    55:         fgets(buffer,512,fi)
    56:       )
    57:         x = x + string(buffer);
    58:       return x;
    59:     }
    60:     else return "";
    61:   }
    62: 
    63:   void write (FILE *fi, string s)
    64:   {
    65:     fwrite(s.data(),s.size(),1,fi);
    66:   }
    67: 
    68:   void writeln (FILE *fi, string s)
    69:   {
    70:     static char *eol = "\n";
    71:     static int n = 0;
    72:     if(n==0)n=strlen(eol);
    73:     fwrite(s.data(),s.size(),1,fi);
    74:     fwrite(eol,n,1,fi);
    75:   }
    76: 
    77: }}}
    78: 
End cpp section to rtl/flx_ioutil.cpp[1]
Start cpp section to rtl/flx_strutil.hpp[1 /1 ]
     1: #line 153 "./lpsrc/flx_lib.ipk"
     2: #include <string>
     3: #include <sstream>
     4: #include <stdarg.h>
     5: 
     6: #include "flx_rtl_config.hpp"
     7: 
     8: //RF: was only to commented out to fix macosx problem,
     9: //but lets see what happens to all the other builds.
    10: //#ifndef MACOSX
    11: //template class RTL_EXTERN std::basic_string<char>;
    12: //#endif
    13: 
    14: namespace flx { namespace rtl { namespace strutil {
    15:   using namespace std;
    16:   template<class T>
    17:   basic_string<T> mul(basic_string<T> s, int n) {
    18:     basic_string<T> r = "";
    19:     while(n--) r+=s;
    20:     return r;
    21:   }
    22: 
    23:   // normalise string positions Python style
    24:   // note substr requires 0<=b<=size, 0<=n,
    25:   // however n>size is OK
    26:   template<class T>
    27:   basic_string<T> substr(basic_string<T> const &s, int b, int e)
    28:   {
    29:     int n = s.size();
    30:     if(b<0)  b=b+n;
    31:     if(b<0)  b=0;
    32:     if(b>=n) b=n;
    33:     if(e<0)  e=e+n;
    34:     if(e<0)  e=0;
    35:     if(e>=n) e=n;
    36:     int m =  e-b;
    37:     if(m<0)  m=0;
    38:     return s.substr(b,m);
    39:   }
    40: 
    41:   template<class T>
    42:   T subscript(basic_string<T> const &s, int i)
    43:   {
    44:     int n = s.size();
    45:     if(i<0)  i=i+n;
    46:     return i<0 || i >= n ? T(0) : s[i];
    47:   }
    48: 
    49:   template<class T>
    50:   string str(T const &t) {
    51:     std::ostringstream x;
    52:     x << t;
    53:     return x.str();
    54:   }
    55: 
    56:   RTL_EXTERN string atostr(char const *a);
    57:   RTL_EXTERN string ltrim(string const &x);
    58:   RTL_EXTERN string rtrim(string const &x);
    59:   RTL_EXTERN string flx_asprintf(char *fmt,...);
    60: 
    61: }}}
    62: 
End cpp section to rtl/flx_strutil.hpp[1]
Start cpp section to rtl/flx_strutil.cpp[1 /1 ]
     1: #line 216 "./lpsrc/flx_lib.ipk"
     2: #include "flx_strutil.hpp"
     3: 
     4: namespace flx { namespace rtl { namespace strutil {
     5: 
     6:   string atostr(char const *a) {
     7:     if(a) return a;
     8:     else return "";
     9:   }
    10: 
    11:  string ltrim(string const &x) {
    12:    int n = x.size();
    13:    int i;
    14:    for(i = 0; i < n; ++i)
    15:      if(x[i]>' ')break;
    16:    return x.substr(i,n-i);
    17:  }
    18: 
    19:  string rtrim(string const &x) {
    20:    int n = x.size();
    21:    int i;
    22:    for(i = n; i > 0; --i)
    23:      if(x[i-1]>' ')break;
    24:    return x.substr(0,i);
    25:  }
    26: 
    27: #ifdef HAVE_VSNPRINTF
    28:   string flx_asprintf(char *fmt,...){
    29:     va_list ap;
    30:     va_start(ap,fmt);
    31:     int n = vsnprintf(NULL,0,fmt,ap);
    32:     va_end(ap);
    33:     char *res = (char*)malloc(n+1);
    34:     va_start(ap,fmt);
    35:     vsnprintf(res,n+1,fmt,ap);
    36:     va_end(ap);
    37:     string s = string(res);
    38:     free(res);
    39:     return s;
    40:   }
    41: #else
    42:   // THIS IS UNSAFE .. but Windows sucks.
    43:   // It documents vsnprintf .. but doesn't provide it
    44:   string flx_asprintf(char *fmt,...){
    45:     va_list ap;
    46:     int n = 1000;
    47:     char *res = (char*)malloc(n+1);
    48:     va_start(ap,fmt);
    49:     vsprintf(res,fmt,ap);
    50:     va_end(ap);
    51:     string s = string(res);
    52:     free(res);
    53:     return s;
    54:   }
    55: #endif
    56: 
    57: }}}
    58: 
End cpp section to rtl/flx_strutil.cpp[1]
Start data section to lib/flx_categories.flxh[1 /1 ]
     1:   macro proc gen_eq(t){
     2:     fun eq: t * t -> bool = "$1==$2" ;
     3:     fun ne: t * t -> bool = "$1!=$2" ;
     4:   }
     5: 
     6:   macro proc gen_cmp(t){
     7:     gen_eq t;
     8:     fun lt: t * t -> bool = "$1<$2" ;
     9:     fun gt: t * t -> bool = "$1>$2" ;
    10:     fun le: t * t -> bool = "$1<=$2" ;
    11:     fun ge: t * t -> bool = "$1>=$2" ;
    12:   }
    13: 
    14:   // additive group
    15:   macro proc gen_add (t){
    16:     fun pos: t -> t = "+$1" ;
    17:     fun neg: t -> t = "-$1" ;
    18:     fun add: t * t -> t = "$1+$2" ;
    19:     fun sub: t * t -> t = "$1-$2" ;
    20:     proc pluseq: lvalue[t] * t = "$1+=$2;";
    21:     proc minuseq: lvalue[t] * t = "$1-=$2;";
    22:   }
    23: 
    24:   // ring
    25:   macro proc gen_arith(t){
    26:     gen_add t;
    27:     fun mul: t * t -> t = "$1*$2" ;
    28:     fun div: t * t -> t = "$1/$2" ;
    29:     proc muleq: lvalue[t] * t = "$1*=$2;";
    30:     proc diveq: lvalue[t] * t = "$1/=$2;";
    31:   }
    32: 
    33:   // division ring
    34:   macro proc gen_dring(t){
    35:     gen_arith t;
    36:     fun mod : t * t -> t = "$1%$2" ;
    37:     proc modeq: lvalue[t] * t = "$1%=$2;";
    38:   }
    39: 
    40:   macro proc gen_forward (t){
    41:     fun succ: t -> t = "$1:add + 1" is add;
    42:     proc pre_incr:  lvalue[t] = "++$1;";
    43:     proc post_incr: lvalue[t] = "$1++;";
    44:   }
    45: 
    46:   macro proc gen_bidirectional(t){
    47:     gen_forward t;
    48:     fun pred: t -> t = "$1:add - 1" is add;
    49:     proc pre_decr:  lvalue[t] = "--$1;";
    50:     proc post_decr: lvalue[t] = "$1--;";
    51:   }
    52: 
    53:   macro proc gen_random(t){
    54:     gen_bidirectional t;
    55:     fun add: t * int -> t = "$1+$2";
    56:     fun sub: t * int -> t = "$1-$2";
    57:     proc pluseq: lvalue[t] * int = "$1+=$2;";
    58:     proc minuseq: lvalue[t] * int = "$1-=$2;";
    59:   }
    60: 
    61:   // division ring
    62:   macro proc gen_integral(t){
    63:     gen_cmp t;
    64:     gen_dring t;
    65:     gen_bidirectional t;
    66:   }
    67: 
End data section to lib/flx_categories.flxh[1]
Start data section to lib/flx.flxh[1 /1 ]
     1: #import <flx_syntax.flxh>
     2: #import <flx_macros.flxh>
     3: include "std";
     4: 
     5: macro val true = case 1 of 2;
     6: macro val false = case 0 of 2;
     7: macro fun print_line (x) = { fprint (cout,x); Stdout::endl cout; };
     8: macro fun print(x) = { fprint (cout,x); };
     9: 
End data section to lib/flx.flxh[1]
Start data section to lib/flx_syntax.flxh[1 /1 ]
     1: #infix 10 "/\\" wedge
     2: #infix 10 "\\/" vee
     3: 
     4: #statement#
     5:   whilst expr do statements done ; =>#
     6:   macro {
     7:     macro lab1 is new;
     8:     macro lab2 is new;
     9:     lab1:>
    10:       if not _1 goto lab2;
    11:       _3;
    12:       goto lab1;
    13:     lab2:>
    14:   };
    15: #
    16: 
    17: #statement#
    18:   until expr do statements done; =>#
    19:   macro {
    20:     macro lab1 is new;
    21:     macro lab2 is new;
    22:     lab1:>
    23:       if _1 goto lab2;
    24:       _3;
    25:       goto lab1;
    26:     lab2:>
    27:   };
    28: #
    29: 
    30: #statement#
    31:   forall ident in expr do statements done ; =>#
    32:     macro for val _2 in _3 do _5; done;
    33: #
    34: 
    35: #keyword upto
    36: #statement#
    37:   forall ident in expr upto expr do statements done ; =>#
    38:   _1 = _3;
    39:   whilst _1 <= _5 do _7; ++_1; done;
    40: #
    41: 
    42: #keyword downto
    43: #statement#
    44:   forall ident in expr downto expr do statements done ; =>#
    45:   _1 = _3;
    46:   whilst _1 >= _5 do _7; --_1; done;
    47: #
    48: 
    49: #statement publish #
    50:   string_literal statement =># _2;
    51: #
    52: 
End data section to lib/flx_syntax.flxh[1]
Start data section to lib/flx_platform.flxh[1 /1 ]
     1: #define true case 1 of 2
     2: #define false case 0 of 2
     3: 
     4: #define WIN32 false
     5: #define POSIX true
     6: #define LINUX true
     7: #define MACOSX false
     8: #define CYGWIN false
     9: #define SOLARIS false
    10: #define BSD false
    11: 
    12: macro val true = case 1 of 2;
    13: macro val false = case 0 of 2;
    14: 
    15: macro val WIN32 = false;
    16: macro val POSIX = true;
    17: macro val LINUX = true;
    18: macro val MACOSX = false;
    19: macro val CYGWIN = false;
    20: macro val SOLARIS = false;
    21: macro val BSD = false;
End data section to lib/flx_platform.flxh[1]
Start data section to lib/std.flx[1 /1 ]
     1: #import <flx_syntax.flxh>
     2: #import <flx_categories.flxh>
     3: #import <flx_platform.flxh>
     4: #import <flx_macros.flxh>
     5: 
     6: header '#include "flx_rtl_config.hpp"';
     7: 
     8: header iostream = "#include <iostream>";
     9: header cmath = """
    10: #include <cmath>
    11: #ifdef HAVE_ISNAN_IN_IEEEFP
    12: extern "C" {
    13: #include <ieeefp.h>
    14: }
    15: #endif
    16: """;
    17: 
    18: header """
    19: #include <cstdio>
    20: #include <cstddef>
    21: #include <cassert>
    22: #include <climits>
    23: using namespace std;
    24: """;
    25: 
    26: header flx_ioutil = '#include "flx_ioutil.hpp"';
    27: header flx_dynlink = '#include "flx_dynlink.hpp"';
    28: header flx_i18n = '#include "flx_i18n.hpp"';
    29: header stdexcept = '#include <stdexcept>';
    30: 
    31: // note -- this code is templated, we include
    32: // it in the header file because that's where
    33: // most C++ compilers need it (ISO requires
    34: // separate compilation of templates but most
    35: // compilers as at 2004 don't implement it)
    36: 
    37: header flx_strutil = '#include "flx_strutil.hpp"';
    38: 
    39: header cctype_hxx = '#include <cctype>';
    40: header string_hxx = '#include <string>';
    41: header complex_hxx = '#include <complex>';
    42: header c99_complex_h = '#include <complex.h>';
    43: 
    44: header c99_stdint_h = "#include <stdint.h>";
    45: header cstdlib = "#include <cstdlib>";
    46: header cstring = "#include <cstring>";
    47: 
    48: 
    49: 
    50: pod type byte = "unsigned char";
    51: pod type address = "void *";
    52: pod type caddress = "void const*";
    53: pod type vaddress = "void volatile*";
    54: pod type cvaddress = "void const volatile*";
    55: pod type offset = "ptrdiff_t";
    56: pod type char = "char";
    57: pod type wchar = "wchar_t";
    58: pod type uchar = "int32_t";
    59: pod type tiny = "signed char";
    60: pod type short = "short";
    61: pod type int = "int";
    62: pod type long = "long";
    63: pod type vlong = "long long";
    64: pod type utiny = "unsigned char";
    65: pod type ushort = "unsigned short";
    66: pod type uint = "unsigned int";
    67: pod type ulong = "unsigned long";
    68: pod type uvlong = "unsigned long long";
    69: pod type float = "float";
    70: pod type double = "double";
    71: pod type ldouble = "long double";
    72: pod type complex = "float _Complex" requires c99_complex_h;
    73: pod type dcomplex = "double _Complex" requires c99_complex_h;
    74: pod type lcomplex = "long double _Complex" requires c99_complex_h;
    75: pod type imaginary = "float _Imaginary" requires c99_complex_h;
    76: pod type dimaginary = "double _Imaginary" requires c99_complex_h;
    77: pod type limaginary = "long double _Imaginary" requires c99_complex_h;
    78: _gc_pointer type gcaddress = "void*";
    79: _gc_pointer type gcptr[t]= "?1*";
    80: 
    81: 
    82: typedef ptrdiff = int;
    83: typedef size = uint;
    84: typedef int8 = tiny;
    85: rename Int8 = Tiny;
    86: typedef int16 = short;
    87: rename Int16 = Short;
    88: typedef int32 = int;
    89: rename Int32 = Int;
    90: typedef int64 = vlong;
    91: rename Int64 = Vlong;
    92: typedef uint8 = utiny;
    93: rename Uint8 = Utiny;
    94: typedef uint16 = ushort;
    95: rename Uint16 = Ushort;
    96: typedef uint32 = uint;
    97: rename Uint32 = Uint;
    98: typedef uint64 = uvlong;
    99: rename Uint64 = Uvlong;
   100: typedef chars = typesetof (char, wchar, uchar);
   101: 
   102: typedef fast_sints = typesetof (tiny, short, int, long, vlong);
   103: typedef exact_sints = typesetof(int8,int16,int32,int64);
   104: typedef fast_uints = typesetof (utiny, ushort, uint, ulong,uvlong);
   105: typedef exact_uints = typesetof (uint8,uint16,uint32,uint64);
   106: 
   107: typedef sints = fast_sints || exact_sints;
   108: typedef uints = fast_uints || exact_uints;
   109: 
   110: typedef fast_ints = fast_sints || fast_uints;
   111: typedef exact_ints = exact_sints || exact_uints;
   112: 
   113: typedef ints = sints || uints;
   114: 
   115: typedef floats = typesetof (float, double, ldouble);
   116: typedef reals = ints || floats;
   117: 
   118: typedef complexes = typesetof (complex,dcomplex,lcomplex);
   119: typedef imaginaries = typesetof (imaginary, dimaginary, limaginary);
   120: 
   121: typedef numbers = reals || imaginaries || complexes;
   122: 
   123: // C integer promotion rule
   124: typedef fun integral_promotion: TYPE -> TYPE =
   125:   | tiny => int
   126:   | utiny => int
   127:   | short => int
   128:   | ushort => int
   129:   | int => int
   130:   | uint => uint
   131:   | long => long
   132:   | ulong => ulong
   133:   | vlong => vlong
   134:   | uvlong => uvlong
   135: ;
   136: 
   137: // arithmetic conversion rule
   138: typedef fun arithmax(l: TYPE, r: TYPE): TYPE =>
   139:   typematch integral_promotion l, integral_promotion r with
   140:   | vlong,vlong => vlong 
   141:   | vlong,ulong => vlong 
   142:   | vlong,int => vlong 
   143:   | vlong,long => vlong 
   144:   | vlong,uint => vlong 
   145:   | ulong,vlong => uvlong // SPECIAL PROMOTION
   146:   | ulong,ulong => uint // SPECIAL PROMOTION
   147:   | ulong,int => uint // SPECIAL PROMOTION
   148:   | ulong,long => uint // SPECIAL PROMOTION
   149:   | ulong,uint => uint 
   150:   | int,vlong => vlong 
   151:   | int,ulong => uint // SPECIAL PROMOTION
   152:   | int,uint => uint 
   153:   | long,vlong => vlong 
   154:   | long,ulong => uint // SPECIAL PROMOTION
   155:   | long,uint => uint // Representation Dependent (long or ulong)
   156:   | uint,vlong => uvlong // SPECIAL PROMOTION
   157:   | uint,ulong => uint 
   158:   | uint,int => uint 
   159:   | uint,long => uint // Representation Dependent (long or ulong)
   160:   | uint,uint => uint 
   161:   | uvlong,_ => uvlong
   162:   | _,uvlong => uvlong
   163:   | _,_ => int
   164:   endmatch
   165: ;
   166: 
   167: body swapper[t] = """
   168:   void swapper(?1 &a, ?1 &b){
   169:     ?1 tmp = a; a = b; b = tmp;
   170:   }
   171: """;
   172: 
   173: proc _swap[t]: lvalue[t] * lvalue[t] =
   174:   "swapper($1,$2);"
   175:   requires swapper[t];
   176: 
   177: typedef charp = C_hack::ptr[char];
   178: typedef charcp = C_hack::cptr[char];
   179: 
   180: typedef ucharp = C_hack::ptr[utiny];
   181: typedef ucharcp = C_hack::cptr[utiny];
   182: 
   183: publish "Empty sum"
   184:   typedef void = 0;
   185: 
   186: publish "Unit type"
   187:   typedef unit = 1;
   188: 
   189: publish "Boolean"
   190:   typedef bool = 2;
   191: 
   192: publish "option type"
   193:   union opt[T] =
   194:     | None
   195:     | Some of T
   196:   ;
   197: 
   198: publish "Universal type 'x as x'"
   199:   typedef any = any;
   200: 
   201: publish "Lvalue hack"
   202:   typedef lvalue[t] = lval t;
   203: 
   204: publish "Deref hack"
   205:   inline fun deref[t](p:&t):lval t => _deref p;
   206: 
   207: module Typing
   208: {
   209:   typedef fun dom(t:TYPE):TYPE =>
   210:     typematch t with
   211:     | ?a -> _ => a
   212:     endmatch
   213:   ;
   214: 
   215:   typedef fun cod(t:TYPE):TYPE =>
   216:     typematch t with
   217:     | _ -> ?b => b
   218:     endmatch
   219:   ;
   220: 
   221:   typedef fun prj1(t:TYPE):TYPE =>
   222:     typematch t with
   223:     | ?a * _ => a
   224:     endmatch
   225:   ;
   226: 
   227:   typedef fun prj2(t:TYPE):TYPE =>
   228:     typematch t with
   229:     | _ * ?b => b
   230:     endmatch
   231:   ;
   232: 
   233:   typedef fun land(x:TYPE, y:TYPE):TYPE =>
   234:     typematch (x,  y) with
   235:     | 0, _ => 0
   236:     | _,0 => 0
   237:     | _,_ => 1
   238:     endmatch
   239:   ;
   240: 
   241:   typedef fun lor(x:TYPE, y:TYPE):TYPE=>
   242:     typematch (x,  y) with
   243:     | 0, 0 => 0
   244:     | _,_ => 1
   245:     endmatch
   246:   ;
   247: 
   248:   const memcount[t] : int = "#memcount";
   249: }
   250: 
   251: publish """
   252: This module provides access to raw C/C++ encodings.
   253: Incorrect typing is likely to pass by Felix and
   254: be trapped by the C/C++ compiler. Incorrect management
   255: of storage can lead to corruption. The use of the
   256: C_hack module is necessary for interfacing.
   257: """
   258: module C_hack
   259: {
   260:   publish "C void"
   261:   incomplete type void_t = "void";
   262: 
   263:   publish "standard variable argument list pointer type"
   264:   type va_list = "va_list";
   265: 
   266:   publish """
   267:   GCC specific valist thingo: it will
   268:   be optimised away if not used (eg on MSVC)
   269:   """
   270:   type __builtin_va_list = '__builtin_va_list';
   271: 
   272:   publish """
   273:   Throw away result of a function call:
   274:   only useful for C functions that are mainly
   275:   called for side effects.
   276:   """
   277:   proc ignore[t]:t = "(void)$t;";
   278: 
   279:   fun cast[dst,src]: src->dst = '(?1)($1)';
   280:   fun static_cast[dst,src]: src->dst = 'static_cast<?1>($1)';
   281:   fun dynamic_cast[dst,src]: src->dst = 'dynamic_cast<?1>($1)';
   282:   fun reinterpret_cast[dst,src]: src->dst = 'reinterpret_cast<?1>($1)';
   283:   fun reinterpret[dst,src]: src->dst = "reinterpret<?1>($1)";
   284:   const sizeof[t]:size = 'sizeof(?1)';
   285:   fun int_of:size->int='$1';
   286:   fun size_of:int->size='$1';
   287: 
   288:   fun eq: address * address -> bool = "$1==$2";
   289:   fun ne: address * address -> bool = "$1!=$2";
   290: 
   291:   publish "Abstract type for C pointer"
   292:   pod type ptr[t]="?1 *";
   293: 
   294:   publish "Abstract type for C pointer to const"
   295:   pod type cptr[t]="?1 const *";
   296: 
   297:   publish "Convert pointer to pointer to const"
   298:   fun enconst[t]: ptr[t]->cptr[t] = "(?1 const*)$1";
   299: 
   300:   publish """
   301:   Unsafe function to get C pointer from Felix reference.
   302:   The pointer may dangle if the collector deletes the
   303:   frame containing the object.
   304:   """
   305:   fun unref[t]: &t->ptr[t] = "(?1*)($1.get_data())";
   306: 
   307:   publish """
   308:   Function to make Felix reference from C pointer.
   309:   This function is only safe if the C pointer
   310:   was not allocated by the Felix collector:
   311:   the resulting reference will never be collected
   312:   (because the frame pointer is set to 0)
   313:   """
   314:   fun mkref[t]: ptr[t]->&t = "(#0 const&)flx::rtl::_ref_(0,(void*)$1-NULL)";
   315: 
   316:   publish """
   317:   Dereference a C pointer. If the expression is an
   318:   an lvalue, the result is an lvalue. Assignments
   319:   to const lvalues are trapped by the C/C++ compiler.
   320:   """
   321:   fun deref[t]: ptr[t] -> lvalue[t] = "*$1";
   322:   fun deref[t]: cptr[t] -> lvalue[t] = "*$1";
   323:   fun deref[t]: gcptr[t] -> lvalue[t] = "*$1";
   324: 
   325:   publish """
   326:   Function to take the address of a C lvalue,
   327:   fails in C/C++ compiler if the argument isn't an lvalue.
   328:   Addresses of Felix variables are safe to use provided the
   329:   containing frame won't be collected.
   330:   Addresses of temporaries must not be taken.
   331:   """
   332:   fun addr[t]: lvalue[t] -> ptr[t] = "&$1";
   333:   fun caddr[t]: lvalue[t] -> cptr[t] ="(?1 const*)&$1";
   334:   fun as_address[t]: ptr[t]->address = "(void*)$1";
   335:   fun address_of[t]: lvalue[t]-> address = "(void*)&$1";
   336:   fun isNULL: address -> bool = "(NULL==$1)";
   337:   fun isNULL[t]: ptr[t] -> bool = "(NULL==$1)";
   338:   fun isNULL[t]: cptr[t] -> bool = "(NULL==$1)";
   339:   fun isNULL[t]: gcptr[t] -> bool = "(NULL==$1)";
   340: 
   341:   publish """
   342:   Polymorphic null pointer constant
   343:   """
   344:   const null_ptr[t]:ptr[t] = "(?1*)NULL";
   345:   const null_gcptr[t]:gcptr[t] = "(?1*)NULL";
   346:   const null_cptr[t]:ptr[t] = "(?1 const*)NULL";
   347:   const NULL : address = "NULL";
   348: 
   349:   publish """
   350:   Unsafe output of hopefully null terminated C strings
   351:   """
   352:   proc fprint: ostream * charp = "*$1<<$2;" requires iostream;
   353:   proc fprint: ostream * charcp = "*$1<<$2;" requires iostream;
   354: 
   355:   publish """ print an address in hex """
   356:   proc fprint: ostream * address = "*$1<<$2;" requires iostream;
   357: 
   358:   header dflt_h = "template<class T> T dflt() { return T(); }";
   359:   publish """
   360:   Workaround for g++ 3.2.2 parsing bug,
   361:   it can parse T() as a default ctor call,
   362:   but screws up on (T())
   363:   """
   364:   fun dflt[t]:1->t = "dflt<?1>()" requires dflt_h;
   365: 
   366:   // this hackery is here to force Felix to make
   367:   // a suitable shape object
   368:   private union _dummy[t] = | _new of t;
   369:   private fun _udata[t]: _dummy[t]->gcptr[t] = "(?1*)$1.data";
   370:   fun xnew[t](x:t) => _udata$ _new x;
   371: 
   372:   // raw allocation and deallocation
   373:   fun malloc: int -> address = 'malloc($1)' requires stdlib_h;
   374:   proc free: address = 'free($1);' requires stdlib_h;
   375: }
   376: 
   377: 
   378: // the internal representation of a Felix source location
   379: // has to be global to simplify compiler hack
   380: type flx_location_t = "flx::rtl::flx_range_srcref_t";
   381: 
   382: module Debug
   383: {
   384:   const FLX_SRCLOC : flx_location_t = "#srcloc";
   385:   fun filename: flx_location_t -> charp = "$1.filename";
   386:   fun startline: flx_location_t -> int = "$1.startline";
   387:   fun startcol: flx_location_t -> int = "$1.startcol";
   388:   fun endline: flx_location_t -> int = "$1.endline";
   389:   fun endcol: flx_location_t -> int = "$1.endcol";
   390: 
   391:   // hack to emit C++ source file locations
   392:   const CPP_FUNCTION : charp = "__FUNCTION__";
   393:   const CPP_FILE: charp = "__FILE__";
   394:   const CPP_LINE: int = "__LINE__";
   395: 
   396:   // hack to emit C code an expression would generate
   397:   fun repr_expr[t]: t -> string = '\\"$a:?1\\"';
   398: 
   399:   // hack to emit C typename of a Felix type
   400:   const repr_type[t]:string = '\\"?1\\"';
   401: }
   402: 
   403: module Carray
   404: {
   405:   requires cstdlib;
   406:   open C_hack;
   407: 
   408:   fun array_alloc[t]: int -> ptr[t] = '(?1*)std::malloc(sizeof(?1)*$1)';
   409:   fun array_calloc[t]: int -> ptr[t] = '(?1*)std::calloc(sizeof(?1),$1)';
   410:   proc free[t]: ptr[t]="std::free($1);";
   411:   fun subscript[t]: ptr[t] * int -> lvalue[t] = '$1[$2]';
   412: 
   413:   fun add[t]: ptr[t] * int -> ptr[t]= '$1+$2';
   414:   fun sub[t]: ptr[t] * int -> ptr[t] = '$1-$2';
   415:   fun sub[t]: ptr[t] * ptr[t]-> int = '$1-$2';
   416: 
   417:   proc pre_incr[t]: lvalue[ptr[t]] = '++$1;';
   418:   proc post_incr[t]: lvalue[ptr[t]] = '$1++;';
   419:   proc pre_decr[t]: lvalue[ptr[t]] = '--$1;';
   420:   proc post_decr[t]: lvalue[ptr[t]] = '$1--;';
   421:   proc pluseq[t]: lvalue[ptr[t]] * int = '$1+=$2;';
   422:   proc minuseq[t]: lvalue[ptr[t]] * int = '$1-=$2;';
   423: 
   424: 
   425:   fun eq[t]: ptr[t] * ptr[t] -> bool = '$1==$2';
   426:   fun ne[t]: ptr[t] * ptr[t] -> bool = '$1!=$2';
   427:   fun lt[t]: ptr[t] * ptr[t] -> bool = '$1<$2';
   428:   fun le[t]: ptr[t] * ptr[t] -> bool = '$1<=$2';
   429:   fun gt[t]: ptr[t] * ptr[t] -> bool = '$1>$2';
   430:   fun ge[t]: ptr[t] * ptr[t] -> bool = '$1>=$2';
   431: 
   432:   publish "Convert Felix array to C array"
   433:   fun carray_of[t,n]: t ^ n -> ptr[t] = "$t.data";
   434: 
   435:   publish "Convert C array to Felix array"
   436:   fun array_of[t,n]: ptr[t] -> ptr[t ^ n] = "*(#0*)(void*)$1";
   437: 
   438:   proc memcpy: address * address * size =
   439:     "{if($1 && $2 && $3)std::memcpy($1,$2,$3);}"
   440:     requires cstring
   441:   ;
   442: }
   443: 
   444: publish "System Interface"
   445: module System
   446: {
   447:   const argc:int = "ptf->argc";
   448:   fun argv:int -> string = 'std::string($1<0||$1>=ptf->argc??"":ptf->argv[$1])';
   449:   fun args () => List::map (the argv) (List::range argc);
   450:   const felix_version : string = 'std::string("1.1.2")';
   451:   fun system: string -> int = "std::system($1.data())"
   452:     requires cstdlib;
   453:   proc exit: int = "std::exit($1);";
   454:   proc abort: 1 = "std::abort($1);";
   455:   type ptf_t = "thread_frame_t*";
   456:   const ptf:ptf_t = "ptf";
   457:     // note this will NOT work if ptf is a struct,
   458:     // then we'd need (&ptf) instead ..
   459:     // however this model isn't supported fully yet and probably never will be
   460:     // we may, however, make ptf a machine register
   461: }
   462: 
   463: module Env
   464: {
   465:   fun getenv:string -> string =
   466:     "flx::rtl::strutil::atostr(getenv($1.data()))"
   467:     requires flx_strutil, cstdlib;
   468: }
   469: 
   470: module Dynlink
   471: {
   472:   requires flx_dynlink;
   473:   type flx_library = "flx::rtl::flx_dynlink_t*";
   474:   type flx_instance = "flx::rtl::flx_libinit_t*";
   475:   proc dlopen:flx_library * string = "$1->link($2.data());";
   476:   proc dlclose:flx_library = "$1->unlink();";
   477: 
   478:   // this is a procedure, so maybe the caller is too
   479:   // which means the thread frame must be available
   480:   proc create: flx_library * flx_instance =
   481:     "_create($1,$2,PTF gc,$1->main_sym,PTF argc,PTF argv,PTF flx_stdin, PTF flx_stdout, PTF flx_stderr);"
   482:     requires property "needs_gc",
   483:     body """
   484:     void _create
   485:     (
   486:       flx::rtl::flx_dynlink_t *library,
   487:       flx::rtl::flx_libinit_t *instance,
   488:       flx::gc::generic::collector_t *gc,
   489:       flx::rtl::main_t main_sym,
   490:       int argc, char **argv,
   491:       FILE *stdin_, FILE *stdout_, FILE *stderr_
   492:     )
   493:     {
   494:       instance->create(library,gc,main_sym,argc,argv,stdin_,stdout_,stderr_);
   495:     }
   496:     """;
   497: 
   498:   private fun get_init: flx_instance -> cont = "$1->start_proc";
   499:   private fun get_library: flx_instance -> flx_library = "$1->lib";
   500:   proc destroy: flx_instance = "$1->destroy();";
   501: 
   502:   fun create_library_handle: unit->flx_library=
   503:     "new flx::rtl::flx_dynlink_t()";
   504: 
   505:   fun create_instance_handle: unit->flx_instance=
   506:     "new flx::rtl::flx_libinit_t()";
   507: 
   508:   proc delete_library_handle: flx_library =
   509:     "delete $1;";
   510: 
   511:   proc delete_instance_handle: flx_instance =
   512:     "delete $1;";
   513: 
   514:   noinline fun init_lib(filename:string):flx_instance = {
   515:     var library = create_library_handle();
   516:     var instance =  create_instance_handle();
   517:     dlopen(library,filename);
   518:     create (library,instance);
   519:     var init = get_init instance;
   520:     Control::run init;
   521:     return instance;
   522:   }
   523: 
   524:   publish """ Run a Felix program.
   525:     WARNING!! All data created by the target
   526:     program must be destroyed
   527:     before the library code is unlinked.
   528:   """
   529:   proc run_lib(filename:string)
   530:   {
   531:     var instance = init_lib(filename);
   532:     destroy_lib instance;
   533:   }
   534: 
   535:   noinline proc destroy_lib(instance:flx_instance)
   536:   {
   537:     destroy instance;
   538:     Control::collect();
   539:     dl := get_library instance;
   540:     delete_instance_handle instance;
   541:     dlclose dl;
   542:     delete_library_handle dl;
   543:   }
   544: 
   545:   publish "dlsym wrapper, returns any symbol"
   546:   fun dlsym:flx_library * string->address =
   547:       "SDLSYM($1->library,$2.data())";
   548: 
   549:   publish """
   550:     execute an address representing a top
   551:     level exported felix procedure's C wrapper,
   552:     this creates a 'read to run' continuation object
   553:     by both constructing the object using the thread
   554:     frame of the instance as an argument, and calling
   555:     it to fix a null return address and an arbitrary
   556:     client data pointer as arguments to the call method.
   557:   """
   558:   fun bind_proc: flx_instance * address * address -> cont =
   559:     "$1->bind_proc($2,$3)";
   560: 
   561:   fun dlib_of : flx_library -> address = "(void*)$1->library";
   562: 
   563:   proc dlsym_err:flx_library*string="""
   564:     throw flx::rtl::flx_link_failure_t($1->filename,$2,"symbol not found");
   565:   """;
   566: 
   567:   noinline proc run_proc (instance:flx_instance, p: string, data: address)
   568:   {
   569:     var lib = get_library instance;
   570:     var sym = dlsym(lib, p);
   571:     if C_hack::isNULL(sym) do dlsym_err(lib,p); done;
   572:     var f = bind_proc(instance, sym, data);
   573:     run f;
   574:   }
   575: 
   576: }
   577: 
   578: module Filename
   579: {
   580:   const sep : charp = c'"/"';
   581: }
   582: 
   583: module Cstdio
   584: {
   585:   header "#include <cstdio>";
   586:   incomplete type FILE = "std::FILE";
   587: }
   588: 
   589: module Text_file
   590: {
   591:   requires flx_ioutil;
   592:   fun load: string -> string = "flx::rtl::ioutil::load_file($1)";
   593:   fun load: text_file -> string = "flx::rtl::ioutil::load_file($1)";
   594: 
   595:   pod type text_file = "FILE*"; // its a macro?
   596: 
   597:   fun fopen_input: string -> text_file = 'std::fopen($1.data(),"rt")';
   598:   fun fopen_output: string -> text_file = 'std::fopen($1.data(),"wt")';
   599:   proc fclose: text_file = '(void)std::fclose($1);';
   600:   fun readln: text_file -> string ="flx::rtl::ioutil::readln($1)";
   601:   proc writeln : text_file * string ="flx::rtl::ioutil::writeln($1,$2);";
   602:   proc write : text_file * string ="flx::rtl::ioutil::write($1,$2);";
   603:   fun valid : text_file -> bool = "$1!=(FILE*)0";
   604:   const stdin: text_file = "PTF flx_stdin";
   605:   const stdout: text_file = "PTF flx_stdout";
   606:   const stderr: text_file = "PTF flx_stderr";
   607: }
   608: 
   609: 
   610: publish "Bool compatible with C"
   611: module Bool
   612: {
   613: 
   614:   gen_eq bool;
   615:   fun land: bool * bool -> bool = "$1&&$2";
   616:   fun nand: bool * bool -> bool = "!($1&&$2)";
   617:   fun lor: bool * bool -> bool = "$1||$2";
   618:   fun nor: bool * bool -> bool = "!($1||$2)";
   619:   fun xor: bool * bool -> bool = "$1!=$2";
   620:   fun lnot: bool -> bool = "!$1";
   621:   proc fprint: ostream * bool = '*$1<<($2??"true":"false");' requires iostream;
   622: }
   623: 
   624: publish "Mixed Mode arithmentic"
   625: module MixedInt
   626: {
   627:   fun add[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1+$2";
   628:   fun sub[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1-$2";
   629:   fun mul[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1*$2";
   630:   fun div[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1/$2";
   631:   fun mod[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1%$2";
   632: 
   633:   fun band[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1&$2";
   634:   fun bor[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1|$2";
   635:   fun bxor[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1^$2";
   636:   fun shl[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1<<$2";
   637:   fun shr[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t2)="$1>>$2";
   638: 
   639:   fun lt[t1:fast_ints, t2:fast_ints]: t1 * t2 -> bool = "$1<$2";
   640:   fun le[t1:fast_ints, t2:fast_ints]: t1 * t2 -> bool = "$1<=$2";
   641:   fun eq[t1:fast_ints, t2:fast_ints]: t1 * t2 -> bool = "$1==$2";
   642:   fun ne[t1:fast_ints, t2:fast_ints]: t1 * t2 -> bool = "$1!=$2";
   643:   fun gt[t1:fast_ints, t2:fast_ints]: t1 * t2 -> bool = "$1>$2";
   644:   fun ge[t1:fast_ints, t2:fast_ints]: t1 * t2 -> bool = "$1>=$2";
   645: }
   646: 
   647: type string = "std::string";
   648: module Tiny
   649: {
   650:   gen_integral(tiny);
   651:   fun _ctor_tiny: string -> tiny = "static_cast<signed char>(std::atoi($1.data()))" requires cstdlib;
   652:   fun _ctor_tiny[T:reals]: T -> tiny = "static_cast<signed char>($1)";
   653:   fun abs: tiny -> tiny = "abs($1)";
   654:   proc fprint: ostream * tiny = "*$1<<(int)$2;" requires iostream;
   655:   fun str: tiny -> string = "flx::rtl::strutil::str<int>($1)" requires flx_strutil;
   656: }
   657: 
   658: module Short
   659: {
   660:   gen_integral(short);
   661:   fun _ctor_short: string -> short = "static_cast<short>(std::atoi($1.data()))" requires cstdlib;
   662:   fun _ctor_short[T:reals]: T -> short = "static_cast<short>($1)";
   663:   fun abs: short -> short = "abs($1)";
   664:   proc fprint: ostream * short = "*$1<<$2;" requires iostream;
   665:   fun str: short -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   666: }
   667: 
   668: module Int
   669: {
   670:   gen_integral(int);
   671:   fun _ctor_int: string -> int = "static_cast<int>(std::atoi($1.data()))" requires cstdlib;
   672:   fun _ctor_int[T:reals]: T -> int = "static_cast<int>($1)";
   673:   fun abs: int -> int = "abs($1)";
   674:   proc fprint: ostream * int = "*$1<<$2;" requires iostream;
   675:   fun str: int -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   676: }
   677: 
   678: module Long
   679: {
   680:   gen_integral(long);
   681:   fun _ctor_long: string -> long = "static_cast<long>(std::atoi($1.data()))" requires cstdlib;
   682:   fun _ctor_long[T:reals]: T -> long = "static_cast<long>($1)";
   683:   fun abs: long -> long = "labs($1)";
   684:   proc fprint: ostream * long = "*$1<<$2;" requires iostream;
   685:   fun str: long -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   686: }
   687: 
   688: module Vlong
   689: {
   690:   gen_integral(vlong);
   691:   fun _ctor_vlong: string -> vlong = "static_cast<long long>(std::atoi($1.data()))" requires cstdlib;
   692:   fun _ctor_vlong[T:reals]: T -> vlong = "static_cast<long long>($1)";
   693:   fun abs: vlong -> vlong = "llabs($1)";
   694:   proc fprint: ostream * vlong = "*$1<<$2;" requires iostream;
   695:   fun str: vlong -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   696: }
   697: 
   698: module Utiny
   699: {
   700:   gen_integral(utiny);
   701:   fun _ctor_utiny: string -> utiny = "static_cast<unsigned char>(std::atoi($1.data()))" requires cstdlib;
   702:   fun _ctor_utiny[T:reals]: T -> utiny = "static_cast<unsigned char>($1)";
   703:   fun bxor: utiny * utiny -> utiny = "$1^$2";
   704:   fun bor: utiny * utiny -> utiny = "$1\|$2";
   705:   fun band: utiny * utiny -> utiny = "$1\&$2";
   706:   fun bnot: utiny -> utiny = "~$1";
   707:   proc bxoreq: lvalue[utiny] * utiny = "$1^=$2;";
   708:   proc boreq: lvalue[utiny] * utiny = "$1|=$2;";
   709:   proc bandeq: lvalue[utiny] * utiny = "$1&=$2;";
   710:   proc fprint: ostream * utiny = "*$1<<(unsigned int)$2;" requires iostream;
   711:   fun str: utiny -> string = "flx::rtl::strutil::str<unsigned int>($1)" requires flx_strutil;
   712: }
   713: 
   714: module Ushort
   715: {
   716:   gen_integral(ushort);
   717:   fun _ctor_ushort: string -> ushort = "static_cast<unsigned short>(std::atoi($1.data()))" requires cstdlib;
   718:   fun _ctor_ushort[T:reals]: T -> ushort = "static_cast<unsigned short>($1)";
   719:   fun bxor: ushort * ushort -> ushort = "$1^$2";
   720:   fun bor: ushort * ushort -> ushort = "$1\|$2";
   721:   fun band: ushort * ushort -> ushort = "$1\&$2";
   722:   fun bnot: ushort -> ushort = "~$1";
   723:   proc bxoreq: lvalue[ushort] * ushort = "$1^=$2;";
   724:   proc boreq: lvalue[ushort] * ushort = "$1|=$2;";
   725:   proc bandeq: lvalue[ushort] * ushort = "$1&=$2;";
   726:   proc fprint: ostream * ushort = "*$1<<$2;" requires iostream;
   727:   fun str: ushort -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   728: }
   729: 
   730: module Uint
   731: {
   732:   gen_integral(uint);
   733:   fun _ctor_uint: string -> uint = "static_cast<unsigned int>(std::atoi($1.data()))" requires cstdlib;
   734:   fun _ctor_uint[T:reals]: T -> uint = "static_cast<unsigned int>($1)";
   735:   fun bxor: uint * uint -> uint = "$1^$2";
   736:   fun bor: uint * uint -> uint = "$1\|$2";
   737:   fun band: uint * uint -> uint = "$1\&$2";
   738:   fun bnot: uint -> uint = "~$1";
   739:   proc bxoreq: lvalue[uint] * uint = "$1^=$2;";
   740:   proc boreq: lvalue[uint] * uint = "$1|=$2;";
   741:   proc bandeq: lvalue[uint] * uint = "$1&=$2;";
   742:   proc fprint: ostream * uint = "*$1<<$2;" requires iostream;
   743:   fun str: uint -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   744: }
   745: 
   746: module Ulong
   747: {
   748:   gen_integral(ulong);
   749:   fun _ctor_ulong: string -> ulong = "static_cast<unsigned long>(std::atoi($1.data()))" requires cstdlib;
   750:   fun _ctor_ulong[T:reals]: T -> ulong = "static_cast<unsigned long>($1)";
   751:   fun bxor: ulong * ulong -> ulong = "$1^$2";
   752:   fun bor: ulong * ulong -> ulong = "$1\|$2";
   753:   fun band: ulong * ulong -> ulong = "$1\&$2";
   754:   fun bnot: ulong -> ulong = "~$1";
   755:   proc bxoreq: lvalue[ulong] * ulong = "$1^=$2;";
   756:   proc boreq: lvalue[ulong] * ulong = "$1|=$2;";
   757:   proc bandeq: lvalue[ulong] * ulong = "$1&=$2;";
   758:   proc fprint: ostream * ulong = "*$1<<$2;" requires iostream;
   759:   fun str: ulong -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   760: }
   761: 
   762: module Uvlong
   763: {
   764:   gen_integral(uvlong);
   765:   fun _ctor_uvlong: string -> uvlong = "static_cast<unsigned long long>(std::atoi($1.data()))" requires cstdlib;
   766:   fun _ctor_uvlong[T:reals]: T -> uvlong = "static_cast<unsigned long long>($1)";
   767:   fun bxor: uvlong * uvlong -> uvlong = "$1^$2";
   768:   fun bor: uvlong * uvlong -> uvlong = "$1\|$2";
   769:   fun band: uvlong * uvlong -> uvlong = "$1\&$2";
   770:   fun bnot: uvlong -> uvlong = "~$1";
   771:   proc bxoreq: lvalue[uvlong] * uvlong = "$1^=$2;";
   772:   proc boreq: lvalue[uvlong] * uvlong = "$1|=$2;";
   773:   proc bandeq: lvalue[uvlong] * uvlong = "$1&=$2;";
   774:   proc fprint: ostream * uvlong = "*$1<<$2;" requires iostream;
   775:   fun str: uvlong -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   776: }
   777: 
   778: module Float
   779: {
   780:   gen_cmp(float);
   781:   gen_arith(float);
   782:   fun _ctor_float: string -> float = "static_cast<float>(std::atof($1.data()))" requires cstdlib;
   783:   fun _ctor_float[T:reals]: T -> float = "static_cast<float>($1)";
   784:   fun pow: float * float -> float = "powf($1, $2)" is postfix requires cmath;
   785:   fun atan2: float * float -> float = "atan2f($1, $2)" is postfix requires cmath;
   786:   fun fmod: float * float -> float = "fmodf($1, $2)" is postfix requires cmath;
   787:   fun fmax: float * float -> float = "fmaxf($1, $2)" is postfix requires cmath;
   788:   fun fmin: float * float -> float = "fminf($1, $2)" is postfix requires cmath;
   789:   fun sin: float -> float = "sinf($1)" is postfix requires cmath;
   790:   fun cos: float -> float = "cosf($1)" is postfix requires cmath;
   791:   fun tan: float -> float = "tanf($1)" is postfix requires cmath;
   792:   fun asin: float -> float = "asinf($1)" is postfix requires cmath;
   793:   fun acos: float -> float = "acosf($1)" is postfix requires cmath;
   794:   fun atan: float -> float = "atanf($1)" is postfix requires cmath;
   795:   fun sinh: float -> float = "sinhf($1)" is postfix requires cmath;
   796:   fun cosh: float -> float = "coshf($1)" is postfix requires cmath;
   797:   fun tanh: float -> float = "tanhf($1)" is postfix requires cmath;
   798:   fun asinh: float -> float = "asinhf($1)" is postfix requires cmath;
   799:   fun acosh: float -> float = "acoshf($1)" is postfix requires cmath;
   800:   fun atanh: float -> float = "atanhf($1)" is postfix requires cmath;
   801:   fun exp: float -> float = "expf($1)" is postfix requires cmath;
   802:   fun log: float -> float = "logf($1)" is postfix requires cmath;
   803:   fun log10: float -> float = "log10f($1)" is postfix requires cmath;
   804:   fun fabs: float -> float = "fabsf($1)" is postfix requires cmath;
   805:   fun sqrt: float -> float = "sqrtf($1)" is postfix requires cmath;
   806:   fun ceil: float -> float = "ceilf($1)" is postfix requires cmath;
   807:   fun floor: float -> float = "floorf($1)" is postfix requires cmath;
   808:   fun trunc: float -> float = "truncf($1)" is postfix requires cmath;
   809:   fun isnan: float -> bool = "isnanf($1)" is postfix requires cmath;
   810:   proc fprint: ostream * float = "*$1<<$2;" requires iostream;
   811:   fun str: float -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   812: }
   813: 
   814: module Double
   815: {
   816:   gen_cmp(double);
   817:   gen_arith(double);
   818:   fun _ctor_double: string -> double = "static_cast<double>(std::atof($1.data()))" requires cstdlib;
   819:   fun _ctor_double[T:reals]: T -> double = "static_cast<double>($1)";
   820:   fun pow: double * double -> double = "pow($1, $2)" is postfix requires cmath;
   821:   fun atan2: double * double -> double = "atan2($1, $2)" is postfix requires cmath;
   822:   fun fmod: double * double -> double = "fmod($1, $2)" is postfix requires cmath;
   823:   fun fmax: double * double -> double = "fmax($1, $2)" is postfix requires cmath;
   824:   fun fmin: double * double -> double = "fmin($1, $2)" is postfix requires cmath;
   825:   fun sin: double -> double = "sin($1)" is postfix requires cmath;
   826:   fun cos: double -> double = "cos($1)" is postfix requires cmath;
   827:   fun tan: double -> double = "tan($1)" is postfix requires cmath;
   828:   fun asin: double -> double = "asin($1)" is postfix requires cmath;
   829:   fun acos: double -> double = "acos($1)" is postfix requires cmath;
   830:   fun atan: double -> double = "atan($1)" is postfix requires cmath;
   831:   fun sinh: double -> double = "sinh($1)" is postfix requires cmath;
   832:   fun cosh: double -> double = "cosh($1)" is postfix requires cmath;
   833:   fun tanh: double -> double = "tanh($1)" is postfix requires cmath;
   834:   fun asinh: double -> double = "asinh($1)" is postfix requires cmath;
   835:   fun acosh: double -> double = "acosh($1)" is postfix requires cmath;
   836:   fun atanh: double -> double = "atanh($1)" is postfix requires cmath;
   837:   fun exp: double -> double = "exp($1)" is postfix requires cmath;
   838:   fun log: double -> double = "log($1)" is postfix requires cmath;
   839:   fun log10: double -> double = "log10($1)" is postfix requires cmath;
   840:   fun fabs: double -> double = "fabs($1)" is postfix requires cmath;
   841:   fun sqrt: double -> double = "sqrt($1)" is postfix requires cmath;
   842:   fun ceil: double -> double = "ceil($1)" is postfix requires cmath;
   843:   fun floor: double -> double = "floor($1)" is postfix requires cmath;
   844:   fun trunc: double -> double = "trunc($1)" is postfix requires cmath;
   845:   fun isnan: double -> bool = "isnan($1)" is postfix requires cmath;
   846:   proc fprint: ostream * double = "*$1<<$2;" requires iostream;
   847:   fun str: double -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   848: }
   849: 
   850: module Ldouble
   851: {
   852:   gen_cmp(ldouble);
   853:   gen_arith(ldouble);
   854:   fun _ctor_ldouble: string -> ldouble = "static_cast<long double>(std::atof($1.data()))" requires cstdlib;
   855:   fun _ctor_ldouble[T:reals]: T -> ldouble = "static_cast<long double>($1)";
   856:   fun pow: ldouble * ldouble -> ldouble = "powl($1, $2)" is postfix requires cmath;
   857:   fun atan2: ldouble * ldouble -> ldouble = "atan2l($1, $2)" is postfix requires cmath;
   858:   fun fmod: ldouble * ldouble -> ldouble = "fmodl($1, $2)" is postfix requires cmath;
   859:   fun fmax: ldouble * ldouble -> ldouble = "fmaxl($1, $2)" is postfix requires cmath;
   860:   fun fmin: ldouble * ldouble -> ldouble = "fminl($1, $2)" is postfix requires cmath;
   861:   fun sin: ldouble -> ldouble = "sinl($1)" is postfix requires cmath;
   862:   fun cos: ldouble -> ldouble = "cosl($1)" is postfix requires cmath;
   863:   fun tan: ldouble -> ldouble = "tanl($1)" is postfix requires cmath;
   864:   fun asin: ldouble -> ldouble = "asinl($1)" is postfix requires cmath;
   865:   fun acos: ldouble -> ldouble = "acosl($1)" is postfix requires cmath;
   866:   fun atan: ldouble -> ldouble = "atanl($1)" is postfix requires cmath;
   867:   fun sinh: ldouble -> ldouble = "sinhl($1)" is postfix requires cmath;
   868:   fun cosh: ldouble -> ldouble = "coshl($1)" is postfix requires cmath;
   869:   fun tanh: ldouble -> ldouble = "tanhl($1)" is postfix requires cmath;
   870:   fun asinh: ldouble -> ldouble = "asinhl($1)" is postfix requires cmath;
   871:   fun acosh: ldouble -> ldouble = "acoshl($1)" is postfix requires cmath;
   872:   fun atanh: ldouble -> ldouble = "atanhl($1)" is postfix requires cmath;
   873:   fun exp: ldouble -> ldouble = "expl($1)" is postfix requires cmath;
   874:   fun log: ldouble -> ldouble = "logl($1)" is postfix requires cmath;
   875:   fun log10: ldouble -> ldouble = "log10l($1)" is postfix requires cmath;
   876:   fun fabs: ldouble -> ldouble = "fabsl($1)" is postfix requires cmath;
   877:   fun sqrt: ldouble -> ldouble = "sqrtl($1)" is postfix requires cmath;
   878:   fun ceil: ldouble -> ldouble = "ceill($1)" is postfix requires cmath;
   879:   fun floor: ldouble -> ldouble = "floorl($1)" is postfix requires cmath;
   880:   fun trunc: ldouble -> ldouble = "truncl($1)" is postfix requires cmath;
   881:   fun isnan: ldouble -> bool = "isnanl($1)" is postfix requires cmath;
   882:   proc fprint: ostream * ldouble = "*$1<<$2;" requires iostream;
   883:   fun str: ldouble -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
   884: }
   885: 
   886: // ordinary value of chars
   887:   gen_eq(char);
   888:   gen_eq(wchar);
   889:   gen_eq(uchar);
   890: module Char
   891: {
   892:   open Int;
   893:   fun ord: char -> int = "(int)$1";
   894:   fun _ctor_char: int -> char = "(char)$1";
   895:   proc fprint: ostream * char = "*$1<<$2;" requires iostream;
   896: }
   897: 
   898: module Wchar
   899: {
   900:   open Long;
   901:   fun ord: wchar -> long ="(long)$1";
   902:   fun _ctor_wchar: long -> wchar = "(wchar_t)$1";
   903:   proc fprint: ostream * wchar = "*$1<<$2;" requires iostream;
   904: }
   905: 
   906: module Unicode
   907: {
   908:   fun ord: uchar -> uint32 ="$1";
   909:   fun _ctor_uchar: uint32 -> uchar = "$1";
   910:   //this needs to be fixed!
   911:   //proc print: uchar = "std::cout<<$1;" requires iostream;
   912: }
   913: 
   914: 
   915: module Stdout
   916: {
   917:   requires iostream;
   918:   type ostream = "std::ostream*";
   919:   const cout: ostream = "&cout";
   920:   proc endl: ostream = "*$1<<std::endl;";
   921:   proc endl: unit = "std::cout << std::endl;";
   922:   proc space: int = "std::cout << ' ';";
   923:   proc flush: unit = "std::cout.flush(); ";
   924: }
   925: 
   926: module String
   927: {
   928:   requires string_hxx;
   929:   open Bool;
   930:   open Char;
   931:   open Int;
   932:   proc pluseq: lvalue[string] * string = "$1.append($2);";
   933:   proc pluseq: lvalue[string] * charcp = "$1.append($2);";
   934:   proc pluseq: lvalue[string] * charp = "$1.append($2);";
   935:   proc pluseq: lvalue[string] * char = "$1 += $2;";
   936: 
   937:   fun str: charp -> string = 'flx::rtl::strutil::atostr($1)' requires flx_strutil;
   938:   fun str: charcp -> string = 'flx::rtl::strutil::atostr($1)' requires flx_strutil;
   939:   fun str: ucharp -> string = 'flx::rtl::strutil::atostr((char const*)$1)' requires flx_strutil;
   940:   fun str: ucharcp -> string = 'flx::rtl::strutil::atostr((char const*)$1)' requires flx_strutil;
   941: 
   942:   fun len: string -> int = "$1.size()";
   943:   fun add: string * string -> string = "$1+$2";
   944:   fun add: string * charp -> string = "$1+$2";
   945:   fun add: charp * string -> string = "$1+$2";
   946:   fun add: string * char -> string = "$1+$2";
   947:   fun add: char * string -> string = "$1+$2";
   948:   fun add: string * int -> string = "$1+flx::rtl::i18n::utf8($2)" requires flx_i18n;
   949:   fun mul: string * int -> string = "flx::rtl::strutil::mul($1,$2)" requires flx_strutil;
   950:   fun mul: char * int -> string = "std::string($2,$1)";
   951: 
   952:   fun apply (x:string, y:string):string => x + y;
   953:   fun apply (x:string, y:int):string => x + y;
   954: 
   955:   fun _ctor_char (x:string) => x.[0];
   956: 
   957:   fun subscript: string * int -> char =
   958:     "flx::rtl::strutil::subscript($1,$2)" requires flx_strutil;
   959:   fun copyfrom: string * int -> string =
   960:     "flx::rtl::strutil::substr($1,$2,$1.size())" requires flx_strutil;
   961:   fun copyto: string * int -> string =
   962:     "flx::rtl::strutil::substr($1,0,$2)" requires flx_strutil;
   963:   fun substring: string * int * int -> string =
   964:     "flx::rtl::strutil::substr($1,$2,$3)" requires flx_strutil;
   965: 
   966:   // comparisons
   967:   gen_cmp string;
   968: 
   969:   // Note we use int instead of size here: size is correct,
   970:   // but that would requires heaps of casts in Felix
   971: 
   972:   const stl_npos: int = "std::string::npos";
   973: 
   974:   fun stl_find: string * string -> int = "$1.find($2)";
   975:   fun stl_find: string * string * int -> int = "$1.find($2,$3)";
   976:   fun stl_find: string * charp -> int = "$1.find($2)";
   977:   fun stl_find: string * charp * int -> int = "$1.find($2,$3)";
   978:   fun stl_find: string * char -> int = "$1.find($2)";
   979:   fun stl_find: string * char * int -> int = "$1.find($2,$3)";
   980: 
   981:   fun find (s:string, e:string) : opt[int] => match stl_find (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   982:   fun find (s:string, e:string, i:int) : opt[int] => match stl_find (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   983:   fun find (s:string, e:charp) : opt[int] => match stl_find (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   984:   fun find (s:string, e:charp, i:int) : opt[int] => match stl_find (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   985:   fun find (s:string, e:char) : opt[int] => match stl_find (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   986:   fun find (s:string, e:char, i:int) : opt[int] => match stl_find (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   987: 
   988:   fun stl_rfind: string * string -> int = "$1.rfind($2)";
   989:   fun stl_rfind: string * string * int -> int = "$1.rfind($2,$3)";
   990:   fun stl_rfind: string * charp -> int = "$1.rfind($2)";
   991:   fun stl_rfind: string * charp * int -> int = "$1.rfind($2,$3)";
   992:   fun stl_rfind: string * char -> int = "$1.rfind($2)";
   993:   fun stl_rfind: string * char * int -> int = "$1.rfind($2,$3)";
   994: 
   995:   fun rfind (s:string, e:string) : opt[int] => match stl_rfind (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   996:   fun rfind (s:string, e:string, i:int) : opt[int] => match stl_rfind (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   997:   fun rfind (s:string, e:charp) : opt[int] => match stl_rfind (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   998:   fun rfind (s:string, e:charp, i:int) : opt[int] => match stl_rfind (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
   999:   fun rfind (s:string, e:char) : opt[int] => match stl_rfind (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1000:   fun rfind (s:string, e:char, i:int) : opt[int] => match stl_rfind (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1001: 
  1002:   fun stl_find_first_of: string * string -> int = "$1.find_first_of($2)";
  1003:   fun stl_find_first_of: string * string * int -> int = "$1.find_first_of($2,$3)";
  1004:   fun stl_find_first_of: string * charp -> int = "$1.find_first_of($2)";
  1005:   fun stl_find_first_of: string * charp * int -> int = "$1.find_first_of($2,$3)";
  1006:   fun stl_find_first_of: string * char -> int = "$1.find_first_of($2)";
  1007:   fun stl_find_first_of: string * char * int -> int = "$1.find_first_of($2,$3)";
  1008: 
  1009:   fun find_first_of (s:string, e:string) : opt[int] => match stl_find_first_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1010:   fun find_first_of (s:string, e:string, i:int) : opt[int] => match stl_find_first_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1011:   fun find_first_of (s:string, e:charp) : opt[int] => match stl_find_first_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1012:   fun find_first_of (s:string, e:charp, i:int) : opt[int] => match stl_find_first_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1013:   fun find_first_of (s:string, e:char) : opt[int] => match stl_find_first_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1014:   fun find_first_of (s:string, e:char, i:int) : opt[int] => match stl_find_first_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1015: 
  1016:   fun stl_find_first_not_of: string * string -> int = "$1.find_first_not_of($2)";
  1017:   fun stl_find_first_not_of: string * string * int -> int = "$1.find_first_not_of($2,$3)";
  1018:   fun stl_find_first_not_of: string * charp -> int = "$1.find_first_not_of($2)";
  1019:   fun stl_find_first_not_of: string * charp * int -> int = "$1.find_first_not_of($2,$3)";
  1020:   fun stl_find_first_not_of: string * char -> int = "$1.find_first_not_of($2)";
  1021:   fun stl_find_first_not_of: string * char * int -> int = "$1.find_first_not_of($2,$3)";
  1022: 
  1023:   fun find_first_not_of (s:string, e:string) : opt[int] => match stl_find_first_not_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1024:   fun find_first_not_of (s:string, e:string, i:int) : opt[int] => match stl_find_first_not_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1025:   fun find_first_not_of (s:string, e:charp) : opt[int] => match stl_find_first_not_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1026:   fun find_first_not_of (s:string, e:charp, i:int) : opt[int] => match stl_find_first_not_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1027:   fun find_first_not_of (s:string, e:char) : opt[int] => match stl_find_first_not_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1028:   fun find_first_not_of (s:string, e:char, i:int) : opt[int] => match stl_find_first_not_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1029: 
  1030:   fun stl_find_last_of: string * string -> int = "$1.find_last_of($2)";
  1031:   fun stl_find_last_of: string * string * int -> int = "$1.find_last_of($2,$3)";
  1032:   fun stl_find_last_of: string * charp -> int = "$1.find_last_of($2)";
  1033:   fun stl_find_last_of: string * charp * int -> int = "$1.find_last_of($2,$3)";
  1034:   fun stl_find_last_of: string * char -> int = "$1.find_last_of($2)";
  1035:   fun stl_find_last_of: string * char * int -> int = "$1.find_last_of($2,$3)";
  1036: 
  1037:   fun find_last_of (s:string, e:string) : opt[int] => match stl_find_last_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1038:   fun find_last_of (s:string, e:string, i:int) : opt[int] => match stl_find_last_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1039:   fun find_last_of (s:string, e:charp) : opt[int] => match stl_find_last_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1040:   fun find_last_of (s:string, e:charp, i:int) : opt[int] => match stl_find_last_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1041:   fun find_last_of (s:string, e:char) : opt[int] => match stl_find_last_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1042:   fun find_last_of (s:string, e:char, i:int) : opt[int] => match stl_find_last_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1043: 
  1044:   fun stl_find_last_not_of: string * string -> int = "$1.find_last_not_of($2)";
  1045:   fun stl_find_last_not_of: string * string * int -> int = "$1.find_last_not_of($2,$3)";
  1046:   fun stl_find_last_not_of: string * charp -> int = "$1.find_last_not_of($2)";
  1047:   fun stl_find_last_not_of: string * charp * int -> int = "$1.find_last_not_of($2,$3)";
  1048:   fun stl_find_last_not_of: string * char -> int = "$1.find_last_not_of($2)";
  1049:   fun stl_find_last_not_of: string * char * int -> int = "$1.find_last_not_of($2,$3)";
  1050: 
  1051:   fun find_last_not_of (s:string, e:string) : opt[int] => match stl_find_last_not_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1052:   fun find_last_not_of (s:string, e:string, i:int) : opt[int] => match stl_find_last_not_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1053:   fun find_last_not_of (s:string, e:charp) : opt[int] => match stl_find_last_not_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1054:   fun find_last_not_of (s:string, e:charp, i:int) : opt[int] => match stl_find_last_not_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1055:   fun find_last_not_of (s:string, e:char) : opt[int] => match stl_find_last_not_of (s, e) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1056:   fun find_last_not_of (s:string, e:char, i:int) : opt[int] => match stl_find_last_not_of (s, e, i) with | ?i when i == stl_npos => None[int] | ?i => Some i endmatch;
  1057: 
  1058:   fun startswith (x:string) (e:string) : bool =
  1059:   {
  1060:     if len x < len e do
  1061:       return false;
  1062:     done;
  1063: 
  1064:     var i: int; forall i in 0 upto (len e) - 1 do
  1065:       if e.[i] != x.[i] do
  1066:         return false;
  1067:       done;
  1068:     done;
  1069: 
  1070:     return true;
  1071:   }
  1072: 
  1073:   fun endswith (x:string) (e:string) : bool =
  1074:   {
  1075:     val len_x = len x;
  1076:     val len_e = len e;
  1077: 
  1078:     if len_x < len_e do
  1079:       return false;
  1080:     done;
  1081: 
  1082:     var i: int; forall i in 0 upto (len_e) - 1 do
  1083:       if e.[len_e - i - 1] != x.[len_x - i - 1] do
  1084:         return false;
  1085:       done;
  1086:     done;
  1087: 
  1088:     return true;
  1089:   }
  1090: 
  1091:   fun startswith (x:string) (e:char) : bool => x.[0] == e;
  1092:   fun endsswith (x:string) (e:char) : bool => x.[len x - 1] == e;
  1093: 
  1094: 
  1095:   // trim whitespace
  1096:   fun ltrim : string -> string =
  1097:     "flx::rtl::strutil::ltrim($1)" requires flx_strutil;
  1098:   fun rtrim : string -> string =
  1099:     "flx::rtl::strutil::rtrim($1)" requires flx_strutil;
  1100:   fun trim (x:string) : string => ltrim$ rtrim x;
  1101: 
  1102:   fun split (x:string, d:char): List::list[string] = {
  1103:     fun aux (x:string,y:List::list[string]) =>
  1104:       match find (x, d) with
  1105:       | None => List::rev$ List::Cons (x, y)
  1106:       | Some ?n => aux$ x.[n+1 to], List::Cons (x.[to n],y)
  1107:       endmatch
  1108:     ;
  1109:     return aux$ x, List::Empty[string];
  1110:   }
  1111: 
  1112:   fun split (x:string, d:string): List::list[string] = {
  1113:     fun aux (x:string,y:List::list[string]) =>
  1114:       match find_first_of (x, d) with
  1115:       | None => List::rev$ List::Cons (x, y)
  1116:       | Some ?n => aux$ x.[n+1 to], List::Cons (x.[to n],y)
  1117:       endmatch
  1118:     ;
  1119:     return aux$ x, List::Empty[string];
  1120:   }
  1121: 
  1122:   fun split (x:string, d:charp): List::list[string] = {
  1123:     fun aux (x:string,y:List::list[string]) =>
  1124:       match find_first_of (x, d) with
  1125:       | None => List::rev$ List::Cons (x, y)
  1126:       | Some ?n => aux$ x.[n+1 to], List::Cons (x.[to n],y)
  1127:       endmatch
  1128:     ;
  1129:     return aux$ x, List::Empty[string];
  1130:   }
  1131: 
  1132:   // Note: pos, length!
  1133:   proc erase: string * int * int = "$1.erase($2,$3);";
  1134:   proc insert: string * int * string = "$1.insert($2,$3);";
  1135:   proc replace: string * int * int * string = "$1.replace($2,$3,$4);";
  1136: 
  1137:   proc fprint: ostream * C_hack::ptr[char] = "*$1<<$2;" requires iostream;
  1138:   proc fprint: ostream * C_hack::cptr[char] = "*$1<<$2;" requires iostream;
  1139:   proc fprint: ostream * string = "*$1<<$2;" requires iostream;
  1140:   fun atoi: string -> int = "std::atoi($1.data())" requires cstdlib;
  1141:   fun atol: string -> long = "std::atol($1.data())" requires cstdlib;
  1142:   fun atof: string -> double = "std::atof($1.data())" requires cstdlib;
  1143: 
  1144:   proc reserve: lvalue[string] * int = "$1.reserve($2);";
  1145: 
  1146:   publish "Unsafe extract buffer pointer"
  1147:   fun cstr: string -> C_hack::ptr[char] = "$1.data()";
  1148: 
  1149:   fun vsprintf[t]: C_hack::ptr[char] * t -> string =
  1150:     "flx::rtl::strutil::flx_asprintf($1,$T2)" requires flx_strutil
  1151:   ;
  1152: }
  1153: 
  1154: module Cstdlib
  1155: {
  1156:   requires cstdlib;
  1157:   const RAND_MAX:long;
  1158: 
  1159:   proc srand: uint = 'std::srand($1);';
  1160:   fun rand: 1 -> int = 'std::rand()';
  1161: }
  1162: 
  1163: type ustring = "basic_string<uint32_t>" requires string_hxx;
  1164: module Ustring
  1165: {
  1166:   open Bool;
  1167:   open Char;
  1168:   open Int;
  1169:   proc pluseq: lvalue[ustring] * ustring = "$1.append($2);";
  1170: 
  1171:   fun len: ustring -> int = "$1.size()";
  1172:   fun add: ustring * ustring -> ustring = "$1+$2";
  1173:   fun mul: ustring * int -> ustring = "flx::lib::mul($1,$2)";
  1174:   fun mul: char * int -> ustring = "ustring($2,$1)";
  1175: 
  1176:   fun apply (x:ustring, y:ustring):ustring => x + y;
  1177: 
  1178:   fun subscript: ustring * int -> char =
  1179:     "$1[$2<0??$1.size()+$2 : $2]";
  1180:   fun copyfrom: ustring * int -> ustring =
  1181:     "flx::rtl::strutil::substr($1,$2,$1.size())" requires flx_strutil;
  1182:   fun copyto: ustring * int -> ustring =
  1183:     "flx::rtl::strutil::substr($1,0,$2)" requires flx_strutil;
  1184:   fun subustring: ustring * int * int -> ustring =
  1185:     "flx::rtl::strutil::substr($1,$2,$3)" requires flx_strutil;
  1186: 
  1187:   // comparisons
  1188:   gen_cmp ustring;
  1189: 
  1190:   proc fprint: ostream * ustring = "*$1<<$2;" requires iostream;
  1191: }
  1192: 
  1193: publish """
  1194: All the arithmetic casts between standard C arithmetic types.
  1195: """
  1196: module Arith_casts
  1197: {
  1198:   fun utiny_of[t2:reals]: t2 -> utiny = "(unsigned char)$1:cast" is cast;
  1199:   fun ushort_of[t2:reals]: t2 -> ushort = "(unsigned short)$1:cast" is cast;
  1200:   fun uint_of[t2:reals]: t2 -> uint = "(unsigned int)$1:cast" is cast;
  1201:   fun ulong_of[t2:reals]: t2 -> ulong = "(unsigned long)$1:cast" is cast;
  1202:   fun uvlong_of[t2:reals]: t2 -> uvlong = "(unsigned long long)$1:cast" is cast;
  1203:   fun uint8_of[t2:reals]: t2 -> uint8 = "(uint8_t)$1:cast" is cast;
  1204:   fun uint16_of[t2:reals]: t2 -> uint16 = "(uint16_t)$1:cast" is cast;
  1205:   fun uint32_of[t2:reals]: t2 -> uint32 = "(uint32_t)$1:cast" is cast;
  1206:   fun uint64_of[t2:reals]: t2 -> uint64 = "(uint64_t)$1:cast" is cast;
  1207:   fun tiny_of[t2:reals]: t2 -> tiny = "(signed char)$1:cast" is cast;
  1208:   fun short_of[t2:reals]: t2 -> short = "(short)$1:cast" is cast;
  1209:   fun int_of[t2:reals]: t2 -> int = "(int)$1:cast" is cast;
  1210:   fun long_of[t2:reals]: t2 -> long = "(long)$1:cast" is cast;
  1211:   fun vlong_of[t2:reals]: t2 -> vlong = "(long long)$1:cast" is cast;
  1212:   fun int8_of[t2:reals]: t2 -> int8 = "(int8_t)$1:cast" is cast;
  1213:   fun int16_of[t2:reals]: t2 -> int16 = "(int16_t)$1:cast" is cast;
  1214:   fun int32_of[t2:reals]: t2 -> int32 = "(int32_t)$1:cast" is cast;
  1215:   fun int64_of[t2:reals]: t2 -> int64 = "(int64_t)$1:cast" is cast;
  1216:   fun float_of[t2:reals]: t2 -> float = "(float)$1:cast" is cast;
  1217:   fun double_of[t2:reals]: t2 -> double = "(double)$1:cast" is cast;
  1218:   fun ldouble_of[t2:reals]: t2 -> ldouble = "(long double)$1:cast" is cast;
  1219: }
  1220: 
  1221: module Control
  1222: {
  1223:   open C_hack;
  1224:   publish 'infinite loop'
  1225:   proc forever (bdy:unit->void)
  1226:   {
  1227:     rpeat:>
  1228:       bdy();
  1229:       goto rpeat;
  1230:     dummy:> // fool reachability checker
  1231:   }
  1232: 
  1233:   publish 'C style while loop'
  1234:   proc while (cond:unit->bool) (bdy:unit->void)
  1235:   {
  1236:     rpeat:>
  1237:       if not (cond()) goto finish;
  1238:       bdy();
  1239:       goto rpeat;
  1240:     finish:>
  1241:   }
  1242: 
  1243:   /* DISABLED: replaced by UNTIL statement until the optimiser is working
  1244:   publish """
  1245:   C style while loop with reversed condition
  1246:   note the until is tested first -- zero iterations are possible
  1247:   """
  1248:   proc until(cond:unit->bool) (bdy:unit->void)
  1249:   {
  1250:     repeatx:>
  1251:       if cond() goto finish;
  1252:       bdy();
  1253:       goto repeatx;
  1254:     finish:>
  1255:   }
  1256:   */
  1257: 
  1258:   publish "do nothing [the name pass comes from Python]"
  1259:   proc pass(){}
  1260: 
  1261:   publish 'C style for loop'
  1262:   proc for_each
  1263:     (init:unit->void)
  1264:     (cond:unit->bool)
  1265:     (incr:unit->void)
  1266:     (bdy:unit->void)
  1267:   {
  1268:     init();
  1269:     rpeat:>
  1270:       if not (cond()) goto finish;
  1271:       bdy();
  1272:       incr();
  1273:       goto rpeat;
  1274:     finish:>
  1275:   }
  1276: 
  1277:   publish 'abnormal termination with message'
  1278:   proc fail:string = 'throw std::runtime_error($1);' requires stdexcept;
  1279: 
  1280:   publish "WILL BE DEPRECATED, these don't work right"
  1281:   fun fail_fun[t]:1->t = 'throw std::runtime_error(""),*(?1*)0' requires stdexcept;
  1282: 
  1283:   publish "WILL BE DEPRECATED, these don't work right"
  1284:   fun fail_fun[t]:string->t = 'throw std::runtime_error($1),*(?1*)0' requires stdexcept;
  1285: 
  1286:   publish "Felix procedural continuation type"
  1287:   _gc_pointer type cont = "flx::rtl::con_t*";
  1288: 
  1289:   publish "Current continuation"
  1290:   fun current_continuation: 1 -> cont = "this";
  1291: 
  1292:   publish "Felix fthread"
  1293:   _gc_pointer type fthread = "flx::rtl::fthread_t*";
  1294: 
  1295: 
  1296:   publish """
  1297:     Throw a continuation. This is unsafe. It should
  1298:     work from a top level procedure, or any function
  1299:     called by such a procedure, but may fail
  1300:     if thrown from a procedure called by a function.
  1301:     The library run and driver will catch the
  1302:     continuation and execute it instead of the
  1303:     current continuation. If the library run is used
  1304:     and the continuation being executed is down the
  1305:     C stack, the C stack will not have been correctly
  1306:     popped. Crudely, nested drivers should rethrow
  1307:     the exception until the C stack is in the correct
  1308:     state to execute the continuation, but there is no
  1309:     way to determine that at the moment.
  1310: 
  1311:     Compiler generated runs ignore the exception,
  1312:     the library run catches it. Exceptions typically
  1313:     use a non-local goto, and they cannot pass across
  1314:     a function boundary.
  1315:   """
  1316:   proc throw(x: unit->void) { _throw (C_hack::cast[cont] x); }
  1317:   private proc _throw: cont = "throw $1;";
  1318: 
  1319:   // THESE VALUES MUST SYNC WITH THE RTL
  1320:   union svc_req_t =
  1321:   /*0*/ | svc_yield
  1322:   /*1*/ | svc_get_fthread         of ptr[fthread]
  1323:   /*2*/ | svc_read                of address
  1324:   /*3*/ | svc_general             of &address
  1325:   /*4*/ | svc_reserved1
  1326:   /*5*/ | svc_spawn_pthread       of fthread
  1327:   /*6*/ | svc_spawn_detached      of fthread
  1328:   /*7*/ | svc_sread               of _schannel * &gcaddress
  1329:   /*8*/ | svc_swrite              of _schannel * &gcaddress
  1330:   /*9*/ | svc_kill                of fthread
  1331:   /*10*/ | svc_compact
  1332:   /*11*/ | svc_collect
  1333:   /*12*/ | svc_collect_and_compact
  1334:   ;
  1335: 
  1336:   publish "Call Supervisor"
  1337:   // this interface just gets rid of the horrible requirement
  1338:   // the request be in a variable so it is addressable
  1339:   proc svc(x:svc_req_t) {
  1340:     var y=x;
  1341:     _svc y;
  1342:   }
  1343: 
  1344:   _gc_pointer type schannel[t] = "flx::rtl::schannel_t*";
  1345:   private _gc_pointer type _schannel = "flx::rtl::schannel_t*";
  1346:   fun mk_schannel[t]: 1->schannel[t] =
  1347:     "new(*PTF gc,flx::rtl::schannel_ptr_map) flx::rtl::schannel_t(PTF gc)"
  1348:   ;
  1349: 
  1350:   proc _read[t](chan:schannel[t],loc:&gcptr[t]) {
  1351:     svc$ svc_sread$ cast[_schannel] chan, reinterpret[&gcaddress] loc;
  1352:   }
  1353: 
  1354:   proc read[t](v:&t,chan:schannel[t]) {
  1355:     var x: gcptr[t];
  1356:     _read(chan,&x);
  1357:     *v = *x;
  1358:   }
  1359: 
  1360:   proc write[t](chan:schannel[t],v:t) {
  1361:     var ps = cast[gcaddress]$ xnew v;
  1362:     svc$ svc_swrite$ cast[_schannel] chan, &ps;
  1363:   }
  1364: 
  1365:   publish "Read primitive"
  1366:   // finds the machine address of the read buffer
  1367:   // then does a supervisor read specifying that address
  1368:   proc read[t](x:&t) {
  1369:     val vadr : address = C_hack::as_address$ C_hack::unref x;
  1370:     req  := svc_read vadr;
  1371:     svc req;
  1372:   }
  1373: 
  1374:   private fun _start[t]: (t->0)*t->cont = "$1->clone()->call(0,$2)";
  1375:   fun start[t] (p:t->0) (x:t) = { return _start (p,x); }
  1376:   private fun _start0: (1->0)->cont = "$1->clone()->call(0)";
  1377:   fun start (p:1->0) = { return _start0 (p); }
  1378: 
  1379:   fun mk_thread: cont->fthread = "new(*PTF gc,_fthread_ptr_map) flx::rtl::fthread_t($1)";
  1380: 
  1381:   proc spawn_fthread(p:1->0)
  1382:   {
  1383:       var con = start p;              // get continuation of p
  1384:       var fthr = mk_thread con;
  1385:       svc$ svc_spawn_detached fthr;
  1386:   }
  1387: 
  1388:   publish "Resume a continuation until it yields"
  1389:   fun step: cont -> cont = "$1->resume()";
  1390:   proc kill: fthread = "$1->cc = 0;";
  1391: 
  1392:   publish """
  1393:   Run a continuation until it terminates.
  1394:   Do not use this proc if the underlying
  1395:   procedure attempts to read messages.
  1396: 
  1397:   This is a low level primitive, bypassing fthreads.
  1398:   """
  1399:   proc run: cont =
  1400:   """
  1401:   {
  1402:     flx::rtl::con_t *tmp=$1;
  1403:     //if(!tmp)
  1404:     //  throw flx::rtl::flx_exec_failure_t (__FILE__,"run","Run terminated procedure");
  1405:     while(tmp) {
  1406:       try { tmp=tmp->resume(); }
  1407:       catch (flx::rtl::con_t *x) { tmp = x; }
  1408:     }
  1409:   }
  1410:   """;
  1411: 
  1412:   private proc _send[t]: &cont * t =
  1413:   """
  1414:   {
  1415:     using namespace flx::rtl;
  1416:     con_t *tmp = *(con_t**)$1.get_data();
  1417:     // run target until it reaches a service request (or death)
  1418:     while(tmp && (!tmp->p_svc || tmp->p_svc->variant == svc_yield)) {
  1419:       try { tmp=tmp->resume(); }
  1420:       catch (con_t *x) { tmp = x; }
  1421:     }
  1422:     // check it is alive and making the expected service request
  1423:     if (!tmp)
  1424:       throw flx_exec_failure_t (__FILE__,"send","Send to terminated procedure");
  1425:     if (!tmp->p_svc)
  1426:       throw flx_exec_failure_t (__FILE__,"send","Send to unready Procedure");
  1427:     if (tmp->p_svc->variant != svc_read)
  1428:       throw flx_exec_failure_t (__FILE__,"send","Send to Procedure which is not trying to read");
  1429:     // store the message
  1430:     **(?1**)tmp->p_svc->data= $2;
  1431:     // clear the service request
  1432:     tmp->p_svc = 0;
  1433:     // run the target until the next service request (or death)
  1434:     while(tmp && (!tmp->p_svc || tmp->p_svc->variant == svc_yield)) {
  1435:       try { tmp=tmp->resume(); }
  1436:       catch (con_t *x) { tmp = x; }
  1437:     }
  1438:     // save the new continuation
  1439:     *(con_t**)$1.get_data() = tmp;
  1440: 
  1441:   }
  1442:   """;
  1443: 
  1444:   publish """Send a message to a continuation.
  1445:   There is no type checking on the message type.
  1446:   The procedure is executed until
  1447:   the next wait_state, then the message is stored.
  1448: 
  1449:   Low level primitive, bypassing fthreads.
  1450:   """
  1451:   proc send[t] (p:&cont) (x:t)
  1452:   {
  1453:     _send (p,x);
  1454:   }
  1455: 
  1456:   publish """
  1457:   Invoke the garbage collector inside a procedure run
  1458:   by the top level (external) driver.
  1459: 
  1460:   Don't call this procedure in a procedure which is run
  1461:   with 'run', because such procedures do not link to their
  1462:   caller with frame pointers -- unless of course a such a
  1463:   procedure has a private collector.
  1464: 
  1465:   Note procedure called by functions are run with
  1466:   code equivalent to 'run'.
  1467:   """
  1468:   proc collect() { svc svc_collect; }
  1469: 
  1470: }
  1471: 
  1472: publish "List manipulation"
  1473: module List
  1474: {
  1475:   union list[T] = | Empty | Cons of T * list[T];
  1476: 
  1477:   fun _ctor_list[T, N] (x:Array::array[T, N]) = {
  1478:     var o = Empty[T];
  1479:     var i : int;
  1480: 
  1481:     forall i in Array::len(x) - 1 downto 0 do
  1482:       o = add(x.[i], o);
  1483:     done;
  1484: 
  1485:     return o;
  1486:   }
  1487: 
  1488:   fun len[T] : list[T] -> int =
  1489:     | Empty => 0
  1490:     | Cons (_,?t) => 1 + len t
  1491:   ;
  1492: 
  1493:   fun is_empty[T] : list[T] -> 2 =
  1494:     | Empty => true
  1495:     | _ => false
  1496:   ;
  1497: 
  1498:   fun map[T,U] (_f:T->U) (x:list[T]): list[U] = {
  1499:     return
  1500:       match x with
  1501:       | Empty[T] => Empty[U]
  1502:       | Cons[T] (?h, ?t) => Cons (_f(h), map[T,U] _f t)
  1503:       endmatch
  1504:     ;
  1505:   }
  1506: 
  1507:   noinline fun rev[T] (x:list[T]):list[T]= {
  1508:     fun aux (x:list[T]) (y:list[T]) : list[T] =
  1509:     {
  1510:       return
  1511:         match x with
  1512:         | Empty[T] => y
  1513:         | Cons[T] (?h, ?t) => aux t (Cons (h, y))
  1514:         endmatch
  1515:       ;
  1516:     }
  1517:     return aux x Empty[T];
  1518:   }
  1519: 
  1520:   proc iter[T] (_f:T->void) (x:list[T]) {
  1521:     match x with
  1522:     | Empty[T] => {}
  1523:     | Cons[T] (?h,?t) => { _f h; iter _f t; }
  1524:     endmatch
  1525:     ;
  1526:   }
  1527: 
  1528:   fun fold_left[T,U] (_f:U->T->U) (init:U) (x:list[T]):U =
  1529:   {
  1530:     return
  1531:       match x with
  1532:       | Empty[T] => init
  1533:       | Cons[T] (?h,?t) => fold_left _f (_f init h) t
  1534:       endmatch
  1535:     ;
  1536:   }
  1537: 
  1538:   fun fold_right[T,U] (_f:T->U->U) (x:list[T]) (init:U):U =
  1539:   {
  1540:     return
  1541:       match x with
  1542:       | Empty[T] => init
  1543:       | Cons[T] (?h,?t) => fold_right _f t (_f h init)
  1544:       endmatch
  1545:     ;
  1546:   }
  1547: 
  1548:   fun range (low:int, high:int, step:int) =
  1549:   {
  1550:     fun inner(low:int, high:int, step:int, values:list[int]) =
  1551:     {
  1552:       return
  1553:         if high < low
  1554:           then values
  1555:           else inner(low, high - step, step, Cons(high, values))
  1556:           endif
  1557:       ;
  1558:     }
  1559: 
  1560:     // reverse low and high so we can do negative steps
  1561:     lo, hi, s := if low < high
  1562:       then low, high, step
  1563:       else high, low, -step
  1564:       endif;
  1565: 
  1566:     // adjust the high to be the actual last value so we don't
  1567:     // have to reverse the list
  1568:     n := hi - lo - 1;
  1569: 
  1570:     return if s <= 0
  1571:       then Empty[int]
  1572:       else inner(lo, lo + n - (n % s), s, Empty[int])
  1573:       endif
  1574:     ;
  1575:   }
  1576: 
  1577:   fun range (low:int, high:int) => range(low, high, 1);
  1578: 
  1579:   fun range (num:int) => range(0, num, 1);
  1580: 
  1581:   noinline fun join[T] (x:list[T]) (y:list[T]):list[T] =
  1582:   {
  1583:     return
  1584:       match x with
  1585:       | Empty[T] => y
  1586:       | Cons[T] (?h,?t) => Cons (h, join t y)
  1587:       endmatch
  1588:     ;
  1589:   }
  1590: 
  1591:   fun add[T] (x:list[T], y: list[T]):list[T] => join x y;
  1592: 
  1593:   fun add[T] (x:T, y: list[T]):list[T] => Cons (x, y);
  1594: 
  1595:   // very slow, adding to end ..
  1596:   noinline fun add[T] (x:list[T], y: T):list[T] => rev$ Cons (y, rev x);
  1597: 
  1598:   noinline fun cat[T] (x:list[list[T]]):list[T] =
  1599:   {
  1600:      return
  1601:        match x with
  1602:        | Empty[list[T]] => Empty[T]
  1603:        | Cons[list[T]] (?h,?t) => fold_left join of (list[T]) h t
  1604:        endmatch
  1605:      ;
  1606:    }
  1607: 
  1608:   fun cat (sep:string) (x:list[string]):string =
  1609:   {
  1610:     return
  1611:       match x with
  1612:       | Empty[string] => ''
  1613:       | Cons[string] (?h, ?t) =>
  1614:           fold_left (fun (a:string) (b:string) => a + sep + b) h t
  1615:       endmatch
  1616:     ;
  1617:   }
  1618: 
  1619:   fun mem[T, U] (eq:T * U -> bool) (x:list[T]) (e:U) : bool =>
  1620:     match x with
  1621:     | Empty => false
  1622:     | Cons (?h,?t) => if eq (h, e) then true else mem eq t e endif
  1623:     endmatch
  1624:   ;
  1625: 
  1626:   fun mem[T] (eq:T -> bool) (x:list[T]) : bool =>
  1627:     match x with
  1628:       | Empty => false
  1629:       | Cons (?h,?t) => if eq(h) then true else mem eq t endif
  1630:     endmatch
  1631:   ;
  1632: 
  1633:   fun find[T, U] (eq:T * U -> bool) (x:list[T]) (e:U) : opt[T] =>
  1634:     match x with
  1635:       | Empty => None[T]
  1636:       | Cons (?h,?t) => if eq(h, e) then Some h else find eq t e endif
  1637:     endmatch
  1638:   ;
  1639: 
  1640:   fun find[T] (eq:T -> bool) (x:list[T]) : opt[T] =>
  1641:     match x with
  1642:       | Empty => None[T]
  1643:       | Cons (?h,?t) => if eq(h) then Some h else find eq t endif
  1644:     endmatch
  1645:   ;
  1646: 
  1647:   noinline fun filter[T] (P:T -> bool) (x:list[T]) : list[T] =
  1648:   {
  1649:     fun aux (inp:list[T], out: list[T]) =>
  1650:       match inp with
  1651:       | Empty => rev out
  1652:       | Cons(?h,?t) =>
  1653:         if P(h) then aux(t,Cons(h,out))
  1654:         else aux (t,out)
  1655:         endif
  1656:       endmatch
  1657:     ;
  1658:     return aux (x,Empty[T]);
  1659:   }
  1660: 
  1661:   fun prepend_unique[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] =>
  1662:     if mem eq x e then x else Cons (e,x) endif
  1663:   ;
  1664: 
  1665:   fun insert_unique[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] =>
  1666:     if mem eq x e then x else rev$ Cons (e,rev x) endif
  1667:   ;
  1668: 
  1669:   fun remove[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] =>
  1670:     filter (fun (y:T) => not eq (e,y)) x
  1671:   ;
  1672: 
  1673:   noinline fun append_unique[T] (eq: T * T -> bool) (x:list[T]) (e:T) : list[T] = {
  1674:     fun aux (inp:list[T], out: list[T]) =>
  1675:       match inp with
  1676:       | Empty => rev$ Cons(e,out)
  1677:       | Cons(?h,?t) =>
  1678:         if not eq (h, e) then aux(t,Cons(h,out))
  1679:         else aux (t,out)
  1680:         endif
  1681:       endmatch
  1682:     ;
  1683:     return aux (x,Empty[T]);
  1684:   }
  1685: }
  1686: 
  1687: publish "Association Lists (lists of pairs)"
  1688: module Assoc_list
  1689: {
  1690:   typedef assoc_list[A,B] = List::list[(A,B)];
  1691: }
  1692: 
  1693: publish "Array manipulation"
  1694: 
  1695: module Array
  1696: {
  1697:   publish "Array type"
  1698:   typedef array[t,n] = t ^ n;
  1699: 
  1700:   publish "Array access: works on LHS of assignment too"
  1701:   fun subscript[t,n]: array[t, n] * int -> t = "$1.data[$2]";
  1702:   fun subscript[t,n]: lvalue[array[t, n]] * int -> lvalue[t] = "$1.data[$2]";
  1703: 
  1704:   publish "Explicit array store function"
  1705:   proc store[t,n]: &array[t,n] * int * t = "((?1*)($1.get_data()))[$2]=$3;";
  1706: 
  1707:   fun len[T, N] (x:array[T, N]): int => Typing::memcount[N];
  1708: 
  1709:   fun map[T, N, U] (_f:T->U) (x:array[T, N]): array[U, N] = {
  1710:     var o : array[U, N];
  1711:     var i : int;
  1712:     forall i in 0 upto len(x) - 1 do
  1713:       o.[i] = _f x.[i];
  1714:     done;
  1715: 
  1716:     return o;
  1717:   };
  1718: 
  1719:   fun rev[T, N] (x:array[T, N]): array[T, N] = {
  1720:     var o : array[T, N];
  1721:     var i : int;
  1722: 
  1723:     val length = len x;
  1724: 
  1725:     forall i in 0 upto length - 1 do
  1726:       o.[length - 1 - i] = x.[i];
  1727:     done;
  1728: 
  1729:     return o;
  1730:   }
  1731: 
  1732:   proc iter[T, N] (_f:T->void) (x:array[T, N]) {
  1733:     var i : int;
  1734:     forall i in 0 upto len(x) - 1 do
  1735:       _f x.[i];
  1736:     done;
  1737:   }
  1738: 
  1739:   fun fold_left[T, N, U] (_f:U->T->U) (init:U) (x:array[T, N]): U = {
  1740:     var o = init;
  1741:     var i : int;
  1742: 
  1743:     forall i in len(x) - 1 downto 0 do
  1744:       o = _f o x.[i];
  1745:     done;
  1746: 
  1747:     return o;
  1748:   }
  1749: 
  1750:   fun fold_right[T, N, U] (_f:T->U->U) (x:array[T, N]) (init:U): U = {
  1751:     var o = init;
  1752:     var i : int;
  1753:     val length = len x;
  1754: 
  1755:     forall i in 0 upto len(x) - 1 do
  1756:       o = _f x.[i] o;
  1757:     done;
  1758: 
  1759:     return o;
  1760:   }
  1761: 
  1762: /*
  1763:   fun join[T, N, M] (x:array[T, N]) (y:array[T, M]):array[T, _flatten(N + M)] = {
  1764:     var o = array[T, _flatten(N + M)];
  1765:     val i : int;
  1766: 
  1767:     forall i in 0 upto len(x) - 1 do
  1768:       o.[i] = x.[i];
  1769:     done;
  1770: 
  1771:     val j : int;
  1772: 
  1773:     forall k in 0 upto len(y) - 1 do
  1774:       o.[i + j] = y.[i];
  1775:     done;
  1776: 
  1777:     return o;
  1778:   }
  1779: */
  1780: 
  1781:   fun mem[T, N] (eq:T*T->bool) (x:array[T, N]) (e:T): bool = {
  1782:     var i : int;
  1783:     forall i in 0 upto len(x) - 1 do
  1784:       if eq(x.[i], e) do
  1785:         return true;
  1786:       done;
  1787:     done;
  1788: 
  1789:     return false;
  1790:   }
  1791: 
  1792:   fun mem[T, N] (eq:T->bool) (x:array[T, N]): bool = {
  1793:     var i : int;
  1794:     forall i in 0 upto len(x) - 1 do
  1795:       if eq(x.[i]) do
  1796:         return true;
  1797:       done;
  1798:     done;
  1799: 
  1800:     return false;
  1801:   }
  1802: 
  1803:   fun find[T, N] (eq:T*T->bool) (x:array[T, N]) (e:T): opt[T] = {
  1804:     var i : int;
  1805:     forall i in 0 upto len(x) - 1 do
  1806:       if eq(x.[i], e) do
  1807:         return Some x.[i];
  1808:       done;
  1809:     done;
  1810: 
  1811:     return None[T];
  1812:   }
  1813: 
  1814:   fun find[T, N] (eq:T->bool) (x:array[T, N]): opt[T] = {
  1815:     var i : int;
  1816: 
  1817:     forall i in 0 upto len(x) - 1 do
  1818:       if eq(x.[i]) do
  1819:         return Some x.[i];
  1820:     done;
  1821:     done;
  1822: 
  1823:     return None[T];
  1824:   }
  1825: }
  1826: 
  1827: publish "Bounded Variable length arrays"
  1828: 
  1829: module Varray
  1830: {
  1831:    _gc_pointer _gc_type t type varray[t] = "?1*";
  1832: 
  1833:    fun mk_array[t]: size -> varray[t] = "new(*PTF gc,@?1,(unsigned long)$1) ?1[$1]";
  1834: 
  1835:    fun len[t]: varray[t] -> size = "flx::gc::generic::get_count($1)";
  1836: 
  1837:    private // unsafe!
  1838:    proc set_length[t]: size * varray[t] =
  1839:      """
  1840:      {
  1841:        unsigned long newcount = $1;
  1842:        unsigned long oldcount = flx::gc::generic::get_count($2);
  1843:        flx::gc::generic::reset_count(newcount,$2);
  1844:        while(oldcount < newcount) ::new($2+oldcount++) ?1;
  1845:        while(oldcount > newcount) ($2+oldcount--)->~?1;
  1846:      }
  1847:      """;
  1848: }
  1849: 
  1850: // This module provides functions to
  1851: // use in conjunction with the reglex construction
  1852: module Lexer
  1853: {
  1854:   pod type iterator = "char const*";
  1855:   fun start_iterator : lvalue[string] -> iterator = "$1.data()";
  1856:   fun end_iterator: lvalue[string] -> iterator = "$1.data()+$1.size()";
  1857:   fun bounds (x:lvalue[string]): iterator * iterator = {
  1858:     return
  1859:       start_iterator x,
  1860:       end_iterator x
  1861:     ;
  1862:   }
  1863:   fun string_between: iterator * iterator -> string =
  1864:    "std::string($1,$2)";
  1865: 
  1866:   gen_cmp iterator;
  1867: 
  1868:   fun add: iterator * int -> iterator = "$1 + $2";
  1869:   fun sub: iterator * int -> iterator = "$1 - $2";
  1870:   fun sub: iterator * iterator -> int = "$1 - $2";
  1871:   proc pre_incr: lvalue[iterator] = "++$1;";
  1872:   proc post_incr: lvalue[iterator] = "++$1;";
  1873:   fun deref: iterator -> char = "*$1";
  1874: 
  1875: }
  1876: 
  1877: // ------ Open common modules -------------
  1878: open Bool;
  1879: open Int;
  1880: open Double;
  1881: open Char;
  1882: open String;
  1883: open Array;
  1884: open Stdout;
  1885: open Arith_casts;
  1886: open Control;
  1887: open Cstdio;
  1888: 
End data section to lib/std.flx[1]