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