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