rlar
15 years ago
8 changed files with 11 additions and 1654 deletions
-
10ChangeLog
-
2src/frontend/numparam/Makefile.am
-
89src/frontend/numparam/downgrad.txt
-
29src/frontend/numparam/general.h
-
420src/frontend/numparam/mystring.c
-
1src/frontend/numparam/numparam.h
-
996src/frontend/numparam/washprog.c
-
118src/frontend/numparam/xpressn.c
@ -1,89 +0,0 @@ |
|||||
! downgrad.txt, Use with 'washprog.c' |
|
||||
! opcodes: x=exclusion, m=macro, w=wordsubst s= general subst |
|
||||
! Macros to keep: Cconst Hi Lo Str Strbig Use ...? |
|
||||
|
|
||||
w Proc void |
|
||||
w Begin { |
|
||||
w EndProc ;} |
|
||||
w Func "" |
|
||||
w EndFunc ;} |
|
||||
w If "if (" |
|
||||
w Then ") {" |
|
||||
w Else ";} else {" |
|
||||
w ElsIf ";} else if (" |
|
||||
w EndIf ;} |
|
||||
w While "while (" |
|
||||
w Do ") {" |
|
||||
w Done ;} |
|
||||
w Repeat "do {" |
|
||||
w Until ";} while ( !(" |
|
||||
w EndRep )); |
|
||||
w For "for (" |
|
||||
w Switch "switch (" |
|
||||
w CaseOne ") { case" |
|
||||
w Case "; break; } case" |
|
||||
w AndCase ":; case" |
|
||||
w Is :{ |
|
||||
w Default "; break;} default: {" |
|
||||
w EndSw ";break;} }" |
|
||||
|
|
||||
m Const(1,2) "const short 1 = 2;" |
|
||||
|
|
||||
m Record(1) "typedef struct _t1 {" |
|
||||
m RecPtr(1) "typedef struct _t1 *" |
|
||||
m EndRec(1) "} 1;" |
|
||||
m Addr(1) &1 |
|
||||
|
|
||||
w False 0 |
|
||||
w True 1 |
|
||||
w Not ! |
|
||||
w And && |
|
||||
w Or || |
|
||||
w Div / |
|
||||
w Mod % |
|
||||
|
|
||||
w Shl << |
|
||||
w Shr >> |
|
||||
w AND & |
|
||||
w OR | |
|
||||
w XOR \^ |
|
||||
w NOT ~ |
|
||||
w AT * |
|
||||
|
|
||||
m Inc(1) 1++ |
|
||||
m Dec(1) 1-- |
|
||||
w Null NULL |
|
||||
w Void void |
|
||||
m Table(1) "[1]= {" |
|
||||
w EndTab }; |
|
||||
|
|
||||
m chr(1) (char)(1) |
|
||||
m Zero(1) (!(1)) |
|
||||
m NotZ(1) (1) |
|
||||
|
|
||||
w Pointer "void *" |
|
||||
w Pfile "FILE *" |
|
||||
|
|
||||
w Char "unsigned char" |
|
||||
w Byte "unsigned char" |
|
||||
w Bool "unsigned char" |
|
||||
w Word "unsigned short" |
|
||||
w Pchar "char *" |
|
||||
|
|
||||
w Intern static |
|
||||
w Extern extern |
|
||||
m Tarray(1,2,3) "typedef 2 1[3];" |
|
||||
m Tarray\2(1,2,3,4) "typedef 2 1[3][4];" |
|
||||
m Darray(1,2,3) "2 1[3];" |
|
||||
|
|
||||
m Cconst(1,2) "typedef enum {1 = 2} _n1;" |
|
||||
!m Str(1,2) "char 2[1+03]={00,00,(char)1}" |
|
||||
!m Strbig(1,2) "char 2[1+04]={00, (char)Hi(1), (char)Lo(1)}" |
|
||||
|
|
||||
w Aconst(1,2,3) "2 1[3] ={" |
|
||||
w EndAco "};" |
|
||||
m Sini(1) "sini(1,sizeof(1)-04)" |
|
||||
m New(1) "(1 *)new(sizeof(1))" |
|
||||
m Dispose(1) "dispose((void *)1)" |
|
||||
m NewArr(1,2) "(1 *)new(sizeof(1)*2)" |
|
||||
|
|
||||
@ -1,996 +0,0 @@ |
|||||
/* washprog.c Copyright (C) 2002 Georg Post |
|
||||
* |
|
||||
* This file is part of Numparam, see: readme.txt |
|
||||
* Free software under the terms of the GNU Lesser General Public License |
|
||||
*/ |
|
||||
|
|
||||
/**** washprog: trivial text substitution utility. ****/ |
|
||||
|
|
||||
/* history: this was an exercise to make an 'intersection' language |
|
||||
of C and Java, that would look like Basic. A complete failure, of course. |
|
||||
|
|
||||
Now only used to clean my Basic/Pascal-contaminated C code. |
|
||||
With the rules file below, it destroys all those macros of mine for |
|
||||
quiche eaters, which seem offensive to C aficionados. |
|
||||
|
|
||||
Standard rules file needed : downgrad.txt |
|
||||
|
|
||||
Typical command line: ./washprog -r downgrad washprog.c |
|
||||
|
|
||||
There is no printf. Console Output/Input primitives are as follows: |
|
||||
wc ws wr wn wi wln rln |
|
||||
The bare-bones string(=Pchar) manipulation library is this: |
|
||||
pscopy streq str length upcase scopy sadd saddn cadd pos |
|
||||
|
|
||||
Format of substitution rules: |
|
||||
|
|
||||
s <string> <string> substitute. use "" around string if spaces inside. |
|
||||
w <string> <string> first string must be a whole word only |
|
||||
m <macro1> <macro2> macro substitution with args 1 2 3 ... |
|
||||
u <macro1> <macro2> macro with atomic args, no punctuation "(;,:)" inside. |
|
||||
x <strng1> <strng2> exclude text section from strng1 to strng2. |
|
||||
a <mac1> <mac2> dynamically add a new macro rule, if table space left. |
|
||||
|
|
||||
string: may contain special chars: ^A ... ^Z \n \" |
|
||||
macro1: string with "placeholders" 1 2 ... 9, in this order |
|
||||
macro2: may contain the "arguments" anywhere |
|
||||
non-arg digits in macro2 are prefixed 0 |
|
||||
|
|
||||
Heavy use of 3 string operations: |
|
||||
- pscopy() substring extraction. |
|
||||
- comparison: match(). |
|
||||
- spos() substring search |
|
||||
|
|
||||
added : special postprocessing for C to place the ; and } : |
|
||||
1. any ';' following a ';' or '}' is wiped out. |
|
||||
2. any ';' preceding a '}' is wiped out. |
|
||||
3. any remaining ';' on start of line is shifted to end of preceding one. |
|
||||
*/ |
|
||||
|
|
||||
#include <stdio.h> /* NULL FILE fopen feof fgets fclose fputs fputc gets */ |
|
||||
#include "general.h" |
|
||||
Cconst(Llen, 15000) |
|
||||
Cconst(nsub, 100+1) /*max nbr of substitution rules */ |
|
||||
Cconst(nargs, 11) /*max number of macro args + 1*/ |
|
||||
Cconst(wild,'æ') /* wildcard character in patterns */ |
|
||||
Cconst(joker,1) /* one-character placeholder */ |
|
||||
Cconst( Recursion, True) /* 20 % slower, re-substitute inside macro args */ |
|
||||
|
|
||||
Tarray(macargs, string, nargs) /* 0..9 macro copy args, 10: a wildcard */ |
|
||||
|
|
||||
/* global vars */ |
|
||||
int isr; /* nb of substitution rules */ |
|
||||
Bool cMode; /* a scanning options: c language mode */ |
|
||||
int lookmax; /* input lookahead max size */ |
|
||||
Pfile fout; /* file filled by: echoOut macroOut translate traduire */ |
|
||||
|
|
||||
Tarray(str40, char, 44) |
|
||||
Tarray(str80, char, 84) |
|
||||
Darray(search, str40, nsub) |
|
||||
Darray(replace, str80, nsub) |
|
||||
Str(nsub, srule); |
|
||||
Str(nsub, wildcard); |
|
||||
|
|
||||
/********* trivial io ***/ |
|
||||
|
|
||||
Proc wsf( Pchar s, int fmt) |
|
||||
Begin |
|
||||
int k; |
|
||||
For k=1; k<=fmt-length(s); Inc(k) Do |
|
||||
wc(' ') |
|
||||
Done |
|
||||
ws(s) |
|
||||
EndProc |
|
||||
|
|
||||
Proc wcf(char c, int fmt) |
|
||||
Begin |
|
||||
int k; |
|
||||
For k=1; k<=fmt-1; Inc(k) Do |
|
||||
wc(' ') |
|
||||
Done |
|
||||
wc(c) |
|
||||
EndProc |
|
||||
|
|
||||
Proc wif(long i, int fmt) |
|
||||
Begin /*default fmt=1*/ |
|
||||
Str(30, s); |
|
||||
nadd(s,i); |
|
||||
wsf(s,fmt) |
|
||||
EndProc |
|
||||
|
|
||||
Proc rln(Pchar s) /* 78 column limit */ |
|
||||
Begin |
|
||||
int i; Bool done; char c; |
|
||||
int max=maxlen(s); |
|
||||
If max>78 Then max=78 EndIf |
|
||||
i=0; done=False; |
|
||||
scopy(s,""); |
|
||||
While Not done Do |
|
||||
c=fgetc(stdin); |
|
||||
If (c>=' ') And (c<='~') And (i<max) Then |
|
||||
cadd(s,c); Inc(i) |
|
||||
EndIf |
|
||||
done= (c=='\n') Or (c==Cr) |
|
||||
Done |
|
||||
EndProc |
|
||||
|
|
||||
/*****************/ |
|
||||
|
|
||||
Proc saddn( Pchar s, Pchar t, int n) |
|
||||
Begin |
|
||||
Strbig(Llen,u); |
|
||||
int lt= length(t); |
|
||||
If lt<= n Then |
|
||||
sadd(s,t) |
|
||||
Else |
|
||||
pscopy(u,t,1,n); |
|
||||
sadd(s,u) |
|
||||
EndIf |
|
||||
EndProc |
|
||||
|
|
||||
Proc allocdata(void) |
|
||||
Begin /* prevent any string overflow */ |
|
||||
int i; |
|
||||
For i=0; i<nsub; Inc(i) Do |
|
||||
Sini(search[i]); |
|
||||
Sini(replace[i]) |
|
||||
Done |
|
||||
EndProc |
|
||||
|
|
||||
Proc setOptions(Pchar s) |
|
||||
/* command-line options c-mode and/or lookahead buffer size */ |
|
||||
Begin |
|
||||
int j,k; |
|
||||
Bool num; |
|
||||
int z; |
|
||||
char c; |
|
||||
/*-StartProc-*/ |
|
||||
ws("Options: "); |
|
||||
For j=1; j<length(s); Inc(j) Do /*scan for option setting chars */ |
|
||||
If s[j]=='C' Then |
|
||||
cMode=True; ws("cMode ") |
|
||||
EndIf |
|
||||
If s[j]=='L' Then /*redefine max lookahead length */ |
|
||||
z=0; |
|
||||
k= (int)(j+1); |
|
||||
Repeat |
|
||||
Inc(k); c=s[k]; |
|
||||
num= (c>='0') And (c<='9'); |
|
||||
If num Then z= (int)( 10*z+ c - '0') EndIf |
|
||||
Until Not num EndRep |
|
||||
If (z>lookmax) And (z<255) Then |
|
||||
lookmax= z |
|
||||
EndIf |
|
||||
ws("Lookahead="); wi(lookmax); |
|
||||
EndIf |
|
||||
Done |
|
||||
wln(); |
|
||||
EndProc |
|
||||
|
|
||||
/******** matching routines *******/ |
|
||||
|
|
||||
Proc copySpace(Pchar s, Pchar t, int a, int b) /* a,b>0 ! Pascal indexing */ |
|
||||
Begin |
|
||||
/*echo any "nontrivial" whitespace t-->s */ |
|
||||
int lt,i,k, comment; |
|
||||
Bool leader; |
|
||||
char c; |
|
||||
/*-StartProc-*/ |
|
||||
scopy(s,""); |
|
||||
leader=False; /*leader space on new line...*/ |
|
||||
k=0; |
|
||||
comment=0; /* for C type whitespaces 1 And 2*/ |
|
||||
lt= length(t); |
|
||||
If b>lt Then b=lt EndIf |
|
||||
For i=(int)(a-1); i<b; Inc(i) Do |
|
||||
c=t[i]; |
|
||||
If (c>0) And (c<' ') Then leader=True EndIf |
|
||||
If cMode And (c=='/') And (t[i+1]=='*') Then comment=1 EndIf |
|
||||
If ((c>0) And (c<' ')) Or (leader And (c==' ')) Or (comment>0) Then |
|
||||
cadd(s,c); Inc(k); |
|
||||
EndIf |
|
||||
If (comment==1) And (c=='/') And (t[i-1]=='*') Then comment=0 EndIf |
|
||||
Done |
|
||||
EndProc |
|
||||
|
|
||||
Func int skipCwhite(Pchar t, int j, int lt) /* assume C indexing */ |
|
||||
Begin |
|
||||
/* skip any C And C++ type whitespace in t, from j to lt */ |
|
||||
/* returns j-1 If current char is no white at all! */ |
|
||||
char c; |
|
||||
int comment; /*types 1 And 2! */ |
|
||||
/*t[j] may already be '/' ? */ comment=0; |
|
||||
c=t[j]; /*If c>' ', we are done! */ |
|
||||
If (c>0) And (c<=' ') Then |
|
||||
Repeat |
|
||||
If (comment==0) And (c=='/') Then |
|
||||
If t[j+1]=='*' Then |
|
||||
comment=1 |
|
||||
ElsIf t[j+1]=='/' Then |
|
||||
comment=2 |
|
||||
EndIf |
|
||||
ElsIf (comment==1) And (c=='/') And (t[j-1]=='*') Then |
|
||||
comment=0 |
|
||||
ElsIf (comment==2) And (c==Lf) Then |
|
||||
comment=0 |
|
||||
EndIf |
|
||||
Inc(j); c=t[j]; |
|
||||
Until (j>lt) Or ((comment==0) And (c>' ')) EndRep |
|
||||
EndIf |
|
||||
return (int)(j-1); /* return last white-matching char position */ |
|
||||
EndProc |
|
||||
|
|
||||
Func Bool simple(Pchar s) |
|
||||
Begin /* check if no strange punctuations inside s */ |
|
||||
char c; |
|
||||
int i,ls; |
|
||||
Bool found; |
|
||||
/*-StartProc-*/ |
|
||||
ls=length(s); |
|
||||
i=0; |
|
||||
Repeat c=s[i]; |
|
||||
found=(c=='(') Or (c==')') Or (c==',') Or (c==';') Or (c==':'); |
|
||||
Inc(i); |
|
||||
Until found Or (i>=ls) EndRep |
|
||||
return Not found; |
|
||||
EndFunc |
|
||||
|
|
||||
Func Bool match(Pchar s, Pchar t, int n, int tstart) |
|
||||
Begin |
|
||||
/* test if t starts with substring s. |
|
||||
returns 0 If tstart is out of range. But n may be 0 ? |
|
||||
options: Singlechar wildcards "?" |
|
||||
*/ |
|
||||
int i,j,lt; |
|
||||
Bool ok; |
|
||||
/*-StartProc-*/ |
|
||||
i=0; j=tstart; |
|
||||
lt= length(t); |
|
||||
ok=(tstart<lt); |
|
||||
While ok And (i<n) Do |
|
||||
ok= (j<lt) And ((s[i]==t[j]) Or (s[i]==joker)); |
|
||||
Inc(i); Inc(j); |
|
||||
Done |
|
||||
return ok |
|
||||
EndFunc |
|
||||
|
|
||||
/* Func int posi(Pchar sub, Pchar s) |
|
||||
Begin re-defines Turbo Pos, result Pascal compatible |
|
||||
int a,b,k; |
|
||||
Bool ok; |
|
||||
-StartProc- |
|
||||
ok=False; |
|
||||
a=length(sub); |
|
||||
b=(int)(length(s)-a); |
|
||||
k=0; |
|
||||
If a>0 Then Else return 0 |
|
||||
While (k<=b) And (Not ok) Do |
|
||||
ok=match(sub,s, a,k); remark we must start at k=0 ! |
|
||||
Inc(k); |
|
||||
Done |
|
||||
EndIf |
|
||||
If ok Then |
|
||||
return k |
|
||||
Else |
|
||||
return 0 |
|
||||
EndIf |
|
||||
EndFunc */ |
|
||||
|
|
||||
Func int matchwhite(Pchar s, Pchar t, int n, int tstart) |
|
||||
Begin |
|
||||
/* like match, but any whitespace in t matches space in s*/ |
|
||||
int i,j,lt; Bool ok; |
|
||||
/*-StartProc-*/ |
|
||||
i=0; j=tstart; |
|
||||
lt= length(t); |
|
||||
ok=(tstart<lt); |
|
||||
While ok And (i<n) Do |
|
||||
If s[i]==' ' Then /* always Ok, skip space in t */ |
|
||||
If cMode Then |
|
||||
j=skipCwhite(t,j,lt) |
|
||||
Else |
|
||||
While (j<=lt) And (t[j]<=' ') And (t[j]>0) Do Inc(j) Done |
|
||||
Dec(j); |
|
||||
EndIf |
|
||||
Repeat |
|
||||
Inc(j) |
|
||||
Until (j>=lt) Or (t[j]>' ') EndRep /*skip space in t*/ |
|
||||
Dec(j); |
|
||||
Else |
|
||||
ok= (j<=lt) And ((s[i]==t[j]) Or (s[i]==joker)); |
|
||||
EndIf |
|
||||
Inc(i); Inc(j); |
|
||||
Done |
|
||||
If ok Then |
|
||||
return (int)(j-tstart) |
|
||||
Else |
|
||||
return (int)0 |
|
||||
EndIf |
|
||||
EndFunc |
|
||||
|
|
||||
Func int posizero(Pchar sub, Pchar s) |
|
||||
Begin /*another Pos */ |
|
||||
/* substring search. like posi, but reject quotes & bracketed stuff */ |
|
||||
int a,b,k; |
|
||||
Bool ok; |
|
||||
int blevel; |
|
||||
char c; |
|
||||
/*-StartProc-*/ |
|
||||
ok=False; |
|
||||
a=length(sub); |
|
||||
b=(int)(length(s)-a); |
|
||||
k=0; blevel=0; |
|
||||
If a>0 Then /*Else return 0*/ |
|
||||
While (k<=b) And (Not ok) Do |
|
||||
ok= (matchwhite(sub,s, a,k)>0); |
|
||||
If (k<=b) And (Not ok) Then |
|
||||
c=s[k]; |
|
||||
If (c==')') Or (c==']') Or (c=='}') Then |
|
||||
If c!=sub[0] Then Dec(blevel) EndIf /*negative level: fail!*/ |
|
||||
If blevel<0 Then k=b EndIf |
|
||||
ElsIf (c=='\'') Or (c=='\"') Then /*skip quote */ |
|
||||
Repeat Inc(k) |
|
||||
Until (k>=b) Or (s[k]==c) EndRep |
|
||||
ElsIf (c=='(') Or (c=='[') Or (c=='{') Then /*skip block*/ |
|
||||
Inc(blevel); /*counts the bracketing level */ |
|
||||
Repeat |
|
||||
Inc(k); c=s[k]; |
|
||||
If (c=='(') Or (c=='[') Or (c=='{') Then |
|
||||
Inc(blevel) |
|
||||
ElsIf (c==')') Or (c==']') Or (c=='}') Then |
|
||||
Dec(blevel) |
|
||||
EndIf |
|
||||
Until (k>=b) Or (blevel==0) EndRep |
|
||||
EndIf |
|
||||
EndIf |
|
||||
Inc(k); |
|
||||
Done |
|
||||
EndIf |
|
||||
If ok Then |
|
||||
return k |
|
||||
Else |
|
||||
return 0 |
|
||||
EndIf |
|
||||
EndFunc |
|
||||
|
|
||||
Func int isMacro(Pchar s, char option, Pchar t, int tstart, |
|
||||
string maccopy[] ) |
|
||||
/* s= macro template, t=buffer, maccopy = arg Array |
|
||||
return value: number of characters matched, |
|
||||
restrictive option: 'u' |
|
||||
macro substitution args 1 2 3 ...9. |
|
||||
sample: bla1tra2gla3vla matches "bla ME tra YOU gla HIM vla" |
|
||||
substitute 1 by maccopy[1] etc |
|
||||
*/ |
|
||||
Begin |
|
||||
Darray(ps, int, nargs+1) |
|
||||
Word j,k,dk,ls, lst, lmt, jmax, pj; |
|
||||
Bool ok; |
|
||||
char arg; |
|
||||
Strbig(Llen,u); |
|
||||
Str(40,st); |
|
||||
/* returns >0 If comparison Ok == length of compared Pchar */ |
|
||||
/*-StartProc-*/ k=0; |
|
||||
ok= (s[0]==t[tstart]); /* intcut: how much does it accelerate ? some % */ |
|
||||
If ok Then |
|
||||
ps[0]=0; |
|
||||
ps[nargs]=0; /*only 1..9 are valid data, 10 filler templates*/ |
|
||||
j=0; |
|
||||
Repeat |
|
||||
Inc(j); arg= (char)(j+'0'); |
|
||||
ps[j]= cpos(arg,s); |
|
||||
Until (j>=nargs) Or (ps[j]==0) EndRep |
|
||||
ls= length(s); |
|
||||
ps[j]=(int)(ls+1); /*For last template chunk*/ |
|
||||
jmax=j; j=1; |
|
||||
k=0; lmt=0; |
|
||||
Repeat |
|
||||
pscopy(st,s, (Word)(ps[j-1]+1), (Word)(ps[j]-ps[j-1]-1) ); |
|
||||
/*j-th template Pchar*/ lst=length(st); |
|
||||
If j==1 Then |
|
||||
If option=='u' Then |
|
||||
lmt= matchwhite(st,t,lst,tstart); |
|
||||
ok=(lmt>0) /*length of match in t*/ |
|
||||
Else |
|
||||
ok= match(st,t,lst,tstart) |
|
||||
EndIf |
|
||||
If ok Then |
|
||||
pscopy(u,t, (Word)(tstart+1), (Word)255); |
|
||||
pj=1 |
|
||||
Else |
|
||||
pj=0 |
|
||||
EndIf |
|
||||
Else |
|
||||
If option=='u' Then |
|
||||
pj= posizero(st,u); |
|
||||
If pj>0 Then lmt= matchwhite(st,u, lst, (int)(pj-1)) EndIf |
|
||||
Else |
|
||||
pj= posi(st,u) |
|
||||
EndIf /* qs[j]= k+pj; is position in t*/ |
|
||||
ok=(pj>0); |
|
||||
EndIf |
|
||||
If ok Then |
|
||||
If option=='u' Then |
|
||||
If j==1 Then scopy(maccopy[0],"") EndIf |
|
||||
saddn(maccopy[j-1],u, (Word)(pj-1)); |
|
||||
dk= (Word)(pj+lmt); |
|
||||
copySpace(maccopy[j], t, |
|
||||
(Word)(tstart+k+pj), (Word)(tstart+k+dk)); |
|
||||
/* space in t[k+pj...k+dk] goes into maccopy[j] as a prefix. */ |
|
||||
Else |
|
||||
pscopy(maccopy[j-1],u, (Word)1, (Word)(pj-1)); |
|
||||
/*the stuff preceding the marker*/ |
|
||||
dk= (Word)(pj+lst); /* start of unexplored part */ |
|
||||
EndIf |
|
||||
pscopy(u,u, (Word)dk, (Word)length(u)); /*shift in the rest*/ |
|
||||
k= (Word)(k+dk-1); |
|
||||
EndIf |
|
||||
Inc(j) |
|
||||
Until (j>jmax) Or (Not ok) EndRep |
|
||||
EndIf |
|
||||
If Not ok Then k=0 EndIf |
|
||||
return k |
|
||||
EndFunc |
|
||||
|
|
||||
Func int similar(Pchar s, char wilds, Pchar t, |
|
||||
int tstart, string maccopy[] ) |
|
||||
/* try to match s with t, then save the wildcard parts ins maccopy[] */ |
|
||||
/* s=template, t=buffer, wilds= number of wildcards, maccopy=substitute */ |
|
||||
/* return value: number of characters matched */ |
|
||||
Begin |
|
||||
Word j,k,ps,ls; |
|
||||
Bool ok; |
|
||||
char endc; |
|
||||
Strbig(Llen,u); |
|
||||
/* returns >0 if comparison Ok = length of compared string */ |
|
||||
/* char comparison, s may have wildcard regions with "æ" BUT 1 valid End */ |
|
||||
/*-StartProc-*/ |
|
||||
ls=length(s); |
|
||||
k=0; |
|
||||
If wilds==wild Then |
|
||||
ps= cpos(wild,s) |
|
||||
Else |
|
||||
ps=0 |
|
||||
EndIf |
|
||||
If ps==0 Then |
|
||||
If match(s,t,ls,tstart) Then |
|
||||
k=ls; |
|
||||
ps= cpos(joker,s); /*save joker's substitute*/ |
|
||||
If ps>0 Then |
|
||||
maccopy[nargs][0]=t[ps-1+tstart] |
|
||||
EndIf |
|
||||
Else |
|
||||
k=0 |
|
||||
EndIf |
|
||||
Else |
|
||||
k= (Word)(ps-1); |
|
||||
While s[k]==wild Do Inc(k) Done |
|
||||
endc=s[k]; /*End char to detect, at length */ |
|
||||
ok= match(s,t, (int)(ps-1), tstart); |
|
||||
If ok Then |
|
||||
pscopy(u,t, (Word)(ps+tstart), (Word)255); |
|
||||
j= cpos(endc, u); |
|
||||
ok=(j>0); |
|
||||
If ok Then |
|
||||
k= (Word)(ps+j-1); |
|
||||
pscopy(maccopy[nargs],t, (Word)(ps+tstart), (Word)(j-1)); |
|
||||
EndIf |
|
||||
EndIf |
|
||||
If Not ok Then k=0 EndIf |
|
||||
EndIf |
|
||||
return k |
|
||||
EndProc |
|
||||
|
|
||||
Func int addSubList(Pchar s, int isr) |
|
||||
/* add the rule s to the Rule list at isr */ |
|
||||
Begin |
|
||||
int j,ls; |
|
||||
char c,d,endc; |
|
||||
Bool start,stop; |
|
||||
/*-StartProc-*/ |
|
||||
ls=length(s); /* must kill the Newline */ |
|
||||
endc=' '; |
|
||||
While (ls>0) And (s[ls]<' ') Do Dec(ls) Done; |
|
||||
s[ls+1]=' '; |
|
||||
s[ls+2]=0; /* add a space */ |
|
||||
If s[0]=='o' Then |
|
||||
setOptions(s) |
|
||||
ElsIf (isr<nsub) And (cpos(s[0],"swmuxa") >0) Then |
|
||||
j=1; |
|
||||
Inc(isr); |
|
||||
scopy(search[isr],""); scopy(replace[isr],""); |
|
||||
srule[isr]=(s[0]); |
|
||||
wildcard[isr]=0; |
|
||||
/*init search*/ |
|
||||
start=True; stop=False; |
|
||||
d=0; |
|
||||
While Not stop Do |
|
||||
Inc(j); c=s[j]; |
|
||||
If start Then |
|
||||
If c !=' ' Then |
|
||||
start=False; |
|
||||
If c=='\"' Then endc=c Else endc=' ' EndIf |
|
||||
EndIf |
|
||||
Else |
|
||||
stop=(c==endc) |
|
||||
EndIf |
|
||||
If Not (start Or (c==endc)) Then |
|
||||
If c=='?' Then |
|
||||
c=joker |
|
||||
ElsIf (c=='^') And (s[j+1]>= ' ') Then |
|
||||
Inc(j); c=s[j]; |
|
||||
If (c>='@') And (c<='_') Then |
|
||||
c= (char)(c-'@') |
|
||||
EndIf |
|
||||
ElsIf (c=='\\') And (s[j+1]>= ' ') Then |
|
||||
Inc(j); c=s[j]; |
|
||||
If c=='n' Then c= Cr; d=Lf EndIf |
|
||||
EndIf |
|
||||
cadd(search[isr],c); |
|
||||
If (c==wild) Or (c==joker) Then |
|
||||
wildcard[isr]=c |
|
||||
EndIf |
|
||||
If d!=0 Then |
|
||||
cadd(search[isr],d); |
|
||||
d=0 |
|
||||
EndIf |
|
||||
EndIf |
|
||||
Done |
|
||||
If endc!=' ' Then Inc(j) EndIf |
|
||||
/*init replace*/ |
|
||||
start=True; stop=False; |
|
||||
d=0; |
|
||||
While Not stop Do |
|
||||
Inc(j); c=s[j]; |
|
||||
If start Then |
|
||||
If c!=' ' Then |
|
||||
start=False; |
|
||||
If c=='\"' Then endc=c Else endc=' ' EndIf |
|
||||
EndIf |
|
||||
Else |
|
||||
stop=(c==endc) |
|
||||
EndIf |
|
||||
If Not (start Or (c==endc)) Then |
|
||||
If c=='?' Then |
|
||||
c=joker |
|
||||
ElsIf (c=='^') And (s[j+1]>= ' ') Then |
|
||||
Inc(j); c=s[j]; |
|
||||
If (c>='@') And (c<='Z') Then c= (char)(c-'@') EndIf |
|
||||
ElsIf (c=='\\') And (s[j+1]>= ' ') Then |
|
||||
Inc(j); c=s[j]; /*echo next char */ |
|
||||
If c=='n' Then c=Cr; d=Lf EndIf |
|
||||
EndIf |
|
||||
cadd(replace[isr],c); |
|
||||
If d!=0 Then |
|
||||
cadd(replace[isr],d); |
|
||||
d=0 |
|
||||
EndIf |
|
||||
EndIf |
|
||||
Done |
|
||||
If endc !=' ' Then Inc(j) EndIf |
|
||||
EndIf |
|
||||
If isr>=nsub Then |
|
||||
ws("No more room for rules."); wln() |
|
||||
EndIf |
|
||||
return isr |
|
||||
EndFunc |
|
||||
|
|
||||
Func Bool getSubList(Pchar slist) |
|
||||
/* read the search and substitution rule list */ |
|
||||
Begin |
|
||||
Strbig(Llen,s); |
|
||||
Pfile f; |
|
||||
Bool done, ok; |
|
||||
/*-StartProc-*/ |
|
||||
cMode=False; |
|
||||
lookmax= 80; /* or 250: handle 4 full lines maximum ? */ |
|
||||
If Zero(slist[0]) Then |
|
||||
scopy(slist, "slist.txt") |
|
||||
EndIf |
|
||||
f=fopen(slist,"rb"); |
|
||||
isr=0; |
|
||||
done= (f == Null); |
|
||||
ok= Not done; |
|
||||
While Not done Do |
|
||||
fgets(s,(int)80,f); |
|
||||
isr=addSubList(s,isr); |
|
||||
done= feof(f) |
|
||||
Done |
|
||||
If f != Null Then fclose(f) EndIf |
|
||||
ws("Number of rules: "); |
|
||||
wi(isr); wln(); |
|
||||
return ok |
|
||||
EndFunc |
|
||||
|
|
||||
Func Bool nonAlfa(char c) |
|
||||
Begin |
|
||||
return ((c<'a') Or (c>'z')) And ((c<'A') Or (c>'Z')) |
|
||||
EndFunc |
|
||||
|
|
||||
/********** optional output postprocessor **************/ |
|
||||
|
|
||||
/* the main translator calls these: |
|
||||
washinit to reset the postprocessor |
|
||||
washchar to output a char |
|
||||
washstring to output a string |
|
||||
washflush to terminate |
|
||||
*/ |
|
||||
|
|
||||
/* C reformatter, keeping an eye on the following (modulo whitespace): |
|
||||
; } Lf. |
|
||||
|
|
||||
This is just a state machine, handling 3 rules using an output buffer obf. |
|
||||
<white> means space excluding \n, and <white2>, space including newlines. |
|
||||
Wanted: regular-expression scripts or tricks to do the same or better... |
|
||||
|
|
||||
Rule1: <white>Lf<white>; --> ;<white>Lf<white> states 2 3 |
|
||||
Rule2: ;<white2>; --> ;<white2> state 1 |
|
||||
Rule3: }<white2>; --> }<white2> state 1 |
|
||||
*/ |
|
||||
|
|
||||
Bool washmore= True; /* flag that activates the postprocessor */ |
|
||||
Strbig(Llen,obf); /* output buffer */ |
|
||||
int iobf=0; /* its index */ |
|
||||
int wstate=0; /* output state machine */ |
|
||||
|
|
||||
Proc washinit(void) |
|
||||
Begin |
|
||||
iobf=0; |
|
||||
wstate=0 |
|
||||
EndProc |
|
||||
|
|
||||
Proc washchar(char c) |
|
||||
Begin /* state machine receives one character */ |
|
||||
int i; |
|
||||
If Not washmore Then /* never leave state 0 */ |
|
||||
fputc(c, fout) |
|
||||
ElsIf wstate==0 Then /* buffer empty */ |
|
||||
If (c==';') Or (c=='}') Then |
|
||||
iobf=0; obf[iobf]=c; |
|
||||
Inc(iobf); wstate=1 |
|
||||
ElsIf c<=' ' Then |
|
||||
iobf=0; obf[iobf]=c; |
|
||||
Inc(iobf); |
|
||||
If c==Lf Then wstate=3 Else wstate=2 EndIf |
|
||||
Else |
|
||||
fputc(c, fout) |
|
||||
EndIf |
|
||||
ElsIf wstate==1 Then |
|
||||
If c <= ' ' Then |
|
||||
obf[iobf]=c; Inc(iobf) |
|
||||
Else |
|
||||
If c != ';' Then |
|
||||
obf[iobf]=c; Inc(iobf) |
|
||||
EndIf |
|
||||
For i=0; i<iobf; Inc(i) Do |
|
||||
fputc(obf[i], fout) |
|
||||
Done |
|
||||
iobf=0; |
|
||||
wstate=0 |
|
||||
EndIf |
|
||||
ElsIf wstate==2 Then |
|
||||
obf[iobf]=c; Inc(iobf); |
|
||||
If c==Lf Then |
|
||||
wstate=3 |
|
||||
ElsIf c<=' ' Then /* keep state */ |
|
||||
Else |
|
||||
For i=0; i<iobf; Inc(i) Do |
|
||||
fputc(obf[i], fout) |
|
||||
Done |
|
||||
iobf=0; |
|
||||
wstate=0 |
|
||||
EndIf |
|
||||
ElsIf wstate==3 Then |
|
||||
obf[iobf]=c; Inc(iobf); |
|
||||
If c<=' ' Then /* keep state */ |
|
||||
Else |
|
||||
If c==';' Then |
|
||||
Dec(iobf); fputc(c, fout) |
|
||||
EndIf |
|
||||
For i=0; i<iobf; Inc(i) Do |
|
||||
fputc(obf[i], fout) |
|
||||
Done |
|
||||
iobf=0; |
|
||||
wstate=0 |
|
||||
EndIf |
|
||||
EndIf |
|
||||
EndProc |
|
||||
|
|
||||
Proc washflush(void) |
|
||||
Begin |
|
||||
int i; |
|
||||
If NotZ(wstate) Then |
|
||||
For i=0; i<iobf; Inc(i) Do |
|
||||
fputc(obf[i], fout) |
|
||||
Done |
|
||||
iobf=0; |
|
||||
wstate=0 |
|
||||
EndIf |
|
||||
EndProc |
|
||||
|
|
||||
Proc washstring( Pchar s) |
|
||||
Begin |
|
||||
int i; |
|
||||
For i=0; i<length(s); Inc(i) Do |
|
||||
washchar(s[i]) |
|
||||
Done |
|
||||
EndProc |
|
||||
|
|
||||
/************* main part of translation filter ***********/ |
|
||||
|
|
||||
Proc translate(Pchar bf); /* recursion */ |
|
||||
|
|
||||
Proc echoOut(Pchar r, char isWild, string mac[] ) |
|
||||
Begin |
|
||||
int u; |
|
||||
Strbig(Llen,s); |
|
||||
/*-StartProc-*/ |
|
||||
If isWild !=0 Then |
|
||||
u= cpos(isWild,r) |
|
||||
Else |
|
||||
u=0 |
|
||||
EndIf |
|
||||
If u==0 Then |
|
||||
washstring(r) |
|
||||
Else /*substitute with wildcard*/ |
|
||||
pscopy(s,r, (Word)1, (Word)(u-1)); washstring(s); |
|
||||
If isWild==joker Then |
|
||||
washchar(mac[nargs][0]) |
|
||||
ElsIf Recursion Then |
|
||||
translate(mac[nargs]) |
|
||||
Else |
|
||||
washstring(mac[nargs]) |
|
||||
EndIf |
|
||||
scopy(mac[nargs], ""); |
|
||||
pscopy(s,r, (Word)(u+1), (Word)40); |
|
||||
washstring(s); |
|
||||
EndIf |
|
||||
EndProc |
|
||||
|
|
||||
Proc macroOut(Pchar r, string mac[] ) |
|
||||
Begin |
|
||||
/* substitutes "1"..."9", uses "0" as escape character*/ |
|
||||
char c; |
|
||||
int i,j; |
|
||||
Bool escape; |
|
||||
/*-StartProc-*/ |
|
||||
escape=False; |
|
||||
For i=0; i<length(r); Inc(i) Do |
|
||||
c=r[i]; |
|
||||
j= (int)(c-'0'); |
|
||||
If j==0 Then |
|
||||
escape=True /*And skip*/ |
|
||||
ElsIf ((j>0) And (j<nargs)) And (Not escape) Then |
|
||||
If Recursion Then |
|
||||
translate(mac[j]) |
|
||||
Else |
|
||||
washstring(mac[j]) |
|
||||
EndIf |
|
||||
Else |
|
||||
washchar(c); |
|
||||
escape=False |
|
||||
EndIf |
|
||||
Done |
|
||||
EndProc |
|
||||
|
|
||||
Proc makeNewRule(Pchar r, string mac[] ) |
|
||||
Begin |
|
||||
/* substitutes "1"..."9", uses "0" as escape character*/ |
|
||||
char c; |
|
||||
int i,j; |
|
||||
Bool escape; |
|
||||
Strbig(Llen,s); |
|
||||
/*-StartProc-*/ |
|
||||
escape=False; |
|
||||
For i=0; i<length(r); Inc(i) Do |
|
||||
c=r[i]; |
|
||||
j= (int)(c-'0'); |
|
||||
If j==0 Then |
|
||||
escape=True /*And skip*/ |
|
||||
ElsIf ((j>0) And (j<nargs)) And (Not escape) Then |
|
||||
sadd(s,mac[j]) |
|
||||
Else |
|
||||
cadd(s,c); escape=False |
|
||||
EndIf |
|
||||
Done |
|
||||
isr= addSubList(s,isr) |
|
||||
EndProc |
|
||||
|
|
||||
Proc translate(Pchar bff) |
|
||||
Begin /*light version, inside recursion only */ |
|
||||
Bool done; |
|
||||
Strbig(Llen,bf); |
|
||||
Darray(mac, string, nargs) |
|
||||
Bool ok; |
|
||||
int i,sm; |
|
||||
char lastBf1; |
|
||||
Word nbrep; |
|
||||
/*-StartProc-*/ |
|
||||
For i=0; i<nargs; Inc(i) Do |
|
||||
Sini(mac[i]) |
|
||||
Done |
|
||||
nbrep=0; |
|
||||
done= Zero(bff[0]); |
|
||||
lastBf1=' '; |
|
||||
If Not done Then scopy(bf,bff) EndIf |
|
||||
While Not done Do |
|
||||
i=1; |
|
||||
ok=False; sm=0; |
|
||||
While (i<=isr) And (Not ok) Do /*search For 1st match*/ |
|
||||
If (srule[i]=='m') Or (srule[i]=='u') Then |
|
||||
If alfa(lastBf1) And (alfa(search[i][0])) Then |
|
||||
sm=0 /*inside word*/ |
|
||||
Else |
|
||||
sm= isMacro(search[i], srule[i], bf, (int)0,mac) |
|
||||
EndIf |
|
||||
Else |
|
||||
sm=similar(search[i],wildcard[i],bf, (int)0, mac) |
|
||||
EndIf |
|
||||
ok=sm>0; |
|
||||
If ok And (srule[i]=='w') Then |
|
||||
ok=nonAlfa(lastBf1) And nonAlfa(bf[sm]) |
|
||||
EndIf |
|
||||
If Not ok Then Inc(i) EndIf |
|
||||
Done |
|
||||
If ok Then |
|
||||
If (srule[i]=='m') Or (srule[i]=='u') Then |
|
||||
macroOut(replace[i], mac) |
|
||||
Else |
|
||||
echoOut(replace[i],wildcard[i], mac) |
|
||||
EndIf |
|
||||
lastBf1=bf[sm-1]; pscopy(bf,bf, (Word)(sm+1), (Word)255); |
|
||||
Inc(nbrep); |
|
||||
Else |
|
||||
lastBf1=bf[0]; |
|
||||
washchar(lastBf1); |
|
||||
pscopy(bf,bf, (Word)2, (Word)255); |
|
||||
EndIf |
|
||||
done= Zero(bf[0]) |
|
||||
Done |
|
||||
EndProc |
|
||||
|
|
||||
Proc translator( Pchar fname) |
|
||||
/* checks list of possible substitution rules sequentially. |
|
||||
Does the first that matches. Option: recursion. |
|
||||
BUG: is very slow. |
|
||||
*/ |
|
||||
Begin |
|
||||
Strbig(Llen, outname); Strbig(Llen,bf); |
|
||||
Bool done; |
|
||||
Darray( mac, string, nargs) |
|
||||
Pfile fin; |
|
||||
Bool ok; |
|
||||
int i,sm, exclusion, idot; |
|
||||
char c,lastBf1; |
|
||||
Word nbrep,nline; |
|
||||
/*-StartProc-*/ |
|
||||
For i=0; i<nargs; Inc(i) Do |
|
||||
Sini(mac[i]) |
|
||||
Done |
|
||||
nbrep=0; |
|
||||
nline=0; |
|
||||
exclusion=0; /* will be >0 if an exclusion rule is active */ |
|
||||
fin=fopen( fname, "rb"); |
|
||||
scopy(outname, fname); |
|
||||
idot= cpos('.',outname); |
|
||||
If idot <= 8 Then /* room for underbar prefix, even in Ms-dos */ |
|
||||
cins(outname,'_') |
|
||||
ElsIf NotZ(outname[0]) Then /* just erase first char */ |
|
||||
outname[0] = '_' |
|
||||
Else |
|
||||
scopy(outname,"washprog.out") |
|
||||
EndIf |
|
||||
fout=fopen( outname,"wb"); |
|
||||
washinit(); |
|
||||
done= (fin == Null) Or (fout == Null); |
|
||||
scopy(bf,""); |
|
||||
lastBf1=' '; |
|
||||
/* lookmax=80; handle a line maximum ! */ |
|
||||
While Not done Do |
|
||||
c=' '; |
|
||||
While (c !=0) And (length(bf)<lookmax) Do /*refill buffer*/ |
|
||||
If Not feof(fin) Then |
|
||||
c=fgetc(fin); |
|
||||
If (c== Cr) Or (c== Lf) Then |
|
||||
Inc(nline); |
|
||||
If odd(nline) Then wc('.') EndIf |
|
||||
If (nline Mod 150)==0 Then wln() EndIf |
|
||||
EndIf |
|
||||
If (c==0) Or feof(fin) Then c=' ' EndIf /*== space*/ |
|
||||
Else |
|
||||
c=0 |
|
||||
EndIf |
|
||||
If NotZ(c) Then cadd(bf,c) EndIf |
|
||||
Done |
|
||||
ok=False; |
|
||||
sm=0; i=0; |
|
||||
If exclusion>0 Then |
|
||||
i=exclusion; |
|
||||
sm=similar(replace[i], (char)0, bf, (int)0, mac); |
|
||||
ok= sm>0 |
|
||||
EndIf |
|
||||
If Zero(exclusion) Then |
|
||||
i=1; |
|
||||
While (i<=isr) And (Not ok) Do /*search for 1st match*/ |
|
||||
If (srule[i]=='m') Or (srule[i]=='u') Or (srule[i]=='a') Then |
|
||||
If alfa(lastBf1) And (alfa(search[i][0])) Then |
|
||||
sm=0 /*inside word*/ |
|
||||
Else |
|
||||
sm= isMacro(search[i], srule[i], bf, (int)0,mac) |
|
||||
EndIf |
|
||||
Else |
|
||||
sm=similar(search[i],wildcard[i],bf, (int)0, mac) |
|
||||
EndIf |
|
||||
ok=sm>0; |
|
||||
If ok And (srule[i]=='w') Then |
|
||||
ok=nonAlfa(lastBf1) And nonAlfa(bf[sm]) |
|
||||
EndIf |
|
||||
If Not ok Then Inc(i) EndIf |
|
||||
Done |
|
||||
EndIf |
|
||||
If ok Then |
|
||||
If (srule[i]=='m') Or (srule[i]=='u') Then |
|
||||
macroOut(replace[i], mac) |
|
||||
ElsIf srule[i]=='x' Then |
|
||||
If Zero(exclusion) Then |
|
||||
exclusion=i |
|
||||
Else |
|
||||
exclusion=0 |
|
||||
EndIf |
|
||||
ElsIf srule[i]=='a' Then |
|
||||
makeNewRule(replace[i],mac) |
|
||||
Else |
|
||||
echoOut(replace[i],wildcard[i],mac) |
|
||||
EndIf |
|
||||
lastBf1=bf[sm-1]; pscopy(bf,bf, (Word)(sm+1), (Word)lookmax); |
|
||||
Inc(nbrep); |
|
||||
Else |
|
||||
lastBf1=bf[0]; |
|
||||
If Zero(exclusion) Then washchar(lastBf1) EndIf; |
|
||||
pscopy(bf,bf, (Word)2, (Word)lookmax); |
|
||||
/*avoid this time-consuming buffer shuffling ?*/ |
|
||||
EndIf |
|
||||
done= Zero(bf[0]); |
|
||||
Done |
|
||||
If fout !=Null Then |
|
||||
washflush(); |
|
||||
fputc('\n', fout); |
|
||||
fclose(fout) |
|
||||
EndIf |
|
||||
If fin !=Null Then fclose(fin) EndIf |
|
||||
ws("Lines: "); wi(nline); |
|
||||
ws(" Replacements: "); |
|
||||
wi(nbrep); wln(); |
|
||||
EndProc |
|
||||
|
|
||||
Func int main( int argc, Pchar argv[]) |
|
||||
Begin |
|
||||
Str(80,dico); |
|
||||
int istart= 1; |
|
||||
Bool ok= True; |
|
||||
/*-StartProc-*/ |
|
||||
allocdata(); |
|
||||
scopy(dico,"downgrad"); /* default rules file */ |
|
||||
ws(" washprog: A text substitution utility"); wln(); |
|
||||
If (argc>2) And steq(argv[1],"-r") Then |
|
||||
scopy(dico,argv[2]); |
|
||||
istart= 3; |
|
||||
/* |
|
||||
Else |
|
||||
ws("Dictionary file (.TXT automatic): "); |
|
||||
rln(dico); |
|
||||
*/ |
|
||||
EndIf |
|
||||
If spos(".txt",dico) <=0 Then |
|
||||
sadd(dico,".txt") |
|
||||
EndIf |
|
||||
ok= getSubList(dico); /*list of substitution rules */ |
|
||||
While ok And (istart< argc) Do |
|
||||
If argv[istart][0] != '_' Then /* leading underbar not accepted */ |
|
||||
translator( argv[istart]) |
|
||||
EndIf |
|
||||
Inc(istart) |
|
||||
Done |
|
||||
return 0 |
|
||||
EndFunc |
|
||||
|
|
||||
Write
Preview
Loading…
Cancel
Save
Reference in new issue