Data commit

Task/Strip-block-comments/ALGOL-W/strip-block-comments.alg

@@ -0,0 +1,119 @@
+begin
+    % strips block comments from a source                                     %
+    % the source is read from standard input and the result written to        %
+    % standard output, The comment start text is in cStart and the ending     %
+    % is in cEnd.                                                             %
+    % As strings are fixed length in Algol W, the first space in cStart/cEnd  %
+    % is assumed to terminate the delimiter, i.e. the comment start/end       %
+    % delimiters cannot contain spaces.                                       %
+    % If non-blank, quote1 and quote2 are the string quote characters.        %
+    % If escape is non-blank it indicates that quotes can be embedded in      %
+    % string literals by preceding them with escape (as in C, java, etc.).    %
+    procedure stripBlockComments( string(32) value cStart, cEnd
+                                ; string(1)  value quote1, quote2, escape
+                                ) ;
+    begin
+        integer     columnNumber, lineWidth;
+        string(256) line;
+        string(1)   currChar;
+        string(1)   newlineChar;
+        % gets the next source character                                      %
+        procedure nextChar ;
+        begin
+            if      columnNumber = lineWidth then begin
+                currChar     := newlineChar;
+                columnNumber := columnNumber + 1
+                end
+            else if columnNumber > lineWidth then begin
+                readcard( line );
+                lineWidth := 256;
+                while lineWidth > 0 and line( lineWidth - 1 // 1 ) = " " do lineWidth := lineWidth - 1;
+                columnNumber := 1;
+                currChar     := line( 0 // 1 )
+                end
+            else begin
+                currChar     := line( columnNumber // 1 );
+                columnNumber := columnNumber + 1
+            end
+        end nextChar ;
+        % copy the current character and get the next                         %
+        procedure copyAndNext ;
+        begin
+            if currChar = newlineChar then write()
+                                      else writeon( currChar );
+            nextChar
+        end copyAndNext ;
+        % skips the current character and gets the next                       %
+        procedure skipAndNext ;
+        begin
+            if currChar not = newlineChar then currChar := " ";
+            copyAndNext
+        end skipAndNext ;
+        % handle a string literal                                             %
+        procedure stringLiteral( string(1) value quote, escape ) ;
+        begin
+            copyAndNext;
+            while currChar not = quote and not XCPNOTED(ENDFILE) do begin
+                if escape <> " " and currChar = escape then copyAndNext;
+                if not XCPNOTED(ENDFILE) then copyAndNext
+            end while_have_more_string ;
+            if currChar = quote then copyAndNext
+        end stringLiteral ;
+        % returns true if the line continues with the specified text          %
+        %         false if not.                                               %
+        logical procedure remainingLineStartsWith ( string(32) value text ) ;
+        begin
+            logical   haveText;
+            integer   lPos, wPos;
+            haveText := currChar = text( 0 // 1 );
+            lPos     := columnNumber;
+            wPos     := 1;
+            while haveText and wPos <= 32 and text( wPos // 1 ) not = " " do begin
+                if lPos >= lineWidth then begin
+                    % past the end of the line                                %
+                    haveText := false
+                    end
+                else begin
+                    % still have text on the line                             %
+                    haveText := line( lPos // 1 ) = text( wPos // 1 );
+                    wPos     := wPos + 1;
+                    lPos     := lPos + 1;
+                end if_past_end_of_line_
+            end while_have_text_and_more_text ;
+            haveText
+        end remainingLineStartsWith ;
+        % skips the number of leading non-blank characters in the delimiter   %
+        procedure skipDelimiter( string(32) value delimiter ) ;
+        begin
+            integer dPos;
+            dPos := 0;
+            while dPos < 32 and not XCPNOTED(ENDFILE) and delimiter( dPos // 1 ) not = " " do begin
+               dPos := dPos + 1;
+               skipAndNext
+           end while_not_at_end_of_delimiter
+        end skipDelimiter ;
+        newlineChar  := code( 10 );
+        lineWidth    := 0;
+        columnNumber := lineWidth + 1;
+        currChar     := " ";
+        % allow the program to continue after reaching end-of-file %
+        ENDFILE      := EXCEPTION( false, 1, 0, false, "EOF" );
+        % get the first source character                                      %
+        nextChar;
+        % strip the comments                                                  %
+        while not XCPNOTED(ENDFILE) do begin
+            if      currChar = " "    then copyAndNext
+            else if remainingLineStartsWith( cStart ) then begin
+                % have a comment                                              %
+                skipDelimiter( cStart );
+                while not remainingLineStartsWith( cEnd ) and not XCPNOTED(ENDFILE) do skipAndNext;
+                skipDelimiter( cEnd )
+                end
+            else if currChar = quote1 then stringLiteral( quote1, escape )
+            else if currChar = quote2 then stringLiteral( quote2, escape )
+            else                           copyAndNext
+        end while_not_at_eof
+    end stripBlockComments ;
+    % text stripBlockComments for C-style source                              %
+    stripBlockComments( "/*", "*/", """", "'", "\" )
+end.