Amiga ISO Collection/AmigaUtilCD2.iso/Programming/E/TFF-A32R.LZX/AmigaE3.2a/Src/Lang/Elex.e

Text File | 1992-09-02 | 5.1 KB | 194 lines

-> Tiny E Lexical Analyzer. Of little use sofar, but nice example

OPT REG=5

MODULE 'tools/ctype', 'tools/file', 'class/hash'

DEF src_begin=NIL, src_size, src_end, p:PTR TO CHAR, curline=1, x=" ",y,
    keyhash:PTR TO hashtable,keylist:PTR TO LONG

ENUM NONE,ER_GARBAGE,ER_STRING,ER_COMMENT

OBJECT keylink OF hashlink
  token:INT
ENDOBJECT

PROC main() HANDLE
  WriteF('Tiny E Lexical Analyzer (c) 1994 Wouter\n')
  src_begin,src_size:=readfile(arg)
  src_end:=(p:=src_begin)+src_size
  lex_keys()
  WHILE x<>256
    IF x<256
      WriteF('\c ',x)
    ELSEIF x>512
      WriteF('\s ',{x}+2)
    ELSEIF x>=300
      WriteF('{\s} ',keylist[x-300])
    ELSEIF x=260
      WriteF('"\s" ',y)
    ELSE
      WriteF('\d ',x-256)
    ENDIF
    x,y:=lex()
  ENDWHILE
  WriteF('\n')
EXCEPT DO
  IF src_begin THEN freefile(src_begin)
  SELECT exception
    CASE NONE;   WriteF('no errors.\n')
    CASE "OPEN"; WriteF('no file!\n')
    CASE "MEM";  WriteF('no mem!\n')
    DEFAULT;     printerr(exception)
  ENDSELECT
ENDPROC

PROC printerr(n)
  DEF ers[200]:STRING,pos,a,b,e
  b:=e:=p
  WHILE b[]--<>"\n" DO NOP
  b++
  WHILE e[]<>"\n" DO e++
  StrCopy(ers,b,e-b)
  pos:=p-b-1
  WriteF('\nERROR: \s\nLINE: \d\n\s\n',
    ListItem([
      '',
      'garbage in line',
      'unmatched \a or \q',
      'unmatched */',
      '',
      '',
      ''
    ],n),curline,ers)
  IF pos>0 THEN FOR a:=1 TO pos DO WriteF(' ')
  WriteF('^\n')
ENDPROC

/*----------------------------LEX-----------------------------------*/

ENUM LEX_EOF=256,
     LEX_EOL,
     LEX_INTEGER,
     LEX_FLOAT,
     LEX_IDENT,
     LEX_STRINGA,
     LEX_STRINGQ


