Feedback for `lfortran fmt` to format Fortran source code

LFortran now has an initial implementation of lfortran fmt, see here for screenshots. Here are the current capabilities as of 0.7.0-132-g35f9ff82:

$ lfortran fmt -h
Format Fortran source files.
Usage: lfortran fmt [OPTIONS] file

Positionals:
  file TEXT REQUIRED     Fortran source file to format

Options:
  -h,--help              Print this help message and exit
  -i                     Modify <file> in-place (instead of writing to stdout)
  --spaces INT=4         Number of spaces to use for indentation
  --indent-unit          Indent contents of sub / fn / prog / mod
  --no-color             Turn off color when writing to stdout

What other options would people like to have so that LFortran could format the source code exactly as you like?

Based on our past discussions, it seems the three major styles are:

  1. Use 2 spaces and indent function bodies:
$ lfortran fmt --spaces 2 --indent-unit integration_tests/program_01.f90 
program program_01
  integer, parameter :: dp=kind(0.d0)
  real :: a
  integer :: i
  print *, "Normal random numbers:"
  do i = 1, 10
    call rand(a)
    print *, a
  end do

contains

  subroutine rand(x)
    real, intent(out) :: x
    logical, save :: first=.true.
    real, save :: u(2)
    real :: r2
    if (first) then
      do
        call random_number(u)
        u = ((2)*(u)) - (1)
        r2 = sum((u)**(2))
        if (((r2)<(1)).and.((r2)>(0))) then
          exit
        end if
      end do
      u = (u)*(sqrt(((-(2))*(log(r2)))/(r2)))
      x = u(1)
    else
      x = u(2)
    end if
    first = .not.(first)
  end subroutine rand

end program program_01
  1. Use 4 spaces, but do not indent function bodies:
$ lfortran fmt --spaces 4 integration_tests/program_01.f90 
program program_01
integer, parameter :: dp=kind(0.d0)
real :: a
integer :: i
print *, "Normal random numbers:"
do i = 1, 10
    call rand(a)
    print *, a
end do

contains

    subroutine rand(x)
    real, intent(out) :: x
    logical, save :: first=.true.
    real, save :: u(2)
    real :: r2
    if (first) then
        do
            call random_number(u)
            u = ((2)*(u)) - (1)
            r2 = sum((u)**(2))
            if (((r2)<(1)).and.((r2)>(0))) then
                exit
            end if
        end do
        u = (u)*(sqrt(((-(2))*(log(r2)))/(r2)))
        x = u(1)
    else
        x = u(2)
    end if
    first = .not.(first)
    end subroutine rand

end program program_01
  1. Use 4 spaces and indent function bodies:
$ lfortran fmt --spaces 4 --indent-unit integration_tests/program_01.f90 
program program_01
    integer, parameter :: dp=kind(0.d0)
    real :: a
    integer :: i
    print *, "Normal random numbers:"
    do i = 1, 10
        call rand(a)
        print *, a
    end do

contains

    subroutine rand(x)
        real, intent(out) :: x
        logical, save :: first=.true.
        real, save :: u(2)
        real :: r2
        if (first) then
            do
                call random_number(u)
                u = ((2)*(u)) - (1)
                r2 = sum((u)**(2))
                if (((r2)<(1)).and.((r2)>(0))) then
                    exit
                end if
            end do
            u = (u)*(sqrt(((-(2))*(log(r2)))/(r2)))
            x = u(1)
        else
            x = u(2)
        end if
        first = .not.(first)
    end subroutine rand

end program program_01

Feel free to comment here or open issues at: https://gitlab.com/lfortran/lfortran/-/issues

I am aware of:

  • #201: not printing parentheses around expressions if not needed
4 Likes

Nice features. What will be interesting:

  • An automatic way to cut a long line
  • Some kind of a tabular format for the variable declaration, so that “intent(…)”, the “::”, the variable names, the “=” (for the initialisation) start at the same column for a given module/type or subroutine.
1 Like

As reference, here are the options of findent:

~/findent-3.1.7$ findent -h
findent [options]
   Format fortran source.
   Findent reads from STDIN, writes to STDOUT.
   Findent uses various kinds of indentations, see OPTIONS.
   Findent can convert from fixed form to free form and vice versa and
   can supplement END statements, see 'Refactor' below.
   Comment lines with '!' in column one are not indented.
   You can correct findent related indenting errors by
   inserting comment lines: 
    !  findentfix: <fortran statement>
   where <fortran statement> is for example DO, END, WHERE() etcetera.
   Findent will adjust the indentation according to <fortran statement>.
