Parse DO blocks block-based in parsers

And disable relevant transformation GroupDo -- GroupLabelledDo is still important for the "nonblock" DO construct. Original code by RaoulHC.
camfort · Jul 26, 2021 · 1e80049 · 1e80049
1 parent 3ad155a
commit 1e80049
Show file tree

Hide file tree

Showing 7 changed files with 149 additions and 101 deletions.
diff --git a/src/Language/Fortran/Parser/Fortran2003.y b/src/Language/Fortran/Parser/Fortran2003.y
@@ -358,6 +358,7 @@ BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
 BLOCK :: { Block A0 }
 : IF_BLOCK MAYBE_COMMENT NEWLINE { $1 }
 | CASE_BLOCK MAYBE_COMMENT NEWLINE { $1 }
+| DO_BLOCK MAYBE_COMMENT NEWLINE { $1 }
 | INTEGER_LITERAL STATEMENT MAYBE_COMMENT NEWLINE
   { BlStatement () (getTransSpan $1 $2) (Just $1) $2 }
 | STATEMENT MAYBE_COMMENT NEWLINE { BlStatement () (getSpan $1) Nothing $1 }
@@ -368,7 +369,6 @@ BLOCK :: { Block A0 }
 | COMMENT_BLOCK { $1 }
 
 IF_BLOCK :: { Block A0 }
-IF_BLOCK
 :                        if '(' EXPRESSION ')' then MAYBE_COMMENT NEWLINE BLOCKS ELSE_BLOCKS
   { let { startSpan = getSpan $1;
           (endSpan, conds, blocks, endLabel) = $9;
@@ -394,7 +394,6 @@ IF_BLOCK
      in BlIf () span startLabel (Just startName) ((Just $6):conds) ((reverse $11):blocks) endLabel }
 
 ELSE_BLOCKS :: { (SrcSpan, [Maybe (Expression A0)], [[Block A0]], Maybe (Expression A0)) }
-ELSE_BLOCKS
 : maybe(INTEGER_LITERAL) elsif '(' EXPRESSION ')' then MAYBE_COMMENT NEWLINE BLOCKS ELSE_BLOCKS
   { let (endSpan, conds, blocks, endLabel) = $10
     in (endSpan, Just $4 : conds, reverse $9 : blocks, endLabel) }
@@ -404,14 +403,12 @@ ELSE_BLOCKS
 | END_IF { let (endSpan, endLabel) = $1 in (endSpan, [], [], endLabel) }
 
 END_IF :: { (SrcSpan, Maybe (Expression A0)) }
-END_IF
 : endif { (getSpan $1, Nothing) }
 | endif id { (getSpan $2, Nothing) }
 | INTEGER_LITERAL endif { (getSpan $2, Just $1) }
 | INTEGER_LITERAL endif id { (getSpan $3, Just $1) }
 
 CASE_BLOCK :: { Block A0 }
-CASE_BLOCK
 :                        selectcase '(' EXPRESSION ')' MAYBE_COMMENT NEWLINE CASES
   { let { (caseRanges, blocks, endLabel, endSpan) = $7;
           span = getTransSpan $1 endSpan }
@@ -454,6 +451,39 @@ END_SELECT :: { (Maybe (Expression A0), SrcSpan) }
 : maybe(INTEGER_LITERAL) endselect maybe(id)
   { ($1, maybe (getSpan $2) getSpan $3) }
 
+DO_BLOCK :: { Block A0 }
+: START_DO                          MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $5; }
+      in if startConstruct /= endConstruct
+         then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+         else return $ BlDo () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing Nothing (reverse $4) endLabel }
+| START_DO DO_SPECIFICATION         MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $6; }
+      in if startConstruct /= endConstruct
+         then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+         else return $ BlDo () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing (Just $2) (reverse $5) endLabel }
+| START_DO while '(' EXPRESSION ')' MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $9; }
+     in if startConstruct /= endConstruct
+        then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+        else return $ BlDoWhile () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing $4 (reverse $8) endLabel
+  }
+
+START_DO :: { (SrcSpan, Maybe String, Maybe (Expression A0)) }
+: do { (getSpan $1, Nothing, Nothing)}
+| id ':' do { let TId s id = $1 in (s, Just id, Nothing) }
+| INTEGER_LITERAL do { (getSpan $1, Nothing, Just $1) }
+| INTEGER_LITERAL id ':' do { let TId _ id = $2 in (getSpan $1, Just id, Just $1) }
+
+END_DO :: { (SrcSpan, Maybe String, Maybe (Expression A0)) }
+: enddo { (getSpan $1, Nothing, Nothing) }
+| INTEGER_LITERAL enddo { (getSpan $2, Nothing, Just $1)}
+| enddo id { let TId s id = $2 in (s, Just id, Nothing)}
+| INTEGER_LITERAL enddo id { let TId s id = $3 in (s, Just id, Just $1) }
+
 ABSTRACTP :: { Bool }
 : abstract { True }
 | {- EMPTY -} { False }