->   ; , := + - * / = > < >= <= <> ( ) : { } [ ] ^ . ` ! | ++ -- <=> :: /* */ ->


PROC lex()
  DEF a,b,c,d,l:PTR TO keylink
  LOOP
    SELECT 256 OF c:=p[]++
      CASE ",","*","=","(",")","{","}","[","]","^",".","`","!","|"
        RETURN c
      CASE "+"
        RETURN IF p[]="+" THEN p++ BUT "++" ELSE "+"
      CASE "-"
        IF (c:=p[])=">"
          WHILE p[]++<>"\n"
          ENDWHILE
          curline++
        ELSEIF c="-"
          p++
          RETURN "--"
        ELSE
          RETURN "-"
        ENDIF
      CASE "/"
        IF p[]<>"*" THEN RETURN "/"
        p++
        a:=1
        b:=p; d:=curline
        REPEAT
          IF (c:=b[]++)="/"
            IF b[]="*" THEN b++ BUT a++
          ELSEIF c="*"
            IF b[]="/" THEN b++ BUT a--
          ELSEIF c="\n"
           IF b>src_end THEN Raise(ER_COMMENT)
           d++
          ENDIF
        UNTIL a=0
        p:=b
        curline:=d
      CASE ">"
        RETURN IF p[]="=" THEN p++ BUT ">=" ELSE ">"
      CASE "<"
        IF (c:=p[])="="
          p++
          RETURN IF p[]=">" THEN p++ BUT "<=>" ELSE "<="
        ELSEIF c=">"
          p++
          RETURN "<>"
        ELSE
          RETURN "<"
        ENDIF
      CASE ":"
        RETURN IF (c:=p[])=":" THEN p++ BUT "::" ELSE IF c="=" THEN p++ BUT ":=" ELSE ":"
      CASE ";","\n"
        IF p>src_end THEN RETURN (p:=src_end) BUT LEX_EOF
        curline++
        WriteF('\n[\d] ',curline)
        RETURN LEX_EOL        -> conditional
      CASE " ", "\t"
        /* whitespace, do nothing */
      CASE "0" TO "9", "$", "%"
        a,b:=Val(p-1)
        IF b=0 THEN RETURN c
        p:=p+b-1
        RETURN LEX_INTEGER, a
      CASE "a" TO "z", "A" TO "Z", "_"
        a:=p-1; c:=p[]
        WHILE isalnum(c) OR (c="_") DO p++ BUT c:=p[]
        IF l:=keyhash.find(a,p-a) THEN RETURN l.token
        NEW b[c:=p-a+1]
        AstrCopy(b,a,c)
        RETURN LEX_IDENT,b
      CASE "\q", "\a"
        a:=p
        WHILE (a[]<>c) AND (a[]<>"\n") DO a++
        IF a[]="\n" THEN Raise(ER_STRING)
        b:=p
        p:=a+1
        RETURN IF c="\a" THEN LEX_STRINGQ ELSE LEX_STRINGA, b
      DEFAULT
        Raise(ER_GARBAGE)
    ENDSELECT
  ENDLOOP
ENDPROC

ENUM K_PROC=300,K_ENDPROC,K_IF,K_ENDIF,K_VOID,K_WHILE,K_ENDWHILE,K_FOR,
     K_ENDFOR,K_SELECT,K_CASE,K_DEFAULT,K_ENDSELECT,K_REPEAT,K_UNTIL,
     K_JUMP,K_DEF,K_ELSE,K_INCBIN,K_LONG,K_INT,K_CHAR,K_INC,K_DEC,K_THEN,
     K_LOOP,K_ENDLOOP,K_DO,K_AND,K_OR,K_CONST,K_OPT,K_MODULE,K_STACK,
     K_EXIT,K_LARGE,K_ASM,K_NOWARN,K_TO,K_STEP,K_ARRAY,K_STRING,K_DIR,
     K_PTR,K_OF,K_ELSEIF,K_LIST,K_OBJECT,K_ENDOBJECT,K_SIZEOF,K_RETURN,
     K_OSVERSION,K_ENUM,K_SET,K_BUT,K_HANDLE,K_EXCEPT,K_RAISE,K_EXPORT,
     K_REG,K_END,K_IS,K_NEW,K_PUBLIC,K_PRIVATE,K_SUPER

PROC lex_keys()
  DEF a,b,h,kl:PTR TO keylink,dat,datl
  NEW keyhash.hashtable(HASH_NORMAL)
  keylist:=[
    'PROC','ENDPROC','IF','ENDIF','VOID','WHILE','ENDWHILE','FOR',
    'ENDFOR','SELECT','CASE','DEFAULT','ENDSELECT','REPEAT','UNTIL',
    'JUMP','DEF','ELSE','INCBIN','LONG','INT','CHAR','INC','DEC','THEN',
    'LOOP','ENDLOOP','DO','AND','OR','CONST','OPT','MODULE','STACK',
    'EXIT','LARGE','ASM','NOWARN','TO','STEP','ARRAY','STRING','DIR',
    'PTR','OF','ELSEIF','LIST','OBJECT','ENDOBJECT','SIZEOF','RETURN',
    'OSVERSION','ENUM','SET','BUT','HANDLE','EXCEPT','RAISE','EXPORT',
    'REG','END','IS','NEW','PUBLIC','PRIVATE','SUPER'
  ]
  FOR a:=0 TO ListLen(keylist)-1
    datl:=StrLen(dat:=keylist[a])
    b,h:=keyhash.find(dat,datl)
    NEW kl
    kl.token:=a+K_PROC
    keyhash.add(kl,h,dat,datl)
  ENDFOR
ENDPROC