losp filter in C

.gitignore

*.log
losp_filter
*.o
*~
.\#*
\#*
*.lsp

losp_filter.c

#include<stdio.h>
#include<stdlib.h>
#include<unistd.h>
#include<string.h>
#define ERR1(i,l,c) fprintf(stderr,"%s:%d:%d Indent Err\n",i,l,c),exit(1)
//enum { D='{', U='}', R='<', L='>' };
enum { D='(', U=')', R='(', L=')' };
int prvn=0,nxtn=0,prvs=0,nxts=0,arr[99]={0},len=1,cnt=0,X=0;
char*_,c,d,endb[99],prvb[99]="",nxtb[99],*prv=prvb,*nxt=nxtb,*I=0,*O=0,*E=0;
char*has(char*a,char*b){while(*b)if((_=index(a,*b++)))break;return _;}
void process(int n){if(!*prv) return; c=D,d=';';
  for(prvs=nxts,nxts=0;nxt[nxts]==' ';nxts++);
  if (prvs<nxts) arr[len++]=nxts; else c=R,d=L;
  for(cnt=0; len>=0 && nxts<arr[len-1]; len--) cnt++;
  for(int n=0; n<cnt; n++) endb[n]=U; endb[cnt]=0;
  if ((has(prv,"'`:;\"0123456789")) && _-prv == prvs) c=d=' ';
  if (len<0||nxts!=arr[len-1]) ERR1(I?I:"-",nxtn,arr[len-1]);
  printf("%c%s%c%s\n",c,prv,d,endb);}
int main (int c,char*v[]){ (v[1]?stdin =fopen(I=v[1], "r"),
			    v[2]?stdout=fopen(O=v[2], "w"),
			    v[3]?stderr=fopen(E=v[3], "a"):0:0:0);
  setbuf(stdout,0); setbuf(stderr,0);
  while(++nxtn,fgets(nxt,99,stdin))
    if (nxt[0]!='\n' && !(nxt[strlen(nxt)-1]=0) && *nxt)
      process(0), prvn=nxtn, _=prv, prv=nxt, nxt=_;
  {strcpy(nxt,";"); process(0); if (X&&O) unlink(O);}}

losp_filter.losp

defvar _ nil
defvar arr  (list 0 )
defvar cnt  0
defvar prvn 0
defvar nxtn 0
defvar prvs 0
defvar nxts 0
defvar pfxt ""
defvar sfxt ""
defvar prvt ""
defun ne (a b)
  not (eq a b)
defun empty (s)
  eq (length s) 0
defun nonempty (s)
  > (length s) 0
defun c (s)
  elt s 0
defun clip (s)
  string-right-trim (format nil " 	~%") s
defun read-next-line ()
  read-line *standard-input* nil nil
defun concats (rest)
  concatenate 'string rest
defun replaces (prvt ss s2)
  if (search (concats ss) prvt)
    format nil "~a~a~a"
      subseq prvt 0  (search ss prvt)
      values s2
      subseq prvt (+ (search ss prvt) 2)
    values prvt
defmacro _nfx (&rest rest)
  if (eq (length rest) 1)    ` ,(car rest)
    if (eq (length rest) 2)  ` ( ,@rest )
      if t                   ` ( ,(cadr rest) ,(car rest) ,@(cadr rest) )
defvar listx (concats (list (c "(") (c "l") (c "i") (c "s") (c "t") (c " ") ))
defvar nfx   (concats (list (c "(") (c "_") (c "n") (c "f") (c "x") (c " ") ))
defvar end1  (concats (list (c " ") (c ")") ))
defvar end2  (concats (list (c " ") (c " ") (c ")") ))
defvar sep   (concats (list (c ")") (c "(") ))
defun proc (nxtt)
  when (nonempty prvt)
    setf prvt (replaces prvt (list (c " ") (c "]") ) end1)
    setf prvt (replaces prvt (list (c "[") (c " ") ) listx)
    setf prvt (replaces prvt (list (c "{") (c " ") ) nfx)
    setf prvt (replaces prvt (list (c " ") (c "]") ) end2)
    setf prvt (replaces prvt (list (c ";") (c ";") ) sep)
    loop
      :initially (setf prvs nxts)
      :initially (setf nxts 0)
      :while     (eq (elt nxtt nxts) (c " "))
      :do        (incf nxts)
    setf pfxt "("
    when (< prvs nxts)
      push nxts arr
    loop
      :initially (setf cnt 0)
      :while     (< nxts (car arr))
      :do        (pop arr)
      :do        (incf cnt)
    loop
      :initially (setf sfxt nil)
      :for       n from 0 below cnt
      :do        (push (c ")") sfxt)
    if
      or
        eq (elt prvt prvs) (c ":")
        eq (elt prvt prvs) (c ";")
        eq (elt prvt prvs) (c "`")
        eq (elt prvt prvs) (c "\"")
      progn
        setq pfxt " "
        push (c " ") sfxt
      if (>= prvs nxts)
        push (c ")") sfxt
        push (c ";") sfxt
    if (ne nxts (car arr))
      ferror "Indent Err~%" nxtn (car arr)
    format t "~a~a~a~%" pfxt prvt (concats sfxt)
