diff -up kaya-0.5.2/configure.ac.gc kaya-0.5.2/configure.ac --- kaya-0.5.2/configure.ac.gc 2010-05-05 19:35:58.601779194 +0200 +++ kaya-0.5.2/configure.ac 2010-05-05 19:39:37.436635037 +0200 @@ -530,6 +530,15 @@ else readlinemodule='System.Console.Readline' fi +if (pkg-config --exists 'bdw-gc >= 7.2'); then + AC_MSG_NOTICE([New GC API found]) + FSDTYPE='Void'; +else + AC_MSG_NOTICE([Old GC API found]) + FSDTYPE='Int'; +fi + +AC_SUBST(FSDTYPE) AC_SUBST(tmpdir) AC_SUBST(version) @@ -548,6 +557,7 @@ AC_OUTPUT(Makefile rts_opt/Makefile rts_fast/Makefile stdlib/Makefile + stdlib/Prelude.k windows/Makefile posix/Makefile libs/Makefile diff -up kaya-0.5.2/stdlib/Prelude.k.in.gc kaya-0.5.2/stdlib/Prelude.k.in --- kaya-0.5.2/stdlib/Prelude.k.in.gc 2010-05-05 19:35:58.665758897 +0200 +++ kaya-0.5.2/stdlib/Prelude.k.in 2010-05-05 19:35:58.665758897 +0200 @@ -0,0 +1,895 @@ +/** + Kaya standard library + Copyright (C) 2004, 2005 Edwin Brady + + This file is distributed under the terms of the GNU Lesser General + Public Licence. See COPYING for licence. +*/ + +"<summary>The standard Prelude</summary> +<prose>The standard Prelude will be imported by all Kaya programs and modules unless the <code>-noprelude</code> compiler option is used. It provides many essential and useful functions and data types used by the Kaya standard library and applications.</prose> +<prose>Generally, only the standard library itself should not automatically import this module.</prose>" +module Prelude; + +import public Builtins; +import public Maths; // Should this be here or not? +import public Array; +import public Tuples; +import public Coercions; + +%include "math.h"; +%include "ctype.h"; + +/** Some generally useful types and functions. All programs import this + implicitly. */ + +/// Linked lists +"<summary>Linked list type.</summary> +<prose><code>nil</code> creates an empty list, <code>cons</code> creates a non empty list. Linked lists may be iterated over using a <code>for</code> loop.</prose> +<example>list = cons(2,cons(5,cons(3,nil)));</example> +<related><functionref>array</functionref></related> +<related><functionref>reverse</functionref></related>" +public data List<a> = nil | cons(a head,List<a> tail); + +"<summary>Taint an array of strings</summary> +<prose>Used when kayac is invoked with -T. Do not call directly.</prose>" +public [Tainted<String>] taint([String] ss) = map(taint,ss); + +%test 0 t_traverse_list_full { + list = cons(1,cons(2,cons(3,cons(4,nil)))); + for l@i in list { + assert(l==i+1,"List element "+i+" was "+l); + } +} +%test 0 t_traverse_list_empty { + list = nil; + for l@i in list { + assert(false); // shouldn't get here + } +} + +"<argument name='block'>The block of code to execute for each list element.</argument> +<argument name='list'>The list to traverse</argument> +<summary>Iteration over linked lists</summary> +<prose>Used by <code>for</code> loops to traverse <dataref>List</dataref> data structure. It is unlikely that you will need to call this function directly.</prose>" +public Void traverse(Bool(a, Int) block, List<a> list) { + i = 0; + repeat case list of { + nil() -> break; + | cons(x,list) -> if (!block(x, i)) { return; } i++; + } +} + +%test 0 t_array_list_full = array(cons(1,cons(2,cons(3,cons(4,nil)))))==[1..4]; +%test 0 t_array_list_empty = array(nil) == []; + +"<argument name='xs'>The list to convert</argument> +<summary>Coerce a linked list to an array.</summary> +<prose>Converts a linked list to an array.</prose> +<example>list = cons(2,cons(5,cons(3,nil))); +arr = array(list); +// arr = [2,3,5]</example> +<related><dataref>List</dataref></related>" +public [a] array(List<a> xs) { + acc = []; + repeat case xs of { + nil -> return acc; + | cons(x,xs) -> push(acc,x); + } + return acc; +} + +%test 0 t_reverse_list_empty { + xs = nil; + reverse(xs); + assert(xs==nil); +} +%test 0 t_reverse_list_odd { + xs = cons(1,cons(2,cons(3,nil))); + reverse(xs); + assert(xs == cons(3,cons(2,cons(1,nil)))); +} +%test 0 t_reverse_list_even { + xs = cons(1,cons(2,cons(3,cons(4,nil)))); + reverse(xs); + assert(xs == cons(4,cons(3,cons(2,cons(1,nil))))); +} +"<argument name='xs'>The list to reverse</argument> +<summary>Reverse a linked list in place.</summary> +<prose>Reverse a linked list in place.</prose> +<related><dataref>List</dataref></related> +<related>Arrays can be reversed in place with <functionref>Array::reverse</functionref></related>" +public Void reverse(var List<a> xs) +{ + acc = nil; + repeat case xs of { + nil -> break; + | cons(x,xs) -> acc = cons(x,acc); + } + xs = acc; +} + + +"<summary>Optional values.</summary> +<prose>A value is either of type <code>a</code>, represented as <code>just(a)</code>, or empty. Maybe is often useful for computations which can possibly fail, for example looking up values in a dictionary. Because the <code>nothing</code> value can be stored, this is often more useful than Exceptions on failure.</prose> +<related><functionref>deref</functionref></related> +<related><functionref>Dict::lookup</functionref></related>" +public data Maybe<a> = nothing | just(a val); + + +"<summary>Tried to dereference an empty Maybe</summary> +<prose>If <functionref>deref</functionref> is called on a <dataref>Maybe</dataref> equal to <code>nothing</code> this Exception will be thrown. Generally it is better to use a <code>case</code> statement if this is likely.</prose> +<related><functionref>deref</functionref></related>" +Exception CantDerefNothing; + +"<summary>Negative string length specified</summary> +<prose>If <functionref>substr</functionref> is called in a way that would require the generation of a string with negative length (either because the length asked for is negative, or because the starting index is after the end of the string), this Exception will be thrown.</prose> +<related><functionref>substr</functionref></related>" +Exception NegativeLengthString(Int len); +"<summary>Position out of range</summary> +<prose>This Exception is thrown if the <functionref>substr</functionref> function is called with an index that is outside the string.</prose> +<related><functionref>substr</functionref></related>" +Exception PositionOutOfRange(Int pos); + + +%test 0 t_deref_nothing { + try { + v = deref(nothing); + assert(false,"Didn't catch dereference"); + } catch(CantDerefNothing); +} +%test 0 t_deref_something = deref(deref(just(just(4)))) == 4; +%test 0 t_deref_shallow { + xs = [1,2,3,4,5]; + maybe = just(just(just(xs))); + ys = deref(deref(deref(maybe))); + assert(ys==[1..5],"xs != ys"); + xs[2] = 7; + assert(ys[2]==7,"References broken when dereferencing"); +} +%test 0 t_deref_pattern { + vals = [nothing,just(nothing),just(just(2)),nothing,just(nothing),just(just(8)),nothing]; + result = ""; + for val@i in vals { + case val of { + nothing -> result += "N"; assert(i%3==0,"Wrong case at "+i); + | just(just(v)) -> result += v; assert(i%3==2,"Wrong case at "+i); + result += deref(deref(val)); + | just(_) -> result += "J"; assert(i%3==1,"Wrong case at "+i); + | _ -> result += "!"; assert(false,"Got to default case somehow"); + } + } + assert(result == "NJ22NJ88N","Wrong pattern extraction ("+result+")"); +} + +"<argument name='v'>The value to dereference</argument> +<summary>Dereference a Maybe.</summary> +<prose>Extract the value from a <dataref>Maybe</dataref>. An Exception is thrown if <variable>v</variable> is <code>nothing</code>. A <code>case</code> statemement is generally more appropriate unless it is known that the dereferencing should succeed (for example, using <functionref>Dict::lookup</functionref> on a key known to have been added). <code>deref(x)</code> is equivalent to <code>x.val</code>.</prose> +<related><dataref>Maybe</dataref></related> +<related><exceptref>CantDerefNothing</exceptref></related>" +public a deref(Maybe<a> v) { + case v of { + nothing -> throw(CantDerefNothing); + | just(a) -> return a; + } +} + +%test 0 t_intBase_bin = intBase("101",2) == 5; +%test 0 t_intBase_oct = intBase("101",8) == 65; +%test 0 t_intBase_dec = intBase("101",10) == 101; +%test 0 t_intBase_hex = intBase("101",16) == 257; + +%test 0 t_stringBase_oct = stringBase(101,8) == "145"; +%test 0 t_stringBase_dec = stringBase(101,10) == "101"; +%test 0 t_stringBase_hex = stringBase(101,16) == "65"; + +%test 0 t_isDigit_true1 = isDigit('0'); +%test 0 t_isDigit_true2 = isDigit('9'); +%test 0 t_isDigit_false = !isDigit('A'); + +%test 0 t_isAlpha_true1 = isAlpha('A'); +%test 0 t_isAlpha_true2 = isAlpha('a'); +%test 0 t_isAlpha_true3 = isAlpha('Z'); +%test 0 t_isAlpha_true4 = isAlpha('z'); +%test 0 t_isAlpha_false1 = !isAlpha('1'); +%test 0 t_isAlpha_false2 = !isAlpha('<'); + +%test 0 t_isAlnum_true1 = isAlnum('A'); +%test 0 t_isAlnum_true2 = isAlnum('a'); +%test 0 t_isAlnum_true3 = isAlnum('Z'); +%test 0 t_isAlnum_true4 = isAlnum('z'); +%test 0 t_isAlnum_true5 = isAlnum('1'); +%test 0 t_isAlnum_false = !isAlnum('<'); + +%test 0 t_isPunct_true = isPunct('.'); +%test 0 t_isPunct_false = !isPunct('A'); + +%test 0 t_isGraph_true1 = isGraph('.'); +%test 0 t_isGraph_true2 = isGraph('A'); +%test 0 t_isGraph_true3 = isGraph('a'); +%test 0 t_isGraph_true4 = isGraph('Z'); +%test 0 t_isGraph_true5 = isGraph('z'); +%test 0 t_isGraph_true6 = isGraph('0'); +%test 0 t_isGraph_true7 = isGraph('9'); +%test 0 t_isGraph_false1 = !isGraph(' '); +%test 0 t_isGraph_false2 = !isGraph(Char(3)); + +%test 0 t_isSpace_true1 = isSpace(' '); +%test 0 t_isSpace_true2 = isSpace('\t'); +%test 0 t_isSpace_true3 = isSpace('\n'); +%test 0 t_isSpace_true4 = isSpace('\r'); +%test 0 t_isSpace_false1 = !isSpace('_'); +%test 0 t_isSpace_false2 = !isSpace(Char(3)); + +%test 0 t_isUpper_true1 = isUpper('A'); +%test 0 t_isUpper_true2 = isUpper('Z'); +%test 0 t_isUpper_false1 = !isUpper('a'); +%test 0 t_isUpper_false2 = !isUpper('z'); +%test 0 t_isUpper_false3 = !isUpper('_'); + +%test 0 t_isLower_true1 = isLower('a'); +%test 0 t_isLower_true2 = isLower('z'); +%test 0 t_isLower_false1 = !isLower('A'); +%test 0 t_isLower_false2 = !isLower('Z'); +%test 0 t_isLower_false3 = !isLower('='); + +%test 0 t_toLower_upper = toLower('A') == 'a'; +%test 0 t_toLower_lower = toLower('a') == 'a'; +%test 0 t_toLower_other = toLower(':') == ':'; + +%test 0 t_toUpper_upper = toUpper('A') == 'A'; +%test 0 t_toUpper_lower = toUpper('a') == 'A'; +%test 0 t_toUpper_other = toUpper(';') == ';'; + +// The foreign bits we use. +foreign "stdfuns.o" { + Void str_offset(str x, Int inc) = str_offset; + Void str_chop(str x, Int inc) = str_chop; + + + "<argument name='str'>The string to convert</argument> +<argument name='base'>The base the string is in (2-36 inclusive)</argument> +<summary>Convert a string, in the given base, to an integer</summary> +<prose>Convert a string, in the given base, to an integer.</prose> +<example>str = \"101\"; +bin = intBase(str,2); // 5 +oct = intBase(str,8); // 65 +dec = intBase(str,10); // 101 +hex = intBase(str,16); // 257</example> +<related><functionref>stringBase</functionref></related>" + public Int intBase(String str, Int base) = strtoint; + "<argument name='num'>The number to convert</argument> +<argument name='base'>The base the number is in</argument> +<summary>Convert an integer in the given base to a string.</summary> +<prose>Convert an integer in the given base to a string. Currently the base may only be decimal (10), hex (16), or octal (8).</prose> +<related><functionref>intBase</functionref></related>" + public String stringBase(Int num, Int base) = inttostr; + +// "Change standard error stream" -- doesn't work portably +// public Void setstderr(File f) = setStdErr; + "<summary>Force a garbage collection</summary> +<prose>Normally the Kaya garbage collector (<link url='http://www.hpl.hp.com/personal/Hans_Boehm/gc/'>libgc</link>) runs in the background at appropriate times. Occasionally, it may be appropriate to garbage-collect immediately. Heavy use of this function carries a high cost in program execution time.</prose>" + public Void gc() = GC_gcollect; + "<summary>Debugging function</summary> +<prose>Get the heap size used by the garbage collector. This is generally only useful when debugging</prose>" + public Int gcHeapSize() = GC_get_heap_size; + "<summary>Debugging function</summary> +<prose>Get a lower bound on the number of free bytes on the heap. This is generally only useful when debugging</prose>" + public Int gcFreeBytes() = GC_get_free_bytes; + "<summary>Debugging function</summary> +<prose>Get the total number of bytes allocated by the garbage collector. This is generally only useful when debugging</prose>" + public Int gcTotalBytes() = GC_get_total_bytes; + "<summary>Debugging function</summary> +<prose>Set the maximum heap size used by the garbage collector. This puts an upper limit on the memory usage of the program (a segfault will occur if it is exceeded)</prose>" + public Void gcSetMaxHeapSize(Int size) = GC_set_max_heap_size; + "<summary>Enable incremental garbage collection.</summary> + <prose>Performs a small amount of garbage collection more often. Most + likely will lead to slower (though smoother) performance, but with less overall memory usage. This function does nothing unless the <code>-nortchecks</code> compiler option was used, as it makes debugging much harder. This is generally recommended for interactive programs.</prose> +<prose>This function is automatically used for CGI programs and webapps.</prose>" + public Void gcIncremental() = do_GC_enable_incremental; + "<argument name='fsd'>The garbage collection parameter</argument> +<summary>Debugging function</summary> +<prose>Adjust garbage collector - higher values use less memory but run slower (the default value is 4, and a value of 1 disables garbage collection entirely). The default is almost always acceptable.</prose>" + public @FSDTYPE@ gcSetFSD(Int fsd) = GC_set_free_space_divisor; + "<summary>Switch off garbage collector.</summary> + <prose>You may want this, for example, before executing some time-critical + code which should not be interrupted by a garbage collection. + Even explicit calls to <functionref>gc</functionref>() are ineffective while collection is disabled.</prose> +<related><functionref>gcEnable</functionref></related> +<related><functionref>gc</functionref></related>" + public Void gcDisable() = GC_disable; + "<summary>Switch on garbage collector.</summary> + <prose>Calls to gcDisable and gcEnable nest; collection is enabled if there + have been an equal number of calls to each. </prose> +<related><functionref>gcDisable</functionref></related> +<related><functionref>gc</functionref></related>" + public Void gcEnable() = GC_enable; + // Removed (temporarily?) since VM no longer does needed instructions. + // Int do_max_heapsize(Ptr vm) = maxMemUsage; + + "<summary>Register a function to call when object is garbage collected</summary> + <prose>If additional cleanup is needed when an object is destroyed, +this function registers a finalisation procedure. e.g. a record containing +a file handle should make sure the file is closed when the object is +deallocated.</prose> + <argument name='object'>The object being watched</argument> + <argument name='destroyFn'>The function to call when the object is destroyed. Takes the object as its argument</argument>" + public Void onDestroy(a object, Void(a) destroyFn) = do_GC_finalizer; + + "<argument name='c'>The character</argument> +<summary>Checks if the character is a digit</summary> +<prose>Returns true if the character is a digit.</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isGraph</functionref></related> +<related><functionref>isSpace</functionref></related>" + public Bool isDigit(Char c) = iswdigit; + "<argument name='c'>The character</argument> +<summary>Checks if the character is alphabetical</summary> +<prose>Returns true if the character is alphabetical.</prose> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isGraph</functionref></related> +<related><functionref>isSpace</functionref></related>" + public Bool isAlpha(Char c) = iswalpha; + "<argument name='c'>The character</argument> +<summary>Checks if the character is a digit or alphabetical</summary> +<prose>Returns true if the character is a digit or alphabetical.</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isGraph</functionref></related> +<related><functionref>isSpace</functionref></related>" + public Bool isAlnum(Char c) = iswalnum; + "<argument name='c'>The character</argument> +<summary>Checks if the character is punctuation</summary> +<prose>Returns true if the character is punctuation.</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isGraph</functionref></related> +<related><functionref>isSpace</functionref></related>" + public Bool isPunct(Char c) = iswpunct; + "<argument name='c'>The character</argument> +<summary>Checks if the character is printable and not whitespace</summary> +<prose>Returns true if the character is printable and not whitespace.</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isSpace</functionref></related>" + public Bool isGraph(Char c) = iswgraph; + "<argument name='c'>The character</argument> +<summary>Checks if the character is whitespace</summary> +<prose>Returns true if the character is whitespace.</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isGraph</functionref></related>" + public Bool isSpace(Char c) = iswspace; + "<argument name='c'>The character</argument> +<summary>Checks if the character is a lower-case letter</summary> +<prose>Returns true if the character is a lower-case letter.</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isGraph</functionref></related> +<related><functionref>isSpace</functionref></related>" + public Bool isLower(Char c) = iswlower; + "<argument name='c'>The character</argument> +<summary>Checks if the character is an upper-case letter</summary> +<prose>Returns true if the character is an upper-case letter.</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLineEnding</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isGraph</functionref></related> +<related><functionref>isSpace</functionref></related>" + public Bool isUpper(Char c) = iswupper; + "<argument name='c'>The character</argument> +<summary>Converts the character to a lower-case letter</summary> +<prose>Converts the character to a lower-case letter. Non-alphabetical characters are returned unchanged.</prose> +<prose>This function may give unusual results with non-ASCII characters.</prose> +<related><functionref index='1'>toLower</functionref></related> +<related><functionref index='0'>toUpper</functionref></related>" + public Char toLower(Char c) = towlower; + "<argument name='c'>The character</argument> +<summary>Converts the character to an upper-case letter</summary> +<prose>Converts the character to an upper-case letter. Non-alphabetical characters are returned unchanged.</prose> +<prose>This function may give unusual results with non-ASCII characters.</prose> +<related><functionref index='0'>toLower</functionref></related> +<related><functionref index='1'>toUpper</functionref></related>" + public Char toUpper(Char c) = towupper; + + String dosubstr(Ptr vm, String x, Int i, Int len) = getsubstr; + String do_strend(Ptr vm, String x, Int i) = getstrend; + Void doPutStr(String text, Int len) = putStr; +} + +// no idea how to self-test this sensibly, but it will be fairly +// obvious if it's broken! +"<argument name='text'>The string to print</argument> +<summary>Send a string to standard output</summary> +<prose>Print a String on standard output. Equivalent to <code>put(stdout(),text);</code>.</prose> +<related><functionref>putStrLn</functionref></related> +<related><functionref>IO::put</functionref></related> +<related><functionref>IO::stdout</functionref></related>" +public Void putStr(String text) { + doPutStr(text,length(text)); +} + +%test 0 t_isLineEnding_n = isLineEnding('\n'); +%test 0 t_isLineEnding_r = isLineEnding('\r'); +%test 0 t_isLineEnding_false = !isLineEnding(' '); + +"<argument name='c'>The character</argument> +<summary>Checks if the character is (part of) a line ending</summary> +<prose>Returns true if the character is (part of) a line ending (i.e. '\\r' or '\\n').</prose> +<related><functionref>isAlpha</functionref></related> +<related><functionref>isAlnum</functionref></related> +<related><functionref>isDigit</functionref></related> +<related><functionref>isLower</functionref></related> +<related><functionref>isPunct</functionref></related> +<related><functionref>isUpper</functionref></related> +<related><functionref>isGraph</functionref></related> +<related><functionref>isSpace</functionref></related>" +public Bool isLineEnding(Char c) +{ + return (c=='\n' || c=='\r'); +} + +%test t_toLower_string_full = toLower("Ab_CdE123PLib") == "ab_cde123plib"; +%test t_toLower_string_empty = toLower("") == ""; + +"<argument name='s'>The string to lower-case</argument> +<summary>Returns a copy of the string with all letters lower-cased</summary> +<prose>Returns a copy of the string with all letters lower-cased</prose> +<example>s = toLower(\"Hello World!\"); +// s = \"hello world!\"</example> +<prose>This function may give unusual results with non-ASCII characters.</prose> +<related><functionref index='0'>toLower</functionref></related> +<related><functionref index='1'>toUpper</functionref></related>" +public String toLower(String s) { + c = copy(s); + translate(c,toLower); + return c; +} + +%test t_toUpper_string_full = toUpper("Ab_CdE123PLib") == "AB_CDE123PLIB"; +%test t_toUpper_string_empty = toUpper("") == ""; + +"<argument name='s'>The string to upper-case</argument> +<summary>Returns a copy of the string with all letters upper-cased</summary> +<prose>Returns a copy of the string with all letters upper-cased</prose> +<example>s = toUpper(\"Hello World!\"); +// s = \"HELLO WORLD!\"</example> +<prose>This function may give unusual results with non-ASCII characters.</prose> +<related><functionref index='1'>toLower</functionref></related> +<related><functionref index='0'>toUpper</functionref></related>" +public String toUpper(String s) { + c = copy(s); + translate(c,toUpper); + return c; +} + +%test t_strEnd_empty_okay = strEnd("",0) == ""; +%test t_strEnd_full_positive = strEnd("abcdefghij",3) == "defghij"; +%test t_strEnd_full_negative = strEnd("abcdefghij",-3) == "hij"; +%test t_strEnd_full_positive2 = strEnd("abcdefghij",10) == ""; +%test t_strEnd_full_negative2 = strEnd("abcdefghij",-10) == "abcdefghij"; +%test t_strEnd_illegal { + e = ""; + f = "abcdefghij"; + try { + v = strEnd(e,1); + assert(false,"Failed to catch positive empty"); + } catch(OutOfBounds) {} + try { + v = strEnd(e,-1); + assert(false,"Failed to catch negative empty"); + } catch(OutOfBounds) {} + try { + v = strEnd(f,11); + assert(false,"Failed to catch positive full"); + } catch(OutOfBounds) {} + try { + v = strEnd(f,-11); + assert(false,"Failed to catch negative full"); + } catch(OutOfBounds) {} + +} + +"<argument name='x'>The string to examine</argument> +<argument name='i'>The index to start from</argument> +<summary>Return the end of a String.</summary> +<prose>Return the end of a string starting at character index <variable>i</variable>. <code>strEnd(x,0)</code> will return the entire string. If a negative <variable>i</variable> is given, then it will be counted backwards from the end of the string.</prose> +<example>x = \"abcdef\"; +putStr(strEnd(x,2)); // \"cdef\" +putStr(strEnd(x,5)); // \"f\" +putStr(strEnd(x,6)); // \"\" +putStr(strEnd(x,7)); // OutOfBounds Exception thrown +putStr(strEnd(x,-3)); // \"def\" +putStr(strEnd(x,-8)); // OutOfBounds Exception thrown</example> +<related><functionref>substr</functionref></related>" +public String strEnd(String x, Int i) { + strlen = length(x); + if (i < -strlen || i > strlen) { + throw(OutOfBounds); + } else if (i < 0) { + i += strlen; + } + return do_strend(getVM,x,i); +} + + +"<argument name='text'>The string to print</argument> +<summary>Send a string and a newline to standard output.</summary> +<prose>Print a string and a newline on standard output.</prose> +<related><functionref>putStr</functionref></related>" +public Void putStrLn(String text) +{ + putStr(text+"\n"); +} + +"<summary>File not found</summary> +<prose>This function will be called if an attempt to access a non-existent file is made.</prose>" +Exception FileNotFound(); + +/// Functional programming features + +a runcompose(a(b) f, b(c) g, c arg) { + return f(g(arg)); +} + +%test t_compose_aa { + fn = compose(\ (a)->a+1, \ (b)->b*2); + assert(fn(7)==15); +} +%test t_compose_ab { + fn = compose(\ (a)->String(a), \ (b)->b*2); + assert(fn(7)=="14"); +} + +"<argument name='f'>The first function to compose</argument> +<argument name='g'>The second function to compose</argument> +<summary>Compose two functions.</summary> +<prose>Compose two functions: <code>compose(f,g)(x) == f(g(x))</code>.</prose> +<example>Float double(Float x) { + return x*2.0; +} +Int roundDown(Float y) { + return Int(floor(y)); +} +Void main() { + combined = compose(roundDown,double); + a = combined(3.6); + // a = 7 +} +</example>" +public a(c) compose(a(b) f, b(c) g) { + return runcompose@(f,g); +} + +%test t_apply_aa = apply(\ (a)->a+3,7)==10; +%test t_apply_ab = apply(\ (a)->String(a+3),7)=="10"; + +"<argument name='f'>The function to apply</argument> +<argument name='arg'>The argument</argument> +<summary>Apply a function to an argument.</summary> +<prose>Apply a function to an argument - useful for functional programming. <code>apply(f,arg)</code> is equivalent to <code>f(arg)</code>.</prose> +" +public a apply(a(b) f, b arg) { + return f(arg); +} + +%test t_force_1 = force(\ ()->3)==3; + +"<argument name='f'>The suspended function</argument> +<summary>Evaluate a suspended function.</summary> +<prose>Evaluate a suspended function. <code>force(f)</code> is equivalent to <code>f()</code>.</prose> +<related>The inverse of <functionref>thunk</functionref></related>" +public a force(a() f) { + return f(); +} + +%test t_thunk_2 = thunk([1..4])()==[1..4]; +%test t_thunk_force = force(thunk([1..4]))==[1..4]; + +"<argument name='val'>The value to convert</argument> +<summary>Turn a value into a function.</summary> +<prose>For a given value, create a function that returns that value.</prose> +<related>The inverse of <functionref>force</functionref></related>" +public a() thunk(a val) { + return \ () -> val; +} + +//// Useful string functions + +%test t_rep_normal = rep("abc",3) == "abcabcabc"; +%test t_rep_once = rep("abc",1) == "abc"; +%test t_rep_zero = rep("abc",0) == ""; +%test t_rep_negative = rep("abc",-10) == ""; +// should that throw an Exception instead? or even return the string reversed? +%test t_rep_empty = rep("",100) == ""; + +"<argument name='str'>The string to repeat</argument> +<argument name='x'>The number of times to repeat it</argument> +<summary>Repeat a string</summary> +<prose>Return the string <variable>str</variable> repeated <variable>x</variable> times.</prose> +<example>str = \"Abc\"; +r = rep(str,4); // \"AbcAbcAbcAbc\" +r = rep(str,1); // \"Abc\" +r = rep(str,0); // \"\"</example> +<prose>A negative or zero <variable>x</variable> will return the empty string</prose>" +public String rep(String str, Int x) +{ + s = createString(length(str)*x); + for i in [1..x] { + s+=str; + } + return s; +} + +%test t_substr_empty1 = substr("",0,0) == ""; +%test t_substr_empty2 = substr("",0,7) == ""; +%test t_substr_full1 = substr("abcdef",0,0) == ""; +%test t_substr_full2 = substr("abcdef",4,2) == "ef"; +%test t_substr_full3 = substr("abcdef",6,2) == ""; +%test t_substr_full4 = substr("abcdef",0,3) == "abc"; +%test t_substr_full5 = substr("abcdef",0,6) == "abcdef"; +%test t_substr_full6 = substr("abcdef",0,9) == "abcdef"; +%test t_substr_fulln1 = substr("abcdef",-4,2) == "cd"; +%test t_substr_fulln2 = substr("abcdef",-1,1) == "f"; +%test t_substr_fulln3 = substr("abcdef",-6,6) == "abcdef"; +%test t_substr_fulln4 = substr("abcdef",-6,9) == "abcdef"; +%test t_substr_illegal { + s = "abcdef"; + e = ""; + try { + v = substr(e,1,1); + assert(false,"e1 uncaught"); + } catch(PositionOutOfRange(i)) {} + try { + v = substr(e,-1,1); + assert(false,"e-1 uncaught"); + } catch(PositionOutOfRange(i)) {} + try { + v = substr(s,3,-2); + assert(false,"s3-2 uncaught"); + } catch(NegativeLengthString(i)) {} + try { + v = substr(s,8,-2); + assert(false,"s8-2 uncaught"); + // could be caught by either + } catch(NegativeLengthString(i)) { + } catch(PositionOutOfRange(i)) {} + try { + v = substr(s,7,2); + assert(false,"s6+2 uncaught"); + } catch(PositionOutOfRange(i)) {} + try { + v = substr(s,-7,2); + assert(false,"s-7+2 uncaught"); + } catch(PositionOutOfRange(i)) {} + +} + +"<argument name='x'>The original string</argument> +<argument name='i'>The starting index</argument> +<argument name='len'>The substring length</argument> +<summary>Return a substring.</summary> +<prose>Starting at character <variable>i</variable>, return the <variable>len</variable> characters long substring. Throws an Exception if <variable>len</variable> is negative, or if <variable>i</variable> is out-of-bounds. In Kaya 0.2.4 and earlier, an Exception was also thrown if <variable>len</variable> was zero. The empty string is now returned in this case.</prose> +<prose>If the starting index is negative, then it will be counted in characters from the end of the string.</prose> +<example>x = \"abcdef\"; +s = substr(x,0,2); // \"ab\" +s = substr(x,4,1); // \"e\" +s = substr(x,3,10); // \"def\" (<variable>len</variable> truncated) +s = substr(x,-4,2); // \"cd\"</example>" +public String substr(String x, Int i, Int len) { + if (len < 0) { + throw(NegativeLengthString(len)); + } else { + strlen = length(x); + if (i < -strlen || i > strlen) { + throw(PositionOutOfRange(i)); + } else if (i < 0) { + i += strlen; + } + if (i+len > strlen) { + len = strlen-i; + if (len < 0) { // CIM: this should never happen now, but I'll + // leave the check in just in case. + throw(NegativeLengthString(len)); + } + } + return dosubstr(getVM,x,i,len); + } +} + +%test t_ltruncate_okay { + s = "abcdef"; + ltruncate(0,s); + assert(s=="abcdef","LT0 changed the string"); + ltruncate(2,s); + assert(s=="cdef","LT2 gave "+s); + ltruncate(4,s); + assert(s=="","LT4 gave "+s); + ltruncate(0,s); + assert(s=="","LT0 changed the empty string"); +} +%test t_ltruncate_illegal { + s = "abcdef"; + try { + ltruncate(-1,s); + assert(false,"LT negative uncaught"); + } catch(OutOfBounds) {} + try { + ltruncate(7,s); + assert(false,"LT too high uncaught"); + } catch(OutOfBounds) {} +} + +"<argument name='i'>The number of characters to remove</argument> +<argument name='x'>The String to remove from</argument> +<summary>Remove characters from the left of a string, in-place.</summary> +<prose>Remove the first <variable>i</variable> characters from a string, in-place.</prose> +<related><functionref>behead</functionref></related> +<related><functionref>rtruncate</functionref></related>" +public Void ltruncate(Int i, String x) { + if (i<0 || i > length(x)) { + throw(OutOfBounds); + } + str_offset(x,i); +} + +%test t_rtruncate_okay { + s = "abcdef"; + rtruncate(0,s); + assert(s=="abcdef","RT0 changed the string"); + rtruncate(2,s); + assert(s=="abcd","RT2 gave "+s); + rtruncate(4,s); + assert(s=="","RT4 gave "+s); + rtruncate(0,s); + assert(s=="","RT0 changed the empty string"); +} +%test t_rtruncate_illegal { + s = "abcdef"; + try { + rtruncate(-1,s); + assert(false,"RT negative uncaught"); + } catch(OutOfBounds) {} + try { + rtruncate(7,s); + assert(false,"RT too high uncaught"); + } catch(OutOfBounds) {} +} + +"<argument name='i'>The number of characters to remove</argument> +<argument name='x'>The String to remove from</argument> +<summary>Remove characters from the right of a string, in-place.</summary> +<prose>Remove the last <variable>i</variable> characters from a string, in-place.</prose> +<related><functionref>ltruncate</functionref></related>" +public Void rtruncate(Int i, String x) { + if (i<0 || i > length(x)) { + throw(OutOfBounds); + } + str_chop(x,i); +} + +"<argument name='x'>The String to remove from</argument> +<summary>Remove the first character of a string, in-place.</summary> +<prose>Remove the first character of a string, in-place.</prose> +<related><functionref>ltruncate</functionref></related>" +public Void behead(String x) { + ltruncate(1,x); +} + +%test 0 t_hasCycle_1 = !hasCycle(nil); + +%test 0 t_hasCycle_2 { // Make whole list a cycle + xs = cons(0,nil); + lastel = xs; + for x in [1..10] { + xs = cons(x, xs); + } + + lastel.tail = xs; + assert(hasCycle(xs)); +} + +%test 0 t_hasCycle_3 { // Make a cycle later in the list + xs = cons(0,nil); + lastel = xs; + for x in [1..10] { + xs = cons(x, xs); + } + + lastel.tail = xs; + for x in [11..20] { + xs = cons(x, xs); + } + assert(hasCycle(xs)); +} + +%test 0 t_hasCycle_4 { // Make a list with no cycle + xs = cons(0,nil); + lastel = xs; + for x in [1..20] { + xs = cons(x, xs); + } + + assert(!hasCycle(xs)); +} + +%test 0 t_hasCycle_5 { // Make whole list a cycle, with odd parity + xs = cons(0,nil); + lastel = xs; + for x in [1..11] { + xs = cons(x, xs); + } + + lastel.tail = xs; + assert(hasCycle(xs)); +} + +%test 0 t_hasCycle_6 { // Make a cycle later in the list, with odd parity + xs = cons(0,nil); + lastel = xs; + for x in [1..11] { + xs = cons(x, xs); + } + + lastel.tail = xs; + for x in [12..22] { + xs = cons(x, xs); + } + assert(hasCycle(xs)); +} + +"<argument name='xs'>List to check</argument> +<summary>Return whether a List has a cycle</summary> +<prose>Search for cycles in the list using the hare and tortoise algorithm. +</prose> +<related><dataref>List</dataref></related>" +Bool hasCycle(List<a> xs) { + if (xs==nil) { return false; } + hare = xs.tail; + tortoise = xs; + + while(hare!=nil) { + if (hare==tortoise) { return true; } + + tortoise = tortoise.tail; + hare = hare.tail; + if (hare==nil) { return false; } + hare = hare.tail; + } + return false; +}