@@ -658,26 +688,13 @@ EXECUTABLE_STATEMENT :: { Statement A0 }
 | endwhere { StEndWhere () (getSpan $1) Nothing }
 | if '(' EXPRESSION ')' INTEGER_LITERAL ',' INTEGER_LITERAL ',' INTEGER_LITERAL
   { StIfArithmetic () (getTransSpan $1 $9) $3 $5 $7 $9 }
-| do { StDo () (getSpan $1) Nothing Nothing Nothing }
-| id ':' do
-  { let TId s id = $1
-    in StDo () (getTransSpan s $3) (Just id) Nothing Nothing }
 | do INTEGER_LITERAL MAYBE_COMMA DO_SPECIFICATION
   { StDo () (getTransSpan $1 $4) Nothing (Just $2) (Just $4) }
-| do DO_SPECIFICATION { StDo () (getTransSpan $1 $2) Nothing Nothing (Just $2) }
-| id ':' do DO_SPECIFICATION
-  { let TId s id = $1
-    in StDo () (getTransSpan s $4) (Just id) Nothing (Just $4) }
 | do INTEGER_LITERAL MAYBE_COMMA while '(' EXPRESSION ')'
   { StDoWhile () (getTransSpan $1 $7) Nothing (Just $2) $6 }
-| do while '(' EXPRESSION ')'
-  { StDoWhile () (getTransSpan $1 $5) Nothing Nothing $4 }
-| id ':' do while '(' EXPRESSION ')'
-  { let TId s id = $1
-    in StDoWhile () (getTransSpan s $7) (Just id) Nothing $6 }
-| enddo { StEnddo () (getSpan $1) Nothing }
-| enddo id
-  { let TId s id = $2 in StEnddo () (getTransSpan $1 s) (Just id) }
+-- | enddo { StEnddo () (getSpan $1) Nothing }
+-- | enddo id
+--  { let TId s id = $2 in StEnddo () (getTransSpan $1 s) (Just id) }
 | cycle { StCycle () (getSpan $1) Nothing }
 | cycle VARIABLE { StCycle () (getTransSpan $1 $2) (Just $2) }
 | exit { StExit () (getSpan $1) Nothing }

diff --git a/src/Language/Fortran/Parser/Fortran77.y b/src/Language/Fortran/Parser/Fortran77.y
@@ -275,6 +275,7 @@ BLOCKS
 BLOCK :: { Block A0 }
 BLOCK
 : IF_BLOCK NEWLINE { $1 }
+| DO_BLOCK NEWLINE { $1 }
 | LABEL_IN_6COLUMN STATEMENT NEWLINE { BlStatement () (getTransSpan $1 $2) (Just $1) $2 }
 | STATEMENT NEWLINE { BlStatement () (getSpan $1) Nothing $1 }
 | COMMENT_BLOCK { $1 }
@@ -299,6 +300,17 @@ ELSE_BLOCKS
   { (getSpan $6, $5, [Nothing], [reverse $4]) }
 | maybe(LABEL_IN_6COLUMN) endif { (getSpan $2, $1, [], []) }
 