defun main ()
  loop
    :while   (setf nxtt (read-next-line))
    :do      (incf nxtn)
    :do      (clip nxtt)
    :when    (nonempty nxtt) :do (proc nxtt)(setf prvn nxtn)(rotatef prvt nxtt)
    :finally (proc ";")
main

Makefile

all: clean losp_filter losp_filter.diff q.zzz ; diff q.zzz losp_filter.lsp
diff: all losp_filter.diff
%.diff: %.lsp %.zzz; diff $^
%.zzz: %.losp ; clisp losp_filter.lsp <$< >$@
clean: ; rm -fr losp_filter *~ *.o *.lsp ? *~ .*~ \#* .\#* *.num *.zzz *.lzp
%.num: % ; cat -n <$< >$@
%.lsp: %.losp; ./losp_filter $< $@
qq.losp: losp_filter.losp
	perl -npe 's/\(list /[ /g; s/ \)/ ]/g; s/\)\(/ -->> /g;' $<>$@

q.losp

defvar _ nil
defvar arr  (list 0 )
defvar cnt  0
defvar prvn 0
defvar nxtn 0
defvar prvs 0
defvar nxts 0
defvar pfxt ""
defvar sfxt ""
defvar prvt ""
defun ne (a b)
  not (eq a b)
defun empty (s)
  eq (length s) 0
defun nonempty (s)
  > (length s) 0
defun c (s)
  elt s 0
defun clip (s)
  string-right-trim (format nil " 	~%") s
defun read-next-line ()
  read-line *standard-input* nil nil
defun concats (rest)
  concatenate 'string rest
defun replaces (prvt ss s2)
  if (search (concats ss) prvt)
    format nil "~a~a~a"
      subseq prvt 0  (search ss prvt)
      values s2
      subseq prvt (+ (search ss prvt) 2)
    values prvt
defmacro _nfx (&rest rest)
  if (eq (length rest) 1)    ` ,(car rest)
    if (eq (length rest) 2)  ` ( ,@rest )
      if t                   ` ( ,(cadr rest) ,(car rest) ,@(cadr rest) )
defvar listx (concats (list (c "(") (c "l") (c "i") (c "s") (c "t") (c " ") ))
defvar nfx   (concats (list (c "(") (c "_") (c "n") (c "f") (c "x") (c " ") ))
defvar end1  (concats (list (c " ") (c ")") ))
defvar end2  (concats (list (c " ") (c " ") (c ")") ))
defvar sep   (concats (list (c ")") (c "(") ))
defun proc (nxtt)
  when (nonempty prvt)
    setf prvt (replaces prvt (list (c " ") (c "]") ) end1)
    setf prvt (replaces prvt (list (c "[") (c " ") ) listx)
    setf prvt (replaces prvt (list (c "{") (c " ") ) nfx)
    setf prvt (replaces prvt (list (c " ") (c "]") ) end2)
    setf prvt (replaces prvt (list (c ";") (c ";") ) sep)
    loop
      :initially (setf prvs nxts)
      :initially (setf nxts 0)
      :while     (eq (elt nxtt nxts) (c " "))
      :do        (incf nxts)
    setf pfxt "("
    when (< prvs nxts)
      push nxts arr
    loop
      :initially (setf cnt 0)
      :while     (< nxts (car arr))
      :do        (pop arr)
      :do        (incf cnt)
    loop
      :initially (setf sfxt nil)
      :for       n from 0 below cnt
      :do        (push (c ")") sfxt)
    if
      or
        eq (elt prvt prvs) (c ":")
        eq (elt prvt prvs) (c ";")
        eq (elt prvt prvs) (c "`")
        eq (elt prvt prvs) (c "\"")
      progn
        setq pfxt " "
        push (c " ") sfxt
      if (>= prvs nxts)
        push (c ")") sfxt
        push (c ";") sfxt
    if (ne nxts (car arr))
      ferror "Indent Err~%" nxtn (car arr)
    format t "~a~a~a~%" pfxt prvt (concats sfxt)
defun main ()
  loop
    :while   (setf nxtt (read-next-line))
    :do      (incf nxtn)
    :do      (clip nxtt)
    :when    (nonempty nxtt) :do (proc nxtt)(setf prvn nxtn)(rotatef prvt nxtt)
    :finally (proc ";")
main