mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-24 20:23:11 +03:00
Add RefC StringIterator support
This commit is contained in:
parent
58a321ca9c
commit
c57bb5a65f
@ -23,6 +23,7 @@ data StringIterator : String -> Type where [external]
|
||||
-- to avoid subverting the linearity guarantees of withString.
|
||||
%foreign
|
||||
"scheme:blodwen-string-iterator-new"
|
||||
"C:stringIteratorNew"
|
||||
"javascript:stringIterator:new"
|
||||
private
|
||||
fromString : (str : String) -> StringIterator str
|
||||
@ -37,6 +38,7 @@ withString str f = f (fromString str)
|
||||
||| iterator `it`
|
||||
%foreign
|
||||
"scheme:blodwen-string-iterator-to-string"
|
||||
"C:stringIteratorToString"
|
||||
"javascript:stringIterator:toString"
|
||||
export
|
||||
withIteratorString : (str : String)
|
||||
@ -61,6 +63,7 @@ data UnconsResult : String -> Type where
|
||||
-- (e.g. byte offset into an UTF-8 string).
|
||||
%foreign
|
||||
"scheme:blodwen-string-iterator-next"
|
||||
"C:stringIteratorNext"
|
||||
"javascript:stringIterator:next"
|
||||
export
|
||||
uncons : (str : String) -> (1 it : StringIterator str) -> UnconsResult str
|
||||
|
@ -22,6 +22,7 @@ data StringIterator : String -> Type where [external]
|
||||
-- to avoid subverting the linearity guarantees of withString.
|
||||
%foreign
|
||||
"scheme:blodwen-string-iterator-new"
|
||||
"C:stringIteratorNew"
|
||||
"javascript:stringIterator:new"
|
||||
private
|
||||
fromString : (str : String) -> StringIterator str
|
||||
@ -49,6 +50,7 @@ data UnconsResult : String -> Type where
|
||||
-- (e.g. byte offset into an UTF-8 string).
|
||||
%foreign
|
||||
"scheme:blodwen-string-iterator-next"
|
||||
"C:stringIteratorNext"
|
||||
"javascript:stringIterator:next"
|
||||
export
|
||||
uncons : (str : String) -> (1 it : StringIterator str) -> UnconsResult str
|
||||
|
@ -185,3 +185,65 @@ char *fastConcat(Value *strList)
|
||||
|
||||
return retVal;
|
||||
}
|
||||
|
||||
typedef struct
|
||||
{
|
||||
char *str;
|
||||
int pos;
|
||||
} String_Iterator;
|
||||
|
||||
Value *stringIteratorNew(char *str)
|
||||
{
|
||||
int l = strlen(str);
|
||||
|
||||
String_Iterator *it = (String_Iterator *)malloc(sizeof(String_Iterator));
|
||||
it->str = (char *)malloc(l + 1);
|
||||
it->pos = 0;
|
||||
memcpy(it->str, str, l + 1); // Take a copy of str, in case it gets GCed
|
||||
|
||||
Value_Arglist *arglist = newArglist(2, 2);
|
||||
Value *(*onCollectRaw)(Value_Arglist*) = onCollectStringIterator_arglist;
|
||||
Value_Closure *onCollect = makeClosureFromArglist(onCollectRaw, arglist);
|
||||
|
||||
return (Value *)makeGCPointer(it, onCollect);
|
||||
}
|
||||
|
||||
Value *onCollectStringIterator(Value_Pointer *ptr, void *null)
|
||||
{
|
||||
String_Iterator *it = (String_Iterator *)ptr->p;
|
||||
free(it->str);
|
||||
free(it);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
Value *onCollectStringIterator_arglist(Value_Arglist *arglist)
|
||||
{
|
||||
return onCollectStringIterator(
|
||||
(Value_Pointer *)arglist->args[0],
|
||||
arglist->args[1]
|
||||
);
|
||||
}
|
||||
|
||||
Value *stringIteratorToString(void *a, char *str, Value *it_p, Value_Closure *f)
|
||||
{
|
||||
String_Iterator *it = ((Value_GCPointer *)it_p)->p->p;
|
||||
return apply_closure((Value *)f, (Value *)makeString(it->str + it->pos));
|
||||
}
|
||||
|
||||
Value *stringIteratorNext(char *s, Value *it_p)
|
||||
{
|
||||
String_Iterator *it = (String_Iterator *)((Value_GCPointer *)it_p)->p->p;
|
||||
char c = it->str[it->pos];
|
||||
|
||||
if (c == '\0') {
|
||||
return (Value *)newConstructor(0, 0, "Data_String_Iterator_EOF");
|
||||
}
|
||||
|
||||
it->pos ++; // Ok to do this as StringIterator linear
|
||||
|
||||
Value_Constructor *retVal = newConstructor(2, 1, "Data_String_Iterator_Character");
|
||||
retVal->args[0] = (Value *)makeChar(c);
|
||||
retVal->args[1] = newReference(it_p);
|
||||
|
||||
return (Value *)retVal;
|
||||
}
|
||||
|
@ -15,4 +15,10 @@ char *fastPack(Value *charList);
|
||||
Value *fastUnpack(char *str);
|
||||
char *fastConcat(Value *strList);
|
||||
|
||||
Value *stringIteratorNew(char *str);
|
||||
Value *onCollectStringIterator(Value_Pointer *ptr, void *null);
|
||||
Value *onCollectStringIterator_arglist(Value_Arglist *arglist);
|
||||
Value *stringIteratorToString(void *a, char *str, Value *it_p, Value_Closure *f);
|
||||
Value *stringIteratorNext(char *s, Value *it_p);
|
||||
|
||||
#endif
|
||||
|
@ -1,6 +1,14 @@
|
||||
module TestStrings
|
||||
|
||||
import Data.String
|
||||
import Data.String.Iterator
|
||||
|
||||
iteratorTail : String -> String
|
||||
iteratorTail str = withString str $ \it => unconsTail str (uncons str it)
|
||||
where
|
||||
unconsTail : (str : String) -> (1 _ : UnconsResult str) -> String
|
||||
unconsTail str EOF = ""
|
||||
unconsTail str (Character _ tailIt) = withIteratorString str tailIt id
|
||||
|
||||
main : IO ()
|
||||
main = do
|
||||
@ -20,7 +28,7 @@ main = do
|
||||
putStrLn $ show $ fastUnpack "unpack"
|
||||
putStrLn $ fastConcat ["con", "cat", "en", "ate"]
|
||||
|
||||
let chars = ['a', 'A', '~', '0', ' ', '\n', '\x9f']
|
||||
let chars = the (List Char) ['a', 'A', '~', '0', ' ', '\n', '\x9f']
|
||||
putStrLn $ show $ map isUpper chars
|
||||
putStrLn $ show $ map isLower chars
|
||||
putStrLn $ show $ map isDigit chars
|
||||
@ -28,5 +36,8 @@ main = do
|
||||
putStrLn $ show $ map isNL chars
|
||||
putStrLn $ show $ map isControl chars
|
||||
|
||||
putStrLn $ show $ map chr [97, 65, 126, 48, 32, 10, 159]
|
||||
putStrLn $ show $ map {f = List} chr [97, 65, 126, 48, 32, 10, 159]
|
||||
putStrLn $ show $ map ord chars
|
||||
|
||||
putStrLn $ show $ Data.String.Iterator.unpack "iterator unpack"
|
||||
putStrLn $ show $ iteratorTail "iterator tail"
|
||||
|
@ -16,3 +16,5 @@ concatenate
|
||||
[False, False, False, False, False, True, True]
|
||||
['a', 'A', '~', '0', ' ', '\LF', '\159']
|
||||
[97, 65, 126, 48, 32, 10, 159]
|
||||
['i', 't', 'e', 'r', 'a', 't', 'o', 'r', ' ', 'u', 'n', 'p', 'a', 'c', 'k']
|
||||
"terator tail"
|
||||
|
@ -1,4 +1,4 @@
|
||||
$1 --no-banner --no-color --console-width 0 --cg refc -o refc_strings TestStrings.idr > /dev/null
|
||||
$1 --no-banner --no-color --console-width 0 --cg refc -p contrib -o refc_strings TestStrings.idr > /dev/null
|
||||
./build/exec/refc_strings
|
||||
|
||||
rm -rf build
|
||||
|
Loading…
Reference in New Issue
Block a user