| 733 | | |
| 734 | | /* ChangeStr */ |
| 735 | | ChangeStr: Procedure ; |
| 736 | | |
| 737 | | PARSE UPPER ARG . , . , . , flags =1 . 'I' +0 ignorecase , . ; |
| 738 | | ignorecase = '' << ignorecase ; /* Booleanate the value */ |
| 739 | | |
| 740 | | PARSE ARG oldneedle, haystack, newneedle, . ; |
| 741 | | |
| 742 | | IF '' = oldneedle THEN |
| 743 | | RETURN haystack ; |
| 744 | | /* Alternate interpretations would be for putting newneedle |
| 745 | | inbetween each character of haystack (where zero length strings |
| 746 | | exist in the interstices :-) of the string.) |
| 747 | | Or one newneedle at the end of haystack, |
| 748 | | where parse interprets '' to be. |
| 749 | | */ |
| 750 | | |
| 751 | | /* First, try to handle a cheap case: */ |
| 752 | | IF 1 = Length( oldneedle ) THEN |
| 753 | | IF 1 = Length( newneedle ) THEN |
| 754 | | DO |
| 755 | | IF ignorecase THEN |
| 756 | | DO |
| 757 | | lowers = XRange( 'a', 'z' ) ; |
| 758 | | IF 0 < Pos( oldneedle, lowers ) THEN |
| 759 | | DO |
| 760 | | newneedle = newneedle || newneedle ; |
| 761 | | oldneedle = oldneedle || Translate( oldneedle ) ; |
| 762 | | END |
| 763 | | ELSE /* not a lower case letter */ |
| 764 | | DO |
| 765 | | upper = Pos( oldneedle, XRange( 'A', 'Z' ) ) ; |
| 766 | | IF 0 < upper THEN |
| 767 | | DO |
| 768 | | newneedle = newneedle || newneedle ; |
| 769 | | oldneedle = oldneedle || SubStr( lowers, upper, 1 ) ; |
| 770 | | END ; /* is upper case */ |
| 771 | | END ; /* non-lower case */ |
| 772 | | END ; /* ignore case */ |
| 773 | | |
| 774 | | RETURN Translate( haystack, newneedle, oldneedle ) ; |
| 775 | | END ; /* both needles a single character */ |
| 776 | | |
| 777 | | /* First let's count how many instances are going to be replaced */ |
| 778 | | /* This could be inlined here if neccessary: */ |
| 779 | | total = CountStr( oldneedle, haystack, flags ) ; |
| 780 | | |
| 781 | | IF ignorecase THEN |
| 782 | | DO |
| 783 | | lneedle = Length( oldneedle ) ; |
| 784 | | PARSE UPPER ARG uneedle ; |
| 785 | | PARSE UPPER VAR haystack outstring (uneedle) . ; |
| 786 | | spot = Length( outstring'#' ) ; |
| 787 | | /* - append another character rather than add 1 after |
| 788 | | calculating length |
| 789 | | */ |
| 790 | | PARSE VAR haystack . =(spot) pneedle +(lneedle) haystack , |
| 791 | | =1 outstring (pneedle) . ; |
| 792 | | DO total |
| 793 | | outstring = outstring || newneedle ; |
| 794 | | PARSE UPPER VAR haystack increment (uneedle) . ; |
| 795 | | spot = Length( increment'#' ) ; |
| 796 | | PARSE VAR haystack . =(spot) pneedle +(lneedle) haystack , |
| 797 | | =1 increment (pneedle) . ; |
| 798 | | outstring = outstring || increment ; |
| 799 | | END /* WHILE */ ; |
| 800 | | END /* IF */ ; |
| 801 | | ELSE /* use case */ |
| 802 | | DO /* this branch is simpler to understand, but still |
| 803 | | mirrors the steps in the branch (case insensitive) |
| 804 | | above |
| 805 | | */ |
| 806 | | PARSE VAR haystack outstring (oldneedle) haystack ; |
| 807 | | DO total |
| 808 | | outstring = outstring || newneedle ; |
| 809 | | PARSE VAR haystack increment (oldneedle) haystack ; |
| 810 | | outstring = outstring || increment ; |
| 811 | | /* - Need a seperate string to store eventual output, |
| 812 | | incase old needle is a substring of new needle, |
| 813 | | which would cause an infinite loop. |
| 814 | | */ |
| 815 | | END /* WHILE */ ; |
| 816 | | END /* ELSE */ ; |
| 817 | | |
| 818 | | /* To some extent, haystack and outstring function as a stacks, |
| 819 | | allowing the shift of the character data from the structure for |
| 820 | | input to the structure for output. |
| 821 | | From this point of view, this demonstrates the ability to |
| 822 | | use data stacks to replace recursive program flow. |
| 823 | | */ |
| 824 | | |
| 825 | | RETURN outstring ; |
| 826 | | |
| 827 | | /* CountStr */ |
| 828 | | CountStr: Procedure ; |
| 829 | | |
| 830 | | PARSE UPPER ARG needle, haystack, . 'I' +0 ignorecase , . ; |
| 831 | | |
| 832 | | ignorecase = '' << ignorecase ; /* Booleanate the value */ |
| 833 | | usecase = \ ignorecase ; |
| 834 | | |
| 835 | | IF usecase THEN |
| 836 | | PARSE ARG needle, haystack, . ; |
| 837 | | |
| 838 | | |
| 839 | | /* fails if needle is a quine statement, |
| 840 | | haystack = haystack || needle ; |
| 841 | | and haystack ends with a fragment of the quine statement, |
| 842 | | such as: |
| 843 | | needle = 'aa' |
| 844 | | haystack = 'Aa' |
| 845 | | gives a false count of 1 |
| 846 | | (or recursively quined = 'abababab', haystack = 'Aab') |
| 847 | | */ |
| 848 | | |
| 849 | | IF '' = needle THEN |
| 850 | | RETURN 0 ; |
| 851 | | /* Parse interpets a null string to be past the end of whatever |
| 852 | | string is being parsed. |
| 853 | | */ |
| 854 | | |
| 855 | | /* |
| 856 | | haystack = haystack || needle ; |
| 857 | | |
| 858 | | DO total = 0 BY 1 UNTIL '' == haystack |
| 859 | | -- Ruined by Quinned statements as needles. |
| 860 | | DO total = 0 BY 1 UNTIL haystack << needle |
| 861 | | DO total = 0 BY 1 UNTIL needle >> haystack |
| 862 | | DO total = 0 BY 1 WHILE haystack >> needle |
| 863 | | DO total = 0 BY 1 UNTIL '' == qtest |
| 864 | | lneedle = Length( needle ) ; |
| 865 | | DO total = 0 BY 1 UNTIL Length( haystack ) < lneedle |
| 866 | | */ |
| 867 | | |
| 868 | | ltest = Length( needle ) ; |
| 869 | | PARSE VAR haystack . '' -(ltest) stest ; |
| 870 | | IF stest == needle THEN |
| 871 | | haystack = haystack || needle ; |
| 872 | | /* |
| 873 | | say 'stest='stest'=' |
| 874 | | */ |
| 875 | | |
| 876 | | |
| 877 | | DO total = 0 BY 1 UNTIL '' == haystack |
| 878 | | PARSE VAR haystack . (needle) haystack ; |
| 879 | | END total |
| 880 | | |
| 881 | | RETURN total ; |