OPTIONS (errors are silently ignored):

  General options:

 	  Below: <n> denotes an unsigned decimal number.
 	         <c> denotes a character.
 	   
 	  In the long options, you can replace '_' with '-'.

-h, --help	: print this text
-H, --manpage	: print man page
--readme	: print some background information
-v, --version	: prints findent version
-q, --query_fix_free	: guess free or fixed, prints 'fixed' or 'free' and exits
--continuation=<c>	:  ' ': (default) do not change continuation characters
 	   '0': create numbered continuation characters
 	   other: use that continuation character
 	   default for conversion from free to fixed is '&'
--include_left=<n>	: (0/1) 1: indent include statements to starting indent (default:0)
-l<n>, --label_left=<n>	: (0/1) 1: move statement labels to start of line (default:1)
 	        (only for free format)
-lastindent, --last_indent	: prints computed indentation of last line
 	        (for usage with vim)
-lastusable, --last_usable	: prints line number of last line usable
 	        as start for indenting(for usage with vim)
-iauto, --input_format=auto	: determine automatically input format (free or fixed)
-ifixed, --input_format=fixed	: force input format fixed
 	  (default: auto)
-ifree, --input_format=free	: force input format free
 	  (default: auto)
-i-, --indent=none	: do not change indent (useful in combination with -R)
-L<n>, --input_line_length=<n>	: use only first <n> characters of each line
 	  default=0: take whole lines
-L<n>g, --input_line_length=<n>g	: same as above, but use gfortran convention
 	  for counting the characters with tabbed lines
 	   example: --input_line_length=72g
-M<n>, --max_indent=<n>	: maximum output indent, default 100, 0: no limit
-ofixed, --output_format=fixed	: force fixed format output
-ofree, --output_format=free	: force free format output
-osame, --output_format=same	: output format same is input format
--openmp=<n>	:  0: do not indent openmp conditionals
 	   1: indent openmp conditionals (default)
 	   NOTE: for free format, the omp sentinel must be '!$ '
-Rr, --refactor_procedures	: refactor procedures and modules: the END line
 	   of a subroutine, program etc. is, if possible, replaced by
 	   'end subroutine <name>' or
 	   'end function <name>' or
 	   'end procedure <name>' or
 	   'end program <name>' or
 	   'end block data <name>' or
 	   'end module <name>' or
 	   'end submodule <name>'
 	   where <name> is the name of the appropriate procedure, subroutine etc.
 	   NOTE1: if the END line contains a continuation the results are undefined
 	   NOTE2: a line like 'end function fun' will be replaced by
 	          'end subroutine sub' if the END line ends 'subroutine sub'
-RR, --refactor_procedures=upcase	: same as -Rr, but 'END SUBROUTINE <name>'
 	  in stead of 'end subroutine <name>' etc.

  Indenting options:

-I<n>, --start_indent=<n>	: starting  indent (default:0)
-Ia, --start_indent=a	: determine starting indent from first line
-i<n>, --indent=<n>	: all       indents except I,c,C,e (default: 3)
-a<n>, --indent_associate=<n>	: ASSOCIATE    indent
-b<n>, --indent_block=<n>	: BLOCK        indent
-d<n>, --indent_do=<n>	: DO           indent
-f<n>, --indent_if=<n>	: IF           indent
-E<n>, --indent_enum=<n>	: ENUM         indent
-F<n>, --indent_forall=<n>	: FORALL       indent
-j<n>, --indent_interface=<n>	: INTERFACE    indent
-m<n>, --indent_module=<n>	: MODULE       indent
-r<n>, --indent_procedure=<n>	: FUNCTION,
 	   SUBROUTINE and PROGRAM indent
-s<n>, --indent_select=<n>	: SELECT       indent
-t<n>, --indent_type=<n>	: TYPE         indent
-w<n>, --indent_where=<n>	: WHERE        indent
-x<n>, --indent_critical=<n>	: CRITICAL     indent
--indent_changeteam=<n>     	: CHANGE TEAM  indent
-C-, --indent_contains=restart, 	: restart indent after CONTAINS
-k<n>, --indent_continuation=<n>	: continuation indent except   
 	    for lines starting with '&'
 	       free to free only
