; lexical scanner
; show how to write a scanner using getchar() (sys 4) 12 July 2010

; ------- lib ------------

(def != (a b) () (if (= a b) 0 1))
(def ge (a b) () (if (< a b) 0 1))
(def le (a b) () (if (> a b) 0 1))
(def nop () () 0)
(def print a () (sys 1 a))
(def printc c () (sys 2 c))
(def space () () (sys 2 32))
(def nl () () (sys 2 10))
(def getchar () () (sys 4))      ; new sys, use with nvm34

; -------- header ----------

(enum 0 NIL)
(enum 40 LP RP)
(enum 32 SP)
(enum 34 QUOTE)
(enum 35 HASH)
(enum 10 NL)

; --------- string ----------

; input output of string functions are pointers
; to dereference it, use (vec s 0)

; print string
(def prstr s ()
  (while (vec s 0)
    (do
    (printc (vec s 0))
    (set s (+ s 1)))))

(def isspace c ()		; check c is space or newline
  (if (= c SP) 1
  (if (= c NL) 1
  0 )))

(def isdelim c ()		; delimiters are space, (, )
  (if (= c SP) 1
  (if (= c LP) 1
  (if (= c RP) 1
  (if (= c NL) 1
  0 )))))

; copy s1[a]..s1[b-1]  to s2
(def copyn (s2 s1 a b) (i)
  (do
  (set i 0)
  (while (< a b)
    (do
    (setv s2 i (vec s1 a))
    (set i (+ i 1))
    (set a (+ a 1))))
  (setv s2 i 0)))

; ----------------------

(let inbuf tok idx)

(def tokenise () (c st be)
  (do
  (set st 1)				; initial state
  (set be idx)
  (while (!= st 4)
    (do
    (set c (vec inbuf idx))
;    (printc c)
    (set idx (+ idx 1))
    (if (= st 1)
      (do
      (set be (- idx 1))
      (if (isspace c) (nop)
      (if (= c LP) (set st 4)
      (if (= c RP) (set st 4)
      (if (= c QUOTE) (set st 3)
      ; else
      (set st 2))))))
    (if (= st 2)
      (if (isdelim c)
        (do
        (set idx (- idx 1))   ; unget
        (set st 4)))
    (if (= st 3)
      (if (= c QUOTE)
        (set st 4)))))))
  (copyn tok inbuf be idx)))

(def testtok () ()
  (do
  (tokenise)
  (while (!= (vec tok 0) HASH)
    (do
    (prstr tok)
    (space)
    (tokenise)))))

; read the whole stdin into buf at once, terminate with #b
(def readfile buf (c)
  (do
  (set c (getchar))
  (while (ge c 0)      ; not EOF
    (do
    (setv buf 0 c)
    (set buf (+ buf 1))
    (set c (getchar))))
  (setv buf 0 HASH)      ; # b, end of input
  (setv buf 1 SP)))

(def printbuf buf (c)
  (do
  (set c (vec buf 0))
  (while (!= c HASH)     ; #, end of input
    (do
    (printc c)
    (set buf (+ buf 1))
    (set c (vec buf 0))))))

(def main () ()
  (do
  (set inbuf (new 1000))
  (set tok (new 100))
  (readfile inbuf)
  (set idx 0)
;  (printbuf inbuf)
;  (copyn tok inbuf 200 220)
;  (prstr tok)
  (testtok)
  ))

;  End