+DO_BLOCK :: { Block A0 }
+DO_BLOCK
+:                  do DO_SPECIFICATION NEWLINE BLOCKS enddo
+  { BlDo () (getTransSpan $1 $5) Nothing Nothing Nothing (Just $2) $4 Nothing }
+| LABEL_IN_6COLUMN do DO_SPECIFICATION NEWLINE BLOCKS enddo
+  { BlDo () (getTransSpan $1 $6) (Just $1) Nothing Nothing (Just $3) $5 Nothing }
+|                  doWhile '(' EXPRESSION ')' NEWLINE BLOCKS enddo
+  { BlDoWhile () (getTransSpan $1 $7) Nothing Nothing Nothing $3 $6 Nothing }
+| LABEL_IN_6COLUMN doWhile '(' EXPRESSION ')' NEWLINE BLOCKS enddo
+  { BlDoWhile () (getTransSpan $1 $8) (Just $1) Nothing Nothing $4 $7 Nothing }
+
 COMMENT_BLOCK :: { Block A0 }
 COMMENT_BLOCK
 : comment NEWLINE { let (TComment s c) = $1 in BlComment () s (Comment c) }
@@ -322,8 +334,6 @@ DO_STATEMENT :: { Statement A0 }
 DO_STATEMENT
 : do LABEL_IN_STATEMENT DO_SPECIFICATION { StDo () (getTransSpan $1 $3) Nothing (Just $2) (Just $3) }
 | do LABEL_IN_STATEMENT ',' DO_SPECIFICATION { StDo () (getTransSpan $1 $4) Nothing (Just $2) (Just $4) }
-| do DO_SPECIFICATION { StDo () (getTransSpan $1 $2) Nothing Nothing (Just $2) }
-| do { StDo () (getSpan $1) Nothing Nothing Nothing }
 
 DO_SPECIFICATION :: { DoSpecification A0 }
 DO_SPECIFICATION
@@ -336,13 +346,11 @@ EXECUTABLE_STATEMENT
 | assign LABEL_IN_STATEMENT to VARIABLE { StLabelAssign () (getTransSpan $1 $4) $2 $4 }
 | GOTO_STATEMENT { $1 }
 | if '(' EXPRESSION ')' LABEL_IN_STATEMENT ',' LABEL_IN_STATEMENT ',' LABEL_IN_STATEMENT { StIfArithmetic () (getTransSpan $1 $9) $3 $5 $7 $9 }
-| doWhile '(' EXPRESSION ')'
-  { StDoWhile () (getTransSpan $1 $4) Nothing Nothing $3 }
 | do LABEL_IN_STATEMENT while '(' EXPRESSION ')'
   { StDoWhile () (getTransSpan $1 $6) Nothing (Just $2) $5 }
 | do LABEL_IN_STATEMENT ',' while '(' EXPRESSION ')'
   { StDoWhile () (getTransSpan $1 $7) Nothing (Just $2) $6 }
-| enddo { StEnddo () (getSpan $1) Nothing }
+-- | enddo { StEnddo () (getSpan $1) Nothing }
 | call VARIABLE ARGUMENTS
   { StCall () (getTransSpan $1 $3) $2 $ Just $3 }
 | call VARIABLE { StCall () (getTransSpan $1 $2) $2 Nothing }

diff --git a/src/Language/Fortran/Parser/Fortran90.y b/src/Language/Fortran/Parser/Fortran90.y
@@ -307,6 +307,7 @@ BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
 BLOCK :: { Block A0 }
 : IF_BLOCK MAYBE_COMMENT NEWLINE { $1 }
 | CASE_BLOCK MAYBE_COMMENT NEWLINE { $1 }
+| DO_BLOCK MAYBE_COMMENT NEWLINE { $1 }
 | INTEGER_LITERAL STATEMENT MAYBE_COMMENT NEWLINE
   { BlStatement () (getTransSpan $1 $2) (Just $1) $2 }
 | STATEMENT MAYBE_COMMENT NEWLINE { BlStatement () (getSpan $1) Nothing $1 }
@@ -317,7 +318,6 @@ BLOCK :: { Block A0 }
 | COMMENT_BLOCK { $1 }
 
 IF_BLOCK :: { Block A0 }
