2debf36 · Idris-dev · git.iko.soy

rts/idris_rts.c+24−10

compare with master

unifiedsplit

@@ -636,7 +636,7 @@ VAL MKSTROFFc(VM* vm, StrOffset* off) {

636 return cl;

637}

638

639−VAL idris_strTail(VM* vm, VAL str) {

639+VAL idris_strShift(VM* vm, VAL str, int num) {

640 // If there's no room, just copy the string, or we'll have a problem after

641 // gc moves str

642 if (space(vm, sizeof(Closure) + sizeof(StrOffset))) {

@@ -654,7 +654,7 @@ VAL idris_strTail(VM* vm, VAL str) {

654 }

655

656 cl->info.str_offset->str = root;

657− cl->info.str_offset->offset = offset+idris_utf8_charlen(GETSTR(str));

657+ cl->info.str_offset->offset = offset+idris_utf8_findOffset(GETSTR(str), num);

658

659 return cl;

660 } else {

@@ -663,6 +663,10 @@ VAL idris_strTail(VM* vm, VAL str) {

663 }

664}

665

666+VAL idris_strTail(VM* vm, VAL str) {

667+ return idris_strShift(vm, str, 1);

668+}

669+

666VAL idris_strCons(VM* vm, VAL x, VAL xs) {

670VAL idris_strCons(VM* vm, VAL x, VAL xs) {

667 char *xstr = GETSTR(xs);

671 char *xstr = GETSTR(xs);

668 int xval = GETINT(x);

672 int xval = GETINT(x);

@@ -692,14 +696,24 @@ VAL idris_strIndex(VM* vm, VAL str, VAL i) {

692}

696}

693

697

694VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {

698VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {

695− char *start = idris_utf8_advance(GETSTR(str), GETINT(offset));

699+ int offset_val = GETINT(offset);

696− char *end = idris_utf8_advance(start, GETINT(length));

700+ int length_val = GETINT(length);

701+ char* str_val = GETSTR(str);

702+

703+ // If the substring is a suffix, use idris_strShift to avoid reallocating

704+ if (offset_val + length_val >= strlen(str_val)) {

705+ return idris_strShift(vm, str, offset_val);

706+ }

707+ else {

708+ char *start = idris_utf8_advance(str_val, offset_val);

709+ char *end = idris_utf8_advance(start, length_val);

697− Closure* newstr = allocate(sizeof(Closure) + (end - start) +1, 0);

710+ Closure* newstr = allocate(sizeof(Closure) + (end - start) +1, 0);

698− SETTY(newstr, CT_STRING);

711+ SETTY(newstr, CT_STRING);

699− newstr -> info.str = (char*)newstr + sizeof(Closure);

712+ newstr -> info.str = (char*)newstr + sizeof(Closure);

700− memcpy(newstr -> info.str, start, end - start);

713+ memcpy(newstr -> info.str, start, end - start);

701− *(newstr -> info.str + (end - start) + 1) = '\0';

714+ *(newstr -> info.str + (end - start) + 1) = '\0';

702− return newstr;

715+ return newstr;

716+ }

703}

717}

704

718

705VAL idris_strRev(VM* vm, VAL str) {

719VAL idris_strRev(VM* vm, VAL str) {

rts/idris_rts.h+1

@@ -378,6 +378,7 @@ VAL idris_readStr(VM* vm, FILE* h);

378VAL idris_readChars(VM* vm, int num, FILE* h);

379

380VAL idris_strHead(VM* vm, VAL str);

381+VAL idris_strShift(VM* vm, VAL str, int num);

381VAL idris_strTail(VM* vm, VAL str);

382VAL idris_strTail(VM* vm, VAL str);

382// This is not expected to be efficient! Mostly we wouldn't expect to call

383// This is not expected to be efficient! Mostly we wouldn't expect to call

383// it at all at run time.

384// it at all at run time.

rts/idris_utf8.c+11

@@ -103,6 +103,17 @@ char* idris_utf8_advance(char* str, int i) {

103 return str;

104}

105

106+int idris_utf8_findOffset(char* str, int i) {

107+ int offset = 0;

108+ while(i > 0) {

109+ int len = idris_utf8_charlen(str);

110+ str+=len;

111+ offset+=len;

112+ i--;

113+ }

114+ return offset;

115+}

116+

106

117

107char* idris_utf8_fromChar(int x) {

118char* idris_utf8_fromChar(int x) {

108 char* str;

119 char* str;

rts/idris_utf8.h+2

@@ -21,4 +21,6 @@ char* idris_utf8_rev(char* s, char* result);

21// Advance a pointer into a string by i UTF8 characters.

22// Return original pointer if i <= 0.

23char* idris_utf8_advance(char* str, int i);

24+// Return the offset of the ith UTF8 character in the string

25+int idris_utf8_findOffset(char* str, int i);

24#endif

26#endif

src/IRTS/CodegenC.hs+1−1

@@ -626,7 +626,7 @@ doOp v (LExternal rf) [_,x]

626 = v ++ "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"

627doOp v (LExternal rf) [_,len,x]

628 | rf == sUN "prim__readChars"

629− = v ++ "idris_readChars(vm, GETINT(" ++ creg len ++

629+ = v ++ "idris_readChars(vm, GETINT(" ++ creg len ++

630 "), GETPTR(" ++ creg x ++ "))"

631doOp v (LExternal wf) [_,x,s]

632 | wf == sUN "prim__writeFile"

src/Idris/Core/Execute.hs+1−1

@@ -425,7 +425,7 @@ execForeign env ctxt arity ty fn xs onfail

425 ". Are all cases covered?"

426 | Just (FFun "idris_addToString" [(_, strBuf), (_, str)] _) <- foreignFromTT arity ty fn xs

427 = case (strBuf, str) of

428− (EStringBuf ref, EConstant (Str add)) ->

428+ (EStringBuf ref, EConstant (Str add)) ->

429 do execIO $ modifyIORef ref (++add)

430 execApp env ctxt ioUnit (drop arity xs)

431 _ -> execFail . Msg $