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

git.iko.soy/Idris-dev

Use offset for substr if possible

If the substring is a suffix, use a pointer to the existing string rather than constructing a new string.

commit2debf366a77f2293b0f5fff05834daeab9e031bb authorEdwin Brady <ecb10@st-andrews.ac.uk> dateWed 15 Mar 2017, 15:59 (10 years ago) parentce5e330

6 files changed+40−12

compare with master

unifiedsplit

rts/idris_rts.c+24−10 rts/idris_rts.h+1 rts/idris_utf8.c+11 rts/idris_utf8.h+2 src/IRTS/CodegenC.hs+1−1 src/Idris/Core/Execute.hs+1−1

rts/idris_rts.c+24−10

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

636636 return cl;

637637}

638638

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

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

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

641641 // gc moves str

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

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

654654 }

655655

656656 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);

658658

659659 return cl;

660660 } else {

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

663663 }

664664}

665665

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

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

668+}

669+

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

667671 char *xstr = GETSTR(xs);

668672 int xval = GETINT(x);

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

692696}

693697

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

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

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

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

698− SETTY(newstr, CT_STRING);

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

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

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

702− return newstr;

699+ int offset_val = GETINT(offset);

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);

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

711+ SETTY(newstr, CT_STRING);

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

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

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

715+ return newstr;

716+ }

703717}

704718

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

rts/idris_rts.h+1

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

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

379379

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

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

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

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

383384// it at all at run time.

rts/idris_utf8.c+11

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

103103 return str;

104104}

105105

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+

106117

107118char* idris_utf8_fromChar(int x) {

108119 char* str;

rts/idris_utf8.h+2

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

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

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

2323char* 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);

2426#endif

src/IRTS/CodegenC.hs+1−1

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

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

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

628628 | rf == sUN "prim__readChars"

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

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

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

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

632632 | wf == sUN "prim__writeFile"

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

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

425425 ". Are all cases covered?"

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

427427 = case (strBuf, str) of

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

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

429429 do execIO $ modifyIORef ref (++add)

430430 execApp env ctxt ioUnit (drop arity xs)

431431 _ -> execFail . Msg $