-IF_BLOCK
 :                        if '(' EXPRESSION ')' then MAYBE_COMMENT NEWLINE BLOCKS ELSE_BLOCKS
   { let { startSpan = getSpan $1;
           (endSpan, conds, blocks, endLabel) = $9;
@@ -343,7 +343,6 @@ IF_BLOCK
      in BlIf () span startLabel (Just startName) ((Just $6):conds) ((reverse $11):blocks) endLabel }
 
 ELSE_BLOCKS :: { (SrcSpan, [Maybe (Expression A0)], [[Block A0]], Maybe (Expression A0)) }
-ELSE_BLOCKS
 : maybe(INTEGER_LITERAL) elsif '(' EXPRESSION ')' then MAYBE_COMMENT NEWLINE BLOCKS ELSE_BLOCKS
   { let (endSpan, conds, blocks, endLabel) = $10
     in (endSpan, Just $4 : conds, reverse $9 : blocks, endLabel) }
@@ -353,7 +352,6 @@ ELSE_BLOCKS
 | END_IF { let (endSpan, endLabel) = $1 in (endSpan, [], [], endLabel) }
 
 END_IF :: { (SrcSpan, Maybe (Expression A0)) }
-END_IF
 : endif { (getSpan $1, Nothing) }
 | endif id { (getSpan $2, Nothing) }
 | INTEGER_LITERAL endif { (getSpan $2, Just $1) }
@@ -402,6 +400,39 @@ END_SELECT :: { (Maybe (Expression A0), SrcSpan) }
 : maybe(INTEGER_LITERAL) endselect maybe(id)
   { ($1, maybe (getSpan $2) getSpan $3) }
 
+DO_BLOCK :: { Block A0 }
+: START_DO                          MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $5; }
+      in if startConstruct /= endConstruct
+         then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+         else return $ BlDo () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing Nothing (reverse $4) endLabel }
+| START_DO DO_SPECIFICATION         MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $6; }
+      in if startConstruct /= endConstruct
+         then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+         else return $ BlDo () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing (Just $2) (reverse $5) endLabel }
+| START_DO while '(' EXPRESSION ')' MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $9; }
+     in if startConstruct /= endConstruct
+        then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+        else return $ BlDoWhile () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing $4 (reverse $8) endLabel
+  }
+
+START_DO :: { (SrcSpan, Maybe String, Maybe (Expression A0)) }
+: do { (getSpan $1, Nothing, Nothing)}
+| id ':' do { let TId s id = $1 in (s, Just id, Nothing) }
+| INTEGER_LITERAL do { (getSpan $1, Nothing, Just $1) }
+| INTEGER_LITERAL id ':' do { let TId _ id = $2 in (getSpan $1, Just id, Just $1) }
+
+END_DO :: { (SrcSpan, Maybe String, Maybe (Expression A0)) }
+: enddo { (getSpan $1, Nothing, Nothing) }
+| INTEGER_LITERAL enddo { (getSpan $2, Nothing, Just $1)}
+| enddo id { let TId s id = $2 in (s, Just id, Nothing)}
+| INTEGER_LITERAL enddo id { let TId s id = $3 in (s, Just id, Just $1) }
+
 MAYBE_EXPRESSION :: { Maybe (Expression A0) }
 : EXPRESSION { Just $1 }
 | {- EMPTY -} { Nothing }
@@ -544,26 +575,13 @@ EXECUTABLE_STATEMENT :: { Statement A0 }
 | endwhere { StEndWhere () (getSpan $1) Nothing }
 | if '(' EXPRESSION ')' INTEGER_LITERAL ',' INTEGER_LITERAL ',' INTEGER_LITERAL
   { StIfArithmetic () (getTransSpan $1 $9) $3 $5 $7 $9 }
-| do { StDo () (getSpan $1) Nothing Nothing Nothing }
-| id ':' do
-  { let TId s id = $1
-    in StDo () (getTransSpan s $3) (Just id) Nothing Nothing }
 | do INTEGER_LITERAL MAYBE_COMMA DO_SPECIFICATION
   { StDo () (getTransSpan $1 $4) Nothing (Just $2) (Just $4) }
-| do DO_SPECIFICATION { StDo () (getTransSpan $1 $2) Nothing Nothing (Just $2) }
-| id ':' do DO_SPECIFICATION
-  { let TId s id = $1
-    in StDo () (getTransSpan s $4) (Just id) Nothing (Just $4) }
 | do INTEGER_LITERAL MAYBE_COMMA while '(' EXPRESSION ')'
   { StDoWhile () (getTransSpan $1 $7) Nothing (Just $2) $6 }
