FTN IO API

[StephenG1CMZ]

Some routines that might help parse Fortran-formatted data.

A work in progress that acts as a reminder of what popular formatting codes mean.

Parsing these comprehensively will never be completed, but some of the simpler formats are handled.
Just to be clear...
The aim is that if you read a data file specifying I8, you can call FTN-I(8) to read the number...
Not to parse FORMAT(I8) in the Fortran source.

[StephenG1CMZ]

Version 0.001

Code:



 //Fortran IO 2017 StephenG1CMZ

 FTN_FMT_SP(); //FORWARD
 FTN_FMT_SS(); //FORWARD

 LOCAL SP:=" ";

 LOCAL STMINUS:="-";  //IN IO TEXT MAY USE -
 LOCAL STNEGATE:="−"; //WHEN PARSING USE NEGATE PLUSMINUS
 LOCAL STMINUSES:=STMINUS+STNEGATE;
 LOCAL STPLUSES :="+ ";

 //CUSTOMISE
 LOCAL FTN_SIGNALLING_NAN:=0; //
 LOCAL AVOID_IE; //1 0 PREVENT EG 1ᴇ12 ON INTEGER OUT
 //LOCAL STMINUSOUT:=STNEGATE;//USE THIS ON OUTPUT
 LOCAL CHPLUS_DEFAULT:=FTN_FMT_SS(); //_SP  OR _SS
 LOCAL CHNEGS_DEFAULT:=STNEGATE; // NEGATE OR MINUS OUT 
 LOCAL LimRec:=128;//LIMIT RECURSION
 //END CUSTOM

 LOCAL STPOS;

 LOCAL CHNEGS:=CHNEGS_DEFAULT;
 LOCAL CHPLUS:=CHPLUS_DEFAULT;//CURRENT USAGE
 
 LOCAL ZNaN;

 NOTIMP()
 BEGIN
  MSGBOX("FTN: FMT NOT IMPLEMENTED");
 END;

 PAD(Ncopies,CH)
 //GENERATE NN COPIES OF CH (CH NORMALLY 1CH)
 BEGIN
  LOCAL NN:=MIN(LimRec,Ncopies);//AVOID EXCESS RECURSION
  //LOCAL ST:="";
  //LOCAL COUNT:=NN;
  RETURN IFTE(NN>0,CH+PAD(NN-1,CH),"");
 END;

 RAISE_NAN()
 BEGIN
  ZNaN:=ZNaN+1;
  IF FTN_SIGNALLING_NAN THEN
   MSGBOX("NaN:"+ZNaN);
  END;
 END;
  
 PLAYFMT(RL,ST)
 //JUST TRY SYNTAX
 //RL:REAL
 //ST:En or Fn or Sn
 BEGIN
  //LOCAL RL:=#2;
  MSGBOX(CAS(format(RL,ST)));
  RETURN 1;
 END;
  

 //SUPPLEMENTARY HANDLING

 FTN_FMT_S()
 //FTN: RESET SHOWPLUSSIGN (TO OUR CHOSEN DEFAULT DEFINED HERE)
 //(APPLIES:MANTISSA; EE N/A)
 BEGIN
  CHPLUS:=CHPLUS_DEFAULT;
 END;

 FTN_FMT_SP()
 //FTN: SET SHOWPLUSSIGN
 BEGIN
  CHPLUS:="+";
 END;

 FTN_FMT_SS()
 //FTN:SUPPRESS SHOWPLUSSIGN
 BEGIN
  CHPLUS:=" ";
 END;

 FTN_FMT_IN_BLANK(ST)
 //HANDLE BLANK CHARS ON INPUT
 //HANDLE FMT BLANKS:B BN BZ
 BEGIN
  IF INSTRING(ST,"BZ") THEN
    NOTIMP();
  END; 
 END;

 FTN_FMT_OUT_NUMSIGN(ST)
 //HANDLE FMT SIGNS: S SP SS 
 //Z:NULL ST=RESET
 //INSTRING DETECTION EG "I SP" OK

 BEGIN
  FTN_FMT_S();//SIGN: OUR SYSTEM DEFAULT

  CASE
   IF INSTRING(ST,"SP") THEN
    FTN_FMT_SP();
   END;
   IF INSTRING(ST,"SS") THEN 
    FTN_FMT_SS();
   END;
   DEFAULT
  END;
 END;

 EXPORT FTN_FMT_II (FWIDTH,STR)
 //FTN: INPUT ST: INTEGER
 //GET INTEGER FROM STR OF FWIDTH DIGITS
 //FWIDTH:1..N INCLUDES SIGN
 //FWIDTH 0:F90: PARSE INTEGER IN STR 
 //(SHOULD PARSE DIGITS. FOR NOW JUST EXPR ENTIRE STR)
 //STR:INCLUDES INTEGER,SPACE=0,*=OVERFLOW IN STR FORMAT
 BEGIN
  LOCAL ST;
  LOCAL INUM:=0;
  LOCAL FW:=IP(FWIDTH);

  FTN_FMT_IN_BLANK("");//WHERE TO GET INPUT FORMAT FROM?

  //IGNORE WSP
  ST:=REPLACE(STR,SP,"");
  ST:=REPLACE(ST,STMINUS,STNEGATE);
  IF SIZE(ST) THEN
   IF FW THEN
    ST:=MID(ST,FW);
   END;
   IF INSTRING(ST,"*")  THEN
    //NAN- 0
    RAISE_NAN;
   ELSE //ASSUME DECIMAL NUM
    INUM:=EXPR(ST);
   END;
  ELSE //WSP==0
  END;
  RETURN IP(INUM); 
 END;

 EXPORT FTN_FMT_A(FWIDTH,STR)
 //FTN:IO AN ST: ALPHA STRNG WIDTH FW
 //FTN:0: NO PADDING OR TRUNC
 BEGIN
  LOCAL FW:=IP(FWIDTH);
  LOCAL ST:=IFTE(FW,MID(STR,1,FW),STR);//TRUNC

  IF FW THEN
   IF FW-DIM(STR)>0 THEN
    //PAD TBD FW-LEN SP AT LEFT
    ST:=ST;
   END;
  END;
  RETURN ST;
 END;

 EXPORT FTN_FMT_I(FMTLST,INUM)
 //FTN:OUTPUT ST: INTEGER
 //FMTLST:"MAX.MIN" WIDTHS AS LIST
 //F90: MAX 0=NO PADDING
 //INUM:INTEGER
 BEGIN
  LOCAL SCHAR;
  LOCAL ST:="";
  LOCAL FMT_ST;//PARAM TBD
  LOCAL FW:=0; //MAXWIDTH
  LOCAL FM:=0; //MINWIDTH 
  //LOCAL FM:=5;//TEST
  LOCAL NUM:=IP(INUM);  //INGUARD
  LOCAL POSNUM:=ABS(NUM);
  LOCAL MODE_STD:=1; //STANDARD NUM FMT

 
  IF SIZE(FMTLST) THEN
   FMT_ST:=FMTLST(1);
   FW:=IP(FMTLST(2));//MAXWIDTH
   IF SIZE(FMTLST)>2 THEN
    FM:=FMTLST(3);
   END;
   ELSE //EMPTY LIST:DEFAULTS?
  END;
  
  FTN_FMT_OUT_NUMSIGN(FMT_ST);
 
  ST:=STRING(POSNUM,MODE_STD); //POSNUM
  IF FM THEN //MIN FIELD WIDTH
   ST:=PAD(FM-DIM(ST),"0")+ST; //INSERT LEADING ZEROS AS REQD
   //POSNUM WITH ANY LEADING ZEROS
  END;
  IF (NUM≥0) AND (DIM(ST)==FW) THEN
   SCHAR:=""; //SUPPRESS "+ " WHEN NEEDED TO FIT
  ELSE
   SCHAR:=IFTE(NUM≥0,CHPLUS,CHNEGS); //SELECT CURRENT SIGN
  END;
  ST:=SCHAR+ST;//SIGNED NUM WITH LEADING ZEROS

  IF AVOID_IE AND INSTRING(ST,"ᴇ") THEN
    //Bug: THE INSTRING HANDLES SYSTEMS LIKE HP
    //WHICH DELIVER INTEGERS WITH EXPONENTS 
    //FORMATTED LIKE 1ᴇ12 IT MIGHT FIT
    //NB THE POINT AT WHICH HP STRING(N) RETURNS 1ᴇ12
    //IS GOVERNED BY N, IRRESPECTIVE OF FW
    ST:=PAD(MAX(FW,1),"*"); //OVERFLOW:STR TOO LARGE FOR HP INTEGER
    //IF FW 0 EMIT ONE *
   END;

  IF FW THEN //MAX FIELD WIDTH CHECKS
   CASE
    IF DIM(ST)>FW THEN
     ST:=PAD(FW,"*"); //OVERFLOW
    END;
    IF DIM(ST)<FW THEN
     ST:=PAD(FW-DIM(ST)," ")+ST; //PAD LEFT WITH SP
    END; 
    DEFAULT
    //FITTED JUST RIGHT
   END;
  END;
  RETURN ST; 
 END;

 EXPORT FTN_FMT_F()
 //FTN:OUTPUT ST: REAL FLOATING
 BEGIN

 END;

 EXPORT FTN_FMT_E()
 //FTN:OUTPUT REAL EXPONENTIAL
 BEGIN

 END;

 EXPORT FTN_FMT_G()
 //FTN:OUTPUT GENERAL REAL (E/F PER SIZE)
 BEGIN

 END;

 //END FTN FMT API

 
 FTN_IO_RESET()
 //OUR COMMAND: RESET FTN DEFAULTS
 BEGIN
  
 END;

 EXPORT FTNIO()
 BEGIN
  STPOS:=1;
  FTN_IO_RESET(); 
  PLAYFMT(STPOS,"S0");
 END;