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