;;;; mother modular generic compiler project
; (c)2001,2002/GPL Oskar Schirmer <oskar@scara.com>
; see file COPYING for GPL license details

; extended affix grammar description for pl0
; according to N. Wirth, "Compilerbau", ISBN 3-519-32338-9

(extended-affix-grammar
  '(
    (program ((
        ()
        ([ ; the complete program:
          prolog
          c-block
          epilog ])))
      ((() ; get global prolog and epilog:
        ([prolog]
         [epilog])) global-frame)
      ( ((([(list "export" "_start")])
          ([c-block])
        ) block))
      (period))

    (block ((
        ([ ; the identification for the block:
          id-block ])
        ([ ; the complete block:
          k-consts
          k-vars
          k-procs
          (list "code"
            (list id-block (source))
            e-vars
            c-stmt
            v-vars)
          f-procs
          f-vars
          f-consts
          ])))
      ( ((()
          ([k-consts]
           [f-consts])
        ) const-empty)
        ((()
          ([k-consts]
           [f-consts])
        ) const))
      ( ((()
          ([k-vars]
           [f-vars]
           [e-vars]
           [v-vars])
        ) var-empty)
        ((()
          ([k-vars]
           [f-vars]
           [e-vars]
           [v-vars])
        ) var))
      ( ((()
          ([k-procs]
           [f-procs])
        ) procedure-empty)
        ((()
          ([k-procs]
           [f-procs])
        ) procedure-more))
      ( ((()
          ([c-stmt])
        ) statement)))

; const generates two output parameters,
; one for the "know" part, and one for the "forget" part:

    (const-empty ((
        ()
        ([][]))))
    (const ((
        ()
        ([k-consts][f-consts])))
      (const)
      ( ((()
          ([k-consts][f-consts])
        ) const-decl))
      (semicolon))
    (const-decl ((
        ()
        ([ ; know:
          (list "know"
            (list
              (list "name" c-name)
              (list "ref" c-ref)
              c-source
              (list "type"
                (list "use"
                  (list (list "name" ".int"))))
              (list "const"))
            (list "const"
              (list
                n-source
                (list "value" c-value)
                (list "type"
                  (list "use"
                    (list (list "name" ".int")))))))
          k-consts]
         [ ; forget:
          f-consts
          (list "forget"
            (list
              (list "ref" c-ref)))])))
      ((() ; get an unique ref:
        ([c-ref])) unique)
      (word)
      ((([2]) ; extract the constant's name:
        ([c-name])) term-value)
      ((()([c-source])) source)
      (compare "=")
      (number)
      ((([6]) ; extract the constant's value:
        ([c-value])) term-value)
      ((()([n-source])) source)
      ( ((()
          ([k-consts][f-consts])
        ) const-empty)
        ((()
          ([k-consts][f-consts])
        ) const-more)))
    (const-more ((
        ()
        ([k-consts][f-consts])))
      (comma)
      ( ((()
          ([k-consts][f-consts])
        ) const-decl)))

; var generates four output parameters,
; one for the "know" part, and one for the "forget" part,
; further one each for the "emerge" and the "vanish":

    (var-empty ((
        ()
        ([][][][]))))
    (var ((
        ()
        ([k-vars][f-vars][e-vars][v-vars])))
      (var)
      ( ((()
          ([k-vars][f-vars][e-vars][v-vars])
        ) var-decl))
      (semicolon))
    (var-decl ((
        ()
        ([ ; know:
          (list "know"
            (list
              (list "name" v-name)
              (list "ref" v-ref)
              v-source
              (list "type"
                (list "use"
                  (list (list "name" ".int"))))))
          k-vars]
         [ ; forget:
          f-vars
          (list "forget"
            (list
              (list "ref" v-ref)))]
         [ ; emerge:
          (list "emerge"
            (list
              (list "ref" v-ref)))
          e-vars]
         [ ; vanish:
          v-vars
          (list "vanish"
            (list
              (list "ref" v-ref)))])))
      ((() ; get an unique ref:
        ([v-ref])) unique)
      (word)
      ((([2]) ; extract the variable's name:
        ([v-name])) term-value)
      ((()([v-source])) source)
      ( ((()
          ([k-vars][f-vars][e-vars][v-vars])
        ) var-empty)
        ((()
          ([k-vars][f-vars][e-vars][v-vars])
        ) var-more)))
    (var-more ((
        ()
        ([k-vars][f-vars][e-vars][v-vars])))
      (comma)
      ( ((()
          ([k-vars][f-vars][e-vars][v-vars])
        ) var-decl)))

; procedure generates two output parameters,
; one for the "know+code" part, and one for the "forget" part:

    (procedure-empty ((
        ()
        ([][]))))
    (procedure-more ((
        ()
        ([ ; know+code:
          kc-this
          kc-more]
         [ ; forget:
          f-this
          f-more])))
      ( ((()
          ([kc-this][f-this])
        ) procedure))
      ( ((()
          ([kc-more][f-more])
        ) procedure-empty)
        ((()
          ([kc-more][f-more])
        ) procedure-more)))
    (procedure ((
        ()
        ([ ; know+code:
          (list "know"
            (list
              (list "name" p-name)
              (list "ref" p-ref)
              p-source
              (list "type"
                (list "function"
                  (list
                    (list "type" (list "void" (list)))
                    (list "argcount" "0"))))))
          c-block]
         [ ; forget:
          (list "forget"
            (list
              (list "ref" p-ref)))])))
      ((() ; get an unique ref:
        ([p-ref])) unique)
      (procedure)
      (word)
      ((([3]) ; extract the procedure's name:
        ([p-name])) term-value)
      ((()([p-source])) source)
      (semicolon)
      ( ((([(list "ref" p-ref)])
          ([c-block])
        ) block))
      (semicolon))

; statements simply produce one output, that is the code:

    (statement ((
        ()
        ([c-stmt])))
      ( ((()
          ([c-stmt])
        ) statement-empty)
        ((()
          ([c-stmt])
        ) assignment)
        ((()
          ([c-stmt])
        ) call)
        ((()
          ([c-stmt])
        ) read)
        ((()
          ([c-stmt])
        ) write)
        ((()
          ([c-stmt])
        ) begin)
        ((()
          ([c-stmt])
        ) if)
        ((()
          ([c-stmt])
        ) while)))
    (statement-empty ((
        ()
        ([]))))
    (assignment ((
        ()
        ([ ; code:
          (list "assign" (list (source))
            (list "use"
              (list
                (list "name" v-name)
                v-source))
            c-expr)])))
      (word)
      ((([1]) ; extract the identifier's name:
        ([v-name])) term-value)
      ((()([v-source])) source)
      (be)
      ( ((()
          ([c-expr])
        ) expression)))
    (call ((
        ()
        ([ ; code:
          (list "call" (list (source))
            (list "use"
              (list
                (list "name" p-name)
                p-source)))])))
      (call)
      (word)
      ((([2]) ; extract the identifier's name:
        ([p-name])) term-value)
      ((()([p-source])) source))
    (read ((
        ()
        ([ ; code:
          (list "call" (list (source))
            (list "use"
              (list
                (list "name" "?")
                f-source))
            (list "use"
              (list
                (list "name" v-name)
                v-source)))])))
      (question)
      ((()([f-source])) source)
      (word)
      ((([3]) ; extract the identifier's name:
        ([v-name])) term-value)
      ((()([v-source])) source))
    (write ((
        ()
        ([ ; code:
          (list "call" (list (source))
            (list "use"
              (list
                (list "name" "!")
                f-source))
            c-expr)])))
      (exclamation)
      ((()([f-source])) source)
      ( ((()
          ([c-expr])
        ) expression)))
    (begin ((
        ()
        ([ ; code:
          (list "seq" (list (source))
            c-this
            c-more)])))
      (begin)
      ( ((()
          ([c-this])
        ) statement))
      ( ((()
          ([c-more])
        ) begin-empty)
        ((()
          ([c-more])
        ) begin-more))
      (end))
    (begin-empty ((
        ()
        ([]))))
    (begin-more ((
        ()
        ([ ; code:
          c-this
          c-more])))
      (semicolon)
      ( ((()
          ([c-this])
        ) statement))
      ( ((()
          ([c-more])
        ) begin-empty)
        ((()
          ([c-more])
        ) begin-more)))
    (if ((
        ()
        ([ ; code:
          (list "if" (list (source))
            c-cond
            c-then)])))
      (if)
      ( ((()
          ([c-cond])
        ) condition))
      (then)
      ( ((()
          ([c-then])
        ) statement)))
    (while ((
        ()
        ([ ; code:
          (list "loop"
            (list
              (list "ref" w-ref)
              (source))
            (list "if" (list (source))
              (list "op"
                (list
                  (list "name" "not")
                  (source))
                c-cond)
              (list "exit"
                (list
                  (list "ref" w-ref)
                  (source))))
            c-stmt)])))
      ((() ; get an unique ref:
        ([w-ref])) unique)
      (while)
      ( ((()
          ([c-cond])
        ) condition))
      (do)
      ( ((()
          ([c-stmt])
        ) statement)))

; like statements, expressions and conditions produce simply code:

    (condition ((
        ()
        ([ ; code:
          c-cond])))
      ( ((()
          ([c-cond])
        ) condition-odd)
        ((()
          ([c-cond])
        ) condition-cmp)))
    (condition-odd ((
        ()
        ([ ; code:
          (list "op"
            (list
              (list "name" "bitwise-and")
              (source))
            (list "const"
              (list
                (source)
                (list "value" "1")
                (list "type"
                  (list "use"
                    (list (list "name" ".int"))))))
            c-expr)])))
      (odd)
      ( ((()
          ([c-expr])
        ) expression)))
    (condition-cmp ((
        ()
        ([ ; code:
          (list "op"
            (list
              (list "name" cmp-name)
              (source))
            c-expr1
            c-expr2)])))
      ( ((()
          ([c-expr1])
        ) expression))
      (compare)
      ((([2]) ; extract the comparision in desired notation:
        ([cmp-name])) compare-value)
      ( ((()
          ([c-expr2])
        ) expression)))

    (expression ((
        ()
        ([ ; code:
          c-expr])))
      ( ((([c-term])
          ([c-signedterm])
        ) expression-add-empty)
        ((([c-term])
          ([c-signedterm])
        ) expression-add))
      ( ((()
          ([c-term])
        ) term))
      ( ((([c-signedterm])
          ([c-expr])
        ) expression-empty)
        ((([c-signedterm])
          ([c-expr])
        ) expression-more)))
    (expression-add-empty ((
        ([c-term])
        ([c-term]))))
    (expression-add ((
        ([c-term])
        ([c-signedterm])))
      (add)
      ((([1] ; takes two parameters: first the terminal +/-,
         [c-term]) ; ...second the term, returns the optionally negated term
        ([c-signedterm])) optional-sign))
    (expression-empty ((
        ([c-expr])
        ([c-expr]))))
    (expression-more ((
        ([c-term])
        ([c-expr])))
      ( ((([c-term])
          ([c-this])
        ) expression-more-sub))
      ( ((([c-this])
          ([c-expr])
        ) expression-empty)
        ((([c-this])
          ([c-expr])
        ) expression-more)))
    (expression-more-sub ((
        ([c-term1])
        ([ ; code:
          (list "op"
            (list
              (list "name" add-name)
              (source))
            c-term1
            c-term2)])))
      (add)
      ((([1]) ; extract the sign itself:
        ([add-name])) sign-value)
      ( ((()
          ([c-term2])
        ) term)))

    (term ((
        ()
        ([ ; code:
          c-term])))
      ( ((()
          ([c-fact])
        ) factor))
      ( ((([c-fact])
          ([c-term])
        ) term-empty)
        ((([c-fact])
          ([c-term])
        ) term-more)))
    (term-empty ((
        ([c-term])
        ([c-term]))))
    (term-more ((
        ([c-fact])
        ([c-term])))
      ( ((([c-fact])
          ([c-this])
        ) term-more-sub))
      ( ((([c-this])
          ([c-term])
        ) term-empty)
        ((([c-this])
          ([c-term])
        ) term-more)))
    (term-more-sub ((
        ([c-fact1])
        ([ ; code:
          (list "op"
            (list
              (list "name" mul-name)
              (source))
            c-fact1
            c-fact2)])))
      (mul)
      ((([1]) ; extract the operator itself:
        ([mul-name])) multiply-value)
      ( ((()
          ([c-fact2])
        ) factor)))

    (factor ((
        ()
        ([c-fact])))
      ( ((()
          ([c-fact])
        ) factor-ident)
        ((()
          ([c-fact])
        ) factor-number)
        ((()
          ([c-fact])
        ) factor-expression)))
    (factor-ident ((
        ()
        ([ ; code:
          (list "use"
            (list
              (list "name" v-name)
              v-source))])))
      (word)
      ((([1]) ; extract the identifier's name:
        ([v-name])) term-value)
      ((()([v-source])) source))
    (factor-number ((
        ()
        ([ ; code:
          (list "const"
            (list
              n-source
              (list "value" n-value)
              (list "type"
                (list "use"
                  (list (list "name" ".int"))))))])))
      (number)
      ((([1]) ; extract the number's value:
        ([n-value])) term-value)
      ((()([n-source])) source))
    (factor-expression ((
        ()
        ([c-expr])))
      (lparen)
      ( ((()
          ([c-expr])
        ) expression))
      (rparen))
  )
)
