fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2001-02-22 22:25 UTC-0800 Ron Pinkas <ron@profit-master.com>

Browse Source 
* contrib/dot/pp.prg
     + Started support for interpreting prg files.
   * contrib/dot/rp_dot.ch
     + Added #command for stealing END

   /* PP can alreay "Run" simple prgs :-). It actually support most Clipper commands.
      It does *not* support LOCAL/STATIC/PRIVATE/PUBLIC, but any refference to a variable will create it as PRIVATE.
      It does not (yet) support creation of FUNCTIONs/PROCEDUREs but will execute any built-in, or linked, prodecure/function.
      It does not (yet) support WHILE and FOR loops.

      It can execute code like this:

      //------------------------------//
      CLS

      Alert( "Testinf PP as Interpreter... " )

      USE test
      IF ! File( "test" + IndexExt() )
   	INDEX on FIELD->First TO First
      ELSE
   	SET INDEX TO First
      ENDIF

      GO TOP

      cName := FIELD->First + FIELD->Last

      IF cName == FIELD->First + FIELD->Last
  	? "Ok"
      ELSE
  	? "Err"
      ENDIF

      DO CASE
         CASE cName == First // Not exact!
           ? "Err"

         CASE cName = First // But still equal
           ? "Ok"

         OTHERWISE
           ? "Err"
      ENDCASE

      REPLACE First WITH "From PP"

      ? FIELD->First
      //------------------------------//

      To have PP execute a PRG use: PP filename -R
    */
This commit is contained in:
Ron Pinkas
2001-02-23 06:40:04 +00:00
parent da7de8dffd
commit a73bcd3e07
3 changed files with 332 additions and 188 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
harbour/ChangeLog
View File

@@ -1,3 +1,57 @@
2001-02-22 22:25 UTC-0800 Ron Pinkas <ron@profit-master.com>
* contrib/dot/pp.prg
+ Started support for interpreting prg files.
* contrib/dot/rp_dot.ch
+ Added #command for stealing END
/* PP can alreay "Run" simple prgs :-). It actually support most Clipper commands.
It does *not* support LOCAL/STATIC/PRIVATE/PUBLIC, but any refference to a variable will create it as PRIVATE.
It does not (yet) support creation of FUNCTIONs/PROCEDUREs but will execute any built-in, or linked, prodecure/function.
It does not (yet) support WHILE and FOR loops.
It can execute code like this:
//------------------------------//
CLS
Alert( "Testinf PP as Interpreter... " )
USE test
IF ! File( "test" + IndexExt() )
INDEX on FIELD->First TO First
ELSE
SET INDEX TO First
ENDIF
GO TOP
cName := FIELD->First + FIELD->Last
IF cName == FIELD->First + FIELD->Last
? "Ok"
ELSE
? "Err"
ENDIF
DO CASE
CASE cName == First // Not exact!
? "Err"
CASE cName = First // But still equal
? "Ok"
OTHERWISE
? "Err"
ENDCASE
REPLACE First WITH "From PP"
? FIELD->First
//------------------------------//
To have PP execute a PRG use: PP filename -R
*/
2001-02-22 17:10 UTC-0800 Ron Pinkas <ron@profit-master.com>
* contrib/dot/pp.prg
! Fixed order of production in multi line result, where some of the resulting lines are re-processed

465
harbour/contrib/dot/pp.prg
View File

