header '#include "flx_rtl_config.hpp"';
#include "flx_categories.flx"
header iostream = "#include <iostream>";
header cmath = """
#include <cmath>
#ifdef HAVE_ISNAN_IN_IEEEFP
extern "C" {
#include <ieeefp.h>
}
#endif
""";
header """
#include <cstdio>
#include <cstddef>
#include <cassert>
#include <climits>
using namespace std;
""";
header flx_ioutil = '#include "flx_ioutil.hpp"';
header flx_dynlink = '#include "flx_dynlink.hpp"';
header flx_i18n = '#include "flx_i18n.hpp"';
// note -- this code is templated, we include
// it in the header file because that's where
// most C++ compilers need it (ISO requires
// separate compilation of templates but most
// compilers as at 2004 don't implement it)
header flx_strutil = '#include "flx_strutil.cpp"';
header cctype_hxx = '#include <cctype>';
header string_hxx = '#include <string>';
header complex_hxx = '#include <complex>';
header c99_complex_h = '#include <complex.h>';
header c99_stdint_h = "#include <stdint.h>";
header cstdlib = "#include <cstdlib>";
pod type byte = "unsigned char";
pod type address = "void *";
pod type caddress = "void const*";
pod type vaddress = "void volatile*";
pod type cvaddress = "void const volatile*";
pod type offset = "ptrdiff_t";
pod type char = "char";
pod type wchar = "wchar_t";
pod type uchar = "int32_t";
pod type tiny = "signed char";
pod type short = "short";
pod type int = "int";
pod type long = "long";
pod type vlong = "long long";
pod type utiny = "unsigned char";
pod type ushort = "unsigned short";
pod type uint = "unsigned int";
pod type ulong = "unsigned long";
pod type uvlong = "unsigned long long";
pod type float = "float";
pod type double = "double";
pod type ldouble = "long double";
pod type complex = "float _Complex" requires c99_complex_h;
pod type dcomplex = "double _Complex" requires c99_complex_h;
pod type lcomplex = "long double _Complex" requires c99_complex_h;
pod type imaginary = "float _Imaginary" requires c99_complex_h;
pod type dimaginary = "double _Imaginary" requires c99_complex_h;
pod type limaginary = "long double _Imaginary" requires c99_complex_h;
typedef ptrdiff = int;
typedef size = uint;
typedef int8 = tiny;
rename Int8 = Tiny;
typedef int16 = short;
rename Int16 = Short;
typedef int32 = int;
rename Int32 = Int;
typedef int64 = vlong;
rename Int64 = Vlong;
typedef uint8 = utiny;
rename Uint8 = Utiny;
typedef uint16 = ushort;
rename Uint16 = Ushort;
typedef uint32 = uint;
rename Uint32 = Uint;
typedef uint64 = uvlong;
rename Uint64 = Uvlong;
typedef chars = typesetof (char, wchar, uchar);
typedef fast_sints = typesetof (tiny, short, int, long, vlong);
typedef exact_sints = typesetof(int8,int16,int32,int64);
typedef fast_uints = typesetof (utiny, ushort, uint, ulong,uvlong);
typedef exact_uints = typesetof (uint8,uint16,uint32,uint64);
typedef sints = fast_sints || exact_sints;
typedef uints = fast_uints || exact_uints;
typedef fast_ints = fast_sints || fast_uints;
typedef exact_ints = exact_sints || exact_uints;
typedef ints = sints || uints;
typedef floats = typesetof (float, double, ldouble);
typedef reals = ints || floats;
typedef complexes = typesetof (complex,dcomplex,lcomplex);
typedef imaginaries = typesetof (imaginary, dimaginary, limaginary);
typedef numbers = reals || imaginaries || complexes;
// C integer promotion rule
typedef fun integral_promotion: TYPE -> TYPE =
| tiny => int
| utiny => int
| short => int
| ushort => int
| int => int
| uint => uint
| long => long
| ulong => ulong
| vlong => vlong
| uvlong => uvlong
;
// arithmetic conversion rule
typedef fun arithmax(l: TYPE, r: TYPE): TYPE =>
typematch integral_promotion l, integral_promotion r with
| vlong,vlong => vlong
| vlong,ulong => vlong
| vlong,int => vlong
| vlong,long => vlong
| vlong,uint => vlong
| ulong,vlong => vlong
| ulong,ulong => ulong
| ulong,int => ulong
| ulong,long => ulong
| ulong,uint => ulong
| int,vlong => vlong
| int,ulong => ulong
| int,long => long
| int,uint => uint
| long,vlong => vlong
| long,ulong => ulong
| long,int => long
| long,long => long
| long,uint => ulong // SPECIAL PROMOTION
| uint,vlong => vlong
| uint,ulong => ulong
| uint,int => uint
| uint,long => ulong // SPECIAL PROMOTION
| uint,uint => uint
| uvlong,_ => uvlong
| _,uvlong => uvlong
| _,_ => int
endmatch
;
body swapper[t] = """
void swapper(?1 &a, ?1 &b){
?1 tmp = a; a = b; b = tmp;
}
""";
proc _swap[t]: lvalue[t] * lvalue[t] =
"swapper($1,$2);"
requires swapper[t];
typedef charp = C_hack::ptr[char];
typedef charcp = C_hack::cptr[char];
publish "Empty sum"
typedef void = 0;
publish "Unit type"
typedef unit = 1;
publish "Boolean"
typedef bool = 2;
publish "option type"
typedef optional[t] = 1 + t;
publish "Universal type 'x as x'"
typedef any = any;
publish "Array type"
typedef array[t,n] = t ^ n;
publish "Lvalue hack"
typedef lvalue[t] = lval t;
publish "Array access: works on LHS of assignment too"
fun subscript[t,n]: array[t, n] * int -> t = "$1.data[$2]";
fun subscript[t,n]: lvalue[array[t, n]] * int -> lvalue[t] = "$1.data[$2]";
publish "Explicit array store function"
proc store[t,n]: &array[t,n] * int * t = "((?1*)($1.data))[$2]=$3;";
module Typing
{
typedef fun dom(t:TYPE):TYPE =>
typematch t with
| ?a -> _ => a
endmatch
;
typedef fun cod(t:TYPE):TYPE =>
typematch t with
| _ -> ?b => b
endmatch
;
typedef fun prj1(t:TYPE):TYPE =>
typematch t with
| ?a * _ => a
endmatch
;
typedef fun prj2(t:TYPE):TYPE =>
typematch t with
| _ * ?b => b
endmatch
;
typedef fun land(x:TYPE, y:TYPE):TYPE =>
typematch (x, y) with
| 0, _ => 0
| _,0 => 0
| _,_ => 1
endmatch
;
typedef fun lor(x:TYPE, y:TYPE):TYPE=>
typematch (x, y) with
| 0, 0 => 0
| _,_ => 1
endmatch
;
}
publish """
This module provides access to raw C/C++ encodings.
Incorrect typing is likely to pass by Felix and
be trapped by the C/C++ compiler. Incorrect management
of storage can lead to corruption. The use of the
C_hack module is necessary for interfacing.
"""
module C_hack
{
publish "C void"
incomplete type void_t = "void";
publish "standard variable argument list pointer type"
type va_list = "va_list";
publish """
GCC specific valist thingo: it will
be optimised away if not used (eg on MSVC)
"""
type __builtin_va_list = '__builtin_va_list';
publish """
Throw away result of a function call:
only useful for C functions that are mainly
called for side effects.
"""
proc ignore[t]:t = "(void)$t;";
fun cast[dst,src]: src->dst = '(?1)($1)';
fun static_cast[dst,src]: src->dst = 'static_cast<?1>($1)';
fun dynamic_cast[dst,src]: src->dst = 'dynamic_cast<?1>($1)';
fun reinterpret_cast[dst,src]: src->dst = 'reinterpret_cast<?1>($1)';
const sizeof[t]:size = 'sizeof(?1)';
fun int_of:size->int='$1';
fun size_of:int->size='$1';
publish "Abstract type for C pointer"
pod type ptr[t]="?1 *";
publish "Abstract type for C pointer to const"
pod type cptr[t]="?1 const *";
publish "Convert pointer to pointer to const"
fun enconst[t]: ptr[t]->cptr[t] = "(?1 const*)$1";
publish """
Unsafe function to get C pointer from Felix reference.
The pointer may dangle if the collector deletes the
frame containing the object.
"""
fun unref[t]: &t->ptr[t] = "(?1*)($1.data)";
publish """
Function to make Felix reference from C pointer.
This function is only safe if the C pointer
was not allocated by the Felix collector:
the resulting reference will never be collected
(because the frame pointer is set to 0)
"""
fun mkref[t]: ptr[t]->&t = "(#0 const&)flx::rtl::_ref_(0,(void*)$1)";
publish """
Dereference a C pointer. If the expression is an
an lvalue, the result is an lvalue. Assignments
to const lvalues are trapped by the C/C++ compiler.
"""
fun deref[t]: ptr[t] -> lvalue[t] = "*$1";
fun deref[t]: cptr[t] -> lvalue[t] = "*$1";
publish """
Function to take the address of a C lvalue,
fails in C/C++ compiler if the argument isn't an lvalue.
Addresses of Felix variables are safe to use provided the
containing frame won't be collected.
Addresses of temporaries must not be taken.
"""
fun addr[t]: lvalue[t] -> ptr[t] = "&$1";
fun caddr[t]: lvalue[t] -> cptr[t] ="(?1 const*)&$1";
fun as_address[t]: ptr[t]->address = "(void*)$1";
fun address_of[t]: lvalue[t]-> address = "(void*)&$1";
fun isNULL: address -> bool = "(NULL==$1)";
publish """
Polymorphic null pointer constant
"""
const null_ptr[t]:ptr[t] = "(?1*)NULL";
const null_cptr[t]:ptr[t] = "(?1 const*)NULL";
publish """
Unsafe output of hopefully null terminated C strings
"""
proc print: charp = "std::cout << $1;" requires iostream;
proc print: charcp = "std::cout << $1;" requires iostream;
publish """ print an address in hex """
proc print: address = "std::cout << $1;" requires iostream;
header dflt_h = "template<class T> T dflt() { return T(); }";
publish """
Workaround for g++ 3.2.2 parsing bug,
it can parse T() as a default ctor call,
but screws up on (T())
"""
fun dflt[t]:1->t = "dflt<?1>()" requires dflt_h;
}
module Carray
{
requires cstdlib;
open C_hack;
fun array_alloc[t]: int -> ptr[t] = '(?1*)std::malloc(sizeof(?1)*$1)';
fun array_calloc[t]: int -> ptr[t] = '(?1*)std::calloc(sizeof(?1),$1)';
proc free[t]: ptr[t]="std::free($1);";
fun subscript[t]: ptr[t] * int -> lvalue[t] = '$1[$2]';
}
publish "System Interface"
module System
{
const argc:int = "ptf->argc";
fun argv:int -> string = 'std::string($1<0||$1>=ptf->argc??"":ptf->argv[$1])';
const felix_version : string = 'std::string("1.1.1")';
fun system: string -> int = "std::system($1.data())"
requires cstdlib;
proc exit: int = "std::exit($1);";
proc abort: 1 = "std::abort($1);";
type ptf_t = "thread_frame_t*";
const ptf:ptf_t = "ptf";
// note this will NOT work if ptf is a struct,
// then we'd need (&ptf) instead ..
// however this model isn't supported fully yet and probably never will be
// we may, however, make ptf a machine register
}
module Env
{
fun getenv:string -> string =
"flx::rtl::strutil::atostr(getenv($1.data()))"
requires flx_strutil, cstdlib;
}
module Dynlink
{
requires flx_dynlink;
type flx_library = "flx::rtl::flx_dynlink_t*";
type flx_instance = "flx::rtl::flx_libinit_t";
proc dlopen:flx_library * string = "$1->link($2.data());";
proc dlclose:flx_library = "$1->unlink();";
// this is a procedure, so maybe the caller is too
// which means the thread frame must be available
proc create: flx_library * flx_instance =
"_create($1,&$2,PTF gc,PTF argc,PTF argv,PTF flx_stdin, PTF flx_stdout, PTF flx_stderr);"
requires property "needs_gc",
body """
void _create
(
flx::rtl::flx_dynlink_t *library,
flx::rtl::flx_libinit_t *instance,
flx::gc::generic::collector_t *gc,
int argc, char **argv,
FILE *stdin_, FILE *stdout_, FILE *stderr_
)
{
instance->create(library,gc,argc,argv,stdin_,stdout_,stderr_);
}
""";
private fun get_init: flx_instance -> cont = "$1.start_proc";
private fun get_library: flx_instance -> flx_library = "$1.lib";
proc destroy: flx_instance = "$1.destroy();";
fun create_library_handle: unit->flx_library=
"new flx::rtl::flx_dynlink_t()";
proc delete_library_handle: flx_library =
"delete $1;";
noinline fun init_lib(filename:string):flx_instance = {
var library = create_library_handle();
var instance: flx_instance;
dlopen(library,filename);
create (library,instance);
var init = get_init instance;
Control::run init;
return instance;
}
publish """ Run a Felix program.
WARNING!! All data created by the target
program must be destroyed
before the library code is unlinked.
"""
proc run_lib(filename:string)
{
var instance = init_lib(filename);
destroy_lib instance;
}
noinline proc destroy_lib(instance:flx_instance)
{
destroy instance;
Control::collect();
dl := get_library instance;
dlclose dl;
delete_library_handle dl;
}
publish "dlsym wrapper, returns any symbol"
fun dlsym:flx_library * string->address =
"SDLSYM($1->library,$2.data())";
publish """
execute an address representing a top
level exported felix procedure's C wrapper,
this creates a 'read to run' continuation object
by both constructing the object using the thread
frame of the instance as an argument, and calling
it to fix a null return address and an arbitrary
client data pointer as arguments to the call method.
"""
fun bind_proc: flx_instance * address * address -> cont =
"$1.bind_proc($2,$3)";
fun dlib_of : flx_library -> address = "(void*)$1->library";
proc dlsym_err:flx_library*string="""
throw flx::rtl::flx_link_failure_t($1->filename,$2,"symbol not found");
""";
noinline proc run_proc (instance:flx_instance, p: string, data: address)
{
var lib = get_library instance;
var sym = dlsym(lib, p);
if C_hack::isNULL(sym) do dlsym_err(lib,p); done;
var f = bind_proc(instance, sym, data);
run f;
}
}
module Text_file
{
requires flx_ioutil;
fun load: string -> string = "flx::rtl::ioutil::load_file($1)";
fun load: text_file -> string = "flx::rtl::ioutil::load_file($1)";
pod type text_file = "FILE*"; // its a macro?
fun fopen_input: string -> text_file = 'std::fopen($1.data(),"rt")';
fun fopen_output: string -> text_file = 'std::fopen($1.data(),"wt")';
proc fclose: text_file = '(void)std::fclose($1);';
fun readln: text_file -> string ="flx::rtl::ioutil::readln($1)";
proc writeln : text_file * string ="flx::rtl::ioutil::writeln($1,$2);";
proc write : text_file * string ="flx::rtl::ioutil::write($1,$2);";
fun valid : text_file -> bool = "$1!=(FILE*)0";
const stdin: text_file = "PTF flx_stdin";
const stdout: text_file = "PTF flx_stdout";
const stderr: text_file = "PTF flx_stderr";
}
publish "Bool compatible with C"
module Bool
{
val false : bool = case 1 of 2; // binary 0
val true : bool = case 2 of 2; // binary 1
gen_eq bool;
fun land: bool * bool -> bool = "$1 && $2";
fun nand: bool * bool -> bool = "!($1 && $2)";
fun lor: bool * bool -> bool = "$1 || $2";
fun nor: bool * bool -> bool = "!($1 || $2)";
fun xor: bool * bool -> bool = "$1 != $2";
fun lnot: bool -> bool = "!$1";
proc print: bool = 'std::cout << ($1??"true":"false");' requires iostream;
}
publish "Mixed Mode arithmentic"
module MixedInt
{
fun add[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1+$2";
fun sub[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1-$2";
fun mul[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1*$2";
fun div[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1/$2";
fun mod[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1%$2";
fun band[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1&$2";
fun bor[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1|$2";
fun bxor[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1^$2";
fun shl[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1<<$2";
fun shr[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1>>$2";
fun lt[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1<$2";
fun le[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1<=$2";
fun eq[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1==$2";
fun ne[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1!=$2";
fun gt[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1>$2";
fun ge[t1:fast_ints, t2:fast_ints]: t1 * t2 -> arithmax(t1,t1)="$1>=$2";
}
type string = "std::string";
module Tiny
{
gen_integral(tiny);
fun abs: tiny -> tiny = "abs($1)";
proc print: tiny = "std::cout << (int)$1;" requires iostream;
fun str: tiny -> string = "flx::rtl::strutil::str<int>($1)" requires flx_strutil;
}
module Short
{
gen_integral(short);
fun abs: short -> short = "abs($1)";
proc print: short = "std::cout<<$1;" requires iostream;
fun str: short -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Int
{
gen_integral(int);
fun abs: int -> int = "abs($1)";
proc print: int = "std::cout<<$1;" requires iostream;
fun str: int -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Long
{
gen_integral(long);
fun abs: long -> long = "labs($1)";
proc print: long = "std::cout<<$1;" requires iostream;
fun str: long -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Vlong
{
gen_integral(vlong);
fun abs: vlong -> vlong = "llabs($1)";
proc print: vlong = "std::cout<<$1;" requires iostream;
fun str: vlong -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Utiny
{
gen_integral(utiny);
fun bxor: utiny * utiny -> utiny = "$1^$2";
fun bor: utiny * utiny -> utiny = "$1|$2";
fun band: utiny * utiny -> utiny = "$1&$2";
fun bnot: utiny -> utiny = "~$1";
proc bxoreq: lvalue[utiny] * utiny = "$1^=$2;";
proc boreq: lvalue[utiny] * utiny = "$1|=$2;";
proc bandeq: lvalue[utiny] * utiny = "$1&=$2;";
proc print: utiny = "std::cout << (unsigned int)$1;" requires iostream;
fun str: utiny -> string = "flx::rtl::strutil::str<unsigned int>($1)" requires flx_strutil;
}
module Ushort
{
gen_integral(ushort);
fun bxor: ushort * ushort -> ushort = "$1^$2";
fun bor: ushort * ushort -> ushort = "$1|$2";
fun band: ushort * ushort -> ushort = "$1&$2";
fun bnot: ushort -> ushort = "~$1";
proc bxoreq: lvalue[ushort] * ushort = "$1^=$2;";
proc boreq: lvalue[ushort] * ushort = "$1|=$2;";
proc bandeq: lvalue[ushort] * ushort = "$1&=$2;";
proc print: ushort = "std::cout<<$1;" requires iostream;
fun str: ushort -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Uint
{
gen_integral(uint);
fun bxor: uint * uint -> uint = "$1^$2";
fun bor: uint * uint -> uint = "$1|$2";
fun band: uint * uint -> uint = "$1&$2";
fun bnot: uint -> uint = "~$1";
proc bxoreq: lvalue[uint] * uint = "$1^=$2;";
proc boreq: lvalue[uint] * uint = "$1|=$2;";
proc bandeq: lvalue[uint] * uint = "$1&=$2;";
proc print: uint = "std::cout<<$1;" requires iostream;
fun str: uint -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Ulong
{
gen_integral(ulong);
fun bxor: ulong * ulong -> ulong = "$1^$2";
fun bor: ulong * ulong -> ulong = "$1|$2";
fun band: ulong * ulong -> ulong = "$1&$2";
fun bnot: ulong -> ulong = "~$1";
proc bxoreq: lvalue[ulong] * ulong = "$1^=$2;";
proc boreq: lvalue[ulong] * ulong = "$1|=$2;";
proc bandeq: lvalue[ulong] * ulong = "$1&=$2;";
proc print: ulong = "std::cout<<$1;" requires iostream;
fun str: ulong -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Uvlong
{
gen_integral(uvlong);
fun bxor: uvlong * uvlong -> uvlong = "$1^$2";
fun bor: uvlong * uvlong -> uvlong = "$1|$2";
fun band: uvlong * uvlong -> uvlong = "$1&$2";
fun bnot: uvlong -> uvlong = "~$1";
proc bxoreq: lvalue[uvlong] * uvlong = "$1^=$2;";
proc boreq: lvalue[uvlong] * uvlong = "$1|=$2;";
proc bandeq: lvalue[uvlong] * uvlong = "$1&=$2;";
proc print: uvlong = "std::cout<<$1;" requires iostream;
fun str: uvlong -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Float
{
gen_cmp(float);
gen_arith(float);
fun pow: float * float -> float = "powf($1, $2)" is postfix requires cmath;
fun atan2: float * float -> float = "atan2f($1, $2)" is postfix requires cmath;
fun fmod: float * float -> float = "fmodf($1, $2)" is postfix requires cmath;
fun fmax: float * float -> float = "fmaxf($1, $2)" is postfix requires cmath;
fun fmin: float * float -> float = "fminf($1, $2)" is postfix requires cmath;
fun sin: float -> float = "sinf($1)" is postfix requires cmath;
fun cos: float -> float = "cosf($1)" is postfix requires cmath;
fun tan: float -> float = "tanf($1)" is postfix requires cmath;
fun asin: float -> float = "asinf($1)" is postfix requires cmath;
fun acos: float -> float = "acosf($1)" is postfix requires cmath;
fun atan: float -> float = "atanf($1)" is postfix requires cmath;
fun sinh: float -> float = "sinhf($1)" is postfix requires cmath;
fun cosh: float -> float = "coshf($1)" is postfix requires cmath;
fun tanh: float -> float = "tanhf($1)" is postfix requires cmath;
fun asinh: float -> float = "asinhf($1)" is postfix requires cmath;
fun acosh: float -> float = "acoshf($1)" is postfix requires cmath;
fun atanh: float -> float = "atanhf($1)" is postfix requires cmath;
fun exp: float -> float = "expf($1)" is postfix requires cmath;
fun log: float -> float = "logf($1)" is postfix requires cmath;
fun log10: float -> float = "log10f($1)" is postfix requires cmath;
fun fabs: float -> float = "fabsf($1)" is postfix requires cmath;
fun sqrt: float -> float = "sqrtf($1)" is postfix requires cmath;
fun ceil: float -> float = "ceilf($1)" is postfix requires cmath;
fun floor: float -> float = "floorf($1)" is postfix requires cmath;
fun trunc: float -> float = "truncf($1)" is postfix requires cmath;
fun isnan: float -> bool = "isnanf($1)" is postfix requires cmath;
proc print: float = "std::cout<<$1;" requires iostream;
fun str: float -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Double
{
gen_cmp(double);
gen_arith(double);
fun pow: double * double -> double = "pow($1, $2)" is postfix requires cmath;
fun atan2: double * double -> double = "atan2($1, $2)" is postfix requires cmath;
fun fmod: double * double -> double = "fmod($1, $2)" is postfix requires cmath;
fun fmax: double * double -> double = "fmax($1, $2)" is postfix requires cmath;
fun fmin: double * double -> double = "fmin($1, $2)" is postfix requires cmath;
fun sin: double -> double = "sin($1)" is postfix requires cmath;
fun cos: double -> double = "cos($1)" is postfix requires cmath;
fun tan: double -> double = "tan($1)" is postfix requires cmath;
fun asin: double -> double = "asin($1)" is postfix requires cmath;
fun acos: double -> double = "acos($1)" is postfix requires cmath;
fun atan: double -> double = "atan($1)" is postfix requires cmath;
fun sinh: double -> double = "sinh($1)" is postfix requires cmath;
fun cosh: double -> double = "cosh($1)" is postfix requires cmath;
fun tanh: double -> double = "tanh($1)" is postfix requires cmath;
fun asinh: double -> double = "asinh($1)" is postfix requires cmath;
fun acosh: double -> double = "acosh($1)" is postfix requires cmath;
fun atanh: double -> double = "atanh($1)" is postfix requires cmath;
fun exp: double -> double = "exp($1)" is postfix requires cmath;
fun log: double -> double = "log($1)" is postfix requires cmath;
fun log10: double -> double = "log10($1)" is postfix requires cmath;
fun fabs: double -> double = "fabs($1)" is postfix requires cmath;
fun sqrt: double -> double = "sqrt($1)" is postfix requires cmath;
fun ceil: double -> double = "ceil($1)" is postfix requires cmath;
fun floor: double -> double = "floor($1)" is postfix requires cmath;
fun trunc: double -> double = "trunc($1)" is postfix requires cmath;
fun isnan: double -> bool = "isnan($1)" is postfix requires cmath;
proc print: double = "std::cout<<$1;" requires iostream;
fun str: double -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
module Ldouble
{
gen_cmp(ldouble);
gen_arith(ldouble);
fun pow: ldouble * ldouble -> ldouble = "powl($1, $2)" is postfix requires cmath;
fun atan2: ldouble * ldouble -> ldouble = "atan2l($1, $2)" is postfix requires cmath;
fun fmod: ldouble * ldouble -> ldouble = "fmodl($1, $2)" is postfix requires cmath;
fun fmax: ldouble * ldouble -> ldouble = "fmaxl($1, $2)" is postfix requires cmath;
fun fmin: ldouble * ldouble -> ldouble = "fminl($1, $2)" is postfix requires cmath;
fun sin: ldouble -> ldouble = "sinl($1)" is postfix requires cmath;
fun cos: ldouble -> ldouble = "cosl($1)" is postfix requires cmath;
fun tan: ldouble -> ldouble = "tanl($1)" is postfix requires cmath;
fun asin: ldouble -> ldouble = "asinl($1)" is postfix requires cmath;
fun acos: ldouble -> ldouble = "acosl($1)" is postfix requires cmath;
fun atan: ldouble -> ldouble = "atanl($1)" is postfix requires cmath;
fun sinh: ldouble -> ldouble = "sinhl($1)" is postfix requires cmath;
fun cosh: ldouble -> ldouble = "coshl($1)" is postfix requires cmath;
fun tanh: ldouble -> ldouble = "tanhl($1)" is postfix requires cmath;
fun asinh: ldouble -> ldouble = "asinhl($1)" is postfix requires cmath;
fun acosh: ldouble -> ldouble = "acoshl($1)" is postfix requires cmath;
fun atanh: ldouble -> ldouble = "atanhl($1)" is postfix requires cmath;
fun exp: ldouble -> ldouble = "expl($1)" is postfix requires cmath;
fun log: ldouble -> ldouble = "logl($1)" is postfix requires cmath;
fun log10: ldouble -> ldouble = "log10l($1)" is postfix requires cmath;
fun fabs: ldouble -> ldouble = "fabsl($1)" is postfix requires cmath;
fun sqrt: ldouble -> ldouble = "sqrtl($1)" is postfix requires cmath;
fun ceil: ldouble -> ldouble = "ceill($1)" is postfix requires cmath;
fun floor: ldouble -> ldouble = "floorl($1)" is postfix requires cmath;
fun trunc: ldouble -> ldouble = "truncl($1)" is postfix requires cmath;
fun isnan: ldouble -> bool = "isnanl($1)" is postfix requires cmath;
proc print: ldouble = "std::cout<<$1;" requires iostream;
fun str: ldouble -> string = "flx::rtl::strutil::str<#1>($1)" requires flx_strutil;
}
// ordinary value of chars
gen_eq(char);
gen_eq(wchar);
gen_eq(uchar);
module Char
{
open Int;
fun ord: char -> int = "(int)$1";
fun chr: int -> char = "(char)$1";
proc print: char = "std::cout<<$1;" requires iostream;
}
module Wchar
{
open Long;
fun ord: wchar -> long ="(long)$1";
fun wchr: long -> wchar = "(wchar_t)$1";
proc print: wchar = "std::cout<<$1;" requires iostream;
}
module Unicode
{
fun ord: uchar -> uint32 ="$1";
fun uchr: uint32 -> uchar = "$1";
//this needs to be fixed!
//proc print: uchar = "std::cout<<$1;" requires iostream;
}
module Stdout
{
proc endl: unit = "std::cout << std::endl;" requires iostream;
proc space: int = "std::cout << ' ';" requires iostream;
}
macro proc print_line (x) { print x; Stdout::endl; }
module String
{
requires string_hxx;
open Bool;
open Char;
open Int;
proc pluseq: lvalue[string] * string = "$1.append($2);";
proc pluseq: lvalue[string] * charcp = "$1.append($2);";
proc pluseq: lvalue[string] * charp = "$1.append($2);";
proc pluseq: lvalue[string] * char = "$1 += $2;";
fun str: charp -> string = 'flx::rtl::strutil::atostr($1)' requires flx_strutil;
fun str: charcp -> string = 'flx::rtl::strutil::atostr($1)' requires flx_strutil;
fun len: string -> int = "$1.size()";
fun add: string * string -> string = "$1+$2";
fun add: string * int -> string = "$1+flx::rtl::i18n::utf8($2)" requires flx_i18n;
fun mul: string * int -> string = "flx::rtl::strutil::mul($1,$2)" requires flx_strutil;
fun mul: char * int -> string = "std::string($2,$1)";
fun apply (x:string, y:string):string => x + y;
fun apply (x:string, y:int):string => x + y;
fun subscript: string * int -> char =
"$1[$2<0??$1.size()+$2 : $2]";
fun copyfrom: string * int -> string =
"flx::rtl::strutil::substr($1,$2,$1.size())" requires flx_strutil;
fun copyto: string * int -> string =
"flx::rtl::strutil::substr($1,0,$2)" requires flx_strutil;
fun substring: string * int * int -> string =
"flx::rtl::strutil::substr($1,$2,$3)" requires flx_strutil;
// comparisons
gen_cmp string;
proc print: string = "std::cout << $1;" requires iostream;
fun atoi: string -> int = "std::atoi($1.data())" requires cstdlib;
fun atol: string -> long = "std::atol($1.data())" requires cstdlib;
fun atof: string -> double = "std::atof($1.data())" requires cstdlib;
proc reserve: lvalue[string] * int = "$1.reserve($2);";
publish "Unsafe extract buffer pointer"
fun cstr: string -> C_hack::ptr[char] = "$1.data()";
fun repr_expr[t]: t -> string = '\\"$a:?1\\"';
const repr_type[t]:string = '\\"?1\\"';
}
module Cstdlib
{
requires cstdlib;
const RAND_MAX:long;
proc srand: uint = 'std::srand($1);';
fun rand: 1 -> int = 'std::rand()';
}
type ustring = "basic_string<uint32_t>" requires string_hxx;
module Ustring
{
open Bool;
open Char;
open Int;
proc pluseq: lvalue[ustring] * ustring = "$1.append($2);";
fun len: ustring -> int = "$1.size()";
fun add: ustring * ustring -> ustring = "$1+$2";
fun mul: ustring * int -> ustring = "flx::lib::mul($1,$2)";
fun mul: char * int -> ustring = "ustring($2,$1)";
fun apply (x:ustring, y:ustring):ustring => x + y;
fun subscript: ustring * int -> char =
"$1[$2<0??$1.size()+$2 : $2]";
fun copyfrom: ustring * int -> ustring =
"flx::rtl::strutil::substr($1,$2,$1.size())";
fun copyto: ustring * int -> ustring =
"flx::rtl::strutil::substr($1,0,$2)";
fun subustring: ustring * int * int -> ustring =
"flx::rtl::strutil::substr($1,$2,$3)";
// comparisons
gen_cmp ustring;
proc print: ustring = "std::cout << $1;" requires iostream;
}
publish """
All the arithmetic casts between standard C arithmetic types.
"""
module Arith_casts
{
fun utiny_of[t2:reals]: t2 -> utiny = "(unsigned char)$1:cast" is cast;
fun ushort_of[t2:reals]: t2 -> ushort = "(unsigned short)$1:cast" is cast;
fun uint_of[t2:reals]: t2 -> uint = "(unsigned int)$1:cast" is cast;
fun ulong_of[t2:reals]: t2 -> ulong = "(unsigned long)$1:cast" is cast;
fun uvlong_of[t2:reals]: t2 -> uvlong = "(unsigned long long)$1:cast" is cast;
fun uint8_of[t2:reals]: t2 -> uint8 = "(uint8_t)$1:cast" is cast;
fun uint16_of[t2:reals]: t2 -> uint16 = "(uint16_t)$1:cast" is cast;
fun uint32_of[t2:reals]: t2 -> uint32 = "(uint32_t)$1:cast" is cast;
fun uint64_of[t2:reals]: t2 -> uint64 = "(uint64_t)$1:cast" is cast;
fun tiny_of[t2:reals]: t2 -> tiny = "(signed char)$1:cast" is cast;
fun short_of[t2:reals]: t2 -> short = "(short)$1:cast" is cast;
fun int_of[t2:reals]: t2 -> int = "(int)$1:cast" is cast;
fun long_of[t2:reals]: t2 -> long = "(long)$1:cast" is cast;
fun vlong_of[t2:reals]: t2 -> vlong = "(long long)$1:cast" is cast;
fun int8_of[t2:reals]: t2 -> int8 = "(int8_t)$1:cast" is cast;
fun int16_of[t2:reals]: t2 -> int16 = "(int16_t)$1:cast" is cast;
fun int32_of[t2:reals]: t2 -> int32 = "(int32_t)$1:cast" is cast;
fun int64_of[t2:reals]: t2 -> int64 = "(int64_t)$1:cast" is cast;
fun float_of[t2:reals]: t2 -> float = "(float)$1:cast" is cast;
fun double_of[t2:reals]: t2 -> double = "(double)$1:cast" is cast;
fun ldouble_of[t2:reals]: t2 -> ldouble = "(long double)$1:cast" is cast;
}
module Control
{
publish 'infinite loop'
proc forever (bdy:unit->void)
{
rpeat:>
bdy();
goto rpeat;
dummy:> // fool reachability checker
}
publish 'C style while loop'
proc while (cond:unit->bool) (bdy:unit->void)
{
rpeat:>
if not (cond()) goto finish;
bdy();
goto rpeat;
finish:>
}
/* DISABLED: replaced by UNTIL statement until the optimiser is working
publish """
C style while loop with reversed condition
note the until is tested first -- zero iterations are possible
"""
proc until(cond:unit->bool) (bdy:unit->void)
{
repeat:>
if cond() goto finish;
bdy();
goto repeat;
finish:>
}
*/
publish "do nothing [the name pass comes from Python]"
proc pass(){}
publish 'C style for loop'
proc for_each
(init:unit->void)
(cond:unit->bool)
(incr:unit->void)
(bdy:unit->void)
{
init();
rpeat:>
if not (cond()) goto finish;
bdy();
incr();
goto rpeat;
finish:>
}
publish 'abnormal termination with message'
proc fail:string = 'throw std::exception ($1);';
publish "WILL BE DEPRECATED, these don't work right"
fun fail_fun[t]:1->t = 'throw std::exception (""),*(?1*)0';
publish "WILL BE DEPRECATED, these don't work right"
fun fail_fun[t]:string->t = 'throw std::exception ($1),*(?1*)0';
publish "Felix procedural continuation type"
_gc_pointer type cont = "flx::rtl::con_t*";
publish "Current continuation"
fun current_continuation: 1 -> cont = "this";
publish "Felix fthread"
_gc_pointer type fthread = "flx::rtl::fthread_t*";
publish """
Throw a continuation. This is unsafe. It should
work from a top level procedure, or any function
called by such a procedure, but may fail
if thrown from a procedure called by a function.
The library run and driver will catch the
continuation and execute it instead of the
current continuation. If the library run is used
and the continuation being executed is down the
C stack, the C stack will not have been correctly
popped. Crudely, nested drivers should rethrow
the exception until the C stack is in the correct
state to execute the continuation, but there is no
way to determine that at the moment.
Compiler generated runs ignore the exception,
the library run catches it. Exceptions typically
use a non-local goto, and they cannot pass across
a function boundary.
"""
proc throw(x: unit->void) { _throw (C_hack::cast[cont] x); }
private proc _throw: cont = "throw $1;";
publish "Supervisor calls"
// THESE VALUES MUST SYNC WITH THE RTL
union svc_req_t =
| svc_yield // 0
| svc_get_fthread of address // 1
| svc_read of address // 2
| svc_general of address // 3
;
publish "Call Supervisor"
// this interface just gets rid of the horrible requirement
// the request be in a variable so it is addressable
proc svc(x:svc_req_t) {
var y=x;
_svc y;
}
publish "Read primitive"
// finds the machine address of the read buffer
// then does a supervisor read specifying that address
proc read[t](x:&t) {
val vadr : address = C_hack::as_address$ C_hack::unref x;
req := svc_read vadr;
svc req;
}
private fun _start[t]: (t->0)*t->cont = "$1->clone()->call(0,$2)";
fun start[t] (p:t->0) (x:t) = { return _start (p,x); }
private fun _start0: (1->0)->cont = "$1->clone()->call(0)";
fun start (p:1->0) = { return _start0 (p); }
fun mk_thread: cont->fthread = "new(*PTF gc,_fthread_ptr_map) flx::rtl::fthread_t($1)";
publish "Resume a continuation until it yields"
fun step: cont -> cont = "$1->resume()";
publish """
Run a continuation until it terminates.
Do not use this proc if the underlying
procedure attempts to read messages.
This is a low level primitive, bypassing fthreads.
"""
proc run: cont =
"""
{
flx::rtl::con_t *tmp=$1;
if(!tmp)
throw flx::rtl::flx_exec_failure_t (__FILE__,"run","Run terminated procedure");
while(tmp) {
try { tmp=tmp->resume(); }
catch (flx::rtl::con_t *x) { tmp = x; }
}
}
""";
private proc _send[t]: &cont * t =
"""
{
using namespace flx::rtl;
con_t *tmp = *(con_t**)$1.data;
// run target until it reaches a service request (or death)
while(tmp && (!tmp->p_svc || tmp->p_svc->variant == svc_yield)) {
try { tmp=tmp->resume(); }
catch (con_t *x) { tmp = x; }
}
// check it is alive and making the expected service request
if (!tmp)
throw flx_exec_failure_t (__FILE__,"send","Send to terminated procedure");
if (!tmp->p_svc)
throw flx_exec_failure_t (__FILE__,"send","Send to unready Procedure");
if (tmp->p_svc->variant != svc_read)
throw flx_exec_failure_t (__FILE__,"send","Send to Procedure which is not trying to read");
// store the message
**(?1**)tmp->p_svc->data= $2;
// clear the service request
tmp->p_svc = 0;
// run the target until the next service request (or death)
while(tmp && (!tmp->p_svc || tmp->p_svc->variant == svc_yield)) {
try { tmp=tmp->resume(); }
catch (con_t *x) { tmp = x; }
}
// save the new continuation
*(con_t**)$1.data = tmp;
}
""";
publish """Send a message to a continuation.
There is no type checking on the message type.
The procedure is executed until
the next wait_state, then the message is stored.
Low level primitive, bypassing fthreads.
"""
proc send[t] (p:&cont) (x:t)
{
_send (p,x);
}
publish """
Invoke the garbage collector inside a procedure run
by the top level (external) driver.
Don't call this procedure in a procedure which is run
with 'run', because such procedures do not link to their
caller with frame pointers -- unless of course a such a
procedure has a private collector.
Note procedure called by functions are run with
code equivalent to 'run'.
"""
proc collect: unit = """
PTF gc->add_root(this);
PTF gc->collect();
PTF gc ->remove_root(this);
""" requires property "needs_gc";
}
publish "List manipulation"
module List
{
union list[T] = | Empty | Cons of T * list[T];
fun map[T,U] (f:T->U) (x:list[T]): list[U] = {
return
match x with
| Empty[T] => Empty[U]
| Cons[T] (?h, ?t) => Cons (f(h), map[T,U] f t)
endmatch
;
}
fun rev[T] (x:list[T]):list[T]= {
fun aux (x:list[T]) (y:list[T]) : list[T] =
{
return
match x with
| Empty[T] => y
| Cons[T] (?h, ?t) => aux t (Cons (h, y))
endmatch
;
}
return aux x Empty[T];
}
proc iter[T] (f:T->void) (x:list[T]) {
match x with
| Empty[T] => {}
| Cons[T] (?h,?t) => { f h; iter f t; }
endmatch
;
}
fun fold_left[T,U] (f:U->T->U) (init:U) (x:list[T]):U =
{
return
match x with
| Empty[T] => init
| Cons[T] (?h,?t) => fold_left f (f init h) t
endmatch
;
}
fun fold_right[T,U] (f:T->U->U) (x:list[T]) (init:U):U =
{
return
match x with
| Empty[T] => init
| Cons[T] (?h,?t) => fold_right f t (f h init)
endmatch
;
}
fun join[T] (x:list[T]) (y:list[T]):list[T] =
{
return
match x with
| Empty[T] => y
| Cons[T] (?h,?t) => Cons (h, join t y)
endmatch
;
}
fun add[T] (x:list[T], y: list[T]):list[T] => join x y;
fun add[T] (x:list[T], y: T):list[T] => Cons (y, x);
fun cat[T] (x:list[list[T]]):list[T] =
{
return
match x with
| Empty[list[T]] => Empty[T]
| Cons[list[T]] (?h,?t) => fold_left join of (list[T]) h t
endmatch
;
}
}
publish "Association Lists (lists of pairs)"
module Assoc_list
{
typedef assoc_list[A,B] = List::list[(A,B)];
}
// This module provides functions to
// use in conjunction with the reglex construction
module Lexer
{
pod type iterator = "char const*";
fun start_iterator : lvalue[string] -> iterator = "$1.data()";
fun end_iterator: lvalue[string] -> iterator = "$1.data()+$1.size()";
fun bounds (x:lvalue[string]): iterator * iterator = {
return
start_iterator x,
end_iterator x
;
}
fun string_between: iterator * iterator -> string =
"std::string($1,$2)";
gen_cmp iterator;
fun add: iterator * int -> iterator = "$1 + $2";
fun sub: iterator * int -> iterator = "$1 - $2";
fun sub: iterator * iterator -> int = "$1 - $2";
proc pre_incr: lvalue[iterator] = "++$1;";
proc post_incr: lvalue[iterator] = "++$1;";
fun deref: iterator -> char = "*$1";
}
// ------ Open common modules -------------
open Bool;
open Int;
open Double;
open Char;
open String;
open Stdout;
open Arith_casts;
open Control;