-k-, --indent_continuation=none	: continuation lines not preceded
 	    by '&' are untouched
 	       free to free only
  	: next defaults are: all - all/2
-c<n>, --indent_case=<n>	: CASE      negative indent
-C<n>, --indent_contains=<n>	: CONTAINS  negative indent
-e<n>, --indent_entry=<n>	: ENTRY     negative indent
 	   
Dependencies:
--deps	: output dependency information only, other flags are ignored.
 	  This can be used to generate a dependencies file for usage with make(1).
 	   The format of this information:
 	   Fortran source      ->        findent output
 	    include "file1"  ->        inc file1
 	    #include "file2" ->        cpp file2
 	    #include <file3>   ->        std file3
 	    ??include 'file4'  ->        coc file4
 	    use module1        ->        use module1
 	    submodule(m) subm  ->        use m
 	                                 mod m:subm
 	    module module2     ->        mod module2
--makefdeps	: outputs a sh(1) script that serves as a an example
 	   to generate dependencies for use in make(1).
1 Like

Some of my favorite additional features of the two apps I typically use other
than basic indenting are cleanup of whitespace. See

https://sourceforge.net/projects/findent
https://github.com/pseewald/fprettify

  • It is good to get rid of tab characters and trailing spaces at a minimum.
  • An option to collapse multiple blank lines
  • toggle enddo <==> end do, same for goto, endif, elseif, …
  • removing//adding a space around +, =, ==,
  • ([; changing comma to comma-space and vice-versa
  • setting margins and redoing continued and long lines to fit
  • interface/Plugin for vim and (put your favorite editor here)
  • putting & at end and beginning of a continued line (and others would want the
    sometimes-redundant & removed)
  • output of a colorized HTML version similiar to what is generated with
    github markup “```fortran” syntax, or what indent(1), vim(1) and emacs(1)
    autoformatting, …does.

See https://fortranwiki.org/fortran/show/Tools and add your favorites there.
So far, I do not think this sight has a tool list or it is harder to find.
Some kind of better index is needed here. Far easier to find recent changes
and categories on the Fortran Wiki so far.

1 Like

Thanks @gardhor, @ivanpribec and @urbanjost for excellent feedback and ideas.

It seems all of the proposed features can be added to LFortran.

The hard ones to implement are those that preserve original user formatting that does not have semantic meaning. For example, if the user adds a blank line and we want to preserve it. The same with comments (which we obviously want to preserve) or any other white space.

Currently the AST only contains things that have semantic meaning. So I think we should add two more AST nodes: Comment and BlankLine (can be repeated). The formatter can then choose to preserve these if requested. It would still lose all other white space (and also whether keywords are uppercase or lowercase or mixed), but it seems most people would be ok with that, since we want to format all other white space automatically.

The alternative is to create a parser that preserves everything (roundtrippable): it can convert to AST and back to source code that is equal to the original. The C# compiler does it. I am a bit worried it would slow the parser down for regular compiling.

So I’ll experiment with adding BlankLine and Comment which might be enough to make it usable for a lot of people. And then we’ll see.

See Tools in Fortran Wiki and add your favorites there.
So far, I do not think this sight has a tool list or it is harder to find.
Some kind of better index is needed here. Far easier to find recent changes
and categories on the Fortran Wiki so far.

Good point. CCing @milancurcic and @lkedward on this. I think we discussed having a “tools” section on our website to collect such tools and allow people to add more.

This is pretty old, but on my version of lfortran I don’t see a number of columns limit, that would be a nice addition too

@fedebenelli thanks, I created an issue for this: fmt: Allow to set the number of columns · Issue #2927 · lfortran/lfortran · GitHub

1 Like

Thanks!

1 Like

Two “problems”:

  • If there is a comment right above a procedure, lfortran fmt adds a blank line between the comment and the procedure. If there is no comment but just a blank line, it adds another one. Is there a way to prevent this?
  • I like the fact there is no indentation by default in the body of procedures, but there is indentation in everything between interface and end interface. In general, this is what people want. But imagine a long interface body e.g. interfacing a C library (even though LFortran does not support iso_c_binding yet, I guess it will in time.) In such long interfaces with lots of procedures defined, it will be nice if indentation can be turned off. Is it possible to add a flag for that, something like --no-indent-interface?

Thanks @Pap for trying the formatter and reporting bugs!

I just created a new issue for this: fmt: comments before a procedure get lost · Issue #2943 · lfortran/lfortran · GitHub

Great idea, I just created an issue for it at fmt: add `--no-indent-interface` · Issue #2942 · lfortran/lfortran · GitHub.

You can find all fmt related issues and bugs at https://github.com/lfortran/lfortran/labels/fmt.

P.S. Regarding:

even though LFortran does not support iso_c_binding yet, I guess it will in time.

LFortran already supports iso_c_binding, all the basic types should work. If you hit any specific bugs using it, please let us know.

1 Like

Thank you @certik for the quick response.
Concerning iso_c_binding, you are right. I actually have two versions of LFortran installed, and I compiled using the old one by mistake. I apologize for the false statement above, which got the strikethrough it deserved. I got rid of the old version so this mistake won’t happen again.

Many things using iso_c_binding work as expected. The progress is impressive. But I have issues interfacing existing C libraries (not C functions themselves, e.g. intefacing c_strlen works.) Will report accordingly at the right place.

1 Like

Perfect, thank you. Yes, please report anything that does not work. We are making steady progress and will not stop until every Fortran code compiles. :slight_smile:

1 Like

Thanks to the contributors to this thread - there are a few format settings which we don’t (yet) have in fpt - for example, squashing multiple blank lines.

Everyone is welcome to use the fpt formatting commands to look at trial formats. To give a feeling for what is available, here is the format script for our in house style. You can find documentation for the commands at http://simconglobal.com .

!H!****************************************************************************
!H! File: saved_format.fsp
!H! Output by fpt 4.2-l  Intel-Linux  On 31:Dec:50  At 00:00:00
!H!****************************************************************************

! Free / Fixed / Tab format
%SET FILE LAYOUTS
%FREE FORMAT OUTPUT
%OUTPUT CODE LINE LENGTH: 132

! Indentation
%DO NOT INDENT HEADER COMMENTS
%INDENT COMMENTS
%INDENT SUB-PROGRAM CODE BY: 8 COLUMNS
%INDENT EACH LEVEL OF NESTING BY: 3 COLUMNS
%MAXIMUM INDENTATION NESTING LEVEL: 8
%INDENT LABELS BY: 0 COLUMNS
%INDENT CONTINUATION LINES BY: 1 COLUMNS

! Continuation lines
%WRITE CONTINUATION CHARACTER IN COLUMN: 88
%CONTINUATION CHARACTER :"1"
%KEEP CONTINUATION LINES

! Upper or lower case
%UPPER CASE KEYWORDS
%LOWER CASE SYMBOLS
%DEFAULT CASE PARAMETERS
%UPPER CASE INTRINSICS
%UPPER CASE OPERATORS
%LOWER CASE FILE NAMES

! Spacing before symbols, intrinsics, numbers etc.
%NO SPACE BEFORE SYMBOLS
%NO SPACE BEFORE INTRINSICS
%NO SPACE BEFORE NUMBERS
%NO SPACE BEFORE OCTALS
%NO SPACE BEFORE LABELS
%NO SPACE BEFORE STRINGS
%NO SPACE BEFORE FORMAT TOKENS
%NO SPACE BEFORE TRAILING COMMENTS

! Spacing after symbols, intrinsics, numbers etc.
%NO SPACE AFTER SYMBOLS
%NO SPACE AFTER INTRINSICS
%NO SPACE AFTER NUMBERS
%NO SPACE AFTER OCTALS
%NO SPACE AFTER LABELS
%NO SPACE AFTER STRINGS
%NO SPACE AFTER FORMAT TOKENS
%SPACE AFTER CONTINUATIONS

! Spacing before keywords
%NO SPACE BEFORE KEYWORDS
%SPACE BEFORE "FUNCTION"
%SPACE BEFORE "CALL"
%SPACE BEFORE "GO"
%SPACE BEFORE "GOTO"
%SPACE BEFORE "PAUSE"
%SPACE BEFORE "RETURN"
%SPACE BEFORE "STOP"
%SPACE BEFORE "ASSIGN"

! Spacing before auxiliary keywords
%SPACE BEFORE "THEN"

! Spacing after keywords
%NO SPACE AFTER KEYWORDS
%SPACE AFTER "PARAMETER"
%SPACE AFTER "COMMON"
%SPACE AFTER "STRUCTURE"
%SPACE AFTER "RECORD"
%SPACE AFTER "EQUIVALENCE"
%SPACE AFTER "DATA"
%SPACE AFTER "NAMELIST"
%SPACE AFTER "WHILE"
%SPACE AFTER "ELSEIF"
%SPACE AFTER "END"
%SPACE AFTER "GOTO"
%SPACE AFTER "IF"
%SPACE AFTER "PAUSE"
%SPACE AFTER "RETURN"
%SPACE AFTER "STOP"
%SPACE AFTER "ACCEPT"
%SPACE AFTER "ENCODE"
%SPACE AFTER "DECODE"
%SPACE AFTER "PRINT"
%SPACE AFTER "READ"
%SPACE AFTER "TYPE"
%SPACE AFTER "WRITE"
%SPACE AFTER "BACKSPACE"
%SPACE AFTER "CLOSE"
%SPACE AFTER "DELETE"
%SPACE AFTER "ENDFILE"
%SPACE AFTER "INQUIRE"
%SPACE AFTER "OPEN"
%SPACE AFTER "REWIND"
%SPACE AFTER "UNLOCK"
%SPACE AFTER "OPTIONS"
%SPACE AFTER "FORMAT"

! Spacing after auxiliary keywords
%SPACE AFTER "TYPE"
%SPACE AFTER "END"
%SPACE AFTER "OPEN"

! Spacing before operators
%NO SPACE BEFORE OPERATORS
%SPACE BEFORE ".AND."
%SPACE BEFORE ".EQ."
%SPACE BEFORE ".EQV."
%SPACE BEFORE ".GE."
%SPACE BEFORE ".GT."
%SPACE BEFORE ".LE."
%SPACE BEFORE ".LT."
%SPACE BEFORE ".NE."
%SPACE BEFORE ".NEQV."
%SPACE BEFORE ".OR."
%SPACE BEFORE ".XOR."
%SPACE BEFORE ".IAND."
%SPACE BEFORE ".IOR."
%SPACE BEFORE ".IEOR."
%SPACE BEFORE ".IMOD."
%SPACE BEFORE ".ISHFT."
%SPACE BEFORE "::"

! Spacing after operators
%NO SPACE AFTER OPERATORS
%SPACE AFTER ".AND."
%SPACE AFTER ".EQ."
%SPACE AFTER ".EQV."
%SPACE AFTER ".GE."
%SPACE AFTER ".GT."
%SPACE AFTER ".LE."
%SPACE AFTER ".LT."
%SPACE AFTER ".NE."
%SPACE AFTER ".NEQV."
%SPACE AFTER ".NOT."
%SPACE AFTER ".OR."
%SPACE AFTER ".XOR."
%SPACE AFTER ".IAND."
%SPACE AFTER ".IOR."
%SPACE AFTER ".IEOR."
%SPACE AFTER ".IMOD."
%SPACE AFTER ".ISHFT."
%SPACE AFTER "::"

! Real numbers
%COMPLETE REAL NUMBERS

! Hex and Octal numbers
%DO NOT CHANGE HEX NUMBERS
%DO NOT CHANGE OCTAL NUMBERS

! Column format
%NO COLUMN FORMAT DECLARATIONS
%NO COLUMN FORMAT CONDITIONALS

! Comments and sentinels
%TRAILING COMMENTS
%DO NOT CHANGE COMMENT DELIMITER
%KEEP OPTIONAL COMMENT DELIMITERS
%DO NOT RECOGNISE TEXT SEPARATOR COMMENTS

! Tabs within code and before comments
%KEEP EMBEDDED TABS

! Special characters
%DO NOT TRANSLATE HIGH VALUED CHARACTERS IN COMMENTS
%DO NOT TRANSLATE HIGH VALUED CHARACTERS IN STRINGS

! Special cases
%DO NOT WRITE STOP STATEMENTS ON ONE LINE

! End of saved_format.fsp

You can run fpt on a test code interactively, use the formatting commands and type the code to see what it looks like. You can then save the format with the “% save format ” command. If you do this, use the %window command to set a llarge number of lines to be displayed.

1 Like