@@ -157,7 +157,8 @@ STATIC aCommRules := {}, aCommResults := {}
STATIC nPendingLines := 0, aPendingLines := {}
STATIC bDbgMatch := .F., bDbgExp := .F., bDbgPPO := .F., bLoadRules := .T., bCount := .T., bCCH := .F., bPP := .F.
STATIC bDbgMatch := .F., bDbgExp := .F., bDbgPPO := .F., bLoadRules := .T., ;
bCount := .T., bCCH := .F., bPP := .F., bRun := .F.
STATIC nIfDef := 0, abIfDef := {}, nIf := 0, abIf := {}
@@ -169,6 +170,10 @@ STATIC s_cLastChar := ' '
STATIC s_sIncludeFile := NIL
STATIC nRow, nCol
//--------------------------------------------------------------//
PROCEDURE Main( sSource, sSwitch )
LOCAL sIncludePath, nNext, sPath
@@ -200,6 +205,9 @@ PROCEDURE Main( sSource, sSwitch )
IF "-U" $ sSwitch
bLoadRules := .F.
ENDIF
IF "-R" $ sSwitch
bRun := .T.
ENDIF
ENDIF
#ifdef __HARBOUR__
@@ -214,18 +222,24 @@ PROCEDURE Main( sSource, sSwitch )
ENDIF
IF sSource != NIL //bPP
nRow := Row()
nCol := Col()
ProcessFile( sSource, sSwitch )
ELSE
nRow := 1
nCol := 0
RP_Dot()
ENDIF
DevPos( nRow, nCol )
RETURN
//------------------------------- *** RP DOT Functions *** -------------------------------//
PROCEDURE RP_Dot()
LOCAL sLine := Space(256), GetList := {}, sPPed, nNext, sBlock, sTemp
LOCAL sTemp2, nLen, sLeft, sSymbol, nNextAssign
LOCAL nRow := 1, nCol := 0
LOCAL GetList := {}, sLine := Space(256)
bCount := .F.
@@ -247,108 +261,123 @@ PROCEDURE RP_Dot()
sLine := StrTran( sLine, Chr(9), " " )
sPPed := ProcessLine( RTrim( sLine ), 1, '' )
ExtractLeadingWS( @sPPed )
DropTrailingWS( @sPPed )
sTemp := sPPed
@ 0,0 SAY "PP: "
@ 0,4 SAY Pad( sPPed, 76 ) COLOR "N/R"
DevPos( nRow, nCol )
BEGIN SEQUENCE
WHILE ( nNext := At( ';', sTemp ) ) > 0
sBlock := Left( sTemp, nNext - 1 )
ExtractLeadingWS( @sBlock )
DropTrailingWS( @sBlock )
sTemp2 := sBlock
WHILE ( nNextAssign := At( ":=", sTemp2 ) ) > 0
sLeft := Left( sTemp2, nNextAssign - 1 )
sTemp2 := SubStr( sTemp2, nNextAssign + 2 )
DropTrailingWS( @sLeft )
nLen := Len( sLeft )
WHILE nLen > 0
IF SubStr( sLeft, nLen, 1 ) $ " (,=><*+-\^&@["
EXIT
ENDIF
nLen--
ENDDO
IF nLen == 0
sSymbol := sLeft
ELSE
sSymbol := SubStr( sLeft, nLen + 1 )
ENDIF
IF ( Type( sSymbol ) == 'U' )
PUBLIC &sSymbol
ENDIF
ENDDO
sSymbol := Upper( Left( sBlock, 14 ) ) // Len( "__SetOtherwise" )
IF nIf == 0 .OR. ;
sSymbol = "__SETIF" .OR. sSymbol = "__SETELSE" .OR. sSymbol = "__SETELSEIF" .OR. sSymbol = "__SETEND" .OR. ;
sSymbol = "__SETDOCASE" .OR. sSymbol = "__SETCASE" .OR. sSymbol = "__SETOTHERWISE" .OR. sSymbol = "__SETENDCASE" .OR. ;
abIf[ nIf ]
Eval( &( "{|| " + sBlock + " }" ) )
ENDIF
sTemp := RTrim( SubStr( sTemp, nNext + 1 ) )
ExtractLeadingWS( @sTemp )
ENDDO
sBlock := sTemp
DropTrailingWS( @sBlock )
IF ! ( sBlock == '' )
sTemp2 := sBlock
WHILE ( nNextAssign := At( ":=", sTemp2 ) ) > 0
sLeft := Left( sTemp2, nNextAssign - 1 )
sTemp2 := SubStr( sTemp2, nNextAssign + 2 )
DropTrailingWS( @sLeft )
nLen := Len( sLeft )
WHILE nLen > 0
IF SubStr( sLeft, nLen, 1 ) $ " (,=><*+-\^&@["
EXIT
ENDIF
nLen--
ENDDO
IF nLen == 0
sSymbol := sLeft
ELSE
sSymbol := SubStr( sLeft, nLen + 1 )
ENDIF
IF ( Type( sSymbol ) == 'U' )
PUBLIC &sSymbol
ENDIF
ENDDO
sSymbol := Upper( Left( sBlock, 11 ) ) // Len( "__SetElseIf" )
IF nIf == 0 .OR. ;
sSymbol = "__SETIF" .OR. sSymbol = "__SETELSE" .OR. sSymbol = "__SETELSEIF" .OR. sSymbol = "__SETEND" .OR. ;
sSymbol = "__SETDOCASE" .OR. sSymbol = "__SETCASE" .OR. sSymbol = "__SETOTHERWISE" .OR. sSymbol = "__SETENDCASE" .OR. ;
abIf[ nIf ]
Eval( &( "{|| " + sTemp + " }" ) )
ENDIF
ENDIF
nRow := Row()
nCol := Col()
@ 0,0 SAY "PP: "
@ 0,4 SAY Pad( sPPed, 76 ) COLOR "N/R"
END SEQUENCE
ExecuteLine( ProcessLine( RTrim( sLine ), 1, '' ) )
ENDDO
CLEAR SCREEN
RETURN
//--------------------------------------------------------------//
PROCEDURE ExecuteLine( sPPed )
LOCAL nNext, sBlock, sTemp
LOCAL sTemp2, nLen, sLeft, sSymbol, nNextAssign
ExtractLeadingWS( @sPPed )
DropTrailingWS( @sPPed )
sTemp := sPPed
IF ! bRun
@ 0,0 SAY "PP: "
@ 0,4 SAY Pad( sPPed, 76 ) COLOR "N/R"
ENDIF
DevPos( nRow, nCol )
BEGIN SEQUENCE
WHILE ( nNext := At( ';', sTemp ) ) > 0
sBlock := Left( sTemp, nNext - 1 )
ExtractLeadingWS( @sBlock )
DropTrailingWS( @sBlock )
sTemp2 := sBlock
WHILE ( nNextAssign := At( ":=", sTemp2 ) ) > 0
sLeft := Left( sTemp2, nNextAssign - 1 )
sTemp2 := SubStr( sTemp2, nNextAssign + 2 )
DropTrailingWS( @sLeft )
nLen := Len( sLeft )
WHILE nLen > 0
IF SubStr( sLeft, nLen, 1 ) $ " (,=><*+-\^&@["
EXIT
ENDIF
nLen--
ENDDO
IF nLen == 0
sSymbol := sLeft
ELSE
sSymbol := SubStr( sLeft, nLen + 1 )
ENDIF
IF ( Type( sSymbol ) = 'U' )
PUBLIC &sSymbol
ENDIF
ENDDO
sSymbol := Upper( Left( sBlock, 14 ) ) // Len( "__SetOtherwise" )
IF nIf == 0 .OR. ;
sSymbol = "__SETIF" .OR. sSymbol = "__SETELSE" .OR. sSymbol = "__SETELSEIF" .OR. sSymbol = "__SETEND" .OR. ;
sSymbol = "__SETDOCASE" .OR. sSymbol = "__SETCASE" .OR. sSymbol = "__SETOTHERWISE" .OR. sSymbol = "__SETENDCASE" .OR. ;
abIf[ nIf ]
Eval( &( "{|| " + sBlock + " }" ) )
ENDIF
sTemp := RTrim( SubStr( sTemp, nNext + 1 ) )
ExtractLeadingWS( @sTemp )
ENDDO
sBlock := sTemp
DropTrailingWS( @sBlock )
IF ! ( sBlock == '' )
sTemp2 := sBlock
WHILE ( nNextAssign := At( ":=", sTemp2 ) ) > 0
sLeft := Left( sTemp2, nNextAssign - 1 )
sTemp2 := SubStr( sTemp2, nNextAssign + 2 )
DropTrailingWS( @sLeft )
nLen := Len( sLeft )
WHILE nLen > 0
IF SubStr( sLeft, nLen, 1 ) $ " (,=><*+-\^&@["
EXIT
ENDIF
nLen--
ENDDO
IF nLen == 0
sSymbol := sLeft
ELSE
sSymbol := SubStr( sLeft, nLen + 1 )
ENDIF
IF ( Type( sSymbol ) = 'U' )
PUBLIC &sSymbol
ENDIF
ENDDO
sSymbol := Upper( Left( sBlock, 11 ) ) // Len( "__SetElseIf" )
IF nIf == 0 .OR. ;
sSymbol = "__SETIF" .OR. sSymbol = "__SETELSE" .OR. sSymbol = "__SETELSEIF" .OR. sSymbol = "__SETEND" .OR. ;
sSymbol = "__SETDOCASE" .OR. sSymbol = "__SETCASE" .OR. sSymbol = "__SETOTHERWISE" .OR. sSymbol = "__SETENDCASE" .OR. ;
abIf[ nIf ]
Eval( &( "{|| " + sTemp + " }" ) )
ENDIF
ENDIF
nRow := Row()
nCol := Col()
IF ! bRun
@ 0,0 SAY "PP: "
@ 0,4 SAY Pad( sPPed, 76 ) COLOR "N/R"
ENDIF
END SEQUENCE
RETURN
//--------------------------------------------------------------//
PROCEDURE RP_Dot_Err()
Alert( "Sorry, could not execute last request." )
@@ -356,6 +385,112 @@ PROCEDURE RP_Dot_Err()
//RETURN // Unreacable code
//--------------------------------------------------------------//
FUNCTION __SetIf( bExp )
IF nIf > 0 .AND. ! abIf[nIf]
bExp := .F.
ENDIF
nIf++
aSize( abIf, nIf )
abIf[nIf] := bExp
RETURN abIf[nIf]
//--------------------------------------------------------------//
FUNCTION __SetElseIf( bExp )
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
IF abIf[nIf]
abIf[nIf] := bExp
ENDIF
RETURN abIf[nIf]
//--------------------------------------------------------------//
FUNCTION __SetElse()
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
RETURN abIf[nIf]
//--------------------------------------------------------------//
FUNCTION __SetEnd()
IF nIf > 0
nIf--
ELSE
Alert( "END with no IF in sight!" )
ENDIF
RETURN nIf
//--------------------------------------------------------------//
FUNCTION __SetDoCase()
nIf++
aSize( abIf, nIf )
abIf[nIf] := .F.
RETURN abIf[nIf]
//--------------------------------------------------------------//
FUNCTION __SetCase( bExp )
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
IF abIf[nIf]
abIf[nIf] := bExp
ENDIF
RETURN abIf[nIf]
//--------------------------------------------------------------//
FUNCTION __SetOtherwise()
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
RETURN abIf[nIf]
//--------------------------------------------------------------//
FUNCTION __SetEndCase()
IF nIf > 0
nIf--
ELSE
Alert( "ENDCASE with no DO CASE in sight!" )
ENDIF
RETURN nIf
//------------------------------- *** END - RP DOT Functions *** -------------------------------//
FUNCTION ProcessFile( sSource, sSwitch )
LOCAL hSource, sBuffer, sLine, nPosition, sExt, cPrev
@@ -414,6 +549,12 @@ FUNCTION ProcessFile( sSource, sSwitch )
bBlanks := .F.
ENDIF
IF bRun .AND. ProcName(1) == "MAIN"
bCount := .F.
ErrorBlock( {|| RP_Dot_Err() } )
ProcessFile( "rp_dot.ch" )
ENDIF
sBuffer := Space( PP_BUFFER_SIZE )
sLine := ''
@@ -840,6 +981,8 @@ FUNCTION ProcessFile( sSource, sSwitch )
RETURN .T.
//--------------------------------------------------------------//
FUNCTION ProcessLine( sLine, nLine, sSource )
LOCAL sDirective, bX, sToken, nRule
@@ -1239,8 +1382,14 @@ FUNCTION ProcessLine( sLine, nLine, sSource )
//WAIT
ENDIF
IF bRun
ExecuteLine( sOut )
ENDIF
RETURN sOut
//--------------------------------------------------------------//
FUNCTION MatchRule( sKey, sLine, aRules, aResults, bStatement, bUpper )
LOCAL Counter, nRules, nRule, aMarkers, xMarker
@@ -1941,6 +2090,8 @@ FUNCTION MatchRule( sKey, sLine, aRules, aResults, bStatement, bUpper )
RETURN 0
//--------------------------------------------------------------//
FUNCTION NextToken( sLine, bCheckRules )
LOCAL sReturn := NIL, cChar, Counter, nLen, nClose, sLeft2Chars := Left( sLine, 2 )
@@ -2173,6 +2324,8 @@ FUNCTION NextToken( sLine, bCheckRules )
RETURN sReturn
//--------------------------------------------------------------//
FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor )
LOCAL sExp, cChar, sTemp, Counter, sWorkLine, sPad, sToken, sGrabber
@@ -2690,6 +2843,8 @@ FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor )
RETURN IIF( cType == 'A', aExp, sExp )
//--------------------------------------------------------------//
FUNCTION PPOut( aResults, aMarkers )
LOCAL Counter, nResults, sResult := "", nMarker, nMatches, nMatch//, aMarkers := aResults[3]
@@ -2991,6 +3146,8 @@ FUNCTION PPOut( aResults, aMarkers )
RETURN sResult
//--------------------------------------------------------------//
FUNCTION CompileRule( sRule, aRules, aResults, bX, bUpper )
LOCAL nNext, sKey, sAnchor := NIL, nOptional := 0, cType := NIL, nId := 0, aRule := NIL, aMatch, aWords := NIL
@@ -4037,6 +4194,8 @@ FUNCTION CompileRule( sRule, aRules, aResults, bX, bUpper )
RETURN NIL
//--------------------------------------------------------------//
FUNCTION RemoveDefine( sDefine )
LOCAL nId
@@ -4050,6 +4209,8 @@ FUNCTION RemoveDefine( sDefine )
RETURN nId
//--------------------------------------------------------------//
FUNCTION CompileDefine( sRule )
LOCAL sKey, sResult, aRule, nCloseAt, nId, sMarker, nCommaAt, aMP
@@ -4139,7 +4300,7 @@ FUNCTION CompileDefine( sRule )
aMP := { 0, 0, ')', NIL, NIL }
aAdd( aRule[2], aMP )
/*----------------------------------------- */
/*----------------------------------------- */
aRPs := {}
@@ -4202,6 +4363,8 @@ FUNCTION CompileDefine( sRule )
RETURN Len( aDefRules )
//--------------------------------------------------------------//
FUNCTION ExtractLeadingWS( sLine, sWS )
LOCAL Counter, cChar, nLen := Len( sLine )
@@ -4226,6 +4389,8 @@ FUNCTION ExtractLeadingWS( sLine, sWS )
RETURN sWS
//--------------------------------------------------------------//
FUNCTION DropTrailingWS( sLine, sWS )
#ifdef __HARBOUR__
@@ -4286,6 +4451,8 @@ FUNCTION DropTrailingWS( sLine, sWS )
RETURN sLine
//--------------------------------------------------------------//
FUNCTION DropExtraTrailingWS( sLine )
#ifdef __HARBOUR__
@@ -4328,6 +4495,8 @@ FUNCTION DropExtraTrailingWS( sLine )
RETURN sLine
//--------------------------------------------------------------//
FUNCTION SetIfDef( sDefine, bExist )
LOCAL nId
@@ -4348,93 +4517,7 @@ FUNCTION SetIfDef( sDefine, bExist )
RETURN nIfDef
FUNCTION __SetIf( bExp )
IF nIf > 0 .AND. ! abIf[nIf]
bExp := .F.
ENDIF
nIf++
aSize( abIf, nIf )
abIf[nIf] := bExp
RETURN abIf[nIf]
FUNCTION __SetElseIf( bExp )
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
IF abIf[nIf]
abIf[nIf] := bExp
ENDIF
RETURN abIf[nIf]
FUNCTION __SetElse()
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
RETURN abIf[nIf]
FUNCTION __SetEnd()
IF nIf > 0
nIf--
ELSE
Alert( "END with no IF in sight!" )
ENDIF
RETURN nIf
FUNCTION __SetDoCase()
nIf++
aSize( abIf, nIf )
abIf[nIf] := .F.
RETURN abIf[nIf]
FUNCTION __SetCase( bExp )
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
IF abIf[nIf]
abIf[nIf] := bExp
ENDIF
RETURN abIf[nIf]
FUNCTION __SetOtherwise()
IF nIf > 1 .AND. ! abIf[nIf - 1]
RETURN .F.
ENDIF
abIf[nIf] := ! abIf[nIf]
RETURN abIf[nIf]
FUNCTION __SetEndCase()
IF nIf > 0
nIf--
ELSE
Alert( "ENDCASE with no DO CASE in sight!" )
ENDIF
RETURN nIf
//--------------------------------------------------------------//
FUNCTION CompileToCCH( sSource )
@@ -4612,6 +4695,8 @@ FUNCTION CompileToCCH( sSource )
RETURN .T.
//--------------------------------------------------------------//
FUNCTION InitRules()
/* Defines */
@@ -4904,6 +4989,8 @@ aAdd( aCommRules, { 'SET' , { { 0, 0, 'ORDER', NIL, NIL }, { 0, 0, 'TO
RETURN .T.
//--------------------------------------------------------------//
FUNCTION InitResults()
/* Defines Results*/
@@ -5195,3 +5282,5 @@ aAdd( aCommResults, { { { 0, 'ordSetFocus( ' }, { 0, 1 }, { 2, ' , ' },
aAdd( aCommResults, { { { 0, 'ordSetFocus(0)' } }, { -1} , { } } )
RETURN .T.
//--------------------------------------------------------------//

1
harbour/contrib/dot/rp_dot.ch
View File

@@ -15,6 +15,7 @@
#COMMAND IF <ifExp> => __SetIf( <ifExp> )
#COMMAND ELSEIF <elseifExp> => __SetElseIf( <elseifExp> )
#COMMAND ELSE => __SetElse()
#COMMAND ENDIF [<*x*>] => __SetEnd()
#COMMAND END [<*x*>] => __SetEnd()
#COMMAND DO CASE => __SetDoCase()