-| do while '(' EXPRESSION ')'
-  { StDoWhile () (getTransSpan $1 $5) Nothing Nothing $4 }
-| id ':' do while '(' EXPRESSION ')'
-  { let TId s id = $1
-    in StDoWhile () (getTransSpan s $7) (Just id) Nothing $6 }
-| enddo { StEnddo () (getSpan $1) Nothing }
-| enddo id
-  { let TId s id = $2 in StEnddo () (getTransSpan $1 s) (Just id) }
+-- | enddo { StEnddo () (getSpan $1) Nothing }
+-- | enddo id
+--   { let TId s id = $2 in StEnddo () (getTransSpan $1 s) (Just id) }
 | cycle { StCycle () (getSpan $1) Nothing }
 | cycle VARIABLE { StCycle () (getTransSpan $1 $2) (Just $2) }
 | exit { StExit () (getSpan $1) Nothing }

diff --git a/src/Language/Fortran/Parser/Fortran95.y b/src/Language/Fortran/Parser/Fortran95.y
@@ -318,6 +318,7 @@ BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
 BLOCK :: { Block A0 }
 : IF_BLOCK MAYBE_COMMENT NEWLINE { $1 }
 | CASE_BLOCK MAYBE_COMMENT NEWLINE { $1 }
+| DO_BLOCK MAYBE_COMMENT NEWLINE { $1 }
 | INTEGER_LITERAL STATEMENT MAYBE_COMMENT NEWLINE
   { BlStatement () (getTransSpan $1 $2) (Just $1) $2 }
 | STATEMENT MAYBE_COMMENT NEWLINE { BlStatement () (getSpan $1) Nothing $1 }
@@ -328,7 +329,6 @@ BLOCK :: { Block A0 }
 | COMMENT_BLOCK { $1 }
 
 IF_BLOCK :: { Block A0 }
-IF_BLOCK
 :                        if '(' EXPRESSION ')' then MAYBE_COMMENT NEWLINE BLOCKS ELSE_BLOCKS
   { let { startSpan = getSpan $1;
           (endSpan, conds, blocks, endLabel) = $9;
@@ -354,7 +354,6 @@ IF_BLOCK
      in BlIf () span startLabel (Just startName) ((Just $6):conds) ((reverse $11):blocks) endLabel }
 
 ELSE_BLOCKS :: { (SrcSpan, [Maybe (Expression A0)], [[Block A0]], Maybe (Expression A0)) }
-ELSE_BLOCKS
 : maybe(INTEGER_LITERAL) elsif '(' EXPRESSION ')' then MAYBE_COMMENT NEWLINE BLOCKS ELSE_BLOCKS
   { let (endSpan, conds, blocks, endLabel) = $10
     in (endSpan, Just $4 : conds, reverse $9 : blocks, endLabel) }
@@ -364,14 +363,12 @@ ELSE_BLOCKS
 | END_IF { let (endSpan, endLabel) = $1 in (endSpan, [], [], endLabel) }
 
 END_IF :: { (SrcSpan, Maybe (Expression A0)) }
-END_IF
 : endif { (getSpan $1, Nothing) }
 | endif id { (getSpan $2, Nothing) }
 | INTEGER_LITERAL endif { (getSpan $2, Just $1) }
 | INTEGER_LITERAL endif id { (getSpan $3, Just $1) }
 
 CASE_BLOCK :: { Block A0 }
-CASE_BLOCK
 :                        selectcase '(' EXPRESSION ')' MAYBE_COMMENT NEWLINE CASES
   { let { (caseRanges, blocks, endLabel, endSpan) = $7;
           span = getTransSpan $1 endSpan }
@@ -414,6 +411,39 @@ END_SELECT :: { (Maybe (Expression A0), SrcSpan) }
 : maybe(INTEGER_LITERAL) endselect maybe(id)
   { ($1, maybe (getSpan $2) getSpan $3) }
 
+DO_BLOCK :: { Block A0 }
+: START_DO                          MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $5; }
+      in if startConstruct /= endConstruct
+         then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+         else return $ BlDo () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing Nothing (reverse $4) endLabel }
+| START_DO DO_SPECIFICATION         MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $6; }
+      in if startConstruct /= endConstruct
+         then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+         else return $ BlDo () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing (Just $2) (reverse $5) endLabel }
+| START_DO while '(' EXPRESSION ')' MAYBE_COMMENT NEWLINE BLOCKS END_DO
+  {% let { (startSpan, startConstruct, startLabel) = $1;
+           (endSpan, endConstruct, endLabel) = $9; }
+     in if startConstruct /= endConstruct
+        then fail $ "Unexpected id for end do " <> show endConstruct <> " at " <> show endSpan
+        else return $ BlDoWhile () (getTransSpan startSpan endSpan) startLabel startConstruct Nothing $4 (reverse $8) endLabel
+  }
+
+START_DO :: { (SrcSpan, Maybe String, Maybe (Expression A0)) }
+: do { (getSpan $1, Nothing, Nothing)}
+| id ':' do { let TId s id = $1 in (s, Just id, Nothing) }
+| INTEGER_LITERAL do { (getSpan $1, Nothing, Just $1) }
+| INTEGER_LITERAL id ':' do { let TId _ id = $2 in (getSpan $1, Just id, Just $1) }
+
+END_DO :: { (SrcSpan, Maybe String, Maybe (Expression A0)) }
+: enddo { (getSpan $1, Nothing, Nothing) }
+| INTEGER_LITERAL enddo { (getSpan $2, Nothing, Just $1)}
+| enddo id { let TId s id = $2 in (s, Just id, Nothing)}
+| INTEGER_LITERAL enddo id { let TId s id = $3 in (s, Just id, Just $1) }
+
 MAYBE_EXPRESSION :: { Maybe (Expression A0) }
 : EXPRESSION { Just $1 }
 | {- EMPTY -} { Nothing }
