Read.borg

`*-----------------------------------*`
`*          >>>Pico v.1.1<<<         *`
`*            Theo D'Hondt           *`
`*  VUB Programming Technology Lab   *`
`*              (c)1999              *`
`*-----------------------------------*`
`*               reader              *`
`*      (METACIRCULAR VERSION)       *`
`*-----------------------------------*`

{ Read(Str):
    { BGN:: Make_TXT('begin');
      TAB:: Make_TXT('tab');
      MSG:: [ 'additive operator',
              'application',
              'declaration',
              'assignment',
              'definition',
              'comma',
              'end of text',
              'fraction',
              'left brace',
              'left bracket',
              'left parenthesis',
              'multiplicative operator',
              'name',
              'number',
              'period',
              'right brace',
              'right bracket',
              'relational operator',
              'right parenthesis',
              'semicolon',
              'text',
              'exponentiation operator' ];

      TKN: void;

      error_message@any:
        Error('Unexpected ' + MSG[TKN]);

      skip()::
        TKN:= Scan();

      next(Dat)::
        { skip();
          Dat };

      expression():
        void;

      operand():
        void;

      operation(Opr, Tkn)::
        { opd: Opr();
          while(TKN = Tkn,
            { opr: next(_SCAN_);
              arg: [ opd, Opr() ];
              opd:= Make_APL(Make_TXT(opr), Make_TAB(arg)) });
          opd };

      factor()::
        operation(operand, XOP_token);

      term()::
        operation(factor, MOP_token);

      comparand()::
        operation(term, AOP_token);

      invocation()::
        operation(comparand, ROP_token);

      list(Sep, Trm)::
        { loop(count):
            { exp: expression();
              tab: if(TKN = Sep,
                     { skip();
                       loop(count+1) },
                     if(TKN = Trm,
                       next(tab[count]: void),
                       error_message()));
              tab[count]:= exp;
              tab };
          Make_TAB(loop(1)) };

      number()::
        Make_NBR(next(_SCAN_));

      fraction()::
        Make_FRC(next(_SCAN_));

      text()::
        Make_TXT(next(_SCAN_));

      application(Nam)::
        { skip();
          if(TKN = RPR_token,
            Make_APL(Make_TXT(Nam), next(_EMPTY_)),
            Make_APL(Make_TXT(Nam), list(COM_token, RPR_token))) };

      apply(Nam)::
        { skip();
          inv: invocation();
          Make_APL(Make_TXT(Nam), inv) };

      tabulation(Nam)::
        { skip();
          Make_TBL(Make_TXT(Nam), list(COM_token, RBR_token)) };

      message(Nam)::
        { skip();
          Make_MES(Make_TXT(Nam), invocation()) };

      reference(Nam)::
        Make_REF(Make_TXT(Nam));

      var_case:: case(CAT_token <> apply,
                      LBR_token <> tabulation,
                      LPR_token <> application,
                      PER_token <> message,
                           void <> reference);

      name()::
        { var: next(_SCAN_);
          cas: var_case(TKN);
          cas(var) };

      prefix(Nam)::
        { arg: [ operand() ];
          Make_APL(Make_TXT(Nam), Make_TAB(arg)) };

      opr_case:: case(AOP_token <> prefix,
                      CAT_token <> apply,
                      FRC_token <> prefix,
                      LBR_token <> tabulation,
                      LPR_token <> application,
                      MOP_token <> prefix,
                      NAM_token <> prefix,
                      NBR_token <> prefix,
                      PER_token <> message,
                      ROP_token <> prefix,
                      TXT_token <> prefix,
                      XOP_token <> prefix,
                           void <> reference);

      operator()::
        { opr: next(_SCAN_);
          cas: opr_case(TKN);
          cas(opr) };

      parentheses()::
        { skip();
          exp: expression();
          if(TKN != RPR_token, error_message());
          skip();
          exp };

      braces()::
        { skip();
          Make_APL(BGN, list(SMC_token, RBC_token)) };

      brackets()::
        { skip();
          if(TKN = RBR_token,
            Make_APL(TAB, next(_EMPTY_)),
            Make_APL(TAB, list(COM_token, RBR_token))) };

      opd_case:: case(AOP_token <> operator,
                      FRC_token <> fraction,
                      LBC_token <> braces,
                      LBR_token <> brackets,
                      LPR_token <> parentheses,
                      MOP_token <> operator,
                      NAM_token <> name,
                      NBR_token <> number,
                      ROP_token <> operator,
                      TXT_token <> text,
                      XOP_token <> operator,
                           void <> error_message);

      operand():=
        { cas: opd_case(TKN);
          cas() };

      identity(Inv)::
        Inv;

      definition(Inv)::
        Make_DEF(next(Inv), expression());

      declaration(Inv)::
        Make_DCL(next(Inv), expression());

      assignment(Inv)::
        Make_SET(next(Inv), expression());

      exp_case:: case(CEQ_token <> assignment,
                      CCL_token <> declaration,
                      COL_token <> definition,
                           void <> identity);

      expression():=
        { inv: invocation();
          cas: exp_case(TKN);
          cas(inv) };

      Read(Str):=
        { Init_Scan(Str);
          TKN := Scan();
          expression() };

      Read(Str) };

  display('reader ....... installed', eoln) }