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