Difference between an AST and ASR

Let us take a simple Fortran code:

integer function f(a, b) result(r)
integer, intent(in) :: a, b
integer :: c, d
c = a + b - d
r = c * a
end function

and look at what the AST and ASR look like.

AST

[1]:
%%showast
integer function f(a, b) result(r)
integer, intent(in) :: a, b
integer :: c, d
c = a + b - d
r = c * a
end function
(TranslationUnit
    [(Function
        f
        [(a)
        (b)]
        [(AttrType
            TypeInteger
            []
            ()
            ()
            None
        )]
        r
        ()
        ()
        []
        []
        []
        [(Declaration
            (AttrType
                TypeInteger
                []
                ()
                ()
                None
            )
            [(AttrIntent
                In
            )]
            [(a
            []
            []
            ()
            None
            ())
            (b
            []
            []
            ()
            None
            ())]
            ()
        )
        (Declaration
            (AttrType
                TypeInteger
                []
                ()
                ()
                None
            )
            []
            [(c
            []
            []
            ()
            None
            ())
            (d
            []
            []
            ()
            None
            ())]
            ()
        )]
        [(Assignment
            0
            c
            (- (+ a b) d)
            ()
        )
        (Assignment
            0
            r
            (* c a)
            ()
        )]
        []
        []
    )]
)

The AST does not have any semantic information, but has nodes to represent declarations such as integer, intent(in) :: a. Variables such as a are represented by a Name node, and are not connected to their declarations yet.

The AST can also be exported in JSON, including source file name, line and column information: lfortran example.f90 --show-ast --json

ASR

[2]:
%%showasr
integer function f(a, b) result(r)
integer, intent(in) :: a, b
integer :: c, d
c = a + b - d
r = c * a
end function
(TranslationUnit
    (SymbolTable
        1
        {
            f:
                (Function
                    (SymbolTable
                        2
                        {
                            a:
                                (Variable
                                    2
                                    a
                                    []
                                    In
                                    ()
                                    ()
                                    Default
                                    (Integer 4)
                                    ()
                                    Source
                                    Public
                                    Required
                                    .false.
                                ),
                            b:
                                (Variable
                                    2
                                    b
                                    []
                                    In
                                    ()
                                    ()
                                    Default
                                    (Integer 4)
                                    ()
                                    Source
                                    Public
                                    Required
                                    .false.
                                ),
                            c:
                                (Variable
                                    2
                                    c
                                    []
                                    Local
                                    ()
                                    ()
                                    Default
                                    (Integer 4)
                                    ()
                                    Source
                                    Public
                                    Required
                                    .false.
                                ),
                            d:
                                (Variable
                                    2
                                    d
                                    []
                                    Local
                                    ()
                                    ()
                                    Default
                                    (Integer 4)
                                    ()
                                    Source
                                    Public
                                    Required
                                    .false.
                                ),
                            r:
                                (Variable
                                    2
                                    r
                                    []
                                    ReturnVar
                                    ()
                                    ()
                                    Default
                                    (Integer 4)
                                    ()
                                    Source
                                    Public
                                    Required
                                    .false.
                                )
                        })
                    f
                    (FunctionType
                        [(Integer 4)
                        (Integer 4)]
                        (Integer 4)
                        Source
                        Implementation
                        ()
                        .false.
                        .false.
                        .false.
                        .false.
                        .false.
                        []
                        .false.
                    )
                    []
                    [(Var 2 a)
                    (Var 2 b)]
                    [(Assignment
                        (Var 2 c)
                        (IntegerBinOp
                            (IntegerBinOp
                                (Var 2 a)
                                Add
                                (Var 2 b)
                                (Integer 4)
                                ()
                            )
                            Sub
                            (Var 2 d)
                            (Integer 4)
                            ()
                        )
                        ()
                    )
                    (Assignment
                        (Var 2 r)
                        (IntegerBinOp
                            (Var 2 c)
                            Mul
                            (Var 2 a)
                            (Integer 4)
                            ()
                        )
                        ()
                    )]
                    (Var 2 r)
                    Public
                    .false.
                    .false.
                    ()
                )
        })
    []
)

The ASR has all the semantic information (types, etc.), nodes like Function have a symbol table and do not have any declaration nodes. Variables are simply pointers to the symbol table.

The ASR can also be exported in JSON, including source file name, line and column information: lfortran example.f90 --show-asr --json

Discussion

The above was a simple example. Things get more apparent for more complicated examples, such as:

integer function f2b(a) result(r)
use gfort_interop, only: c_desc1_int32
integer, intent(in) :: a(:)
interface
    integer function f2b_c_wrapper(a) bind(c, name="__mod1_MOD_f2b")
    use gfort_interop, only: c_desc1_t
    type(c_desc1_t), intent(in) :: a
    end function
end interface
r = f2b_c_wrapper(c_desc1_int32(a))
end function

AST must represent all the use statements and the interface block, and keep things semantically consistent.

ASR, on the other hand, keeps track of the c_desc1_int32, c_desc1_t and f2b_c_wrapper in the symbol table and it knows they are defined in the gfort_interop module, and so ASR does not have any of these declaration nodes.

When converting from ASR to AST, LFortran will create all the appropriate AST declaration nodes automatically and correctly.