@@ -562,26 +592,13 @@ EXECUTABLE_STATEMENT :: { Statement A0 }
 | endwhere { StEndWhere () (getSpan $1) Nothing }
 | if '(' EXPRESSION ')' INTEGER_LITERAL ',' INTEGER_LITERAL ',' INTEGER_LITERAL
   { StIfArithmetic () (getTransSpan $1 $9) $3 $5 $7 $9 }
-| do { StDo () (getSpan $1) Nothing Nothing Nothing }
-| id ':' do
-  { let TId s id = $1
-    in StDo () (getTransSpan s $3) (Just id) Nothing Nothing }
 | do INTEGER_LITERAL MAYBE_COMMA DO_SPECIFICATION
   { StDo () (getTransSpan $1 $4) Nothing (Just $2) (Just $4) }
-| do DO_SPECIFICATION { StDo () (getTransSpan $1 $2) Nothing Nothing (Just $2) }
-| id ':' do DO_SPECIFICATION
-  { let TId s id = $1
-    in StDo () (getTransSpan s $4) (Just id) Nothing (Just $4) }
 | do INTEGER_LITERAL MAYBE_COMMA while '(' EXPRESSION ')'
   { StDoWhile () (getTransSpan $1 $7) Nothing (Just $2) $6 }
-| do while '(' EXPRESSION ')'
-  { StDoWhile () (getTransSpan $1 $5) Nothing Nothing $4 }
-| id ':' do while '(' EXPRESSION ')'
-  { let TId s id = $1
-    in StDoWhile () (getTransSpan s $7) (Just id) Nothing $6 }
-| enddo { StEnddo () (getSpan $1) Nothing }
-| enddo id
-  { let TId s id = $2 in StEnddo () (getTransSpan $1 s) (Just id) }
+-- | enddo { StEnddo () (getSpan $1) Nothing }
+-- | enddo id
+--  { let TId s id = $2 in StEnddo () (getTransSpan $1 s) (Just id) }
 | cycle { StCycle () (getSpan $1) Nothing }
 | cycle VARIABLE { StCycle () (getTransSpan $1 $2) (Just $2) }
 | exit { StExit () (getSpan $1) Nothing }

diff --git a/src/Language/Fortran/Transformer.hs b/src/Language/Fortran/Transformer.hs
@@ -53,7 +53,7 @@ defaultTransformations = \case
     , DisambiguateFunction
     ]
   Fortran77         -> defaultTransformations Fortran66
-  Fortran77Legacy   -> GroupDo   : defaultTransformations Fortran77
+  Fortran77Legacy   -> defaultTransformations Fortran77
   Fortran77Extended -> defaultTransformations Fortran77Legacy
   Fortran90   -> defaultTransformations Fortran77Extended
   Fortran95   -> defaultTransformations Fortran77Extended