Skip to content

Instantly share code, notes, and snippets.

@MikeRalphson
Created April 17, 2009 09:07
Show Gist options
  • Save MikeRalphson/96934 to your computer and use it in GitHub Desktop.
Save MikeRalphson/96934 to your computer and use it in GitHub Desktop.
pfxstate.inc xml version
#IFDEF show_includes
#REM pfxstate.inc
#ENDIF
#USE stringf.pfi
#USE lparse.inc
STRING S_PFX_STATE 1 // C=CODE, I=IMAGE
STRING S_PFX_CODE 4096 S_PFX_COMMENT 256 S_PFX_IMAGE 256
string s_inc_stack 4096
string s_inc_done 4096
string s_st_type 32
INDICATOR X_PFX_LABEL
INDICATOR X_IN_INDEX X_IN_TOKEN X_IN_NUMBER X_IN_INIT
indicator x_in_punct
indicator x_in_method_call
indicator x_in_error
indicator x_in_label
indicator x_in_precondition
indicator x_follow_includes //TODO
indicator x_rename_symbols //TODO
indicator x_first
INTEGER I_IN_EXPR
INTEGER I_IN_FUNC_CALL
STRING S_NEW 4096
STRING S_TOKEN 128 S_NUMBER 28
string s_punct 5
string s_block 32
STRING S_HOLD 2
string s_bracket 128
INTEGER I_PFX_LINE
procedure set_follow_includes indicator x_new
x_follow_includes = x_new
end_procedure
procedure set_rename_symbols indicator x_new
x_rename_symbols = x_new
end_procedure
procedure set_in_error indicator x_new
x_in_error = x_new
if x_new x_in_token = true // or fref it
end_procedure
procedure set_in_precondition indicator x_new
if (x_new) begin
x_first = false
s_st_type = "</stmt>"
end
x_in_precondition = x_new
end_procedure
procedure set_in_label indicator x_new
x_in_label = x_new
end_procedure
procedure set_in_token indicator x_new
string s_method 128
if x_in_token and (not x_new) begin
if pos("\",s_token) > 0 begin
parse s_token at "\" to s_token s_method
append s_new '<method_call object="' s_token '" method="' s_method '"/>'
end
else begin
//s_token = uppercase(s_token)
switch uppercase(s_token)
when "BEGIN" "REPEAT" "WHILE" "SWITCH" "PROCEDURE" "FUNCTION" "CONSTRAINT" "FOR"
if (not x_first) and (s_st_type <> "") begin
append s_new s_st_type
s_st_type = ""
end
append s_new '<block type="' lowercase(s_token) '">'
if x_first s_st_type = ""
when "END" "LOOP" "ENDSWITCH" "END_PROCEDURE" "END_FUNCTION" "END_CONSTRAINT"
append s_new s_st_type '</block>'
s_st_type = ""
when "UNTIL"
append s_new s_st_type '</block><expr type="until">'
s_st_type = '</expr>'
when "CALC" "CALCULATE" "INCREMENT" "MOVE" "MOVEINT" "MOVENUM" "MOVESTR"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "CLEARSCREEN" "CLEARXY" "GOTOXY" "INKEY" "INKEY$" "INPUT" "KEYCHECK" "SCREENMODE" "SHOW" "SHOWLN"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "ABORT" "CHAIN" "CLEARWARNING" "DEBUG" "ERROR" "GOSUB" "GOTO" "ON" "RETURN"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "ATTACH" "CLEAR" "CLOSE" "DELETE" "FIND" "OPEN" "RELATE" "SAVE" "SAVERECORD" "ZEROFILE"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "DATE" "INDICATOR" "INTEGER" "NUMBER" "STRING" "WINDOW"
append s_new '<declare type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</declare>'
when "ENDGROUP" "ENTDISPLAY" "ENTER" "ENTEREND" "ENTERGROUP" "ENTERMODE" "ENTRY"
append s_new '<enter stage="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</enter>'
when "ACCEPT" "AUTOPAGE" "BLANKFORM" "CLEARFORM" "DISPLAY" "FORMAT" "IFCHANGE"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "NAME" "OUTCLOSE" "OUTFILE" "OUTPUT" "PAGE" "PRINT" "SETCHANGE"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "IF" "ELSE"
append s_new '<flow type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</flow>'
when "BACKFIELD" "ENTAGAIN" "HELP" "KEYPROC" "INDICATE"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "ABS" "ACOS" "ASIN" "ATAN" "COS" "EXP" "LOG" "REAL" "ROUND" "SIN" "SQRT" "TAN"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "DESPOOL" "LOCK" "REREAD" "UNLOCK"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "FORMFEED" "PAGECHECK" "REPORT" "REPORTEND" "SECTION"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "CLOSE_INPUT" "CLOSE_OUTPUT" "DIRECT_INPUT" "OUTFILE" "READ" "READ_BLOCK" "READLN" "WRITE" "WRITELN"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "DIRECT_OUTPUT" "BEEP" "DECREMENT" "DELAY" "FILE_DEF" "FILE_SET" "FIELD_SET" "GET_ENV" ;
"INDEX_SET" "REINDEX" "SYSTIME" "GET_SCREEN" "SET_SCREEN" "CLASS" "OBJECT" "APPEND_OUTPUT" ;
"SWITCH" "WHEN" "BREAK" "LOAD_MODULE" "UNLOAD_MODULE"
append s_new '<stmt type="pfxplus" value="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "TO" "AS" "IN" "FROM" "BY"
append s_new '<noise type="' lowercase(s_token) '"/>'
if x_first s_st_type = '<parse_error6/>'
when "EQ" "GE" "GT" "LE" "LT" "NE"
append s_new '<operator type="' lowercase(s_token) '"/>'
if x_first s_st_type = '<parse_error7/>'
when "STRMARK" "STRLEN" "LASTIF" "#$" "FOUND" "FINDERR"
append s_new '<symbol type="builtin" value="' lowercase(s_token) '"/>'
if x_first s_st_type = '<parse_error7/>'
when "$POWERFLEX"
append s_new '<symbol type="pfxplus" value="' lowercase(s_token) '"/>'
if x_first s_st_type = '<parse_error8/>'
when "APPEND" "ASCII" "CHARACTER" "CMDLINE" "INSERT" "LEFT" "LENGTH" "MID" "PAD" "POS" "REPLACE" "RIGHT" "TRIM" "UPPERCASE"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "COPYFILE" "DIRECTORY" "ERASEFILE" "FIELD_DEF" "FILE_MODE" "FILE_SIZE" "FILELIST" "NEXT" "PATHNAME" "INDEX_DEF" ;
"MAKE_FILE" "MEMORY" "REGISTRATION" "RENAMEFILE" "RUNPROGRAM" "SYSDATE" "SYSTEM"
append s_new '<stmt type="' lowercase(s_token) if(x_first,'">','"/>')
if x_first s_st_type = '</stmt>'
when "#ERROR"
append s_new '<directive type="error" value="'
s_st_type = '"/>'
set_in_error true
when "#USE" "#RENAME" "#IFDEF" "#IFNDEF" "#ENDIF" "#REPLACE" // dataflex 2.3b
replace "#" in s_token with ""
append s_new '<directive type="' lowercase(s_token) if(x_first,'">','"/>')
s_st_type = '</directive>'
when "#COMMAND" "#SET" "#IFSAME" "#IFCLASS" "#IFTYPE" "#ELSE" "#ENDCOMMAND" // supported
replace "#" in s_token with ""
append s_new '<directive type="' lowercase(s_token) if(x_first,'">','"/>')
s_st_type = '</directive>'
when "#CHECK" "#FORMAT" "#FREF" "#IFIND" "XPOP" "#XPUSH"
replace "#" in s_token with ""
append s_new '<directive type="ignored" value="' lowercase(s_token) if(x_first,'">','"/>')
s_st_type = '</directive>'
otherwise
if x_first begin
//TODO could handle I-Code functions here
if x_in_label begin
append s_new '<label value="' lowercase(s_token) '"/>'
s_st_type = ""
set_in_label false
end
else begin
append s_new '<stmt type="symbol" value="' lowercase(s_token) '">'
s_st_type = '</stmt>'
end
end
else ;
append s_new '<token value="' lowercase(s_token) '"/>'
endswitch
end
end
if (x_in_token) and (not x_new) ;
x_first = false
x_in_token = x_new
if (not x_in_token) s_token = ""
end_procedure
procedure set_in_number indicator x_new
if x_in_number and (not x_new) ;
append s_new '<number value="' uppercase(s_number) '"/>'
x_in_number = x_new
if (not x_in_number) s_number = ""
else if (s_hold <> "") begin
s_number = s_hold + s_number
s_hold = ""
end
end_procedure
procedure set_in_expr indicator x_new
if (i_in_expr <= 0) and (not x_new) begin
append s_new "<parse_error1/>"
end
else if x_new begin
append s_new "<expr>"
increment i_in_expr
append s_bracket "E"
end
else begin
set_in_token false
set_in_number false
append s_new "</expr>"
decrement i_in_expr
s_bracket = remove(s_bracket,length(s_bracket),1)
end
end_procedure
procedure set_in_func_call indicator x_new indicator x_empty
string s_method 128
if (i_in_func_call <= 0) and (not x_new) begin
append s_new "<parse_error2/>"
end
else if x_new begin
if pos("\",s_token) > 0 begin
parse s_token at "\" to s_token s_method
append s_new '<method_call object="' s_token '" method="' s_method '">'
x_in_method_call = true
end
else ;
append s_new '<func_call function="' lowercase(s_token) '">'
if not x_empty append s_new '<param>'
x_in_token = false
set_in_token false
increment i_in_func_call
append s_bracket "F"
end
else begin
set_in_token false
set_in_number false
if (not x_empty) append s_new "</param>"
if x_in_method_call ;
append s_new "</method_call>"
else ;
append s_new "</func_call>"
decrement i_in_func_call
x_in_method_call = false
s_bracket = remove(s_bracket,length(s_bracket),1)
end
end_procedure
procedure set_in_index indicator x_new
if x_new and (not x_in_index) begin
if x_first begin
append s_new '<stmt><precondition>'
set_in_precondition true
end
else append s_new '<index>'
end
if (not x_new) and (x_in_index) begin
if x_in_precondition ;
append s_new '</precondition>'
else ;
append s_new '</index>'
end
x_in_index = x_new
end_procedure
procedure set_in_init indicator x_new
if x_new and (not x_in_index) append s_new '<init>'
if (not x_new) and (x_in_index) append s_new '</init>'
x_in_init = x_new
end_procedure
procedure set_in_punct indicator x_new
if x_in_punct and (not x_new) begin
append s_new '<operator type="'
switch s_punct
when "LE" "<="
append s_new 'le"/>'
when "LT" "<"
append s_new 'lt"/>'
when "GE" ">="
append s_new 'ge"/>'
when "GT" ">"
append s_new 'gt"/>'
when "EQ" "=="
append s_new 'eq"/>'
when "NE" "<>"
append s_new 'ne"/>'
when "+"
append s_new 'plus"/>'
when "-"
append s_new 'minus"/>'
when "*"
append s_new 'mult"/>'
when "/"
append s_new 'div"/>'
when "^"
append s_new 'pow"/>'
when "="
append s_new 'assign"/>'
when "~" "NOT"
append s_new 'not"/>'
endswitch
end
x_in_punct = x_new
if (not x_in_punct) s_punct = ""
end_procedure
//___________________________________________________________________________[]
PROCEDURE PFXS_PARSE STRING S_INPUT TO STRING S_REMAINDER BYREF INDICATOR X_CONT BYREF
INDICATOR X_STRINGLIT
INDICATOR X_EMPTY
indicator x_end_stmt
INTEGER I_LOOP
STRING S_CHAR 1 S_NEXT 1 S_OPENER 1 S_T2 2
STRING S_LIT 256
INCREMENT I_PFX_LINE
MOVE "" TO S_PFX_CODE
MOVE "" TO S_PFX_COMMENT
MOVE "" TO S_PFX_IMAGE
X_PFX_LABEL = FALSE
S_REMAINDER = ""
x_end_stmt = true
x_first = (not x_cont)
if x_first begin
s_st_type = ""
set_in_error false
set_in_precondition false
end
x_cont = false
MOVE LEFT(S_INPUT,2) TO S_T2
IF (S_T2 NE "//") AND (LEFT(S_T2,1) EQ "/") AND (S_PFX_STATE EQ "C") ;
MOVE "I" TO S_PFX_STATE
IF (S_T2 EQ "/*") AND (S_PFX_STATE EQ "I") MOVE "C" TO S_PFX_STATE
IF S_PFX_STATE EQ "C" BEGIN
REPLACES CHARACTER(9) IN S_INPUT WITH " "
//REPLACES " (" IN S_INPUT WITH "(" // in test, spaces before brackets of a function-call, insanity!
// the above screws up things like SWITCH(expression) //TODO resolve this
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
S_NEW = ""
X_STRINGLIT = FALSE
FOR I_LOOP FROM 1 TO LENGTH(S_INPUT)
MOVE MID(S_INPUT,1,I_LOOP) TO S_CHAR
MOVE UPPERCASE(MID(S_INPUT,1,I_LOOP+1)) TO S_NEXT
IF X_IN_ERROR BEGIN
APPEND S_NEW S_CHAR
END
ELSE IF X_STRINGLIT BEGIN
IF (S_CHAR EQ S_OPENER) BEGIN
X_STRINGLIT = FALSE
S_LIT = REPLACES('&',S_LIT,"&amp;")
S_LIT = REPLACES('<',S_LIT,"&lt;")
S_LIT = REPLACES('>',S_LIT,"&gt;")
S_LIT = REPLACES('"',S_LIT,"&quot;")
S_LIT = REPLACES("'",S_LIT,"&apos;")
APPEND S_NEW '<stringlit value="' S_LIT '"/>'
END
ELSE BEGIN
OVERSTRIKE "£" TO S_INPUT AT I_LOOP
APPEND S_LIT S_CHAR
END
END
ELSE BEGIN
IF (S_CHAR EQ "'") OR (S_CHAR EQ '"') BEGIN
X_STRINGLIT = TRUE
S_LIT = ""
MOVE S_CHAR TO S_OPENER
END
ELSE BEGIN
SWITCH UPPERCASE(S_CHAR)
WHEN " " CHARACTER(10) CHARACTER(13)
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
SET_IN_PUNCT FALSE
WHEN ","
IF I_IN_FUNC_CALL > 0 BEGIN
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
APPEND S_NEW "</param><param>"
END
ELSE IF X_IN_TOKEN APPEND S_TOKEN "," // things like |FN1234,5
WHEN ";"
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
x_cont = true
x_end_stmt = false
S_INPUT = TRIM(RIGHT(S_INPUT,LENGTH(S_INPUT)-(I_LOOP+1)))
IF (S_INPUT <> "") AND (LEFT(S_INPUT,2) <> "//") ;
INSERT "//" IN S_INPUT AT (I_LOOP+1)
//APPEND S_NEW S_INPUT
//I_LOOP = MAXINT-1 // stop processing
WHEN "&"
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
APPEND S_NEW '<index type="auto"/>'
WHEN "%"
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
APPEND S_NEW '<index type="acc"/>'
WHEN "<"
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
SET_IN_PUNCT TRUE
APPEND S_PUNCT S_CHAR
WHEN ">"
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
SET_IN_PUNCT TRUE
APPEND S_PUNCT S_CHAR
WHEN "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" ;
"P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "#" "?" "@" "_" "\"
SET_IN_PUNCT FALSE
SET_IN_TOKEN TRUE
APPEND S_TOKEN UPPERCASE(S_CHAR)
WHEN "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."
IF X_IN_TOKEN BEGIN
APPEND S_TOKEN UPPERCASE(S_CHAR)
END
ELSE BEGIN
SET_IN_PUNCT FALSE
SET_IN_NUMBER TRUE
APPEND S_NUMBER UPPERCASE(S_CHAR)
END
WHEN "+" "-" // could be an operator or part of a number-literal
IF X_IN_NUMBER APPEND S_NUMBER S_CHAR
ELSE APPEND S_HOLD S_CHAR
WHEN "E"
IF X_IN_NUMBER APPEND S_NUMBER "e"
ELSE BEGIN
SET_IN_TOKEN TRUE
APPEND S_TOKEN "E"
END
WHEN "$" // can introduce a hex number or be part of a token
IF X_IN_TOKEN APPEND S_TOKEN S_CHAR
ELSE BEGIN
SET_IN_NUMBER TRUE
APPEND S_NUMBER "0x"
END
WHEN "/" // could be a division operator or part of a date-literal
IF (S_NEXT <> "/") AND (S_NEXT <> "*") BEGIN
SET_IN_TOKEN FALSE
IF X_IN_NUMBER APPEND S_NUMBER "/" // date-literal
ELSE BEGIN
SET_IN_PUNCT TRUE
APPEND S_PUNCT S_CHAR
END
END
ELSE BEGIN
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
SET_IN_ERROR FALSE
APPEND S_PFX_COMMENT RIGHT(S_INPUT,LENGTH(S_INPUT)-(I_LOOP+1))
I_LOOP = MAXINT-1 // stop!
END
WHEN "|" // can be a token-letter or a statement separator
IF X_IN_TOKEN OR (S_NEXT == "F") OR (S_NEXT == "V") OR (S_NEXT == "W") BEGIN
SET_IN_TOKEN TRUE
APPEND S_TOKEN S_CHAR
END
ELSE BEGIN
SET_IN_NUMBER FALSE
SET_IN_ERROR FALSE
S_REMAINDER = TRIM(RIGHT(S_INPUT,LENGTH(S_INPUT)-I_LOOP))
I_LOOP = MAXINT-1 // stop
END
WHEN CHARACTER(0) CHARACTER(12) // null and FF are end of line
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
S_REMAINDER = TRIM(RIGHT(S_INPUT,LENGTH(S_INPUT)-(I_LOOP+1)))
I_LOOP = MAXINT-1 // stop
WHEN "("
IF X_IN_TOKEN BEGIN //AND (S_TOKEN NE "SWITCH")
X_EMPTY = (S_NEXT == ")")
SET_IN_FUNC_CALL TRUE X_EMPTY
SET_IN_TOKEN FALSE
END
ELSE BEGIN
SET_IN_NUMBER FALSE
SET_IN_PUNCT FALSE
SET_IN_EXPR TRUE
END
WHEN ")"
IF RIGHT(S_BRACKET,1) == "E" BEGIN
SET_IN_EXPR FALSE
END
ELSE IF RIGHT(S_BRACKET,1) == "F" BEGIN
SET_IN_FUNC_CALL FALSE X_EMPTY
END
ELSE APPEND S_NEW "<parse_error3/>"
WHEN "["
SET_IN_TOKEN FALSE
SET_IN_INDEX TRUE
WHEN "]"
IF X_IN_INDEX BEGIN
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
SET_IN_INDEX FALSE
END
ELSE APPEND S_NEW "<parse_error4/>"
WHEN "{"
SET_IN_TOKEN FALSE
SET_IN_INIT TRUE
WHEN "]"
IF X_IN_INIT BEGIN
SET_IN_INIT FALSE
END
ELSE APPEND S_NEW "<parse_error5/>"
WHEN "=" "^" "*" "~"
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
SET_IN_PUNCT TRUE
APPEND S_PUNCT S_CHAR
WHEN ":"
SET_IN_LABEL TRUE
SET_IN_TOKEN FALSE
OTHERWISE
SHOW S_CHAR
//APPEND S_NEW S_CHAR
ENDSWITCH
END
END
LOOP
SET_IN_TOKEN FALSE
SET_IN_NUMBER FALSE
// doesn't end expressions, need to handle continuation lines better now
MOVE TRIM(S_NEW) TO S_PFX_CODE
MOVE TRIM(S_PFX_COMMENT) TO S_PFX_COMMENT
IF S_PFX_COMMENT NE "" BEGIN
//REPLACES '&' IN S_PFX_COMMENT WITH "&amp;"
//REPLACES '"' IN S_PFX_COMMENT WITH "&quot;"
//APPEND S_PFX_CODE '<comment value="' S_PFX_COMMENT '"/>'
REPLACES '--' IN S_PFX_COMMENT WITH "__"
APPEND S_PFX_CODE '<!-- ' S_PFX_COMMENT ' -->'
END
if (s_pfx_code <> "") and x_end_stmt ;
append s_pfx_code s_st_type
// limit inspection of code in this routine to declarations
// for symbol rewriting etc, and pre-processor directives
END
ELSE MOVE S_INPUT TO S_PFX_IMAGE // TODO
END_PROCEDURE
//___________________________________________________________________________[]
PROCEDURE PFXS_INIT INDICATOR X_FOLLOW_INCLUDES TO INDICATOR X_CONT BYREF
STRING S_DUMMY 1
MOVE "C" TO S_PFX_STATE // PfxPlus starts in code-mode unlike DataFlex
MOVE -1 TO I_PFX_LINE
SET_IN_EXPR FALSE
SET_IN_INDEX FALSE
SET_IN_INIT FALSE
SET_FOLLOW_INCLUDES X_FOLLOW_INCLUDES
SET_RENAME_SYMBOLS FALSE
PFXS_PARSE "" TO S_DUMMY X_CONT // returns all strings / indicators correctly conditioned
x_cont = FALSE // except maybe that one
s_bracket = ""
s_inc_stack = ""
s_inc_done = ""
END_PROCEDURE
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment